Back to home page

Project CMSSW displayed by LXR

 
 

    


File indexing completed on 2021-02-14 13:29:54

0001 C-+++++++++++++++++++++++++++++++++++++++++++++++++++++++++

0002 C- Version EDDE 2.1.2 /R.Ryutin,A.Sobol ++++++++++++++++++++++

0003 C-+++++++++++++++++++++++++++++++++++++++++++++++++++++++++

0004 C-+++++++++++++++++++++++++++++++++++++++++++++++++++++++++

0005       PROGRAM  MAIN 
0006       IMPLICIT DOUBLE PRECISION(A-H, O-Z)
0007       IMPLICIT INTEGER(I-N)
0008 c-...global EDDE parameters

0009       INTEGER MXGLPAR      
0010       REAL EDDEPAR
0011       PARAMETER   (MXGLPAR=200)
0012       COMMON /EDDEGLPAR/ EDDEPAR(MXGLPAR)
0013 
0014 c-- initialization 

0015       CALL EDDEINI
0016 c

0017       NTOT=EDDEPAR(2)       
0018       DO NEV=1,NTOT
0019        CALL EDDEEVE
0020        IF(EDDEPAR(3).EQ.1) CALL EDDE_PYUPEV
0021 c       IF(EDDEPAR(3).EQ.1) CALL PYUPEV

0022        IF(NEV.LE.3)        CALL PYLIST(1)
0023       ENDDO 
0024 
0025 C...Final statistics.

0026       CALL PYSTAT(1)
0027 
0028 C...Produce final Les Houches Event File.

0029       IF(EDDEPAR(3).EQ.1) CALL PYLHEF
0030     
0031       STOP
0032       END            
0033 c--------------------------------------------------------------------

0034  
0035       SUBROUTINE EDDESW
0036 C...global EDDE parameters

0037       INTEGER     MXGLPAR      
0038       REAL EDDEPAR
0039       PARAMETER   (MXGLPAR=200)
0040       COMMON /EDDEGLPAR/ EDDEPAR(MXGLPAR)
0041 c

0042 c      CALL EDDEDEF

0043 
0044       RETURN
0045       END
0046 C

0047 c----------------------------------------------------------------------              

0048 c-*... EDDE initialization ! A.Sobol,R.Ryutin

0049 c----------------------------------------------------------------------              

0050       SUBROUTINE EDDEINI
0051       IMPLICIT DOUBLE PRECISION(A-H, O-Z)
0052       IMPLICIT INTEGER(I-N)
0053 C-... model parameters

0054       EXTERNAL EDDEDATA
0055 c-...global EDDE parameters

0056       INTEGER     MXGLPAR      
0057       REAL EDDEPAR
0058       PARAMETER   (MXGLPAR=200)
0059       COMMON /EDDEGLPAR/ EDDEPAR(MXGLPAR)
0060 c-...some EDDE variables

0061 c------ fundamental constants -----------------------------

0062       INTEGER NF,NC,NLOSW
0063       DOUBLE PRECISION PI,CSMB,LAMQCD,
0064      & TF,CF,BF0,BF1
0065       DOUBLE COMPLEX MNI,REI
0066       COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,
0067      & TF,CF,BF0,BF1,NF,NC,NLOSW    
0068 c------ parameters for soft rescattering (trajectories)----

0069 c------ (t1,t2,fi0 dependence) ----------------------------

0070       INTEGER NAPR,NFI
0071       DOUBLE PRECISION CP,DP,RP,RG,AP,
0072      &   T1MIN,T1MAX,T2MIN,T2MAX,FKK,CGP
0073       COMMON/EDDESOFT/ CP(3),DP(3),RP(3),RG(3),AP(3),
0074      &   T1MIN,T1MAX,T2MIN,T2MAX,FKK,CGP,NAPR,NFI 
0075 c----- parameters to calculate overall s-dependence -------

0076       DOUBLE PRECISION XI1MIN,XI2MIN,XI1MAX,XI2MAX
0077       COMMON/EDDETOT/ XI1MIN,XI2MIN,XI1MAX,XI2MAX
0078 c----- parameters for hard cross-sections -----------------

0079       DOUBLE PRECISION MGGCUT,ETJCUT,MXMAX,
0080      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,
0081      & PSIDD1,PSIDD2
0082       COMMON/EDDEHARD/ MGGCUT,ETJCUT,MXMAX,
0083      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,
0084      & PSIDD1,PSIDD2
0085 c--- restrictions on the phase space of g-jet ---

0086 c--- DER3J - max. angle between g-jet and parallel jet ----

0087 c--- XMAX3J - max ratio 2*Eg/MJJ --------------------------

0088 c--- parameters for 3g functions -----------------------------

0089       DOUBLE PRECISION DER3J,XMAX3J,PAR3G
0090       COMMON/EDDE3JP/ DER3J,XMAX3J,PAR3G(5)     
0091 c----- parameters to calculate total cross-sections -------      

0092 c----- RS1 parameters -------------------------------------

0093       INTEGER NRS0 
0094       DOUBLE PRECISION RSXI0,RSGAM0,RSMH0,RSMR0 
0095       COMMON/EDDERS1/ RSXI0,RSGAM0,RSMH0,RSMR0,NRS0
0096 c----- additional global parameters -----

0097       INTEGER KCP,IPROC
0098       DOUBLE PRECISION AM0,AMP,S,MQ
0099       COMMON/EDDEOTHER/ KCP,IPROC,AM0,AMP,S,MQ
0100 c-...some EDDE functions

0101       DOUBLE PRECISION EDDECS
0102 c-*...standard PYTHIA ( v. >= 6.2) commons for initialization

0103       EXTERNAL PYDATA
0104       INTEGER  PYCOMP
0105       COMMON /PYJETS/ N, NPAD, K(4000,5), P(4000,5), V(4000,5)
0106       COMMON /PYDAT1/ MSTU(200),PARU(200),MSTJ(200),PARJ(200)
0107       COMMON /PYDAT2/ KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
0108       COMMON /PYDAT3/ MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5)
0109       COMMON /PYSUBS/ MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200)
0110       COMMON /PYPARS/ MSTP(200),PARP(200),MSTI(200),PARI(200)
0111       COMMON /PYINT5/ NGENPD,NGEN(0:500,3),XSEC(0:500,3)
0112       COMMON /PYDATR/ MRPY(6),RRPY(100)  
0113 C-...User process initialization commonblock.

0114       INTEGER MAXPUP
0115       PARAMETER (MAXPUP=100)
0116       INTEGER IDBMUP,PDFGUP,PDFSUP,IDWTUP,NPRUP,LPRUP
0117       DOUBLE PRECISION EBMUP,XSECUP,XERRUP,XMAXUP
0118       COMMON/HEPRUP/IDBMUP(2),EBMUP(2),PDFGUP(2),PDFSUP(2),
0119      &IDWTUP,NPRUP,XSECUP(MAXPUP),XERRUP(MAXPUP),XMAXUP(MAXPUP),
0120      &LPRUP(MAXPUP)
0121       SAVE /HEPRUP/
0122 C      

0123       CALL EDDEDEF                ! Read default parameters for generation
0124 
0125       CALL EDDEPUTDAT ! to include the data
0126       CALL EDDETITLE ! title page for the generator
0127 
0128       AMP   =PMAS(PYCOMP(2212),1)                    !proton mass
0129 C--

0130 c      CALL PYINIT('USER','p','p',SQS)            !PYTHIA < 6.403

0131 C-...incoming protons                           !PYTHIA >= 6.404

0132        K(1,1)=11
0133        K(1,2)=2212
0134        P(1,1)=0.D0
0135        P(1,2)=0.D0
0136        P(1,4)=SQS/2       
0137        P(1,3)=DSQRT(P(1,4)**2 - AMP**2)
0138        P(1,5)=AMP 
0139        K(2,1)=11
0140        K(2,2)=2212
0141        P(2,1)=0.D0
0142        P(2,2)=0.D0
0143        P(2,4)=SQS/2  
0144        P(2,3)=-DSQRT(P(2,4)**2 - AMP**2) 
0145        P(2,5)=AMP 
0146        MSTP(127)=1
0147       CALL PYINIT('3MOM','p','p',SQS)            !PYTHIA >= 6.404
0148 c

0149 C

0150       MSUB(IPROC)=1
0151       PARI(1)   = EDDECS(IPROC)*1.D-12      ! cross section in mb
0152       PARI(7)   = 1.D0 
0153       IDBMUP(1) = 2212 
0154       IDBMUP(2) = 2212 
0155       EBMUP(1)  = SQS/2
0156       EBMUP(2)  = SQS/2
0157       IDWTUP    = 1
0158       IF(IPROC.EQ.440)   IDWTUP    = 3
0159       IF(IPROC.EQ.446)   IDWTUP    = 3  
0160       NPRUP     = 1
0161       LPRUP(1)  = IPROC
0162       XSECUP(1) = 1.D0 
0163       XMAXUP(1) = 1.D0 
0164       XSEC(IPROC,3) = PARI(1)
0165       NGEN(IPROC,3) = 0
0166       XSECUP(IPROC) = PARI(1)*1.D+09
0167       WRITE(*,*)' CS(',IPROC,')=',PARI(1)*1.D+12,' fb'
0168 
0169 cccccccccccccccccccccccccccccccccccccccccc

0170 C...Temporary files for initialization/event output.

0171       IF(EDDEPAR(3).EQ.1) THEN
0172        MSTP(161)=77
0173        OPEN(77,FILE='edde.init',STATUS='unknown')
0174        MSTP(162)=78
0175        OPEN(78,FILE='edde.evnt',STATUS='unknown')
0176 
0177 C...Final Les Houches Event File, obtained by combining above two.

0178        MSTP(163)=79
0179        OPEN(79,FILE='edde.lhe',STATUS='unknown')
0180 c      MSTP(164) = 1

0181        CALL EDDE_PYUPIN
0182 c      CALL PYUPIN

0183       ENDIF
0184 cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

0185 
0186       RETURN
0187       END
0188 c----------------------------------------------------------------------              

0189 c-*... read initual parameters from edde.ffr card file /A.Sobol

0190 c----------------------------------------------------------------------              

0191       SUBROUTINE EDDEDEF
0192       IMPLICIT DOUBLE PRECISION(A-H, O-Z)
0193       IMPLICIT INTEGER(I-N)
0194 c-...global EDDE parameters

0195       INTEGER     MXGLPAR      
0196       REAL EDDEPAR
0197       PARAMETER   (MXGLPAR=200)
0198       COMMON /EDDEGLPAR/ EDDEPAR(MXGLPAR)
0199 c-*...standard PYTHIA ( v. >= 6.2) commons for initialization

0200       EXTERNAL PYDATA
0201       COMMON /PYDAT1/ MSTU(200),PARU(200),MSTJ(200),PARJ(200)
0202       COMMON /PYDAT2/ KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
0203       COMMON /PYDAT3/ MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5)
0204       COMMON /PYSUBS/ MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200)
0205       COMMON /PYPARS/ MSTP(200),PARP(200),MSTI(200),PARI(200)
0206       COMMON /PYDATR/ MRPY(6),RRPY(100) 
0207 C

0208       EDDEPAR(1)=440  ! code of the process
0209       EDDEPAR(2)= 10000           ! number of events to generate
0210       EDDEPAR(3)= 1             ! key for Les Houches data(1-save,0-no) 
0211       EDDEPAR(4)=14000   ! pp centre mass energy in GeV 
0212       EDDEPAR(5)=25            ! code of the central particle M
0213       EDDEPAR(6)=120  ! mass in GeV of the central particle M
0214       EDDEPAR(7)=1   ! key for J^PC of the central particle
0215       EDDEPAR(8)=20  ! transverse mass cut
0216       EDDEPAR(9)=0   ! type of the central particle in RS1 model',

0217       EDDEPAR(10)=0.16 ! mixing parameter

0218       EDDEPAR(11)=0.246   ! scale parameter 

0219       EDDEPAR(12)=150   ! "bare" mass of Higgs

0220       EDDEPAR(13)=110   ! "bare" mass of Radion

0221       EDDEPAR(14)=10.1     ! pseudirapidity interval for "soft" radiation

0222       EDDEPAR(15)=4.8     ! mass of the final "hard" quark

0223         MRPY(1)=77123456          ! State of random number generator   

0224         MSEL =0                 !full user control

0225 C...some PYTHIA definitions...

0226         MSTP (61) =1             ! Initial-state QCD and QED radiation

0227         MSTP (71) =1             ! Final-state QCD and QED radiation

0228         MSTP (81) =1             ! multiple interaction

0229         MSTP (111)=1             ! fragmentation and decay

0230         MSTP (122)=0             ! switch off X section print out

0231 C...Higgs decay definition...

0232         MDME (210,1) =0           ! h0 -> d dbar

0233         MDME (211,1) =0           ! h0 -> u ubar

0234         MDME (212,1) =0           ! h0 -> s sbar

0235         MDME (213,1) =0           ! h0 -> c cbar

0236         MDME (214,1) =1           ! h0 -> b bbar 

0237         MDME (215,1) =0           ! h0 -> t tbar  

0238         MDME (216,1) =-1          ! h0 -> b' b'bar

0239         MDME (217,1) =-1          ! h0 -> t' t'bar

0240         MDME (218,1) =0           ! h0 -> e+e-

0241         MDME (219,1) =0           ! h0 -> mu+mu- 

0242         MDME (220,1) =0           ! h0 -> tau+tau-

0243         MDME (221,1) =-1          ! h0 -> tau'+ tau'-

0244         MDME (222,1) =0           ! h0 ->  gg 

0245         MDME (223,1) =0           ! h0-> gamma gamma

0246         MDME (224,1) =0           ! h0 -> gamma Z0  

0247         MDME (225,1) =0           ! h0 -> Z0 Z0  

0248         MDME (226,1) =0           ! h0 -> W+W-        

0249 C     

0250       RETURN

0251       END

0252 C

0253 c-!!+++++++++++++ EDDE2.1 SUBROUTINES ++++++++++++++++++++++++

0254 c------------------------------------------------------------- 

0255 C-++++++++++++++++++++++++++++++++++++++++++++++

0256 C- EDDE2.1: PYTHIA interface - event generation

0257 C-++++++++++++++++++++++++++++++++++++++++++++++

0258 c-----------------------------------------------------------------              

0259 c-*... event generation/A.Sobol,R.Ryutin

0260 c-----------------------------------------------------------------              

0261       SUBROUTINE EDDEEVE

0262       IMPLICIT DOUBLE PRECISION(A-H, O-Z)

0263       IMPLICIT INTEGER(I-N)

0264 

0265 c-*...standard PYTHIA ( v. >= 6.2) commons for initialization

0266 c      INTEGER PYCOMP

0267       COMMON /PYJETS/ NN, NPAD, KK(4000,5), PP(4000,5), VV(4000,5)

0268       COMMON /PYDAT2/ KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)

0269       COMMON /PYINT5/ NGENPD,NGEN(0:500,3),XSEC(0:500,3)

0270       COMMON /PYPARS/ MSTP(200),PARP(200),MSTI(200),PARI(200)

0271 c-...some of global EDDE variables

0272 c----- parameters for hard cross-sections -----------------

0273       DOUBLE PRECISION MGGCUT,ETJCUT,MXMAX,

0274      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

0275      & PSIDD1,PSIDD2

0276       COMMON/EDDEHARD/ MGGCUT,ETJCUT,MXMAX,

0277      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

0278      & PSIDD1,PSIDD2

0279 c----- additional global parameters -----

0280       INTEGER KCP,IPROC

0281       DOUBLE PRECISION AM0,AMP,S,MQ

0282       COMMON/EDDEOTHER/ KCP,IPROC,AM0,AMP,S,MQ

0283 c-...global EDDE parameters from FFR file

0284       INTEGER MXGLPAR

0285       REAL EDDEPAR

0286       PARAMETER   (MXGLPAR=200)

0287       COMMON /EDDEGLPAR/ EDDEPAR(MXGLPAR)

0288 

0289 c--- call the data one time from EDDEINI!!!

0290 c- CALL EDDEPUTDAT

0291 

0292 C-...incoming protons

0293        KK(1,1)=11

0294        KK(1,2)=2212

0295        PP(1,1)=0.D0

0296        PP(1,2)=0.D0

0297        PP(1,4)=SQS/2       

0298        PP(1,3)=DSQRT(PP(1,4)**2 - AMP**2)

0299        PP(1,5)=AMP 

0300        KK(2,1)=11

0301        KK(2,2)=2212

0302        PP(2,1)=0.D0

0303        PP(2,2)=0.D0

0304        PP(2,4)=SQS/2  

0305        PP(2,3)=-DSQRT(PP(2,4)**2 - AMP**2) 

0306        PP(2,5)=AMP 

0307      

0308 c      print*,'EDDEEVE',IPROC

0309 c       KDUMMY=IPROC

0310 

0311       IF(IPROC.EQ.440) CALL EDDERES              ! pp -> pHp (pH*p,pR*p)

0312       IF(IPROC.EQ.441) CALL EDDEQQ               ! pp -> p QQbar p, Q=b default

0313       IF(IPROC.EQ.442) CALL EDDEGG               ! pp -> p gg p

0314       IF(IPROC.EQ.443) CALL EDDE2GAM          ! pp -> p gammagamma p

0315       IF(IPROC.EQ.444) CALL EDDEQQG            ! pp -> p QQbarg g p

0316       IF(IPROC.EQ.445) CALL EDDE3G               ! pp -> p gg g p

0317 C- SEMI-INCLUSIVE ------ 

0318       IF(IPROC.EQ.446) CALL SIDDERES              ! pp -> p{X H Y}p (p{X H*,R* Y}p)

0319       IF(IPROC.EQ.447) CALL SIDDEQQ                ! pp -> p {X QQbar Y} p

0320       IF(IPROC.EQ.448) CALL SIDDEGG                ! pp -> p {X gg Y} p

0321       IF(IPROC.EQ.449) CALL SIDDE2GAM            ! pp -> p {X gammagamma Y} p

0322 C-- reserved for the future version

0323 C-      IF(IPROC.EQ.410) CALL SIDDEQQG          ! pp -> p {X QQbarg g Y} p

0324 C-      IF(IPROC.EQ.411) CALL SIDDE3G               ! pp -> p {X gg g Y} p

0325 C-      

0326       IF(IPROC.EQ.500) CALL EDDEFLAT           ! jet with flat E vs eta distr. 

0327 

0328       IF(EDDEPAR(3).NE.1) CALL PYEXEC

0329 

0330       RETURN

0331       END

0332       

0333 c----------------------------------------------------------------------              

0334 c-*...exclusive resonance generation /A.Sobol,R.Ryutin 

0335 c----------------------------------------------------------------------              

0336       SUBROUTINE EDDERES

0337       IMPLICIT DOUBLE PRECISION(A-H, O-Z)

0338       IMPLICIT INTEGER(I-N)

0339 c-*...standard PYTHIA ( v. >= 6.2) commons for initialization

0340 c      INTEGER PYCOMP

0341       COMMON /PYJETS/ NN, NPAD, KK(4000,5), PP(4000,5), VV(4000,5)

0342       COMMON /PYDAT2/ KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)

0343       COMMON /PYINT1/ MINT(400),VINT(400)

0344       COMMON /PYINT5/ NGENPD,NGEN(0:500,3),XSEC(0:500,3)

0345       COMMON /PYPARS/ MSTP(200),PARP(200),MSTI(200),PARI(200)

0346 c-...some of global EDDE variables

0347 c------ fundamental constants -----------------------------

0348       INTEGER NF,NC,NLOSW

0349       DOUBLE PRECISION PI,CSMB,LAMQCD,

0350      & TF,CF,BF0,BF1

0351       DOUBLE COMPLEX MNI,REI

0352       COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

0353      & TF,CF,BF0,BF1,NF,NC,NLOSW

0354 c------ parameters for soft rescattering (trajectories)----

0355 c------ (t1,t2,fi0 dependence) ----------------------------

0356       INTEGER NAPR,NFI

0357       DOUBLE PRECISION CP,DP,RP,RG,AP,

0358      &   T1MIN,T1MAX,T2MIN,T2MAX,FKK,CGP

0359       COMMON/EDDESOFT/ CP(3),DP(3),RP(3),RG(3),AP(3),

0360      &   T1MIN,T1MAX,T2MIN,T2MAX,FKK,CGP,NAPR,NFI 

0361 c----- parameters for hard cross-sections -----------------

0362       DOUBLE PRECISION MGGCUT,ETJCUT,MXMAX,

0363      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

0364      & PSIDD1,PSIDD2

0365       COMMON/EDDEHARD/ MGGCUT,ETJCUT,MXMAX,

0366      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

0367      & PSIDD1,PSIDD2

0368 c----- additional global parameters -----

0369       INTEGER KCP,IPROC

0370       DOUBLE PRECISION AM0,AMP,S,MQ

0371       COMMON/EDDEOTHER/ KCP,IPROC,AM0,AMP,S,MQ

0372       

0373  1    CONTINUE

0374       X=EDDEX(AM0)

0375       CALL EDDETTPHI(NFI,AM0,T1,T2,FI0) 

0376       DT12= DABS(T1)+DABS(T2)

0377       DT12= DT12+2.D0*DSQRT(DABS(T1)*DABS(T2))*DCOS(FI0)

0378       XF1 = 1.D0-X

0379       XF2 = 1.D0-(AM0*AM0+DT12)/S/X           

0380       IF(XF2.LE.0.OR.XF2.GT.1) GOTO 1

0381       IF(PYR(0).LE.0.5) THEN

0382         XSAVE=XF1

0383         XF1=XF2

0384         XF2=XSAVE

0385       ENDIF

0386 C-...scattered proton 1

0387       PZ  = PP(1,3)*XF1

0388       PT  = DSQRT(DABS(T1))

0389       FI  = 2.*PI*PYR(0)

0390       PX  = PT*DCOS(FI)

0391       PY  = PT*DSIN(FI)

0392       PP(3,1) = PX

0393       PP(3,2) = PY

0394       PP(3,3) = PZ

0395       PP(3,4) = DSQRT(PX**2+PY**2+PZ**2+AMP**2)

0396       PP(3,5) = AMP 

0397       KK(3,1) = 1

0398       KK(3,2) = 2212

0399       KK(3,3) = 1

0400 C-...scattered proton 2

0401       PZ  = PP(2,3)*XF2

0402       PT  = DSQRT(DABS(T2))

0403       PX  = PT*DCOS(FI+FI0)

0404       PY  = PT*DSIN(FI+FI0)

0405       PP(4,1) = PX

0406       PP(4,2) = PY

0407       PP(4,3) = PZ

0408       PP(4,4) = DSQRT(PX**2+PY**2+PZ**2+AMP**2)

0409       PP(4,5) = AMP 

0410       KK(4,1) = 1

0411       KK(4,2) = 2212

0412       KK(4,3) = 2 

0413 C-...central particle

0414       KK(5,1) = 1

0415       KK(5,2) = KCP

0416       KK(5,3) = 0 

0417       DO I=1,3

0418        PP(5,I)=-(PP(3,I)+PP(4,I))

0419       ENDDO

0420       PP(5,4) = DSQRT(PP(5,1)**2+PP(5,2)**2+PP(5,3)**2+AM0**2)

0421       PP(5,5) = AM0

0422       NN = 5 ! number of particles and systems 

0423       MINT(1)=440

0424 

0425       RETURN

0426       END        

0427 c----------------------------------------------------------------------              

0428 c-*... exclusive Q Qbar generation /A.Sobol,R.Ryutin

0429 c----------------------------------------------------------------------              

0430       SUBROUTINE EDDEQQ

0431       IMPLICIT DOUBLE PRECISION(A-H, O-Z)

0432       IMPLICIT INTEGER(I-N)

0433 c-*...standard PYTHIA ( v. >= 6.2) commons for initialization

0434 c      INTEGER PYCOMP

0435       COMMON /PYJETS/ NN, NPAD, KK(4000,5), PP(4000,5), VV(4000,5)

0436       COMMON /PYDAT2/ KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)

0437       COMMON /PYINT1/ MINT(400),VINT(400)

0438       COMMON /PYINT5/ NGENPD,NGEN(0:500,3),XSEC(0:500,3)

0439       COMMON /PYPARS/ MSTP(200),PARP(200),MSTI(200),PARI(200)

0440 c-...some of global EDDE variables

0441 c------ fundamental constants -----------------------------

0442       INTEGER NF,NC,NLOSW

0443       DOUBLE PRECISION PI,CSMB,LAMQCD,

0444      & TF,CF,BF0,BF1

0445       DOUBLE COMPLEX MNI,REI

0446       COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

0447      & TF,CF,BF0,BF1,NF,NC,NLOSW

0448 c------ parameters for soft rescattering (trajectories)----

0449 c------ (t1,t2,fi0 dependence) ----------------------------

0450       INTEGER NAPR,NFI

0451       DOUBLE PRECISION CP,DP,RP,RG,AP,

0452      &   T1MIN,T1MAX,T2MIN,T2MAX,FKK,CGP

0453       COMMON/EDDESOFT/ CP(3),DP(3),RP(3),RG(3),AP(3),

0454      &   T1MIN,T1MAX,T2MIN,T2MAX,FKK,CGP,NAPR,NFI 

0455 c----- parameters for hard cross-sections -----------------

0456       DOUBLE PRECISION MGGCUT,ETJCUT,MXMAX,

0457      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

0458      & PSIDD1,PSIDD2

0459       COMMON/EDDEHARD/ MGGCUT,ETJCUT,MXMAX,

0460      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

0461      & PSIDD1,PSIDD2

0462 c----- additional global parameters -----

0463       INTEGER KCP,IPROC

0464       DOUBLE PRECISION AM0,AMP,S,MQ

0465       COMMON/EDDEOTHER/ KCP,IPROC,AM0,AMP,S,MQ

0466 c----- for this subroutine -----------------------------------      

0467       DOUBLE PRECISION MTQ2,MXX,PQ1(5),PQ2(5),PMX(5),PVS(5)

0468       LOGICAL FIRST

0469       DATA FIRST /.TRUE./

0470       SAVE FIRST

0471 

0472       IF(FIRST) THEN

0473        IF((2*ETJCUT).LT.14.D0.OR.(2*ETJCUT).GT.300.D0) THEN

0474         PRINT*,'EDDEQQ:Attention: generator works in the ETcut'

0475         PRINT*,'range 7-150 GeV; you use the cut = ',ETJCUT

0476        ENDIF

0477       ENDIF     

0478 

0479   1   CONTINUE

0480       CALL GENEREXQQ(MQ,MXX,ETAJ)

0481 c--- sign of etaj

0482       IF (ETAJ.EQ.0.D0) THEN

0483        SIGNETA=0.D0

0484       ELSE

0485        SIGNETA=ETAJ/DABS(ETAJ)

0486       ENDIF 

0487 c---

0488       CALL EDDETTPHI(NFI,MXX,T1,T2,FI0) 

0489       DT12= DABS(T1)+DABS(T2)

0490       DT12= DT12+2.D0*DSQRT(DABS(T1)*DABS(T2))*DCOS(FI0)      

0491       PKAP = 1.D0/DCOSH(ETAJ)**2

0492       X1  = EDDEX(MXX)

0493       XF1 = 1.D0-X1

0494       X2  = (MXX*MXX+DT12)/(S*X1)

0495       XF2 = 1.D0-X2   

0496        IF(XF2.LE.0.OR.XF2.GT.1) GOTO 1

0497        IF(PYR(0).LE.0.5) THEN

0498         XSAVE=XF1

0499         XF1=XF2

0500         XF2=XSAVE

0501        ENDIF

0502       X1=1.D0-XF1

0503       X2=1.D0-XF2

0504 C-...scattered proton 1

0505       PZ  = PP(1,3)*XF1

0506       PT  = DSQRT(DABS(T1))

0507       FI  = 2.*PI*PYR(0)

0508       PX  = PT*DCOS(FI)

0509       PY  = PT*DSIN(FI)

0510       PP(3,1) = PX

0511       PP(3,2) = PY

0512       PP(3,3) = PZ

0513       PP(3,4) = DSQRT(PX**2+PY**2+PZ**2+AMP**2)

0514       PP(3,5) = AMP 

0515       KK(3,1) = 1

0516       KK(3,2) = 2212

0517       KK(3,3) = 1

0518 C-...scattered proton 2

0519       PZ  = PP(2,3)*XF2

0520       PT  = DSQRT(DABS(T2))

0521       PX  = PT*DCOS(FI+FI0)

0522       PY  = PT*DSIN(FI+FI0)

0523       PP(4,1) = PX

0524       PP(4,2) = PY

0525       PP(4,3) = PZ

0526       PP(4,4) = DSQRT(PX**2+PY**2+PZ**2+AMP**2)

0527       PP(4,5) = AMP 

0528       KK(4,1) = 1

0529       KK(4,2) = 2212

0530       KK(4,3) = 2 

0531 C-...

0532 C--- momentum of X-system in the lab ---------------------

0533 C--- and new value of MX ---------------------------------

0534       DO I=1,4   

0535        PMX(I)=PP(1,I)+PP(2,I)-PP(3,I)-PP(4,I)

0536       ENDDO

0537        PMX(5)=DSQRT(PMX(4)**2-PMX(1)**2-PMX(2)**2-PMX(3)**2)        

0538 c-was a BUG! new PKAP sometimes was >1,changed to if

0539        AUX1=PKAP

0540        PKAP=PKAP*MXX*MXX/(PMX(5)*PMX(5))

0541        IF (PKAP.GT.1.D0) THEN

0542         PKAP=AUX1

0543        ENDIF

0544        MXX=PMX(5)

0545        MTQ2 = MXX*MXX*PKAP/4.D0

0546 C-... QQbar system in the X-rest frame

0547 C-... parton1 - momentum

0548       PQ1(5) = PMAS(5,1)

0549       PT=DSQRT(MTQ2-PQ1(5)**2)

0550       FI  = 2.*PI*PYR(0)

0551       PQ1(1)=PT*DCOS(FI)

0552       PQ1(2)=PT*DSIN(FI)

0553       PQ1(3)=SIGNETA*MXX*DSQRT(1.D0-PKAP)/2.D0

0554       PQ1(4)=DSQRT(PQ1(1)**2+PQ1(2)**2+PQ1(3)**2+PQ1(5)**2) 

0555 C-... parton2 - momentum

0556       PQ2(5) = PMAS(5,1) 

0557       DO I=1,3

0558        PQ2(I)=-PQ1(I)

0559       ENDDO

0560       PQ2(4)=DSQRT(PQ2(1)**2+PQ2(2)**2+PQ2(3)**2+PQ2(5)**2)   

0561 C-... QQbar system in the lab. frame

0562 C-... lorentz transformation

0563       CALL XCMTOLAB(PMX,PQ1,PVS)

0564       DO I=1,5

0565        PQ1(I)=PVS(I)

0566       ENDDO      

0567       CALL XCMTOLAB(PMX,PQ2,PVS)

0568       DO I=1,5

0569        PQ2(I)=PVS(I)

0570       ENDDO

0571 C-... equal probability for Q and Qbar

0572       IF(PYR(0).LT.0.5) THEN

0573        DO I=1,5

0574         PVS(I)=PQ1(I)

0575         PQ1(I)=PQ2(I)

0576         PQ2(I)=PVS(I)

0577        ENDDO

0578       ENDIF       

0579 C-...Q - quark and Qbar quark in the lab. frame

0580       DO I=1,5

0581        PP(6,I)=PQ1(I)

0582        PP(7,I)=PQ2(I)

0583       ENDDO 

0584 C-...Q Qbar system and its decay products definition.

0585 C-...B Bbar by default (change to other numbers,

0586 C-... insert option to ffr-file!!!)

0587       DO I=1,4

0588        PP(5,I) = PP(6,I) + PP(7,I) 

0589       ENDDO

0590        PP(5,5) = DSQRT(PP(5,4)**2-PP(5,1)**2-PP(5,2)**2-PP(5,3)**2)

0591       DO I=1,5

0592        PQ1(I) = PP(6,I)  

0593        PQ2(I) = PP(7,I)  

0594       ENDDO

0595        CALL PY2ENT(-6,5,-5,PP(5,5)) 

0596       DO I=1,5

0597        PP(6,I) = PQ1(I)

0598        PP(7,I) = PQ2(I) 

0599       ENDDO

0600       NN=7

0601       KK(5,1)=11

0602       KK(5,2)=90 

0603       KK(5,3)=0

0604       KK(5,4)=6

0605       KK(5,5)=7

0606       KK(6,3)=5

0607       KK(7,3)=5

0608       MINT(1)=441

0609 c      CALL PYSHOW(6,7,PP(5,5)) 

0610 

0611       RETURN

0612       END

0613 c----------------------------------------------------------------------              

0614 c- *... exclusive g g generation /A.Sobol,R.Ryutin

0615 c----------------------------------------------------------------------              

0616       SUBROUTINE EDDEGG

0617       IMPLICIT DOUBLE PRECISION(A-H, O-Z)

0618       IMPLICIT INTEGER(I-N)

0619 c- *...standard PYTHIA ( v. >= 6.2) commons for initialization

0620 c      INTEGER PYCOMP

0621       COMMON /PYJETS/ NN, NPAD, KK(4000,5), PP(4000,5), VV(4000,5)

0622       COMMON /PYDAT2/ KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)

0623       COMMON /PYINT1/ MINT(400),VINT(400)

0624       COMMON /PYINT5/ NGENPD,NGEN(0:500,3),XSEC(0:500,3)

0625       COMMON /PYPARS/ MSTP(200),PARP(200),MSTI(200),PARI(200)

0626 

0627 c-...some of global EDDE variables

0628 c------ fundamental constants -----------------------------

0629       INTEGER NF,NC,NLOSW

0630       DOUBLE PRECISION PI,CSMB,LAMQCD,

0631      & TF,CF,BF0,BF1

0632       DOUBLE COMPLEX MNI,REI

0633       COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

0634      & TF,CF,BF0,BF1,NF,NC,NLOSW

0635 c------ parameters for soft rescattering (trajectories)----

0636 c------ (t1,t2,fi0 dependence) ----------------------------

0637       INTEGER NAPR,NFI

0638       DOUBLE PRECISION CP,DP,RP,RG,AP,

0639      &   T1MIN,T1MAX,T2MIN,T2MAX,FKK,CGP

0640       COMMON/EDDESOFT/ CP(3),DP(3),RP(3),RG(3),AP(3),

0641      &   T1MIN,T1MAX,T2MIN,T2MAX,FKK,CGP,NAPR,NFI 

0642 c----- parameters for hard cross-sections -----------------

0643       DOUBLE PRECISION MGGCUT,ETJCUT,MXMAX,

0644      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

0645      & PSIDD1,PSIDD2

0646       COMMON/EDDEHARD/ MGGCUT,ETJCUT,MXMAX,

0647      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

0648      & PSIDD1,PSIDD2

0649 c----- additional global parameters -----

0650       INTEGER KCP,IPROC

0651       DOUBLE PRECISION AM0,AMP,S,MQ

0652       COMMON/EDDEOTHER/ KCP,IPROC,AM0,AMP,S,MQ

0653 c----- for this subroutine -----------------------------------      

0654       DOUBLE PRECISION MTG2,MXX,PG1(5),PG2(5),PMX(5),PVS(5)

0655       LOGICAL FIRST

0656       DATA FIRST /.TRUE./

0657       SAVE FIRST

0658 

0659       IF(FIRST) THEN

0660        IF((2*ETJCUT).LT.14.D0.OR.(2*ETJCUT).GT.300.D0) THEN

0661         PRINT*,'EDDEGG:Attention: generator works in the ETcut'

0662         PRINT*,'range 7-150 GeV; you use the cut = ',ETJCUT

0663        ENDIF

0664       ENDIF   

0665 

0666  1    CONTINUE

0667       CALL GENEREXGG(MXX,ETAJ)

0668       CALL EDDETTPHI(NFI,MXX,T1,T2,FI0)

0669 c--- sign of etaj

0670       IF (ETAJ.EQ.0.D0) THEN

0671        SIGNETA=0.D0

0672       ELSE

0673        SIGNETA=ETAJ/DABS(ETAJ)

0674       ENDIF 

0675 c---

0676       DT12= DABS(T1)+DABS(T2)

0677       DT12= DT12+2.D0*DSQRT(DABS(T1)*DABS(T2))*DCOS(FI0)      

0678       PKAP = 1.D0/DCOSH(ETAJ)**2

0679       X1  = EDDEX(MXX)

0680       XF1 = 1.D0-X1

0681       X2  = (MXX*MXX+DT12)/(S*X1)

0682       XF2 = 1.D0-X2   

0683        IF(XF2.LE.0.OR.XF2.GT.1) GOTO 1

0684        IF(PYR(0).LE.0.5) THEN

0685         XSAVE=XF1

0686         XF1=XF2

0687         XF2=XSAVE

0688        ENDIF

0689       X1=1.D0-XF1

0690       X2=1.D0-XF2

0691 C-...scattered proton 1

0692       PZ  = PP(1,3)*XF1

0693       PT  = DSQRT(DABS(T1))

0694       FI  = 2.*PI*PYR(0)

0695       PX  = PT*DCOS(FI)

0696       PY  = PT*DSIN(FI)

0697       PP(3,1) = PX

0698       PP(3,2) = PY

0699       PP(3,3) = PZ

0700       PP(3,4) = DSQRT(PX**2+PY**2+PZ**2+AMP**2)

0701       PP(3,5) = AMP 

0702       KK(3,1) = 1

0703       KK(3,2) = 2212

0704       KK(3,3) = 1

0705 C-...scattered proton 2

0706       PZ  = PP(2,3)*XF2

0707       PT  = DSQRT(DABS(T2))

0708       PX  = PT*DCOS(FI+FI0)

0709       PY  = PT*DSIN(FI+FI0)

0710       PP(4,1) = PX

0711       PP(4,2) = PY

0712       PP(4,3) = PZ

0713       PP(4,4) = DSQRT(PX**2+PY**2+PZ**2+AMP**2)

0714       PP(4,5) = AMP 

0715       KK(4,1) = 1

0716       KK(4,2) = 2212

0717       KK(4,3) = 2 

0718 C-...

0719 C--- momentum of X-system in the lab ---------------------

0720 C--- and new value of MX ---------------------------------

0721       DO I=1,4   

0722        PMX(I)=PP(1,I)+PP(2,I)-PP(3,I)-PP(4,I)

0723       ENDDO

0724        PMX(5)=DSQRT(PMX(4)**2-PMX(1)**2-PMX(2)**2-PMX(3)**2)        

0725 c-was a BUG! new PKAP sometimes was >1,changed to if

0726        AUX1=PKAP

0727        PKAP=PKAP*MXX*MXX/(PMX(5)*PMX(5))

0728        IF (PKAP.GT.1.D0) THEN

0729         PKAP=AUX1

0730        ENDIF

0731        MXX=PMX(5)

0732        MTG2 = MXX*MXX*PKAP/4.D0

0733 C-... gg system in the X-rest frame

0734 C-... parton1 - momentum

0735       PG1(5) = PMAS(21,1)

0736       PT=DSQRT(MTG2-PG1(5)**2)

0737       FI  = 2.*PI*PYR(0)

0738       PG1(1)=PT*DCOS(FI)

0739       PG1(2)=PT*DSIN(FI)

0740 C-...PG1(3)=MTG*DSINH(ETAJ) 

0741       PG1(3)=SIGNETA*MXX*DSQRT(1.D0-PKAP)/2.D0

0742       PG1(4)=DSQRT(PG1(1)**2+PG1(2)**2+PG1(3)**2+PG1(5)**2) 

0743 C-... parton2 - momentum

0744       PG2(5) = PMAS(21,1) 

0745       DO I=1,3

0746        PG2(I)=-PG1(I)

0747       ENDDO

0748       PG2(4)=DSQRT(PG2(1)**2+PG2(2)**2+PG2(3)**2+PG2(5)**2)

0749 C-... gg system in the lab. frame

0750 C-... lorentz transformation

0751       CALL XCMTOLAB(PMX,PG1,PVS)

0752       DO I=1,5

0753        PG1(I)=PVS(I)

0754       ENDDO      

0755       CALL XCMTOLAB(PMX,PG2,PVS)

0756       DO I=1,5

0757        PG2(I)=PVS(I)

0758       ENDDO    

0759 

0760 c- system in the lab.      

0761       DO I=1,4

0762        PP(5,I) = PG1(I) + PG2(I) 

0763       ENDDO

0764        PP(5,5) = DSQRT(PP(5,4)**2-PP(5,1)**2-PP(5,2)**2-PP(5,3)**2)

0765 C-...gg in the lab. frame

0766       DO I=1,5

0767        PP(6,I)=PG1(I)

0768        PP(7,I)=PG2(I)

0769       ENDDO 

0770 C-...gg-system and its decay products definition 

0771        CALL PY2ENT(-6,21,21,PP(5,5)) 

0772       DO I=1,5

0773        PP(6,I) = PG1(I)

0774        PP(7,I) = PG2(I)

0775       ENDDO  

0776       NN=7

0777       KK(5,1)=11

0778       KK(5,2)=90 

0779       KK(5,3)=0

0780       KK(5,4)=6

0781       KK(5,5)=7

0782       KK(6,3)=5

0783       KK(7,3)=5

0784       MINT(1)=442

0785 c      CALL PYSHOW(6,7,PP(5,5)) 

0786         

0787       RETURN

0788       END

0789 

0790 c----------------------------------------------------------------------              

0791 c-*... exclusive 2gamma generation /A.Sobol,R.Ryutin

0792 c----------------------------------------------------------------------              

0793       SUBROUTINE EDDE2GAM

0794       IMPLICIT DOUBLE PRECISION(A-H, O-Z)

0795       IMPLICIT INTEGER(I-N)

0796 c-*...standard PYTHIA ( v. >= 6.2) commons for initialization

0797 c      INTEGER PYCOMP

0798       COMMON /PYJETS/ NN, NPAD, KK(4000,5), PP(4000,5), VV(4000,5)

0799       COMMON /PYDAT2/ KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)

0800       COMMON /PYINT1/ MINT(400),VINT(400)

0801       COMMON /PYINT5/ NGENPD,NGEN(0:500,3),XSEC(0:500,3)

0802       COMMON /PYPARS/ MSTP(200),PARP(200),MSTI(200),PARI(200)

0803 

0804 c-...some of global EDDE variables

0805 c------ fundamental constants -----------------------------

0806       INTEGER NF,NC,NLOSW

0807       DOUBLE PRECISION PI,CSMB,LAMQCD,

0808      & TF,CF,BF0,BF1

0809       DOUBLE COMPLEX MNI,REI

0810       COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

0811      & TF,CF,BF0,BF1,NF,NC,NLOSW

0812 c------ parameters for soft rescattering (trajectories)----

0813 c------ (t1,t2,fi0 dependence) ----------------------------

0814       INTEGER NAPR,NFI

0815       DOUBLE PRECISION CP,DP,RP,RG,AP,

0816      &   T1MIN,T1MAX,T2MIN,T2MAX,FKK,CGP

0817       COMMON/EDDESOFT/ CP(3),DP(3),RP(3),RG(3),AP(3),

0818      &   T1MIN,T1MAX,T2MIN,T2MAX,FKK,CGP,NAPR,NFI 

0819 c----- parameters for hard cross-sections -----------------

0820       DOUBLE PRECISION MGGCUT,ETJCUT,MXMAX,

0821      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

0822      & PSIDD1,PSIDD2

0823       COMMON/EDDEHARD/ MGGCUT,ETJCUT,MXMAX,

0824      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

0825      & PSIDD1,PSIDD2

0826 c----- additional global parameters -----

0827       INTEGER KCP,IPROC

0828       DOUBLE PRECISION AM0,AMP,S,MQ

0829       COMMON/EDDEOTHER/ KCP,IPROC,AM0,AMP,S,MQ

0830 c----- for this subroutine -----------------------------------      

0831       DOUBLE PRECISION MTG2,MXX,PG1(5),PG2(5),PMX(5),PVS(5)

0832       LOGICAL FIRST

0833       DATA FIRST /.TRUE./

0834       SAVE FIRST

0835 

0836       IF(FIRST) THEN

0837        IF((2*ETJCUT).LT.14.D0.OR.(2*ETJCUT).GT.300.D0) THEN

0838         PRINT*,'EDDE2GAM:Attention: generator works in the ETcut'

0839         PRINT*,'range 7-150 GeV; you use the cut = ',ETJCUT

0840        ENDIF

0841       ENDIF   

0842 C

0843  1    CONTINUE

0844       CALL GENEREX2GAM(MXX,ETAJ)

0845 c--- sign of etaj

0846       IF (ETAJ.EQ.0.D0) THEN

0847        SIGNETA=0.D0

0848       ELSE

0849        SIGNETA=ETAJ/DABS(ETAJ)

0850       ENDIF 

0851 c---      

0852       CALL EDDETTPHI(NFI,MXX,T1,T2,FI0) 

0853       DT12= DABS(T1)+DABS(T2)

0854       DT12= DT12+2.D0*DSQRT(DABS(T1)*DABS(T2))*DCOS(FI0)      

0855       PKAP = 1.D0/DCOSH(ETAJ)**2

0856       X1  = EDDEX(MXX)

0857       XF1 = 1.D0-X1

0858       X2  = (MXX*MXX+DT12)/(S*X1)

0859       XF2 = 1.D0-X2   

0860        IF(XF2.LE.0.OR.XF2.GT.1) GOTO 1

0861        IF(PYR(0).LE.0.5) THEN

0862         XSAVE=XF1

0863         XF1=XF2

0864         XF2=XSAVE

0865        ENDIF

0866       X1=1.D0-XF1

0867       X2=1.D0-XF2

0868 C-...scattered proton 1

0869       PZ  = PP(1,3)*XF1

0870       PT  = DSQRT(DABS(T1))

0871       FI  = 2.*PI*PYR(0)

0872       PX  = PT*DCOS(FI)

0873       PY  = PT*DSIN(FI)

0874       PP(3,1) = PX

0875       PP(3,2) = PY

0876       PP(3,3) = PZ

0877       PP(3,4) = DSQRT(PX**2+PY**2+PZ**2+AMP**2)

0878       PP(3,5) = AMP 

0879       KK(3,1) = 1

0880       KK(3,2) = 2212

0881       KK(3,3) = 1

0882 C-...scattered proton 2

0883       PZ  = PP(2,3)*XF2

0884       PT  = DSQRT(DABS(T2))

0885       PX  = PT*DCOS(FI+FI0)

0886       PY  = PT*DSIN(FI+FI0)

0887       PP(4,1) = PX

0888       PP(4,2) = PY

0889       PP(4,3) = PZ

0890       PP(4,4) = DSQRT(PX**2+PY**2+PZ**2+AMP**2)

0891       PP(4,5) = AMP 

0892       KK(4,1) = 1

0893       KK(4,2) = 2212

0894       KK(4,3) = 2 

0895 C-...

0896 C--- momentum of X-system in the lab ---------------------

0897 C--- and new value of MX ---------------------------------

0898       DO I=1,4   

0899        PMX(I)=PP(1,I)+PP(2,I)-PP(3,I)-PP(4,I)

0900       ENDDO

0901        PMX(5)=DSQRT(PMX(4)**2-PMX(1)**2-PMX(2)**2-PMX(3)**2)        

0902 c-was a BUG! new PKAP sometimes was >1,changed to if

0903        AUX1=PKAP

0904        PKAP=PKAP*MXX*MXX/(PMX(5)*PMX(5))

0905        IF (PKAP.GT.1.D0) THEN

0906         PKAP=AUX1

0907        ENDIF

0908        MXX=PMX(5)

0909        MTG2 = MXX*MXX*PKAP/4.D0

0910 C-... gamma gamma system in the X-rest frame

0911 C-... parton1 - momentum

0912       PG1(5) = PMAS(22,1)

0913       PT=DSQRT(MTG2-PG1(5)**2)

0914       FI  = 2.*PI*PYR(0)

0915       PG1(1)=PT*DCOS(FI)

0916       PG1(2)=PT*DSIN(FI)

0917       PG1(3)=SIGNETA*MXX*DSQRT(1.D0-PKAP)/2.D0

0918       PG1(4)=DSQRT(PG1(1)**2+PG1(2)**2+PG1(3)**2+PG1(5)**2) 

0919 C-... parton2 - momentum

0920       PG2(5) = PMAS(22,1) 

0921       DO I=1,3

0922        PG2(I)=-PG1(I)

0923       ENDDO

0924       PG2(4)=DSQRT(PG2(1)**2+PG2(2)**2+PG2(3)**2+PG2(5)**2)

0925 C-... gamma gamma system in the lab. frame

0926 C-... lorentz transformation

0927       CALL XCMTOLAB(PMX,PG1,PVS)

0928       DO I=1,5

0929        PG1(I)=PVS(I)

0930       ENDDO      

0931       CALL XCMTOLAB(PMX,PG2,PVS)

0932       DO I=1,5

0933        PG2(I)=PVS(I)

0934       ENDDO    

0935 C-...gamma gamma in the lab. frame

0936       DO I=1,5

0937        PP(6,I) = PG1(I) 

0938        PP(7,I) = PG2(I) 

0939       ENDDO

0940 C-...gamma gamma-system definition 

0941       DO I=1,4

0942        PP(5,I) = PG1(I) + PG2(I) 

0943       ENDDO

0944        PP(5,5) = DSQRT(PP(5,4)**2-PP(5,1)**2-PP(5,2)**2-PP(5,3)**2)

0945        CALL PY2ENT(6,22,22,PP(5,5)) 

0946       DO I=1,5

0947        PP(6,I) = PG1(I)

0948        PP(7,I) = PG2(I)

0949       ENDDO  

0950 c      CALL PYSHOW(6,7,PP(5,5)) 

0951        NN=7

0952        KK(5,1)=11

0953        KK(5,2)=90 

0954        KK(6,1)=1

0955        KK(6,2)=22 

0956        KK(6,3)=5        

0957        KK(7,1)=1

0958        KK(7,2)=22 

0959        KK(7,3)=5

0960        MINT(1)=443

0961         

0962       RETURN

0963       END

0964 

0965 c----------------------------------------------------------------------              

0966 c-*... exclusive Q Qbar g generation /A.Sobol,R.Ryutin

0967 c----------------------------------------------------------------------              

0968       SUBROUTINE EDDEQQG

0969       IMPLICIT DOUBLE PRECISION(A-H, O-Z)

0970       IMPLICIT INTEGER(I-N)

0971 c-*...standard PYTHIA ( v. >= 6.2) commons for initialization

0972 c      INTEGER PYCOMP

0973       COMMON /PYJETS/ NN, NPAD, KK(4000,5), PP(4000,5), VV(4000,5)

0974       COMMON /PYDAT2/ KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)

0975       COMMON /PYINT1/ MINT(400),VINT(400)

0976       COMMON /PYINT5/ NGENPD,NGEN(0:500,3),XSEC(0:500,3)

0977       COMMON /PYPARS/ MSTP(200),PARP(200),MSTI(200),PARI(200)

0978 

0979 c-...some of global EDDE variables

0980 c------ fundamental constants -----------------------------

0981        INTEGER NF,NC,NLOSW

0982        DOUBLE PRECISION PI,CSMB,LAMQCD,

0983      & TF,CF,BF0,BF1

0984        DOUBLE COMPLEX MNI,REI

0985        COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

0986      & TF,CF,BF0,BF1,NF,NC,NLOSW

0987 c------ parameters for soft rescattering (trajectories)----

0988 c------ (t1,t2,fi0 dependence) ----------------------------

0989        INTEGER NAPR,NFI

0990        DOUBLE PRECISION CP,DP,RP,RG,AP,

0991      &   T1MIN,T1MAX,T2MIN,T2MAX,FKK,CGP

0992        COMMON/EDDESOFT/ CP(3),DP(3),RP(3),RG(3),AP(3),

0993      &   T1MIN,T1MAX,T2MIN,T2MAX,FKK,CGP,NAPR,NFI 

0994 c----- parameters for hard cross-sections -----------------

0995        DOUBLE PRECISION MGGCUT,ETJCUT,MXMAX,

0996      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

0997      & PSIDD1,PSIDD2

0998        COMMON/EDDEHARD/ MGGCUT,ETJCUT,MXMAX,

0999      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

1000      & PSIDD1,PSIDD2

1001 c----- additional global parameters -----

1002       INTEGER KCP,IPROC

1003       DOUBLE PRECISION AM0,AMP,S,MQ

1004       COMMON/EDDEOTHER/ KCP,IPROC,AM0,AMP,S,MQ

1005 c----- for this subroutine -----------------------------------      

1006       DOUBLE PRECISION MTQ2, MXX,MJJ

1007       DOUBLE PRECISION PQ1(5),PQ2(5),PG3(5),PMX(5),PVS(5)

1008        LOGICAL FIRST

1009        DATA FIRST /.TRUE./

1010        SAVE FIRST

1011 

1012        IF(FIRST) THEN

1013         IF((2*ETJCUT).LT.14.D0.OR.(2*ETJCUT).GT.300.D0) THEN

1014          PRINT*,'EDDEQQG:Attention: generator works in the ETcut'

1015          PRINT*,'range 7-150 GeV; you use the cut = ',ETJCUT

1016         ENDIF

1017        ENDIF   

1018 

1019 c-------------------------------------------------------------------

1020 

1021  1    CONTINUE

1022       CALL GENEREXQQG(MJJ,ETAJ,XG3,FIS,THETAS)

1023       MXX=MJJ/DSQRT(1.D0-XG3)

1024 c--- sign of etaj

1025       IF (ETAJ.EQ.0.D0) THEN

1026        SIGNETA=0.D0

1027       ELSE

1028        SIGNETA=ETAJ/DABS(ETAJ)

1029       ENDIF 

1030 c---            

1031       CALL EDDETTPHI(NFI,MXX,T1,T2,FI0)

1032       PKAP = 1.D0/DCOSH(ETAJ)**2

1033       DT12 = DABS(T1)+DABS(T2)

1034       DT12 = DT12+2.D0*DSQRT(DABS(T1)*DABS(T2))*DCOS(FI0)

1035       X1  = EDDEX(MXX)

1036       XF1 = 1.D0-X1

1037       X2  = (MXX*MXX+DT12)/(S*X1)

1038       XF2 = 1.D0-X2   

1039        IF(XF2.LE.0.OR.XF2.GT.1) GOTO 1

1040        IF(PYR(0).LE.0.5) THEN

1041         XSAVE=XF1

1042         XF1=XF2

1043         XF2=XSAVE

1044        ENDIF

1045       X1=1.D0-XF1

1046       X2=1.D0-XF2 

1047 C-...scattered proton 1

1048       PZ  = PP(1,3)*XF1

1049       PT  = DSQRT(DABS(T1))

1050       FI  = 2.*PI*PYR(0)

1051       PX  = PT*DCOS(FI)

1052       PY  = PT*DSIN(FI)

1053       PP(3,1) = PX

1054       PP(3,2) = PY

1055       PP(3,3) = PZ

1056       PP(3,4) = DSQRT(PX**2+PY**2+PZ**2+AMP**2)

1057       PP(3,5) = AMP 

1058       KK(3,1) = 1

1059       KK(3,2) = 2212

1060       KK(3,3) = 1

1061 C-...scattered proton 2

1062       PZ  = PP(2,3)*XF2

1063       PT  = DSQRT(DABS(T2))

1064       PX  = PT*DCOS(FI+FI0)

1065       PY  = PT*DSIN(FI+FI0)

1066       PP(4,1) = PX

1067       PP(4,2) = PY

1068       PP(4,3) = PZ

1069       PP(4,4) = DSQRT(PX**2+PY**2+PZ**2+AMP**2)

1070       PP(4,5) = AMP 

1071       KK(4,1) = 1

1072       KK(4,2) = 2212

1073       KK(4,3) = 2 

1074 C-...

1075 C--- momentum of X-system in the lab ---------------------

1076 C--- and new value of MX ---------------------------------

1077       DO I=1,4   

1078        PMX(I)=PP(1,I)+PP(2,I)-PP(3,I)-PP(4,I)

1079       ENDDO

1080        PMX(5)=DSQRT(PMX(4)**2-PMX(1)**2-PMX(2)**2-PMX(3)**2)

1081        MJJ=PMX(5)*DSQRT(1-XG3)

1082 c-was a BUG! new PKAP sometimes was >1,changed to if

1083        AUX1=PKAP

1084        PKAP=PKAP*MXX*MXX/(PMX(5)*PMX(5))

1085        IF (PKAP.GT.1.D0) THEN

1086         PKAP=AUX1

1087        ENDIF

1088        MXX=PMX(5)

1089 C------ momenta of partons in the rest X-system frame ----------

1090 C------ max-E quark

1091       PQ1(5) = PMAS(5,1)

1092       AUX1=(2.D0-XG3)**2-(XG3*DCOS(THETAS))**2

1093       AUX2=DSQRT(1.D0-AUX1*(PQ1(5)/(MXX*(1-XG3)))**2)

1094       XQ1=2.D0*(1-XG3)*(2.D0-XG3+XG3*DABS(DCOS(THETAS))*AUX2)/AUX1

1095       MTQ2 = (XQ1*MXX*0.5D0)**2*PKAP

1096       PT=DSQRT(MTQ2-PQ1(5)**2)

1097 c------------------------------------    

1098       PFULL=DSQRT((XQ1*MXX*0.5D0)**2-PQ1(5)**2)

1099 C---- new value of THETA_max-E parton in the rest X-system frame

1100       THETA2=DACOS(SIGNETA*DSQRT(PFULL**2-PT**2)/PFULL)

1101 C------ parton 1 momentum -------------------------------------      

1102       FI  = 2.*PI*PYR(0)

1103       PQ1(1)= PT*DCOS(FI)

1104       PQ1(2)= PT*DSIN(FI)

1105       PQ1(3)= SIGNETA*DSQRT(PFULL**2-PT**2)

1106       PQ1(4)=DSQRT(PQ1(1)**2+PQ1(2)**2+PQ1(3)**2+PQ1(5)**2)       

1107 C---  gluon (parton 3) momentum ---------------------

1108       PG3(5) = PMAS(21,1)

1109       PG3(4) = XG3*MXX/2.D0

1110       PFULL  = DSQRT(PG3(4)**2-PG3(5)**2)      

1111       AUX1 = DSIN(THETAS)*DSIN(FI)*DSIN(FIS)

1112       AUX1 = AUX1-DSIN(THETAS)*DCOS(THETA2)*DCOS(FI)*DCOS(FIS)

1113       AUX1 = AUX1-DCOS(THETAS)*DSIN(THETA2)*DCOS(FI)

1114       AUX2 = -DCOS(THETAS)*DSIN(THETA2)*DSIN(FI)

1115       AUX2 = AUX2-DSIN(THETAS)*DCOS(THETA2)*DSIN(FI)*DCOS(FIS)

1116       AUX2 = AUX2-DSIN(THETAS)*DCOS(FI)*DSIN(FIS)

1117       AUX3 = -DCOS(THETAS)*DCOS(THETA2)

1118       AUX3 = AUX3+DSIN(THETAS)*DSIN(THETA2)*DCOS(FIS)

1119       PG3(1) = PFULL*AUX1     

1120       PG3(2) = PFULL*AUX2

1121       PG3(3) = PFULL*AUX3

1122 C-- parton 2 momentum ------------------------------------------

1123       DO I=1,3

1124        PQ2(I)=-(PQ1(I)+PG3(I))

1125       ENDDO

1126       PQ2(5)= PMAS(5,1) 

1127       PQ2(4)= DSQRT(PQ2(1)**2+PQ2(2)**2+PQ2(3)**2+PQ2(5)**2)

1128 C-- variables for PY3ENT

1129       XQ2=2.D0-XG3-XQ1

1130 C-- lorentz transformation of momenta to the lab.      

1131       CALL XCMTOLAB(PMX,PQ1,PVS)

1132       DO I=1,5

1133       PQ1(I)=PVS(I)

1134       ENDDO      

1135       CALL XCMTOLAB(PMX,PG3,PVS)

1136       DO I=1,5

1137       PG3(I)=PVS(I)

1138       ENDDO

1139       CALL XCMTOLAB(PMX,PQ2,PVS)

1140       DO I=1,5

1141       PQ2(I)=PVS(I)

1142       ENDDO      

1143 C-...interchange between Q and Qbar (equal probability)

1144       IF (PYR(0).LT.0.5) THEN

1145        DO I=1,5

1146         PVS(I)=PQ1(I)

1147         PQ1(I)=PQ2(I)

1148         PQ2(I)=PVS(I)

1149         XQSAVE=XQ1

1150         XQ1=XQ2

1151         XQ2=XQSAVE

1152        ENDDO

1153       ENDIF

1154 C-... PYTHIA: definition of momenta      

1155        DO I=1,5

1156         PP(6,I) = PQ1(I)

1157         PP(7,I) = PG3(I)

1158         PP(8,I) = PQ2(I)

1159        ENDDO      

1160 c-...Q Qbar g system and its decay products definition.

1161       DO I=1,4

1162        PP(5,I) = PQ1(I) + PQ2(I) +PG3(I)

1163       ENDDO

1164        PP(5,5) = DSQRT(PP(5,4)**2-PP(5,1)**2-PP(5,2)**2-PP(5,3)**2)

1165 

1166       CALL PY3ENT(-6,5,21,-5,PP(5,5),XQ1,XQ2) 

1167 

1168        DO I=1,5

1169         PP(6,I) = PQ1(I)

1170         PP(7,I) = PG3(I)

1171         PP(8,I) = PQ2(I)

1172        ENDDO

1173 

1174       NN=8

1175       KK(5,1)=11

1176       KK(5,2)=90 

1177       KK(5,3)=0

1178       KK(5,4)=6

1179       KK(5,5)=8

1180       KK(6,3)=5

1181       KK(7,3)=5

1182       KK(8,3)=5

1183       MINT(1)=444

1184 

1185 c      CALL PYSHOW(6,-3,PP(5,5)) 

1186         

1187       RETURN

1188       END

1189 

1190 c----------------------------------------------------------------------              

1191 c-... exclusive 3 g generation /R.Ryutin

1192 c----------------------------------------------------------------------              

1193       SUBROUTINE EDDE3G

1194       IMPLICIT DOUBLE PRECISION(A-H, O-Z)

1195       IMPLICIT INTEGER(I-N)

1196 c-...standard PYTHIA ( v. >= 6.2) commons for initialization

1197 c      INTEGER PYCOMP

1198       COMMON /PYJETS/ NN, NPAD, KK(4000,5), PP(4000,5), VV(4000,5)

1199       COMMON /PYDAT2/ KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)

1200       COMMON /PYINT1/ MINT(400),VINT(400)

1201       COMMON /PYINT5/ NGENPD,NGEN(0:500,3),XSEC(0:500,3)

1202       COMMON /PYPARS/ MSTP(200),PARP(200),MSTI(200),PARI(200)

1203 

1204 c-...some of global EDDE variables

1205 c------ fundamental constants -----------------------------

1206       INTEGER NF,NC,NLOSW

1207       DOUBLE PRECISION PI,CSMB,LAMQCD,

1208      & TF,CF,BF0,BF1

1209       DOUBLE COMPLEX MNI,REI

1210       COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

1211      & TF,CF,BF0,BF1,NF,NC,NLOSW

1212 c------ parameters for soft rescattering (trajectories)----

1213 c------ (t1,t2,fi0 dependence) ----------------------------

1214       INTEGER NAPR,NFI

1215       DOUBLE PRECISION CP,DP,RP,RG,AP,

1216      &   T1MIN,T1MAX,T2MIN,T2MAX,FKK,CGP

1217       COMMON/EDDESOFT/ CP(3),DP(3),RP(3),RG(3),AP(3),

1218      &   T1MIN,T1MAX,T2MIN,T2MAX,FKK,CGP,NAPR,NFI 

1219 c----- parameters for hard cross-sections -----------------

1220       DOUBLE PRECISION MGGCUT,ETJCUT,MXMAX,

1221      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

1222      & PSIDD1,PSIDD2

1223       COMMON/EDDEHARD/ MGGCUT,ETJCUT,MXMAX,

1224      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

1225      & PSIDD1,PSIDD2

1226 c----- additional global parameters -----

1227       INTEGER KCP,IPROC

1228       DOUBLE PRECISION AM0,AMP,S,MQ

1229       COMMON/EDDEOTHER/ KCP,IPROC,AM0,AMP,S,MQ

1230 c----- for this subroutine -----------------------------------      

1231       DOUBLE PRECISION MTG2,MXX,MJJ

1232       DOUBLE PRECISION PG1(5),PG2(5),PG3(5),PMX(5),PVS(5)

1233       LOGICAL FIRST

1234       DATA FIRST /.TRUE./

1235       SAVE FIRST

1236 

1237        IF(FIRST) THEN

1238         IF((2*ETJCUT).LT.14.D0.OR.(2*ETJCUT).GT.300.D0) THEN

1239          PRINT*,'EDDE3G:Attention: generator works in the ETcut'

1240          PRINT*,'range 7-150 GeV; you use the cut = ',ETJCUT

1241         ENDIF

1242        ENDIF   

1243 

1244 c--------------------------------------------------------------------

1245 

1246  1    CONTINUE

1247       CALL GENEREX3G(MJJ,ETAJ,XG3,PTG3,FIG3)

1248       MXX=MJJ/DSQRT(1.D0-XG3)     

1249 c--- sign of etaj

1250       IF (ETAJ.EQ.0.D0) THEN

1251        SIGNETA=0.D0

1252       ELSE

1253        SIGNETA=ETAJ/DABS(ETAJ)

1254       ENDIF 

1255 c---            

1256       CALL EDDETTPHI(NFI,MXX,T1,T2,FI0)

1257       PKAP = 1.D0/DCOSH(ETAJ)**2

1258       DT12 = DABS(T1)+DABS(T2)

1259       DT12 = DT12+2.D0*DSQRT(DABS(T1)*DABS(T2))*DCOS(FI0)

1260       X1  = EDDEX(MXX)

1261       XF1 = 1.D0-X1

1262       X2  = (MXX*MXX+DT12)/(S*X1)

1263       XF2 = 1.D0-X2   

1264        IF(XF2.LE.0.OR.XF2.GT.1) GOTO 1

1265        IF(PYR(0).LE.0.5) THEN

1266         XSAVE=XF1

1267         XF1=XF2

1268         XF2=XSAVE

1269        ENDIF

1270       X1=1.D0-XF1

1271       X2=1.D0-XF2 

1272 C-...scattered proton 1

1273       PZ  = PP(1,3)*XF1

1274       PT  = DSQRT(DABS(T1))

1275       FI  = 2.*PI*PYR(0)

1276       PX  = PT*DCOS(FI)

1277       PY  = PT*DSIN(FI)

1278       PP(3,1) = PX

1279       PP(3,2) = PY

1280       PP(3,3) = PZ

1281       PP(3,4) = DSQRT(PX**2+PY**2+PZ**2+AMP**2)

1282       PP(3,5) = AMP 

1283       KK(3,1) = 1

1284       KK(3,2) = 2212

1285       KK(3,3) = 1

1286 C-...scattered proton 2

1287       PZ  = PP(2,3)*XF2

1288       PT  = DSQRT(DABS(T2))

1289       PX  = PT*DCOS(FI+FI0)

1290       PY  = PT*DSIN(FI+FI0)

1291       PP(4,1) = PX

1292       PP(4,2) = PY

1293       PP(4,3) = PZ

1294       PP(4,4) = DSQRT(PX**2+PY**2+PZ**2+AMP**2)

1295       PP(4,5) = AMP 

1296       KK(4,1) = 1

1297       KK(4,2) = 2212

1298       KK(4,3) = 2 

1299 C-...

1300 C--- momentum of X-system in the lab ---------------------

1301 C--- and new value of MX ---------------------------------

1302       DO I=1,4   

1303        PMX(I)=PP(1,I)+PP(2,I)-PP(3,I)-PP(4,I)

1304       ENDDO

1305        PMX(5)=DSQRT(PMX(4)**2-PMX(1)**2-PMX(2)**2-PMX(3)**2)

1306        MJJ=PMX(5)*DSQRT(1-XG3)       

1307 c-was a BUG! new PKAP sometimes was >1,changed to if

1308        AUX1=PKAP

1309        PKAP=PKAP*MXX*MXX/(PMX(5)*PMX(5))

1310        IF (PKAP.GT.1.D0) THEN

1311         PKAP=AUX1

1312        ENDIF

1313        MXX=PMX(5)

1314 C---- new value of THETA_max-E parton in the rest X-system frame

1315       THETA2=DACOS(SIGNETA*DSQRT(1-PKAP))

1316       FI  = 2.*PI*PYR(0)

1317 C------ momenta of partons in the rest X-system frame ----------      

1318 C---  gluon (parton 3) momentum ---------------------

1319       PG3(5) = PMAS(21,1)

1320       PG3(4) = XG3*MXX/2.D0

1321       PFULL  = DSQRT(PG3(4)**2-PG3(5)**2)

1322 C--- abs. value of the longitudinal momentum      

1323       PLG=DSQRT(PFULL**2-PTG3**2)

1324  2    CONTINUE

1325       FIG3=2.D0*PI*PYR(0)      

1326       CONSA=PTG3*DSIN(THETA2)*DCOS(FI-FIG3)

1327       CONSA=CONSA+PLG*DCOS(THETA2)

1328       CONSB=PTG3*DSIN(THETA2)*DCOS(FI-FIG3)

1329       CONSB=CONSB-PLG*DCOS(THETA2)      

1330 C------- CONSTRAINT --------

1331        IF (CONSA.GE.0.D0.AND.CONSB.GE.0.D0) GOTO 2

1332 C-------------------------------------------------------------

1333       PG3(1) = PTG3*DCOS(FIG3)     

1334       PG3(2) = PTG3*DSIN(FIG3)

1335       PG3(3) = PLG

1336 C-------------------------------------------------------------     

1337 C-       IF (CONSA.LT.0.D0.AND.CONSB.GE.0.D0) THEN

1338 C-        PG3(3)=PLG

1339 C-       ENDIF

1340        IF (CONSA.GE.0.D0.AND.CONSB.LT.0.D0) THEN

1341         PG3(3)=-PLG

1342        ENDIF       

1343        IF (CONSA.LT.0.D0.AND.CONSB.LT.0.D0) THEN

1344         IF (PYR(0).LE.0.5) THEN       

1345          PG3(3)=PLG

1346         ELSE

1347          PG3(3)=-PLG

1348         ENDIF

1349        ENDIF       

1350 C------ max-E gluon

1351       PG1(5) = PMAS(21,1)

1352       AUX1=PG3(3)*DCOS(THETA2)+PTG3*DSIN(THETA2)*DCOS(FI-FIG3)

1353       AUX1=AUX1*2.D0/MXX

1354       XG1=2.D0*(1-XG3)/(2.D0-XG3+AUX1)

1355       MTG2 = (XG1*MXX*0.5D0)**2*PKAP

1356       PT=DSQRT(MTG2-PG1(5)**2)

1357 c------------------------------------    

1358       PFULL=DSQRT((XG1*MXX/2.D0)**2-PG1(5)**2)

1359 C------ parton 1 momentum -------------------------------------      

1360       PG1(1)= PT*DCOS(FI)

1361       PG1(2)= PT*DSIN(FI)

1362       PG1(3)= SIGNETA*DSQRT(PFULL**2-PT**2)

1363       PG1(4)=DSQRT(PG1(1)**2+PG1(2)**2+PG1(3)**2+PG1(5)**2) 

1364 C-- parton 2 momentum ------------------------------------------

1365       DO I=1,3

1366        PG2(I)=-(PG1(I)+PG3(I))

1367       ENDDO

1368       PG2(5)= PMAS(21,1) 

1369       PG2(4)= DSQRT(PG2(1)**2+PG2(2)**2+PG2(3)**2+PG2(5)**2)

1370 C-- variables for PY3ENT

1371       XG2=2.D0-XG3-XG1     

1372 C-- lorentz transformation of momenta to the lab.      

1373       CALL XCMTOLAB(PMX,PG1,PVS)

1374       DO I=1,5

1375       PG1(I)=PVS(I)

1376       ENDDO      

1377       CALL XCMTOLAB(PMX,PG3,PVS)

1378       DO I=1,5

1379       PG3(I)=PVS(I)

1380       ENDDO

1381       CALL XCMTOLAB(PMX,PG2,PVS)

1382       DO I=1,5

1383       PG2(I)=PVS(I)

1384       ENDDO                     

1385 C-... PYTHIA: definition of momenta      

1386        DO I=1,5

1387         PP(6,I) = PG1(I)

1388         PP(7,I) = PG3(I)

1389         PP(8,I) = PG2(I)

1390        ENDDO      

1391 c-...3 g system and its decay products definition.

1392       DO I=1,4

1393        PP(5,I) = PG1(I) + PG2(I) +PG3(I)

1394       ENDDO

1395        PP(5,5) = DSQRT(PP(5,4)**2-PP(5,1)**2-PP(5,2)**2-PP(5,3)**2)

1396 

1397       CALL PY3ENT(-6,21,21,21,PP(5,5),XG1,XG2) 

1398 

1399        DO I=1,5

1400         PP(6,I) = PG1(I)

1401         PP(7,I) = PG3(I)

1402         PP(8,I) = PG2(I)

1403        ENDDO

1404 

1405       NN=8

1406       KK(5,1)=11

1407       KK(5,2)=90 

1408       KK(5,3)=0

1409       KK(5,4)=6

1410       KK(5,5)=8

1411       KK(6,3)=5

1412       KK(7,3)=5

1413       KK(8,3)=5

1414       MINT(1)=445

1415 

1416 c      CALL PYSHOW(6,-3,PP(5,5)) 

1417         

1418       RETURN

1419       END

1420 

1421 c----------------------------------------------------------------------              

1422 c-...semi-inclusive resonance generation /A.Sobol,R.Ryutin 

1423 c----------------------------------------------------------------------              

1424       SUBROUTINE SIDDERES

1425       IMPLICIT DOUBLE PRECISION(A-H, O-Z)

1426       IMPLICIT INTEGER(I-N)

1427 c-...standard PYTHIA ( v. >= 6.2) commons for initialization

1428 c      INTEGER PYCOMP

1429       COMMON /PYJETS/ NN, NPAD, KK(4000,5), PP(4000,5), VV(4000,5)

1430       COMMON /PYDAT2/ KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)

1431       COMMON /PYINT1/ MINT(400),VINT(400)

1432       COMMON /PYINT5/ NGENPD,NGEN(0:500,3),XSEC(0:500,3)

1433       COMMON /PYPARS/ MSTP(200),PARP(200),MSTI(200),PARI(200)

1434 c-...some of global EDDE variables

1435 c------ fundamental constants -----------------------------

1436       INTEGER NF,NC,NLOSW

1437       DOUBLE PRECISION PI,CSMB,LAMQCD,

1438      & TF,CF,BF0,BF1

1439       DOUBLE COMPLEX MNI,REI

1440       COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

1441      & TF,CF,BF0,BF1,NF,NC,NLOSW

1442 c------ parameters for soft rescattering (trajectories)----

1443 c------ (t1,t2,fi0 dependence) ----------------------------

1444       INTEGER NAPR,NFI

1445       DOUBLE PRECISION CP,DP,RP,RG,AP,

1446      &   T1MIN,T1MAX,T2MIN,T2MAX,FKK,CGP

1447       COMMON/EDDESOFT/ CP(3),DP(3),RP(3),RG(3),AP(3),

1448      &   T1MIN,T1MAX,T2MIN,T2MAX,FKK,CGP,NAPR,NFI 

1449 c----- parameters for hard cross-sections -----------------

1450       DOUBLE PRECISION MGGCUT,ETJCUT,MXMAX,

1451      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

1452      & PSIDD1,PSIDD2

1453       COMMON/EDDEHARD/ MGGCUT,ETJCUT,MXMAX,

1454      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

1455      & PSIDD1,PSIDD2

1456 c----- additional global parameters -----

1457       INTEGER KCP,IPROC

1458       DOUBLE PRECISION AM0,AMP,S,MQ

1459       COMMON/EDDEOTHER/ KCP,IPROC,AM0,AMP,S,MQ

1460 c----- cascads parameters ----------------

1461       INTEGER NG1,NG2,NGSUM,NGS,CEVENT(2,500),NA2,NA3

1462       DOUBLE PRECISION PNG1(5,500),PNG2(5,500),PGC1(5),PGC2(5),

1463      & PGSUM1(5),PGSUM2(5),PVS2(500,5) 

1464 c----- for this subroutine -----------------------------------      

1465       INTEGER NFAIL

1466       DOUBLE PRECISION MXX,PMX(5),PVS(5),PAUX(5),AUXM,PCS(5)

1467       

1468  1    CONTINUE

1469 c--- 2 cascads generation

1470       CALL SICASCAD2(AM0,NG1,PNG1,PGC1,NG2,PNG2,PGC2,MXX,NFAIL)

1471       IF (NFAIL.EQ.1) GOTO 1

1472       

1473 c--- definition

1474 c---

1475       X=EDDEX(MXX)

1476       CALL EDDETTPHI(NFI,MXX,T1,T2,FI0) 

1477       DT12= DABS(T1)+DABS(T2)

1478       DT12= DT12+2.D0*DSQRT(DABS(T1)*DABS(T2))*DCOS(FI0)

1479       XF1 = 1.D0-X

1480       XF2 = 1.D0-(MXX*MXX+DT12)/S/X           

1481       IF(XF2.LE.0.OR.XF2.GT.1) GOTO 1

1482       IF(PYR(0).LE.0.5) THEN

1483         XSAVE=XF1

1484         XF1=XF2

1485         XF2=XSAVE

1486       ENDIF

1487 C-...scattered proton 1

1488       PZ  = PP(1,3)*XF1

1489       PT  = DSQRT(DABS(T1))

1490       FI  = 2.*PI*PYR(0)

1491       PX  = PT*DCOS(FI)

1492       PY  = PT*DSIN(FI)

1493       PP(3,1) = PX

1494       PP(3,2) = PY

1495       PP(3,3) = PZ

1496       PP(3,4) = DSQRT(PX**2+PY**2+PZ**2+AMP**2)

1497       PP(3,5) = AMP 

1498       KK(3,1) = 1

1499       KK(3,2) = 2212

1500       KK(3,3) = 1

1501 C-...scattered proton 2

1502       PZ  = PP(2,3)*XF2

1503       PT  = DSQRT(DABS(T2))

1504       PX  = PT*DCOS(FI+FI0)

1505       PY  = PT*DSIN(FI+FI0)

1506       PP(4,1) = PX

1507       PP(4,2) = PY

1508       PP(4,3) = PZ

1509       PP(4,4) = DSQRT(PX**2+PY**2+PZ**2+AMP**2)

1510       PP(4,5) = AMP 

1511       KK(4,1) = 1

1512       KK(4,2) = 2212

1513       KK(4,3) = 2 

1514 C-...central system ---------------

1515 C-...

1516 C--- momentum of X-system in the lab ---------------------

1517 C--- and new value of MX ---------------------------------

1518       AUXM=MXX

1519       DO I=1,4   

1520        PMX(I)=PP(1,I)+PP(2,I)-PP(3,I)-PP(4,I)

1521       ENDDO

1522        PMX(5)=DSQRT(PMX(4)**2-PMX(1)**2-PMX(2)**2-PMX(3)**2)        

1523        MXX=PMX(5)

1524 c- mass correction for all momenta -------

1525 c- and sum of final momenta -

1526       DO I=1,5 

1527        PGSUM1(I)=0.D0

1528        PGSUM2(I)=0.D0

1529       ENDDO

1530       IF (NG1.GT.0) THEN 

1531        DO J=1,NG1       

1532         DO I=1,4

1533          PAUX(I)=PNG1(I,J)

1534         ENDDO

1535         PAUX(5)=PMAS(21,1)

1536         CALL SIMXCOR(1,AUXM,MXX,PAUX,PVS)

1537         DO I=1,3

1538          PNG1(I,J)=PVS(I)

1539          PGSUM1(I)=PGSUM1(I)+PNG1(I,J)

1540         ENDDO

1541         PNG1(4,J)=DSQRT(PNG1(1,J)**2+PNG1(2,J)**2+PNG1(3,J)**2)

1542         PGSUM1(4)=PGSUM1(4)+PNG1(4,J)

1543        ENDDO 

1544       ENDIF 

1545 c----------------------------------------------------

1546       IF (NG2.GT.0) THEN

1547        DO J=1,NG2       

1548         DO I=1,4

1549          PAUX(I)=PNG2(I,J)

1550         ENDDO

1551         PAUX(5)=PMAS(21,1)

1552         CALL SIMXCOR(2,AUXM,MXX,PAUX,PVS)

1553         DO I=1,3

1554          PNG2(I,J)=PVS(I)

1555          PGSUM2(I)=PGSUM2(I)+PNG2(I,J)

1556         ENDDO

1557         PNG2(4,J)=DSQRT(PNG2(1,J)**2+PNG2(2,J)**2+PNG2(3,J)**2)

1558         PGSUM2(4)=PGSUM2(4)+PNG2(4,J)

1559        ENDDO

1560       ENDIF

1561 c- momentum of central system -

1562       PGC1(4)=0.5D0*MXX-PGSUM1(4)

1563       PGC1(3)=0.5D0*MXX-PGSUM1(3)

1564       PGC2(4)=0.5D0*MXX-PGSUM2(4)

1565       PGC2(3)=-0.5D0*MXX-PGSUM2(3)      

1566       DO I=1,4

1567          PCS(I)=PGC1(I)+PGC2(I)

1568       ENDDO

1569        AM0=DSQRT(PCS(4)**2-PCS(1)**2-PCS(2)**2-PCS(3)**2)

1570        PCS(5)=AM0

1571 c----------------------------------------------------       

1572 c-- 2 cascads momenta transformation ----------------

1573 c-- from CMX to lab. --------------------------------

1574 c- transformation

1575 

1576       DO I=1,5 

1577        PGSUM1(I)=0.D0

1578        PGSUM2(I)=0.D0

1579       ENDDO

1580 

1581       IF (NG1.GT.0) THEN 

1582       DO J=1,NG1       

1583        DO I=1,4

1584        PAUX(I)=PNG1(I,J)

1585        ENDDO

1586        PAUX(5)=PMAS(21,1)

1587        CALL XCMTOLAB(PMX,PAUX,PVS)

1588        DO I=1,5

1589        PNG1(I,J)=PVS(I)

1590        PGSUM1(I)=PGSUM1(I)+PNG1(I,J)

1591        ENDDO

1592       ENDDO 

1593       ENDIF 

1594 c----------------------------------------------------

1595       IF (NG2.GT.0) THEN

1596       DO J=1,NG2       

1597        DO I=1,4

1598        PAUX(I)=PNG2(I,J)

1599        ENDDO

1600        PAUX(5)=PMAS(21,1)

1601        CALL XCMTOLAB(PMX,PAUX,PVS)

1602        DO I=1,5

1603        PNG2(I,J)=PVS(I)

1604        PGSUM2(I)=PGSUM2(I)+PNG2(I,J)

1605        ENDDO     

1606       ENDDO

1607       ENDIF      

1608       

1609        DO I=1,4

1610        PAUX(I)=PCS(I)

1611        ENDDO

1612        PAUX(5)=PCS(5)

1613        CALL XCMTOLAB(PMX,PAUX,PVS)

1614        DO I=1,5

1615        PCS(I)=PVS(I)

1616        ENDDO       

1617       

1618       DO I=1,4

1619       PAUX(I)=PGSUM1(I)+PGSUM2(I)+PCS(I)

1620       ENDDO

1621       PAUX(5)=DSQRT(PAUX(4)**2-PAUX(3)**2-PAUX(2)**2-PAUX(1)**2)

1622 c---- momentum of resonance particle 

1623 c--- number of particles (2+2)(protons)+1(systemX)+NGS+NG1+NG2

1624 c--- NGS - number of gg or ggg singlet systems -------

1625 c-   NN = 5+NGS+NG1+NG2

1626       NGS=0 ! number of singlet systems

1627       NGSUM=NG1+NG2 !<80

1628       NN=5+NGS+NGSUM 

1629 c---      

1630       KK(5,1) = 1

1631       KK(5,2) = KCP

1632       KK(5,3) = 0 

1633       DO I=1,3

1634        PP(5,I)=PP(1,I)+PP(2,I)

1635        PP(5,I)=PP(5,I)-(PP(3,I)+PP(4,I)+PGSUM1(I)+PGSUM2(I))

1636       ENDDO

1637       PP(5,4) = DSQRT(PP(5,1)**2+PP(5,2)**2+PP(5,3)**2+AM0**2)

1638       PP(5,5) = AM0

1639 c--- combinatorics of cascad gluons N singlet systems -----

1640 c--- Formulaes for all cases:

1641 c- number of terms in n2 couples and n3 triples combined

1642 c- from N gluons: N!/(n2! (2!)**n2 n3! (3!)**n3)

1643 c- total number of terms for N-even:

1644 c- Ntot=Sum[{k=0,INT[N/6]},

1645 c- {N!/((N/2-3*k)! (2!)**(N/2-3*k) (2*k)! (3!)**(2*k))}]

1646 c- total number of terms for N-add:

1647 c- Ntot=Sum[{k=0,INT[(N-3)/6]},

1648 c- {N!/(((N-3)/2-3*k)! (2!)**((N-3)/2-3*k) (2*k+1)! (3!)**(2*k+1))}] 

1649 c-- simple case realization --------------

1650 c-- in the complicated case we have to define

1651 c-- NA2+NA3 singlet systems of gluons with specified

1652 c-- 4-momentum, i.e. call COMBSING from here!

1653 c-      KK(6,1)=11

1654 c-      KK(6,2)=90

1655 c-      KK(6,3)=0

1656 c-      KK(6,4)=0

1657 c-      KK(6,5)=0

1658 c-      DO I=1,4

1659 c-       PP(6,I) = PGSUM1(I)+PGSUM2(I)

1660 c-      ENDDO

1661 c-       PP(6,5) = DSQRT(PP(6,4)**2-PP(6,1)**2-PP(6,2)**2-PP(6,3)**2)

1662 c- check out

1663 c-      WRITE(*,*)'check sum all!!!' 

1664 c-      DO I=1,4

1665 c-       WRITE(*,*)' psum(',I,')=',PP(3,I)+PP(4,I)+PP(5,I)+PP(6,I)

1666 c-      ENDDO

1667 

1668 c--- NG1+NG2 gluons

1669 c-  KK(I,1)=2 or 1,KK(I,2)=21,KK(I,3)=0,KK(I,4)=0,KK(I,5)=0      

1670 c- gluons permutations

1671        CALL COMBSING(NGSUM,NA2,NA3,CEVENT)

1672       DO I=6,NGSUM+5

1673        KK(I,1)=CEVENT(2,I-5)

1674        KK(I,2)=21 

1675        KK(I,3)=0

1676        KK(I,4)=0

1677        KK(I,5)=0

1678       ENDDO       

1679 c-- all the momenta to PYTHIA              

1680       IF (NG1.GT.0) THEN

1681       DO I=6,NG1+5

1682        DO J=1,5 

1683         PP(I,J)=PNG1(J,I-5)

1684        ENDDO

1685       ENDDO

1686       ENDIF

1687       IF (NG2.GT.0) THEN      

1688       DO I=NG1+6,NGSUM+5

1689        DO J=1,5 

1690         PP(I,J)=PNG2(J,I-5-NG1)

1691        ENDDO

1692       ENDDO

1693       ENDIF

1694 c- permutations of momenta according to CEVENT(1,I)

1695       DO I=1,NGSUM

1696        DO J=1,5

1697         PVS2(I,J)=PP(5+I,J)

1698        ENDDO       

1699       ENDDO

1700       DO I=1,NGSUM

1701        DO J=1,5

1702         PP(5+I,J)=PVS2(CEVENT(1,I),J)

1703        ENDDO       

1704       ENDDO

1705 c--- all the gluons to PYLIST

1706 c-      CALL PYSHOW(7,-NGSUM,PP(6,5))  

1707       MINT(1)=446

1708     

1709       RETURN

1710       END

1711   

1712 c----------------------------------------------------------------------              

1713 c-*... semi-inclusive Q Qbar generation /A.Sobol,R.Ryutin

1714 c----------------------------------------------------------------------              

1715       SUBROUTINE SIDDEQQ

1716       IMPLICIT DOUBLE PRECISION(A-H, O-Z)

1717       IMPLICIT INTEGER(I-N)

1718 c-*...standard PYTHIA ( v. >= 6.2) commons for initialization

1719 c      INTEGER PYCOMP

1720       COMMON /PYJETS/ NN, NPAD, KK(4000,5), PP(4000,5), VV(4000,5)

1721       COMMON /PYDAT2/ KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)

1722       COMMON /PYINT1/ MINT(400),VINT(400)

1723       COMMON /PYINT5/ NGENPD,NGEN(0:500,3),XSEC(0:500,3)

1724       COMMON /PYPARS/ MSTP(200),PARP(200),MSTI(200),PARI(200)

1725 c-...some of global EDDE variables

1726 c------ fundamental constants -----------------------------

1727       INTEGER NF,NC,NLOSW

1728       DOUBLE PRECISION PI,CSMB,LAMQCD,

1729      & TF,CF,BF0,BF1

1730       DOUBLE COMPLEX MNI,REI

1731       COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

1732      & TF,CF,BF0,BF1,NF,NC,NLOSW

1733 c------ parameters for soft rescattering (trajectories)----

1734 c------ (t1,t2,fi0 dependence) ----------------------------

1735       INTEGER NAPR,NFI

1736       DOUBLE PRECISION CP,DP,RP,RG,AP,

1737      &   T1MIN,T1MAX,T2MIN,T2MAX,FKK,CGP

1738       COMMON/EDDESOFT/ CP(3),DP(3),RP(3),RG(3),AP(3),

1739      &   T1MIN,T1MAX,T2MIN,T2MAX,FKK,CGP,NAPR,NFI 

1740 c----- parameters for hard cross-sections -----------------

1741       DOUBLE PRECISION MGGCUT,ETJCUT,MXMAX,

1742      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

1743      & PSIDD1,PSIDD2

1744       COMMON/EDDEHARD/ MGGCUT,ETJCUT,MXMAX,

1745      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

1746      & PSIDD1,PSIDD2

1747 c----- additional global parameters -----

1748       INTEGER KCP,IPROC

1749       DOUBLE PRECISION AM0,AMP,S,MQ

1750       COMMON/EDDEOTHER/ KCP,IPROC,AM0,AMP,S,MQ

1751 c----- cascads parameters ----------------

1752       INTEGER NG1,NG2,NGSUM,NGS,CEVENT(2,500),NA2,NA3

1753       DOUBLE PRECISION PNG1(5,500),PNG2(5,500),PGC1(5),PGC2(5),

1754      & PGSUM1(5),PGSUM2(5),PVS2(500,5)       

1755 c----- for this subroutine -----------------------------------      

1756       DOUBLE PRECISION MTQ2,MXX,MJJ,PQ1(5),PQ2(5),

1757      & PMX(5),PMJJ(5),PVS(5),PAUX(5),AUXM,PCS(5)

1758       INTEGER NFAIL

1759       LOGICAL FIRST

1760       DATA FIRST /.TRUE./

1761       SAVE FIRST

1762 

1763       IF(FIRST) THEN

1764        IF((2*ETJCUT).LT.14.D0.OR.(2*ETJCUT).GT.300.D0) THEN

1765         PRINT*,'EDDEQQ:Attention: generator works in the ETcut'

1766         PRINT*,'range 7-150 GeV; you use the cut = ',ETJCUT

1767        ENDIF

1768       ENDIF     

1769 

1770   1   CONTINUE

1771       CALL GENERSIQQ(MQ,MJJ,ETAJ)

1772 c--- sign of etaj

1773       IF (ETAJ.EQ.0.D0) THEN

1774        SIGNETA=0.D0

1775       ELSE

1776        SIGNETA=ETAJ/DABS(ETAJ)

1777       ENDIF 

1778 c--- 2 cascads generation

1779 c-      WRITE(*,*)'MJJ_gen=',MJJ 

1780 c-      WRITE(*,*)'point 1'

1781       CALL SICASCAD2(MJJ,NG1,PNG1,PGC1,NG2,PNG2,PGC2,MXX,NFAIL)

1782       IF (NFAIL.EQ.1) GOTO 1

1783 c-      WRITE(*,*)'point 2' 

1784 c---

1785 c-      WRITE(*,*)'SIDDEQQ==========================='

1786 c-      WRITE(*,*)'MJJ_OLD=',MJJ,' MX_OLD=',MXX

1787       CALL EDDETTPHI(NFI,MXX,T1,T2,FI0) 

1788       DT12= DABS(T1)+DABS(T2)

1789       DT12= DT12+2.D0*DSQRT(DABS(T1)*DABS(T2))*DCOS(FI0)      

1790       PKAP = 1.D0/DCOSH(ETAJ)**2

1791       X1  = EDDEX(MXX)

1792       XF1 = 1.D0-X1

1793       X2  = (MXX*MXX+DT12)/(S*X1)

1794       XF2 = 1.D0-X2   

1795        IF(XF2.LE.0.OR.XF2.GT.1) GOTO 1

1796        IF(PYR(0).LE.0.5) THEN

1797         XSAVE=XF1

1798         XF1=XF2

1799         XF2=XSAVE

1800        ENDIF

1801       X1=1.D0-XF1

1802       X2=1.D0-XF2

1803 C-...scattered proton 1

1804       PZ  = PP(1,3)*XF1

1805       PT  = DSQRT(DABS(T1))

1806       FI  = 2.*PI*PYR(0)

1807       PX  = PT*DCOS(FI)

1808       PY  = PT*DSIN(FI)

1809       PP(3,1) = PX

1810       PP(3,2) = PY

1811       PP(3,3) = PZ

1812       PP(3,4) = DSQRT(PX**2+PY**2+PZ**2+AMP**2)

1813       PP(3,5) = AMP 

1814       KK(3,1) = 1

1815       KK(3,2) = 2212

1816       KK(3,3) = 1

1817 C-...scattered proton 2

1818       PZ  = PP(2,3)*XF2

1819       PT  = DSQRT(DABS(T2))

1820       PX  = PT*DCOS(FI+FI0)

1821       PY  = PT*DSIN(FI+FI0)

1822       PP(4,1) = PX

1823       PP(4,2) = PY

1824       PP(4,3) = PZ

1825       PP(4,4) = DSQRT(PX**2+PY**2+PZ**2+AMP**2)

1826       PP(4,5) = AMP 

1827       KK(4,1) = 1

1828       KK(4,2) = 2212

1829       KK(4,3) = 2 

1830 C-...

1831 C--- momentum of X-system in the lab ---------------------

1832 C--- and new value of MX ---------------------------------

1833       AUXM=MXX 

1834       DO I=1,4   

1835        PMX(I)=PP(1,I)+PP(2,I)-PP(3,I)-PP(4,I)

1836       ENDDO

1837        PMX(5)=DSQRT(PMX(4)**2-PMX(1)**2-PMX(2)**2-PMX(3)**2)        

1838        MXX=PMX(5)

1839 c-      WRITE(*,*)'PMX: ',PMX(4),' ',PMX(1),' ',PMX(2),' ',PMX(3),

1840 c-     & ' ',PMX(5) 

1841 c-      WRITE(*,*)'soft gluons before transform'

1842 c-      IF (NG1.GT.0) THEN 

1843 c-      DO J=1,NG1       

1844 c-      WRITE(*,*)'PG',J,':  ',PNG1(4,J),' ',PNG1(1,J),' ',

1845 c-     & PNG1(2,J),' ',PNG1(3,J),' ',PNG1(5,J)       

1846 c-      ENDDO 

1847 c-      ENDIF 

1848 c----------------------------------------------------

1849 c-      IF (NG2.GT.0) THEN

1850 c-      DO J=1,NG2       

1851 c-      WRITE(*,*)'PG',J+NG1,':  ',PNG2(4,J),' ',PNG2(1,J),' ',

1852 c-     & PNG2(2,J),' ',PNG2(3,J),' ',PNG2(5,J)       

1853 c-      ENDDO

1854 c-      ENDIF

1855 c----------------------------------------------------

1856 c- mass correction for all momenta -------

1857 c- and sum of final momenta -

1858       DO I=1,5 

1859        PGSUM1(I)=0.D0

1860        PGSUM2(I)=0.D0

1861       ENDDO

1862       IF (NG1.GT.0) THEN 

1863        DO J=1,NG1       

1864         DO I=1,4

1865          PAUX(I)=PNG1(I,J)

1866         ENDDO

1867         PAUX(5)=PMAS(21,1)

1868         CALL SIMXCOR(1,AUXM,MXX,PAUX,PVS)

1869         DO I=1,3

1870          PNG1(I,J)=PVS(I)

1871          PGSUM1(I)=PGSUM1(I)+PNG1(I,J)

1872         ENDDO

1873         PNG1(4,J)=DSQRT(PNG1(1,J)**2+PNG1(2,J)**2+PNG1(3,J)**2)

1874         PGSUM1(4)=PGSUM1(4)+PNG1(4,J)

1875        ENDDO 

1876       ENDIF 

1877 c----------------------------------------------------

1878       IF (NG2.GT.0) THEN

1879        DO J=1,NG2       

1880         DO I=1,4

1881          PAUX(I)=PNG2(I,J)

1882         ENDDO

1883         PAUX(5)=PMAS(21,1)

1884         CALL SIMXCOR(2,AUXM,MXX,PAUX,PVS)

1885         DO I=1,3

1886          PNG2(I,J)=PVS(I)

1887          PGSUM2(I)=PGSUM2(I)+PNG2(I,J)

1888         ENDDO

1889         PNG2(4,J)=DSQRT(PNG2(1,J)**2+PNG2(2,J)**2+PNG2(3,J)**2)

1890         PGSUM2(4)=PGSUM2(4)+PNG2(4,J)

1891        ENDDO

1892       ENDIF

1893 c- momentum of central system -

1894       PGC1(4)=0.5D0*MXX-PGSUM1(4)

1895       PGC1(3)=0.5D0*MXX-PGSUM1(3)

1896       PGC2(4)=0.5D0*MXX-PGSUM2(4)

1897       PGC2(3)=-0.5D0*MXX-PGSUM2(3)      

1898       DO I=1,4

1899          PCS(I)=PGC1(I)+PGC2(I)

1900       ENDDO

1901        PCS(5)=DSQRT(PCS(4)**2-PCS(1)**2-PCS(2)**2-PCS(3)**2)

1902 c-was a BUG! new PKAP sometimes was >1,changed to if

1903        AUX1=PKAP

1904        PKAP=PKAP*MJJ*MJJ/(PCS(5)*PCS(5))

1905        IF (PKAP.GT.1.D0) THEN

1906         PKAP=AUX1

1907        ENDIF       

1908        MJJ=PCS(5)

1909       

1910 c-      WRITE(*,*)'MX_NEW=',MXX,' MJJ_NEW=',MJJ

1911 c-      WRITE(*,*)'particles before transform corrected'

1912 c-      IF (NG1.GT.0) THEN 

1913 c-      DO J=1,NG1       

1914 c-      WRITE(*,*)'PG',J,':  ',PNG1(4,J),' ',PNG1(1,J),' ',

1915 c-     & PNG1(2,J),' ',PNG1(3,J),' ',PNG1(5,J)       

1916 c-      ENDDO 

1917 c-      ENDIF 

1918 c----------------------------------------------------

1919 c-      IF (NG2.GT.0) THEN

1920 c-      DO J=1,NG2       

1921 c-      WRITE(*,*)'PG',J+NG1,':  ',PNG2(4,J),' ',PNG2(1,J),' ',

1922 c-     & PNG2(2,J),' ',PNG2(3,J),' ',PNG2(5,J)       

1923 c-      ENDDO

1924 c-      ENDIF

1925 c-      WRITE(*,*)'---------------------------------------------'

1926 c-      WRITE(*,*)'PCS:    ',PCS(4),' ',PCS(1),' ',

1927 c-     & PCS(2),' ',PCS(3),' ',PCS(5)    

1928 c-      WRITE(*,*)'Pf1:    ',PGC1(4),' ',PGC1(1),' ',

1929 c-     & PGC1(2),' ',PGC1(3),' ',PGC1(5)

1930 c-      WRITE(*,*)'Pf2:    ',PGC2(4),' ',PGC2(1),' ',

1931 c-     & PGC2(2),' ',PGC2(3),' ',PGC2(5)

1932 c-      WRITE(*,*)'--------------------------------------------'

1933 c-      WRITE(*,*)'SUM:    ',PCS(4)+PGSUM1(4)+PGSUM2(4),' ',

1934 c-     & PCS(1)+PGSUM1(1)+PGSUM2(1),' ',

1935 c-     & PCS(2)+PGSUM1(2)+PGSUM2(2),' ',

1936 c-     & PCS(3)+PGSUM1(3)+PGSUM2(3),' ',

1937 c-     & DSQRT((PCS(4)+PGSUM1(4)+PGSUM2(4))**2-

1938 c-     & (PCS(3)+PGSUM1(3)+PGSUM2(3))**2-

1939 c-     & (PCS(2)+PGSUM1(2)+PGSUM2(2))**2-

1940 c-     & (PCS(1)+PGSUM1(1)+PGSUM2(1))**2)

1941 c----------------------------------------------------       

1942 C--- momentum of JJ-system in the gg C.M. -----------------

1943 C--- and new value of MJJ ---------------------------------

1944       DO I=1,5   

1945        PMJJ(I)=PCS(I)

1946       ENDDO

1947 c-- 2 cascads momenta transformation ----------------

1948 c-- from CMX to lab. --------------------------------

1949 c- and sum of final momenta -

1950       

1951       DO I=1,5 

1952        PGSUM1(I)=0.D0

1953        PGSUM2(I)=0.D0

1954       ENDDO

1955 

1956 c- transformation      

1957       IF (NG1.GT.0) THEN 

1958       DO J=1,NG1       

1959        DO I=1,4

1960        PAUX(I)=PNG1(I,J)

1961        ENDDO

1962        PAUX(5)=PMAS(21,1)

1963        CALL XCMTOLAB(PMX,PAUX,PVS)

1964        DO I=1,5

1965        PNG1(I,J)=PVS(I)

1966        PGSUM1(I)=PGSUM1(I)+PNG1(I,J)

1967        ENDDO 

1968       ENDDO 

1969       ENDIF 

1970 c----------------------------------------------------

1971       IF (NG2.GT.0) THEN

1972       DO J=1,NG2       

1973        DO I=1,4

1974        PAUX(I)=PNG2(I,J)

1975        ENDDO

1976        PAUX(5)=PMAS(21,1)

1977        CALL XCMTOLAB(PMX,PAUX,PVS)

1978        DO I=1,5

1979        PNG2(I,J)=PVS(I)

1980        PGSUM2(I)=PGSUM2(I)+PNG2(I,J)

1981        ENDDO 

1982       ENDDO

1983       ENDIF 

1984 C-...        

1985 c-------

1986        MTQ2=MJJ*MJJ*PKAP/4.D0

1987 C-... QQbar system in the JJ-rest frame

1988 C-... parton1 - momentum

1989       PQ1(5) = PMAS(5,1)

1990       PT=DSQRT(MTQ2-PQ1(5)**2)

1991       FI  = 2.*PI*PYR(0)

1992       PQ1(1)=PT*DCOS(FI)

1993       PQ1(2)=PT*DSIN(FI)

1994       PQ1(3)=SIGNETA*MJJ*DSQRT(1.D0-PKAP)/2.D0

1995       PQ1(4)=DSQRT(PQ1(1)**2+PQ1(2)**2+PQ1(3)**2+PQ1(5)**2) 

1996 C-... parton2 - momentum

1997       PQ2(5) = PMAS(5,1) 

1998       DO I=1,3

1999        PQ2(I)=-PQ1(I)

2000       ENDDO

2001       PQ2(4)=DSQRT(PQ2(1)**2+PQ2(2)**2+PQ2(3)**2+PQ2(5)**2)   

2002 C-... QQbar system in the lab. frame

2003 C-... lorentz transformation

2004       CALL XCMTOLAB(PMJJ,PQ1,PAUX)

2005       CALL XCMTOLAB(PMX,PAUX,PVS)

2006       DO I=1,5

2007        PQ1(I)=PVS(I)

2008       ENDDO      

2009       CALL XCMTOLAB(PMJJ,PQ2,PAUX)

2010       CALL XCMTOLAB(PMX,PAUX,PVS)

2011       DO I=1,5

2012        PQ2(I)=PVS(I)

2013       ENDDO

2014 C-... equal probability for Q and Qbar

2015       IF(PYR(0).LT.0.5) THEN

2016        DO I=1,5

2017         PVS(I)=PQ1(I)

2018         PQ1(I)=PQ2(I)

2019         PQ2(I)=PVS(I)

2020        ENDDO

2021       ENDIF

2022 c-      WRITE(*,*)'particles after transform'

2023 c-      IF (NG1.GT.0) THEN 

2024 c-      DO J=1,NG1       

2025 c-      WRITE(*,*)'PG',J,':  ',PNG1(4,J),' ',PNG1(1,J),' ',

2026 c-     & PNG1(2,J),' ',PNG1(3,J),' ',PNG1(5,J)       

2027 c-      ENDDO 

2028 c-      ENDIF 

2029 c----------------------------------------------------

2030 c-      IF (NG2.GT.0) THEN

2031 c-      DO J=1,NG2       

2032 c-      WRITE(*,*)'PG',J+NG1,':  ',PNG2(4,J),' ',PNG2(1,J),' ',

2033 c-     & PNG2(2,J),' ',PNG2(3,J),' ',PNG2(5,J)       

2034 c-      ENDDO

2035 c-      ENDIF

2036 c-      WRITE(*,*)'---------------------------------------------'

2037 c-      WRITE(*,*)'PQ1:   ',PQ1(4),' ',PQ1(1),' ',

2038 c-     & PQ1(2),' ',PQ1(3),' ',PQ1(5)    

2039 c-      WRITE(*,*)'PQ2:   ',PQ2(4),' ',PQ2(1),' ',

2040 c-     & PQ2(2),' ',PQ2(3),' ',PQ2(5) 

2041 c-      WRITE(*,*)'PSUM1: ',PGSUM1(4),' ',PGSUM1(1),' ',

2042 c-     & PGSUM1(2),' ',PGSUM1(3),' ',PGSUM1(5) 

2043 c-      WRITE(*,*)'PSUM2: ',PGSUM2(4),' ',PGSUM2(1),' ',

2044 c-     & PGSUM2(2),' ',PGSUM2(3),' ',PGSUM2(5)     

2045 c-      WRITE(*,*)'--------------------------------------------'

2046 c-      WRITE(*,*)'SUM:    ',PQ1(4)+PQ2(4)+PGSUM1(4)+PGSUM2(4),' ',

2047 c-     & PQ1(1)+PQ2(1)+PGSUM1(1)+PGSUM2(1),' ',

2048 c-     & PQ1(2)+PQ2(2)+PGSUM1(2)+PGSUM2(2),' ',

2049 c-     & PQ1(3)+PQ2(3)+PGSUM1(3)+PGSUM2(3),' ',

2050 c-     & DSQRT((PQ1(4)+PQ2(4)+PGSUM1(4)+PGSUM2(4))**2-

2051 c-     & (PQ1(3)+PQ2(3)+PGSUM1(3)+PGSUM2(3))**2-

2052 c-     & (PQ1(2)+PQ2(2)+PGSUM1(2)+PGSUM2(2))**2-

2053 c-     & (PQ1(1)+PQ2(1)+PGSUM1(1)+PGSUM2(1))**2)      

2054 C-...Q - quark and Qbar quark in the lab. frame

2055       DO I=1,5

2056        PP(6,I)=PQ1(I)

2057        PP(7,I)=PQ2(I)

2058       ENDDO 

2059 C-...Q Qbar system and its decay products definition.

2060 C-...B Bbar by default (change to other numbers,

2061 C-... insert option to ffr-file!!!)

2062        KK(5,1)=11

2063        KK(5,2)=90 

2064       DO I=1,4

2065        PP(5,I) = PP(6,I) + PP(7,I) 

2066       ENDDO

2067        PP(5,5) = DSQRT(PP(5,4)**2-PP(5,1)**2-PP(5,2)**2-PP(5,3)**2)

2068       DO I=1,5

2069        PQ1(I) = PP(6,I)  

2070        PQ2(I) = PP(7,I)  

2071       ENDDO

2072        CALL PY2ENT(-6,5,-5,PP(5,5)) 

2073       DO I=1,5

2074        PP(6,I) = PQ1(I)

2075        PP(7,I) = PQ2(I) 

2076       ENDDO

2077        NGS=0 ! number of singlet systems

2078        NGSUM=NG1+NG2 !<80

2079        NN=7+NGS+NGSUM

2080 c-- simple case realization --------------

2081 c-      KK(8,1)=11

2082 c-      KK(8,2)=90

2083 c-      DO I=1,4

2084 c-       PP(8,I) = PGSUM1(I)+PGSUM2(I)

2085 c-      ENDDO

2086 c-       PP(8,5) = DSQRT(PP(8,4)**2-PP(8,1)**2-PP(8,2)**2-PP(8,3)**2)

2087 c--- NG1+NG2 gluons

2088 c-  KK(I,1)=2 or 1,KK(I,2)=21,KK(I,3)=0,KK(I,4)=0,KK(I,5)=0      

2089 c- gluons permutations

2090        CALL COMBSING(NGSUM,NA2,NA3,CEVENT)

2091       DO I=8,NGSUM+7

2092        KK(I,1)=CEVENT(2,I-7)

2093        KK(I,2)=21 

2094        KK(I,3)=0

2095        KK(I,4)=0

2096        KK(I,5)=0

2097       ENDDO       

2098 c-- all the momenta to PYTHIA              

2099       IF (NG1.GT.0) THEN

2100       DO I=8,NG1+7

2101        DO J=1,5 

2102         PP(I,J)=PNG1(J,I-7)

2103        ENDDO

2104       ENDDO

2105       ENDIF

2106       IF (NG2.GT.0) THEN      

2107       DO I=NG1+8,NGSUM+7

2108        DO J=1,5 

2109         PP(I,J)=PNG2(J,I-7-NG1)

2110        ENDDO

2111       ENDDO

2112       ENDIF

2113 c- permutations of momenta according to CEVENT(1,I)

2114       DO I=1,NGSUM

2115        DO J=1,5

2116         PVS2(I,J)=PP(7+I,J)

2117        ENDDO       

2118       ENDDO

2119       DO I=1,NGSUM

2120        DO J=1,5

2121         PP(7+I,J)=PVS2(CEVENT(1,I),J)

2122        ENDDO       

2123       ENDDO 

2124 c--- QQbar to PYLIST    

2125       CALL PYSHOW(6,7,PP(5,5))

2126 c--- all the gluons to PYLIST

2127 c-      CALL PYSHOW(9,-NGSUM,PP(8,5))   

2128       MINT(1)=447

2129 

2130       RETURN

2131       END  

2132       

2133 c----------------------------------------------------------------------              

2134 c- *... semi-inclusive g g generation /A.Sobol,R.Ryutin

2135 c----------------------------------------------------------------------              

2136       SUBROUTINE SIDDEGG

2137       IMPLICIT DOUBLE PRECISION(A-H, O-Z)

2138       IMPLICIT INTEGER(I-N)

2139 c- *...standard PYTHIA ( v. >= 6.2) commons for initialization

2140 c      INTEGER PYCOMP

2141       COMMON /PYJETS/ NN, NPAD, KK(4000,5), PP(4000,5), VV(4000,5)

2142       COMMON /PYDAT2/ KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)

2143       COMMON /PYINT1/ MINT(400),VINT(400)

2144       COMMON /PYINT5/ NGENPD,NGEN(0:500,3),XSEC(0:500,3)

2145       COMMON /PYPARS/ MSTP(200),PARP(200),MSTI(200),PARI(200)

2146 c-...some of global EDDE variables

2147 c------ fundamental constants -----------------------------

2148       INTEGER NF,NC,NLOSW

2149       DOUBLE PRECISION PI,CSMB,LAMQCD,

2150      & TF,CF,BF0,BF1

2151       DOUBLE COMPLEX MNI,REI

2152       COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

2153      & TF,CF,BF0,BF1,NF,NC,NLOSW

2154 c------ parameters for soft rescattering (trajectories)----

2155 c------ (t1,t2,fi0 dependence) ----------------------------

2156       INTEGER NAPR,NFI

2157       DOUBLE PRECISION CP,DP,RP,RG,AP,

2158      &   T1MIN,T1MAX,T2MIN,T2MAX,FKK,CGP

2159       COMMON/EDDESOFT/ CP(3),DP(3),RP(3),RG(3),AP(3),

2160      &   T1MIN,T1MAX,T2MIN,T2MAX,FKK,CGP,NAPR,NFI 

2161 c----- parameters for hard cross-sections -----------------

2162       DOUBLE PRECISION MGGCUT,ETJCUT,MXMAX,

2163      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

2164      & PSIDD1,PSIDD2

2165       COMMON/EDDEHARD/ MGGCUT,ETJCUT,MXMAX,

2166      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

2167      & PSIDD1,PSIDD2

2168 c----- additional global parameters -----

2169       INTEGER KCP,IPROC

2170       DOUBLE PRECISION AM0,AMP,S,MQ

2171       COMMON/EDDEOTHER/ KCP,IPROC,AM0,AMP,S,MQ

2172 c----- cascads parameters ----------------

2173       INTEGER NG1,NG2,NGSUM,NGS,CEVENT(2,500),NA2,NA3

2174       DOUBLE PRECISION PNG1(5,500),PNG2(5,500),PGC1(5),PGC2(5),

2175      & PGSUM1(5),PGSUM2(5),PVS2(500,5)         

2176 c----- for this subroutine -----------------------------------      

2177       DOUBLE PRECISION MTG2,MXX,MJJ,PG1(5),PG2(5),

2178      & PMX(5),PMJJ(5),PVS(5),PAUX(5),AUXM,PCS(5)

2179       INTEGER NFAIL

2180       LOGICAL FIRST

2181       DATA FIRST /.TRUE./

2182       SAVE FIRST

2183 

2184       IF(FIRST) THEN

2185        IF((2*ETJCUT).LT.14.D0.OR.(2*ETJCUT).GT.300.D0) THEN

2186         PRINT*,'EDDEGG:Attention: generator works in the ETcut'

2187         PRINT*,'range 7-150 GeV; you use the cut = ',ETJCUT

2188        ENDIF

2189       ENDIF   

2190 

2191  1    CONTINUE

2192       CALL GENERSIGG(MJJ,ETAJ)

2193 c--- sign of etaj

2194       IF (ETAJ.EQ.0.D0) THEN

2195        SIGNETA=0.D0

2196       ELSE

2197        SIGNETA=ETAJ/DABS(ETAJ)

2198       ENDIF 

2199 c--- 2 cascads generation

2200       CALL SICASCAD2(MJJ,NG1,PNG1,PGC1,NG2,PNG2,PGC2,MXX,NFAIL)

2201       IF (NFAIL.EQ.1) GOTO 1

2202 c---      

2203       CALL EDDETTPHI(NFI,MXX,T1,T2,FI0)

2204 c---

2205       DT12= DABS(T1)+DABS(T2)

2206       DT12= DT12+2.D0*DSQRT(DABS(T1)*DABS(T2))*DCOS(FI0)      

2207       PKAP = 1.D0/DCOSH(ETAJ)**2

2208       X1  = EDDEX(MXX)

2209       XF1 = 1.D0-X1

2210       X2  = (MXX*MXX+DT12)/(S*X1)

2211       XF2 = 1.D0-X2   

2212        IF(XF2.LE.0.OR.XF2.GT.1) GOTO 1

2213        IF(PYR(0).LE.0.5) THEN

2214         XSAVE=XF1

2215         XF1=XF2

2216         XF2=XSAVE

2217        ENDIF

2218       X1=1.D0-XF1

2219       X2=1.D0-XF2

2220 C-...scattered proton 1

2221       PZ  = PP(1,3)*XF1

2222       PT  = DSQRT(DABS(T1))

2223       FI  = 2.*PI*PYR(0)

2224       PX  = PT*DCOS(FI)

2225       PY  = PT*DSIN(FI)

2226       PP(3,1) = PX

2227       PP(3,2) = PY

2228       PP(3,3) = PZ

2229       PP(3,4) = DSQRT(PX**2+PY**2+PZ**2+AMP**2)

2230       PP(3,5) = AMP 

2231       KK(3,1) = 1

2232       KK(3,2) = 2212

2233       KK(3,3) = 1

2234 C-...scattered proton 2

2235       PZ  = PP(2,3)*XF2

2236       PT  = DSQRT(DABS(T2))

2237       PX  = PT*DCOS(FI+FI0)

2238       PY  = PT*DSIN(FI+FI0)

2239       PP(4,1) = PX

2240       PP(4,2) = PY

2241       PP(4,3) = PZ

2242       PP(4,4) = DSQRT(PX**2+PY**2+PZ**2+AMP**2)

2243       PP(4,5) = AMP 

2244       KK(4,1) = 1

2245       KK(4,2) = 2212

2246       KK(4,3) = 2 

2247 C-...

2248 C--- momentum of X-system in the lab ---------------------

2249 C--- and new value of MX ---------------------------------

2250       AUXM=MXX 

2251       DO I=1,4   

2252        PMX(I)=PP(1,I)+PP(2,I)-PP(3,I)-PP(4,I)

2253       ENDDO

2254        PMX(5)=DSQRT(PMX(4)**2-PMX(1)**2-PMX(2)**2-PMX(3)**2)        

2255        MXX=PMX(5)

2256 c----------------------------------------------------

2257 c- mass correction for all momenta -------

2258 c- and sum of final momenta -

2259       DO I=1,5 

2260        PGSUM1(I)=0.D0

2261        PGSUM2(I)=0.D0

2262       ENDDO

2263       IF (NG1.GT.0) THEN 

2264        DO J=1,NG1       

2265         DO I=1,4

2266          PAUX(I)=PNG1(I,J)

2267         ENDDO

2268         PAUX(5)=PMAS(21,1)

2269         CALL SIMXCOR(1,AUXM,MXX,PAUX,PVS)

2270         DO I=1,3

2271          PNG1(I,J)=PVS(I)

2272          PGSUM1(I)=PGSUM1(I)+PNG1(I,J)

2273         ENDDO

2274         PNG1(4,J)=DSQRT(PNG1(1,J)**2+PNG1(2,J)**2+PNG1(3,J)**2)

2275         PGSUM1(4)=PGSUM1(4)+PNG1(4,J)

2276        ENDDO 

2277       ENDIF 

2278 c----------------------------------------------------

2279       IF (NG2.GT.0) THEN

2280        DO J=1,NG2       

2281         DO I=1,4

2282          PAUX(I)=PNG2(I,J)

2283         ENDDO

2284         PAUX(5)=PMAS(21,1)

2285         CALL SIMXCOR(2,AUXM,MXX,PAUX,PVS)

2286         DO I=1,3

2287          PNG2(I,J)=PVS(I)

2288          PGSUM2(I)=PGSUM2(I)+PNG2(I,J)

2289         ENDDO

2290         PNG2(4,J)=DSQRT(PNG2(1,J)**2+PNG2(2,J)**2+PNG2(3,J)**2)

2291         PGSUM2(4)=PGSUM2(4)+PNG2(4,J)

2292        ENDDO

2293       ENDIF

2294 c- momentum of central system -

2295       PGC1(4)=0.5D0*MXX-PGSUM1(4)

2296       PGC1(3)=0.5D0*MXX-PGSUM1(3)

2297       PGC2(4)=0.5D0*MXX-PGSUM2(4)

2298       PGC2(3)=-0.5D0*MXX-PGSUM2(3)      

2299       DO I=1,4

2300          PCS(I)=PGC1(I)+PGC2(I)

2301       ENDDO

2302        PCS(5)=DSQRT(PCS(4)**2-PCS(1)**2-PCS(2)**2-PCS(3)**2)

2303 c-was a BUG! new PKAP sometimes was >1,changed to if

2304        AUX1=PKAP

2305        PKAP=PKAP*MJJ*MJJ/(PCS(5)*PCS(5))

2306        IF (PKAP.GT.1.D0) THEN

2307         PKAP=AUX1

2308        ENDIF 

2309        MJJ=PCS(5)

2310 C--- momentum of JJ-system in the gg C.M. -----------------

2311 C--- and new value of MJJ ---------------------------------

2312       DO I=1,5   

2313        PMJJ(I)=PCS(I)

2314       ENDDO

2315 c-- 2 cascads momenta transformation ----------------

2316 c-- from CMX to lab. --------------------------------

2317 c- and sum of final momenta -

2318       DO I=1,5 

2319        PGSUM1(I)=0.D0

2320        PGSUM2(I)=0.D0

2321       ENDDO

2322       

2323       IF (NG1.GT.0) THEN 

2324       DO J=1,NG1       

2325        DO I=1,4

2326        PAUX(I)=PNG1(I,J)

2327        ENDDO

2328        PAUX(5)=PMAS(21,1)

2329        CALL XCMTOLAB(PMX,PAUX,PVS)

2330        DO I=1,5

2331        PNG1(I,J)=PVS(I)

2332        PGSUM1(I)=PGSUM1(I)+PNG1(I,J)

2333        ENDDO 

2334       ENDDO 

2335       ENDIF 

2336 c----------------------------------------------------

2337       IF (NG2.GT.0) THEN

2338       DO J=1,NG2       

2339        DO I=1,4

2340        PAUX(I)=PNG2(I,J)

2341        ENDDO

2342        PAUX(5)=PMAS(21,1)

2343        CALL XCMTOLAB(PMX,PAUX,PVS)

2344        DO I=1,5

2345        PNG2(I,J)=PVS(I)

2346        PGSUM2(I)=PGSUM2(I)+PNG2(I,J)

2347        ENDDO 

2348       ENDDO

2349       ENDIF 

2350 C-...

2351 c-------

2352        MTG2 = MJJ*MJJ*PKAP/4.D0

2353 C-... gg system in the X-rest frame

2354 C-... parton1 - momentum

2355       PG1(5) = PMAS(21,1)

2356       PT=DSQRT(MTG2-PG1(5)**2)

2357       FI  = 2.*PI*PYR(0)

2358       PG1(1)=PT*DCOS(FI)

2359       PG1(2)=PT*DSIN(FI)

2360 C-...PG1(3)=MTG*DSINH(ETAJ) 

2361       PG1(3)=SIGNETA*MJJ*DSQRT(1.D0-PKAP)/2.D0

2362       PG1(4)=DSQRT(PG1(1)**2+PG1(2)**2+PG1(3)**2+PG1(5)**2) 

2363 C-... parton2 - momentum

2364       PG2(5) = PMAS(21,1) 

2365       DO I=1,3

2366        PG2(I)=-PG1(I)

2367       ENDDO

2368       PG2(4)=DSQRT(PG2(1)**2+PG2(2)**2+PG2(3)**2+PG2(5)**2)

2369 C-... gg system in the lab. frame

2370 C-... lorentz transformation

2371       CALL XCMTOLAB(PMJJ,PG1,PAUX)

2372       CALL XCMTOLAB(PMX,PAUX,PVS)      

2373       DO I=1,5

2374        PG1(I)=PVS(I)

2375       ENDDO      

2376       CALL XCMTOLAB(PMJJ,PG2,PAUX)

2377       CALL XCMTOLAB(PMX,PAUX,PVS)      

2378       DO I=1,5

2379        PG2(I)=PVS(I)

2380       ENDDO    

2381 C-...gg in the lab. frame

2382       DO I=1,5

2383        PP(6,I)=PG1(I)

2384        PP(7,I)=PG2(I)

2385       ENDDO 

2386 C-...gg-system and its decay products definition 

2387        KK(5,1)=11

2388        KK(5,2)=90 

2389       DO I=1,4

2390        PP(5,I) = PG1(I) + PG2(I) 

2391       ENDDO

2392        PP(5,5) = DSQRT(PP(5,4)**2-PP(5,1)**2-PP(5,2)**2-PP(5,3)**2)

2393        CALL PY2ENT(-6,21,21,PP(5,5)) 

2394       DO I=1,5

2395        PP(6,I) = PG1(I)

2396        PP(7,I) = PG2(I)

2397       ENDDO  

2398        NGS=0 ! number of singlet systems

2399        NGSUM=NG1+NG2 !<80

2400        NN=7+NGS+NGSUM

2401 c-- simple case realization --------------

2402 c-      KK(8,1)=11

2403 c-      KK(8,2)=90

2404 c-      DO I=1,4

2405 c-       PP(8,I) = PGSUM1(I)+PGSUM2(I)

2406 c-      ENDDO

2407 c-       PP(8,5) = DSQRT(PP(8,4)**2-PP(8,1)**2-PP(8,2)**2-PP(8,3)**2)

2408 c--- NG1+NG2 gluons

2409 c-  KK(I,1)=2 or 1,KK(I,2)=21,KK(I,3)=0,KK(I,4)=0,KK(I,5)=0      

2410 c- gluons permutations

2411        CALL COMBSING(NGSUM,NA2,NA3,CEVENT)

2412       DO I=8,NGSUM+7

2413        KK(I,1)=CEVENT(2,I-7)

2414        KK(I,2)=21 

2415        KK(I,3)=0

2416        KK(I,4)=0

2417        KK(I,5)=0

2418       ENDDO       

2419 c-- all the momenta to PYTHIA              

2420       IF (NG1.GT.0) THEN

2421       DO I=8,NG1+7

2422        DO J=1,5 

2423         PP(I,J)=PNG1(J,I-7)

2424        ENDDO

2425       ENDDO

2426       ENDIF

2427       IF (NG2.GT.0) THEN      

2428       DO I=NG1+8,NGSUM+7

2429        DO J=1,5 

2430         PP(I,J)=PNG2(J,I-7-NG1)

2431        ENDDO

2432       ENDDO

2433       ENDIF

2434 c- permutations of momenta according to CEVENT(1,I)

2435       DO I=1,NGSUM

2436        DO J=1,5

2437         PVS2(I,J)=PP(7+I,J)

2438        ENDDO       

2439       ENDDO

2440       DO I=1,NGSUM

2441        DO J=1,5

2442         PP(7+I,J)=PVS2(CEVENT(1,I),J)

2443        ENDDO       

2444       ENDDO

2445 c--- {gg}_singlet to PYLIST     

2446       CALL PYSHOW(6,7,PP(5,5))

2447 c--- all the gluons to PYLIST

2448 c-      CALL PYSHOW(9,-NGSUM,PP(8,5))

2449       MINT(1)=448

2450         

2451       RETURN

2452       END

2453 

2454 c----------------------------------------------------------------------              

2455 c-*... semi-inclusive 2gamma generation /A.Sobol,R.Ryutin

2456 c----------------------------------------------------------------------              

2457       SUBROUTINE SIDDE2GAM

2458       IMPLICIT DOUBLE PRECISION(A-H, O-Z)

2459       IMPLICIT INTEGER(I-N)

2460 c-*...standard PYTHIA ( v. >= 6.2) commons for initialization

2461 c      INTEGER PYCOMP

2462       COMMON /PYJETS/ NN, NPAD, KK(4000,5), PP(4000,5), VV(4000,5)

2463       COMMON /PYDAT2/ KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)

2464       COMMON /PYINT1/ MINT(400),VINT(400)

2465       COMMON /PYINT5/ NGENPD,NGEN(0:500,3),XSEC(0:500,3)

2466       COMMON /PYPARS/ MSTP(200),PARP(200),MSTI(200),PARI(200)

2467 c-...some of global EDDE variables

2468 c------ fundamental constants -----------------------------

2469       INTEGER NF,NC,NLOSW

2470       DOUBLE PRECISION PI,CSMB,LAMQCD,

2471      & TF,CF,BF0,BF1

2472       DOUBLE COMPLEX MNI,REI

2473       COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

2474      & TF,CF,BF0,BF1,NF,NC,NLOSW

2475 c------ parameters for soft rescattering (trajectories)----

2476 c------ (t1,t2,fi0 dependence) ----------------------------

2477       INTEGER NAPR,NFI

2478       DOUBLE PRECISION CP,DP,RP,RG,AP,

2479      &   T1MIN,T1MAX,T2MIN,T2MAX,FKK,CGP

2480       COMMON/EDDESOFT/ CP(3),DP(3),RP(3),RG(3),AP(3),

2481      &   T1MIN,T1MAX,T2MIN,T2MAX,FKK,CGP,NAPR,NFI 

2482 c----- parameters for hard cross-sections -----------------

2483       DOUBLE PRECISION MGGCUT,ETJCUT,MXMAX,

2484      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

2485      & PSIDD1,PSIDD2

2486       COMMON/EDDEHARD/ MGGCUT,ETJCUT,MXMAX,

2487      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

2488      & PSIDD1,PSIDD2

2489 c----- additional global parameters -----

2490       INTEGER KCP,IPROC

2491       DOUBLE PRECISION AM0,AMP,S,MQ

2492       COMMON/EDDEOTHER/ KCP,IPROC,AM0,AMP,S,MQ

2493 c----- cascads parameters ----------------

2494       INTEGER NG1,NG2,NGSUM,NGS,CEVENT(2,500),NA2,NA3

2495       DOUBLE PRECISION PNG1(5,500),PNG2(5,500),PGC1(5),PGC2(5),

2496      & PGSUM1(5),PGSUM2(5),PVS2(500,5) 

2497 c----- for this subroutine -----------------------------------      

2498       DOUBLE PRECISION MTG2,MXX,MJJ,PG1(5),PG2(5),

2499      & PMX(5),PMJJ(5),PVS(5),PAUX(5),AUXM,PCS(5)

2500       INTEGER NFAIL

2501       LOGICAL FIRST

2502       DATA FIRST /.TRUE./

2503       SAVE FIRST

2504 

2505       IF(FIRST) THEN

2506        IF((2*ETJCUT).LT.14.D0.OR.(2*ETJCUT).GT.300.D0) THEN

2507         PRINT*,'EDDE2GAM:Attention: generator works in the ETcut'

2508         PRINT*,'range 7-150 GeV; you use the cut = ',ETJCUT

2509        ENDIF

2510       ENDIF   

2511 

2512  1    CONTINUE

2513       CALL GENERSI2GAM(MJJ,ETAJ)

2514 c--- sign of etaj

2515       IF (ETAJ.EQ.0.D0) THEN

2516        SIGNETA=0.D0

2517       ELSE

2518        SIGNETA=ETAJ/DABS(ETAJ)

2519       ENDIF 

2520 c--- 2 cascads generation

2521       CALL SICASCAD2(MJJ,NG1,PNG1,PGC1,NG2,PNG2,PGC2,MXX,NFAIL)

2522       IF (NFAIL.EQ.1) GOTO 1

2523 c--- 

2524       CALL EDDETTPHI(NFI,MXX,T1,T2,FI0) 

2525       DT12= DABS(T1)+DABS(T2)

2526       DT12= DT12+2.D0*DSQRT(DABS(T1)*DABS(T2))*DCOS(FI0)      

2527       PKAP = 1.D0/DCOSH(ETAJ)**2

2528       X1  = EDDEX(MXX)

2529       XF1 = 1.D0-X1

2530       X2  = (MXX*MXX+DT12)/(S*X1)

2531       XF2 = 1.D0-X2   

2532        IF(XF2.LE.0.OR.XF2.GT.1) GOTO 1

2533        IF(PYR(0).LE.0.5) THEN

2534         XSAVE=XF1

2535         XF1=XF2

2536         XF2=XSAVE

2537        ENDIF

2538       X1=1.D0-XF1

2539       X2=1.D0-XF2

2540 C-...scattered proton 1

2541       PZ  = PP(1,3)*XF1

2542       PT  = DSQRT(DABS(T1))

2543       FI  = 2.*PI*PYR(0)

2544       PX  = PT*DCOS(FI)

2545       PY  = PT*DSIN(FI)

2546       PP(3,1) = PX

2547       PP(3,2) = PY

2548       PP(3,3) = PZ

2549       PP(3,4) = DSQRT(PX**2+PY**2+PZ**2+AMP**2)

2550       PP(3,5) = AMP 

2551       KK(3,1) = 1

2552       KK(3,2) = 2212

2553       KK(3,3) = 1

2554 C-...scattered proton 2

2555       PZ  = PP(2,3)*XF2

2556       PT  = DSQRT(DABS(T2))

2557       PX  = PT*DCOS(FI+FI0)

2558       PY  = PT*DSIN(FI+FI0)

2559       PP(4,1) = PX

2560       PP(4,2) = PY

2561       PP(4,3) = PZ

2562       PP(4,4) = DSQRT(PX**2+PY**2+PZ**2+AMP**2)

2563       PP(4,5) = AMP 

2564       KK(4,1) = 1

2565       KK(4,2) = 2212

2566       KK(4,3) = 2 

2567 C-...

2568 C--- momentum of X-system in the lab ---------------------

2569 C--- and new value of MX ---------------------------------

2570       AUXM=MXX

2571       DO I=1,4   

2572        PMX(I)=PP(1,I)+PP(2,I)-PP(3,I)-PP(4,I)

2573       ENDDO

2574        PMX(5)=DSQRT(PMX(4)**2-PMX(1)**2-PMX(2)**2-PMX(3)**2)        

2575        MXX=PMX(5)

2576 c----------------------------------------------------       

2577 c- mass correction for all momenta -------

2578 c- and sum of final momenta -

2579       DO I=1,5 

2580        PGSUM1(I)=0.D0

2581        PGSUM2(I)=0.D0

2582       ENDDO

2583       IF (NG1.GT.0) THEN 

2584        DO J=1,NG1       

2585         DO I=1,4

2586          PAUX(I)=PNG1(I,J)

2587         ENDDO

2588         PAUX(5)=PMAS(21,1)

2589         CALL SIMXCOR(1,AUXM,MXX,PAUX,PVS)

2590         DO I=1,3

2591          PNG1(I,J)=PVS(I)

2592          PGSUM1(I)=PGSUM1(I)+PNG1(I,J)

2593         ENDDO

2594         PNG1(4,J)=DSQRT(PNG1(1,J)**2+PNG1(2,J)**2+PNG1(3,J)**2)

2595         PGSUM1(4)=PGSUM1(4)+PNG1(4,J)

2596        ENDDO 

2597       ENDIF 

2598 c----------------------------------------------------

2599       IF (NG2.GT.0) THEN

2600        DO J=1,NG2       

2601         DO I=1,4

2602          PAUX(I)=PNG2(I,J)

2603         ENDDO

2604         PAUX(5)=PMAS(21,1)

2605         CALL SIMXCOR(2,AUXM,MXX,PAUX,PVS)

2606         DO I=1,3

2607          PNG2(I,J)=PVS(I)

2608          PGSUM2(I)=PGSUM2(I)+PNG2(I,J)

2609         ENDDO

2610         PNG2(4,J)=DSQRT(PNG2(1,J)**2+PNG2(2,J)**2+PNG2(3,J)**2)

2611         PGSUM2(4)=PGSUM2(4)+PNG2(4,J)

2612        ENDDO

2613       ENDIF

2614 c- momentum of central system -

2615       PGC1(4)=0.5D0*MXX-PGSUM1(4)

2616       PGC1(3)=0.5D0*MXX-PGSUM1(3)

2617       PGC2(4)=0.5D0*MXX-PGSUM2(4)

2618       PGC2(3)=-0.5D0*MXX-PGSUM2(3)      

2619       DO I=1,4

2620          PCS(I)=PGC1(I)+PGC2(I)

2621       ENDDO

2622        PCS(5)=DSQRT(PCS(4)**2-PCS(1)**2-PCS(2)**2-PCS(3)**2)

2623 c-was a BUG! new PKAP sometimes was >1,changed to if

2624        AUX1=PKAP

2625        PKAP=PKAP*MJJ*MJJ/(PCS(5)*PCS(5))

2626        IF (PKAP.GT.1.D0) THEN

2627         PKAP=AUX1

2628        ENDIF 

2629        MJJ=PCS(5)

2630 C--- momentum of JJ-system in the gg C.M. -----------------

2631 C--- and new value of MJJ ---------------------------------

2632       DO I=1,5   

2633        PMJJ(I)=PCS(I)

2634       ENDDO

2635 

2636 c-- 2 cascads momenta transformation ----------------

2637 c-- from CMX to lab. --------------------------------

2638 c- and sum of final momenta -

2639       DO I=1,5 

2640        PGSUM1(I)=0.D0

2641        PGSUM2(I)=0.D0

2642       ENDDO

2643       

2644       IF (NG1.GT.0) THEN 

2645       DO J=1,NG1       

2646        DO I=1,4

2647        PAUX(I)=PNG1(I,J)

2648        ENDDO

2649        PAUX(5)=PMAS(21,1)

2650        CALL XCMTOLAB(PMX,PAUX,PVS)

2651        DO I=1,5

2652        PNG1(I,J)=PVS(I)

2653        PGSUM1(I)=PGSUM1(I)+PNG1(I,J)

2654        ENDDO 

2655       ENDDO 

2656       ENDIF 

2657 c----------------------------------------------------

2658       IF (NG2.GT.0) THEN

2659       DO J=1,NG2       

2660        DO I=1,4

2661        PAUX(I)=PNG2(I,J)

2662        ENDDO

2663        PAUX(5)=PMAS(21,1)

2664        CALL XCMTOLAB(PMX,PAUX,PVS)

2665        DO I=1,5

2666        PNG2(I,J)=PVS(I)

2667        PGSUM2(I)=PGSUM2(I)+PNG2(I,J)

2668        ENDDO 

2669       ENDDO

2670       ENDIF  

2671 C-...

2672        MTG2 = MJJ*MJJ*PKAP/4.D0

2673 C-... gamma gamma system in the X-rest frame

2674 C-... parton1 - momentum

2675       PG1(5) = PMAS(22,1)

2676       PT=DSQRT(MTG2-PG1(5)**2)

2677       FI  = 2.*PI*PYR(0)

2678       PG1(1)=PT*DCOS(FI)

2679       PG1(2)=PT*DSIN(FI)

2680       PG1(3)=SIGNETA*MJJ*DSQRT(1.D0-PKAP)/2.D0

2681       PG1(4)=DSQRT(PG1(1)**2+PG1(2)**2+PG1(3)**2+PG1(5)**2) 

2682 C-... parton2 - momentum

2683       PG2(5) = PMAS(22,1) 

2684       DO I=1,3

2685        PG2(I)=-PG1(I)

2686       ENDDO

2687       PG2(4)=DSQRT(PG2(1)**2+PG2(2)**2+PG2(3)**2+PG2(5)**2)

2688 C-... gamma gamma system in the lab. frame

2689 C-... lorentz transformation

2690       CALL XCMTOLAB(PMJJ,PG1,PAUX)

2691       CALL XCMTOLAB(PMX,PAUX,PVS)

2692       DO I=1,5

2693        PG1(I)=PVS(I)

2694       ENDDO      

2695       CALL XCMTOLAB(PMJJ,PG2,PAUX)

2696       CALL XCMTOLAB(PMX,PAUX,PVS)

2697       DO I=1,5

2698        PG2(I)=PVS(I)

2699       ENDDO    

2700 C-...gamma gamma in the lab. frame

2701       DO I=1,5

2702        PP(6,I) = PG1(I)

2703        PP(7,I) = PG2(I)

2704       ENDDO  

2705        KK(6,1)=1

2706        KK(6,2)=22 

2707        KK(6,3)=0        

2708        KK(7,1)=1

2709        KK(7,2)=22 

2710        KK(7,3)=0

2711       DO I=1,5

2712        PP(6,I) = PG1(I) 

2713        PP(7,I) = PG2(I) 

2714       ENDDO

2715 C-...gamma gamma-system definition 

2716        KK(5,1)=11

2717        KK(5,2)=90 

2718       DO I=1,4

2719        PP(5,I) = PG1(I) + PG2(I) 

2720       ENDDO

2721        PP(5,5) = DSQRT(PP(5,4)**2-PP(5,1)**2-PP(5,2)**2-PP(5,3)**2)

2722        CALL PY2ENT(6,22,22,PP(5,5)) 

2723       DO I=1,5

2724        PP(6,I) = PG1(I)

2725        PP(7,I) = PG2(I)

2726       ENDDO  

2727 

2728        NGS=0 ! number of singlet systems

2729        NGSUM=NG1+NG2 !<80

2730        NN=7+NGS+NGSUM

2731 c-- simple case realization --------------

2732 c-      KK(8,1)=11

2733 c-      KK(8,2)=90

2734 c-      DO I=1,4

2735 c-       PP(8,I) = PGSUM1(I)+PGSUM2(I)

2736 c-      ENDDO

2737 c-       PP(8,5) = DSQRT(PP(8,4)**2-PP(8,1)**2-PP(8,2)**2-PP(8,3)**2)

2738 c--- NG1+NG2 gluons

2739 c-  KK(I,1)=2 or 1,KK(I,2)=21,KK(I,3)=0,KK(I,4)=0,KK(I,5)=0      

2740 c- gluons permutations

2741        CALL COMBSING(NGSUM,NA2,NA3,CEVENT)

2742       DO I=8,NGSUM+7

2743        KK(I,1)=CEVENT(2,I-7)

2744        KK(I,2)=21 

2745        KK(I,3)=0

2746        KK(I,4)=0

2747        KK(I,5)=0

2748       ENDDO       

2749 c-- all the momenta to PYTHIA              

2750       IF (NG1.GT.0) THEN

2751       DO I=8,NG1+7

2752        DO J=1,5 

2753         PP(I,J)=PNG1(J,I-7)

2754        ENDDO

2755       ENDDO

2756       ENDIF

2757       IF (NG2.GT.0) THEN      

2758       DO I=NG1+8,NGSUM+7

2759        DO J=1,5 

2760         PP(I,J)=PNG2(J,I-7-NG1)

2761        ENDDO

2762       ENDDO

2763       ENDIF

2764 c- permutations of momenta according to CEVENT(1,I)

2765       DO I=1,NGSUM

2766        DO J=1,5

2767         PVS2(I,J)=PP(7+I,J)

2768        ENDDO       

2769       ENDDO

2770       DO I=1,NGSUM

2771        DO J=1,5

2772         PP(7+I,J)=PVS2(CEVENT(1,I),J)

2773        ENDDO       

2774       ENDDO

2775 c--- 2gamma to PYLIST   

2776       CALL PYSHOW(6,7,PP(5,5))

2777 c--- all the gluons to PYLIST

2778 c-      CALL PYSHOW(9,-NGSUM,PP(8,5))

2779       MINT(1)=449

2780         

2781       RETURN

2782       END      

2783 

2784 C-++++++++++++++++++++++++++++++++++++++++++

2785 C- EDDE2.1: basic subroutines and functions

2786 C-++++++++++++++++++++++++++++++++++++++++++

2787       SUBROUTINE EDDETITLE

2788       

2789       IMPLICIT DOUBLE PRECISION (A-H,O-Z)

2790       IMPLICIT INTEGER (I-N)

2791        

2792       WRITE(*,*)'*************************************
2793      & *****************************************'

2794       WRITE(*,*)'                                    '

2795       WRITE(*,*)' OOOOO    OOOO     OOOO     OOOOO   '

2796       WRITE(*,*)' O        O   O    O   O    O       '

2797       WRITE(*,*)' OOOOO    O   O    O   O    OOOOO   '

2798       WRITE(*,*)' O        O   O    O   O    O       '

2799       WRITE(*,*)' OOOOO    OOOO     OOOO     OOOOO   '

2800       WRITE(*,*)'    X        O        I       V     '

2801       WRITE(*,*)'                     F       E      '

2802       WRITE(*,*)'      C      U      F       N       '

2803       WRITE(*,*)'                   R       T        '

2804       WRITE(*,*)'        L    B    A       S         '

2805       WRITE(*,*)'         U       C                  '

2806       WRITE(*,*)'          S  L  T                   '

2807       WRITE(*,*)'           I   I                    '

2808       WRITE(*,*)'            VEV                     '

2809       WRITE(*,*)'                                    '

2810       WRITE(*,*)'     Version 2.1.2 (2008)           '

2811       WRITE(*,*)'                                    '

2812       WRITE(*,*)'  By Diffractive groupe:            '

2813       WRITE(*,*)'  ------------------                '      

2814       WRITE(*,*)'  V.Petrov,R.Ryutin,A.Sobol         '

2815       WRITE(*,*)' (IHEP,Protvino)                    '

2816       WRITE(*,*)'  J.-P.Guillaud                     '

2817       WRITE(*,*)' (LAPP,Annecy)                      '

2818       WRITE(*,*)'                                    '      

2819       WRITE(*,*)'                                    '

2820       WRITE(*,*)'                                    '

2821       WRITE(*,*)'                                    '

2822       WRITE(*,*)'*************************************
2823      & *****************************************'      

2824 

2825       RETURN

2826       END

2827 C

2828 C--- 1-dim integration ----------------

2829        FUNCTION DISIMP(TOTFUN,P1,P2,ERR)

2830        

2831        IMPLICIT DOUBLE PRECISION (A-H,O-Z)

2832        IMPLICIT INTEGER (I-N)

2833        

2834        M=1000

2835  1     N=2*M

2836        H=(P2-P1)/N

2837        X1=P1+H

2838        XD1=P1+0.5D0*H

2839        SN=TOTFUN(P1)+TOTFUN(P2)+2.D0*TOTFUN(X1)

2840        S2N=TOTFUN(P1)+TOTFUN(P2)+4.D0*TOTFUN(XD1)

2841        VY=0.D0       

2842        DO I=1,M-1

2843        VAR1=P1+I*H

2844        VAR2=P1+(2*I+1)*H

2845        VAR3=P1+(2*I+1)*0.5D0*H

2846        VY=VY+2.D0*TOTFUN(VAR1)

2847        SN=SN+2.D0*TOTFUN(VAR2)

2848        S2N=S2N+4.D0*TOTFUN(VAR3)        

2849        ENDDO

2850        DO I=M,N-1 

2851        VAR1=P1+I*H

2852        VAR3=P1+(2*I+1)*0.5D0*H

2853        VY=VY+2.D0*TOTFUN(VAR1)

2854        S2N=S2N+4.D0*TOTFUN(VAR3)         

2855        ENDDO

2856        SN=SN+VY

2857        SN=SN*H/3.D0

2858        S2N=S2N+VY

2859        S2N=S2N*H/6.D0

2860        IF (DABS(S2N).GT.0.D0) THEN

2861        RN=DABS(S2N-SN)/(15.D0*DABS(S2N))

2862        ELSE

2863        RN=1.D0

2864        ENDIF

2865        M=2*M

2866        IF (RN.GT.ERR) GOTO 1             

2867        DISIMP=S2N

2868        

2869        RETURN

2870        END

2871        

2872 c-------------------------------------------------------------              

2873 c- ... model functions !R.Ryutin

2874 c-------------------------------------------------------------

2875 c--------ADDITIONAL FUNCTIONS and SUBROUTINES-----------------

2876 C-============================================================

2877 C-==== linear interpolation of any f(x,y) from data table ====

2878 C-============================================================

2879 C--- check+

2880        SUBROUTINE LINTERPOL2(FUNDAT,N1,N2,X0,Y0,DX,DY,XV,YV,FUN)

2881        

2882        IMPLICIT NONE

2883        INTEGER I,J

2884        INTEGER N1,N2

2885        DOUBLE PRECISION FUNDAT(N1,N2),X0,Y0,DX,DY

2886        DOUBLE PRECISION XV,YV,FUN

2887        DOUBLE PRECISION X(2),Y(2),C(2),D(2),F(2,2)

2888        

2889        I=DINT((XV-X0)/DX)+1

2890        J=DINT((YV-Y0)/DY)+1

2891        

2892        F(1,1)=FUNDAT(I,J)

2893        F(2,1)=FUNDAT(I+1,J)

2894        F(1,2)=FUNDAT(I,J+1)

2895        F(2,2)=FUNDAT(I+1,J+1)

2896        IF (I.GE.N1) THEN

2897            F(1,2)=F(1,1)

2898            F(2,2)=F(2,1)

2899        ENDIF

2900        IF (J.GE.N2) THEN

2901            F(2,1)=F(1,1)

2902            F(2,2)=F(1,2)

2903        ENDIF

2904        IF (I.GE.N1.AND.J.GE.N2) THEN

2905             F(1,2)=F(1,1)

2906             F(2,1)=F(1,1)

2907             F(2,2)=F(1,1)

2908        ENDIF

2909        X(1)=X0+(I-1)*DX

2910        X(2)=X0+I*DX

2911        Y(1)=Y0+(J-1)*DY

2912        Y(2)=Y0+J*DY

2913        

2914        C(1)=(F(1,1)+F(2,2)-F(1, 2)-F(2, 1))/(DX*DY)

2915        C(2)=(F(2,1)*X(1)-F(2,2)*X(1)-F(1,1)*X(2)+F(1,2)*X(2))/(DX*DY)

2916        D(1)=(F(1,2)*Y(1)-F(2,2)*Y(1)-F(1,1)*Y(2)+F(2,1)*Y(2))/(DX*DY)

2917        D(2)=(F(2,2)*X(1)*Y(1)+F(1,1)*X(2)*Y(2))/(DX*DY)

2918        D(2)=D(2)-(F(1,2)*X(2)*Y(1)+F(2,1)*X(1)*Y(2))/(DX*DY)

2919              

2920        FUN=XV*(C(1)*YV+D(1))+C(2)*YV+D(2)

2921        IF (I.GT.N1.OR.J.GT.N2) THEN

2922 c-          WRITE(*,*)'OUT OF THE INTERPOLATION RANGE'

2923           FUN=0.D0

2924        ENDIF       

2925                     

2926        RETURN

2927        END  

2928 

2929 

2930 C-============================================================

2931 C-=========== factorial integer ==============================

2932 C-============================================================

2933        FUNCTION FACTN(NI)

2934 

2935        IMPLICIT NONE

2936        INTEGER FACTN 

2937        INTEGER FCT,NI,NI0,J

2938        

2939        FCT=1

2940        NI0=NI

2941        IF (NI.LT.1) THEN

2942         NI0=1

2943        ENDIF

2944        DO J=1,NI0

2945         FCT=FCT*J

2946        ENDDO

2947        

2948        FACTN=FCT

2949        

2950        RETURN

2951        END

2952 C-============================================================

2953 

2954 C-============================================================

2955 C-=========== factorial ======================================

2956 C-============================================================

2957        FUNCTION FACT(NI)

2958 

2959        IMPLICIT NONE

2960        DOUBLE PRECISION FACT 

2961        INTEGER FCT,NI,NI0,J

2962        

2963        FCT=1

2964        NI0=NI

2965        IF (NI.LT.1) THEN

2966         NI0=1

2967        ENDIF

2968        DO J=1,NI0

2969         FCT=FCT*J

2970        ENDDO

2971        

2972        FACT=DBLE(FCT)

2973        

2974        RETURN

2975        END

2976 C-============================================================

2977 

2978 c--------"SOFT" FUNCTIONS and SUBROUTINES---------------------

2979 C-============================================================

2980 C-= bare t-hard slope function (for total cs. calc.) =========

2981 C-= AMP_gp-gp~EXP(-TSLOPEBH(sqrt(s)/M)*|T|) ==================

2982 C-============================================================

2983 C--- check+

2984       FUNCTION TSLOPEBH(VAR)

2985       IMPLICIT NONE

2986       DOUBLE PRECISION TSLOPEBH,VAR,RAUX

2987 c------ parameters for soft rescattering (trajectories)----

2988 c------ (t1,t2,fi0 dependence) ----------------------------

2989       INTEGER NAPR,NFI

2990       DOUBLE PRECISION CP,DP,RP,RG,AP,

2991      &   T1MIN,T1MAX,T2MIN,T2MAX,FKK,CGP

2992       COMMON/EDDESOFT/ CP(3),DP(3),RP(3),RG(3),AP(3),

2993      &   T1MIN,T1MAX,T2MIN,T2MAX,FKK,CGP,NAPR,NFI 

2994      

2995        RAUX=0.25D0*RG(3)+0.125D0*RP(3)

2996        TSLOPEBH=AP(3)*DLOG(VAR)+RAUX

2997 

2998       RETURN

2999       END

3000 C-============================================================

3001 C-============================================================

3002 C-= t-slope argument correction ============================== 

3003 C-= fqt2Isud=0.756*0.6<qt**2>/(1+0.6<qt**2>) =================

3004 C-= from qt-loop integral with general semi-incl. sudakov ====

3005 C-============================================================

3006 C--- check+

3007        FUNCTION FQT2ISUD(MU,DETA)

3008 

3009        IMPLICIT NONE

3010        DOUBLE PRECISION  FQT2ISUD,MU,DETA,QT2SR

3011 

3012        QT2SR=1.38D0*MU**0.93D0*(2.9D0/MU)**(0.055D0*DETA)

3013        FQT2ISUD=0.756D0*0.6D0*QT2SR/(1.D0+0.3D0*QT2SR)

3014        

3015        RETURN

3016        END

3017 C-============================================================

3018 C-!!!!!!!!!!!!!!!!!!!!!!!!

3019 

3020 C-============================================================

3021 C- t1,t2,phi_(1,2) generator for the EDDE and SI DDE =========

3022 C-============================================================

3023 C--- check+

3024       SUBROUTINE EDDETTPHI(NX,MX,GT1,GT2,GFI0)

3025       

3026       IMPLICIT NONE

3027       

3028       DOUBLE PRECISION TSLOPEBH,FQT2ISUD,FACT

3029 c-... Mass of the central system and random value

3030       DOUBLE PRECISION MX,MU,PYR

3031 c-... parameters of 3 Pomeron trajectories and "hard" slope (2*B_hard(J/Psi)) 

3032       DOUBLE COMPLEX OP(3),BP(3)

3033       DOUBLE PRECISION REBP(3),IMBP(3)

3034 c-... variables to generate      

3035       DOUBLE PRECISION GT1,GT2,GFI0

3036 c-... aux. parameters

3037       DOUBLE PRECISION AUX0,BETA

3038       DOUBLE PRECISION AUX3,AUX4,AUX5,AUX6

3039       DOUBLE PRECISION AUX7,AUX8,AUX9,AUX10,AUX11

3040 c-... "hard" slope, function for the "soft" survival factor

3041       DOUBLE PRECISION REBH,REBH2,IMBH,IMBH2

3042       DOUBLE COMPLEX BH,BH2

3043       DOUBLE COMPLEX SFU1,SFU2,SFU3,SFU4

3044       DOUBLE COMPLEX SFU10,SFU20,SFU30,SFU40

3045 c      DOUBLE COMPLEX BIND,FLL2,FLL2M

3046       DOUBLE COMPLEX BIND

3047       DOUBLE PRECISION REBIND,IMBIND

3048 c      DOUBLE COMPLEX FU1,FU2,FU3,FU4

3049       DOUBLE COMPLEX FU1,FU2,FU3

3050       DOUBLE PRECISION FIM,FIMM,SURV2,SURV2M

3051       DOUBLE PRECISION VPB,VBVSP,VBVSP2

3052 c-... gp->gp amplitude unitar.corr. generation parameters .....

3053       DOUBLE COMPLEX AUX1,AUX2,SSFU1,SSFU2,SSFU0

3054       DOUBLE PRECISION AAGP1,AAGP2,AAGP0

3055       DOUBLE PRECISION AAGP10,AAGP20,AAGPX,AAGPXM

3056 c-... first generation      

3057       DOUBLE PRECISION RT1,RT2,RFI0,RPT,RATFG

3058 c-... NAPR=7 optimal value for the eikonal approximation.

3059       INTEGER N1,N2,N3,NX

3060 c-... FLAGS=1 0++ Higgs,Chi; FLAGS=2 ... other states.      

3061       INTEGER FLAGS 

3062 c------ fundamental constants -----------------------------

3063       INTEGER NF,NC,NLOSW

3064       DOUBLE PRECISION PI,CSMB,LAMQCD,

3065      & TF,CF,BF0,BF1

3066       DOUBLE COMPLEX MNI,REI

3067       COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

3068      & TF,CF,BF0,BF1,NF,NC,NLOSW

3069 c----- parameters for hard cross-sections -----------------

3070       DOUBLE PRECISION MGGCUT,ETJCUT,MXMAX,

3071      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

3072      & PSIDD1,PSIDD2

3073       COMMON/EDDEHARD/ MGGCUT,ETJCUT,MXMAX,

3074      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

3075      & PSIDD1,PSIDD2     

3076 c------ parameters for soft rescattering (trajectories)----

3077 c------ (t1,t2,fi0 dependence) ----------------------------

3078       INTEGER NAPR,NFI

3079       DOUBLE PRECISION CP,DP,RP,RG,AP,

3080      &   T1MIN,T1MAX,T2MIN,T2MAX,FKK,CGP

3081       COMMON/EDDESOFT/ CP(3),DP(3),RP(3),RG(3),AP(3),

3082      &   T1MIN,T1MAX,T2MIN,T2MAX,FKK,CGP,NAPR,NFI    

3083 c-    

3084 c-      LOGICAL START

3085 c-      DATA START / .TRUE. /

3086 c-      SAVE START, BP, OP

3087 c-      

3088 c----------------------------------------------------------------------------

3089 c-      Switch on (off) for different phi0 distributions                     

3090 c-      FLAGS=1(default) -> general heavy 0++ (Higgs, H*, R*,...)                           *

3091 c-      FLAGS=2 -> (Jz=0 and +-2)

3092 c-      FLAGS=3 -> heavy conserved 0-+

3093 c-      FLAGS=4 -> conserved "glueball"

3094 c-      FLAGS=5 -> (Jz=+-2) ^

3095 c----------------------------------------------------------------------------

3096 c-----------------------------------

3097       FLAGS=NX 

3098 c-      IF (START) THEN

3099 c-... Pomerons

3100       REBP(1)=2.D0*AP(1)*DLOG(SQS)+RP(1)/4.D0

3101       IMBP(1)=-AP(1)*PI/2.D0

3102       REBP(2)=2.D0*AP(2)*DLOG(SQS)+RP(2)/4.D0

3103       IMBP(2)=-AP(2)*PI/2.D0

3104       REBP(3)=2.D0*AP(3)*DLOG(SQS)+RP(3)/4.D0

3105       IMBP(3)=-AP(3)*PI/2.D0      

3106       BP(1)=REI*REBP(1)+MNI*IMBP(1)

3107       BP(2)=REI*REBP(2)+MNI*IMBP(2)

3108       BP(3)=REI*REBP(3)+MNI*IMBP(3)

3109       OP(1)=CP(1)*SQS**(2.D0*DP(1))/BP(1)      

3110       OP(1)=OP(1)*(REI*DCOS(0.5D0*PI*DP(1))-MNI*DSIN(0.5D0*PI*DP(1)))

3111       OP(2)=CP(2)*SQS**(2.D0*DP(2))/BP(2)

3112       OP(2)=OP(2)*(REI*DCOS(0.5D0*PI*DP(2))-MNI*DSIN(0.5D0*PI*DP(2))) 

3113       OP(3)=CP(3)*SQS**(2.D0*DP(3))/BP(3)

3114       OP(3)=OP(3)*(REI*DCOS(0.5D0*PI*DP(3))-MNI*DSIN(0.5D0*PI*DP(3)))

3115 c-      START = .FALSE.

3116 c-      END IF

3117 c---     

3118       MU=MX*0.5D0

3119       AUX0=SQS*FQT2ISUD(MU,0.D0)/MX

3120       REBH=TSLOPEBH(AUX0)

3121       IMBH=-AP(3)*PI/2.D0

3122       BH=REI*REBH+MNI*IMBH

3123       BH2=BH+BH

3124       REBH2=REBH+REBH

3125       IMBH2=IMBH+IMBH

3126       BETA=0.4D0*DLOG(SQS/MX**1.7D0)

3127 c---

3128  1     CALL GENERTTUP(MX,RT1,RT2)

3129         RFI0=PI*PYR(0)

3130         RPT=RT1+RT2-2*DSQRT(RT1*RT2)*DCOS(RFI0)

3131         IF (RPT.GT.2.5D0) GOTO 1

3132 c-... T1,T2 dep. of gp->gp amplitudes (unitarized) ------------

3133        AUX1=REI*CGP*AUX0**DP(3)

3134        AUX1=AUX1/(8.D0*PI*BH)

3135        AUX1=AUX1*(REI*DCOS(0.5D0*PI*DP(3))-MNI*DSIN(0.5D0*PI*DP(3)))

3136        SSFU1=REI

3137        SSFU2=REI

3138        SSFU0=REI

3139         DO N1=2,NAPR+2

3140          AUX2=(-AUX1)**(N1-1)/(N1*N1*FACT(N1-1))

3141          AUX3=REBH*(N1-1)*RT1/N1

3142          AUX4=REBH*(N1-1)*RT2/N1

3143          AUX5=IMBH*(N1-1)*RT1/N1

3144          AUX6=IMBH*(N1-1)*RT2/N1

3145         SSFU1=SSFU1+AUX2*DEXP(AUX3)*(REI*DCOS(AUX5)-MNI*DSIN(AUX5))

3146         SSFU2=SSFU2+AUX2*DEXP(AUX4)*(REI*DCOS(AUX6)-MNI*DSIN(AUX6))

3147         SSFU0=SSFU0+AUX2

3148         ENDDO

3149         AAGP1=SSFU1*DCONJG(SSFU1)

3150         AAGP2=SSFU2*DCONJG(SSFU2)

3151         AAGP0=SSFU0*DCONJG(SSFU0)

3152         AAGP10=AAGP0

3153         AAGP20=AAGP0

3154         IF (RT1.GT.3.7D0) THEN

3155          AAGP10=AAGP10*DEXP(0.4D0*DLOG(SQS/MX**1.7D0)*(RT1-3.7D0))

3156         ENDIF

3157         IF (RT2.GT.3.7D0) THEN

3158          AAGP20=AAGP20*DEXP(0.4D0*DLOG(SQS/MX**1.7D0)*(RT1-3.7D0))

3159         ENDIF

3160         AAGPX=AAGP1*AAGP2

3161         AAGPXM=AAGP10*AAGP20

3162 c-... general survival distribution

3163          SFU3=0.D0*REI

3164          SFU30=0.D0*REI

3165         DO N1=1,NAPR

3166            SFU2=0.D0*REI

3167            SFU20=0.D0*REI

3168          DO N2=0,N1

3169            SFU1=0.D0*REI

3170            SFU10=0.D0*REI

3171           DO N3=0,N1-N2

3172            REBIND=N2*REBP(1)/(REBP(1)**2+IMBP(1)**2)

3173            REBIND=REBIND+N3*REBP(2)/(REBP(2)**2+IMBP(2)**2)

3174            REBIND=REBIND+(N1-N2-N3)*REBP(3)/(REBP(3)**2+IMBP(3)**2)

3175            IMBIND=-N2*IMBP(1)/(REBP(1)**2+IMBP(1)**2)

3176            IMBIND=IMBIND-N3*IMBP(2)/(REBP(2)**2+IMBP(2)**2)

3177            IMBIND=IMBIND-(N1-N2-N3)*IMBP(3)/(REBP(3)**2+IMBP(3)**2)           

3178            BIND=REI*REBIND+MNI*IMBIND

3179            AUX7=REBH2*REBIND-IMBH2*IMBIND+1.D0

3180            AUX8=IMBH2*REBIND+REBH2*IMBIND

3181            AUX9=RPT/(AUX7**2+AUX8**2)

3182            AUX10=(REBH**2-IMBH**2)*(REBIND*AUX7+IMBIND*AUX8)

3183            AUX10=AUX10-2.D0*IMBH*REBH*(IMBIND*AUX7-REBIND*AUX8)

3184            AUX10=AUX10*AUX9

3185            AUX11=(REBH**2-IMBH**2)*(IMBIND*AUX7-REBIND*AUX8)

3186            AUX11=AUX11+2.D0*IMBH*REBH*(REBIND*AUX7+IMBIND*AUX8)

3187            AUX11=AUX11*AUX9

3188            FU1=DEXP(AUX10)*(REI*DCOS(AUX11)+MNI*DSIN(AUX11))

3189            FU2=FACT(N3)*FACT(N1-N2-N3)*(BH2*BIND+1)

3190            FU3=(OP(2)/OP(3))**N3

3191            SFU1=SFU1+FU1*FU3/FU2                    

3192            SFU10=SFU10+FU3/FU2

3193           ENDDO

3194           SFU2=SFU2+SFU1*(OP(1)/OP(3))**N2/FACT(N2)

3195           SFU20=SFU20+SFU10*(OP(1)/OP(3))**N2/FACT(N2)

3196          ENDDO 

3197          SFU3=SFU3+SFU2*(-OP(3)/(16.D0*PI))**N1

3198          SFU30=SFU30+SFU20*(-OP(3)/(16.D0*PI))**N1

3199         ENDDO 

3200           SFU4=(1+SFU3)*(1+SFU3)+FKK

3201           SFU40=(1+SFU30)*(1+SFU30)+FKK

3202           SURV2=SFU4*DCONJG(SFU4)*AAGPX

3203           SURV2M=SFU40*DCONJG(SFU40)*AAGPXM

3204 c-... additional phi0-distribution from mass dependence

3205 c-... significant contribution only for masses <3 GeV

3206           FIM=((MX*MX+RT1+RT1+RT2+RT2-RPT)/(MX*MX))**(DP(3)+DP(3))

3207           SURV2=SURV2*FIM

3208           FIMM=(MX*MX+T1MAX+T2MAX+2.D0*DSQRT(T1MAX*T2MAX))/(MX*MX)

3209           FIMM=FIMM**(DP(3)+DP(3))

3210           SURV2M=SURV2M*FIMM

3211 c-... additional phi0-distribution for different states 0++,...

3212        IF (FLAGS.EQ.2) THEN

3213        VPB=0.3D0*MX**0.65D0

3214        VBVSP=1.D0+VPB*DSQRT(RT1*RT2)*DCOS(RFI0)

3215        VBVSP2=1.D0+VPB*DSQRT(T1MAX*T2MAX)

3216        SURV2=SURV2*VBVSP*VBVSP

3217        SURV2M=SURV2M*VBVSP2*VBVSP2

3218        ENDIF

3219 c-

3220        IF (FLAGS.EQ.3) THEN

3221        SURV2=SURV2*RT1*RT2*DSIN(RFI0)**2

3222        SURV2M=SURV2M*T1MAX*T2MAX

3223        ENDIF

3224 c-       

3225        IF (FLAGS.EQ.4) THEN

3226        SURV2=SURV2*RT1*RT2*DCOS(RFI0)**2

3227        SURV2M=SURV2M*T1MAX*T2MAX

3228        ENDIF

3229 c-

3230        IF (FLAGS.EQ.5) THEN

3231        VPB=0.3D0*MX**0.65D0

3232        VBVSP=VPB*DSQRT(RT1*RT2)*DCOS(RFI0)

3233        VBVSP2=VPB*DSQRT(T1MAX*T2MAX)

3234        SURV2=SURV2*VBVSP*VBVSP

3235        SURV2M=SURV2M*VBVSP2*VBVSP2

3236        ENDIF

3237 c-... Monte-carlo generation of the distribution SURV2          

3238        RATFG=SURV2/SURV2M

3239        IF (RATFG.LE.PYR(0)) GOTO 1

3240 c-

3241        GT1=RT1

3242        GT2=RT2

3243        GFI0=RFI0

3244 c-                    

3245       RETURN

3246       END

3247 c---uper t generation ----------------------------------------

3248       SUBROUTINE GENERTTUP(MX,RT1,RT2)

3249 

3250       IMPLICIT NONE

3251       

3252       DOUBLE PRECISION TSLOPEBH,FQT2ISUD,PYR

3253       DOUBLE PRECISION RF1,RF2,RT1,RT2,MX

3254       DOUBLE PRECISION AUX0,AUX1,AUX2,AUX3,AUX4

3255       DOUBLE PRECISION AUX5,AUX6,AUX7

3256       DOUBLE PRECISION AUX8,AUX9

3257       DOUBLE PRECISION REBH,REBH2,MU,BETA

3258 c------ fundamental constants -----------------------------

3259       INTEGER NF,NC,NLOSW

3260       DOUBLE PRECISION PI,CSMB,LAMQCD,

3261      & TF,CF,BF0,BF1

3262       DOUBLE COMPLEX MNI,REI

3263       COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

3264      & TF,CF,BF0,BF1,NF,NC,NLOSW

3265 c----- parameters for hard cross-sections -----------------

3266       DOUBLE PRECISION MGGCUT,ETJCUT,MXMAX,

3267      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

3268      & PSIDD1,PSIDD2

3269       COMMON/EDDEHARD/ MGGCUT,ETJCUT,MXMAX,

3270      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

3271      & PSIDD1,PSIDD2     

3272 c------ parameters for soft rescattering (trajectories)----

3273 c------ (t1,t2,fi0 dependence) ----------------------------

3274       INTEGER NAPR,NFI

3275       DOUBLE PRECISION CP,DP,RP,RG,AP,

3276      &   T1MIN,T1MAX,T2MIN,T2MAX,FKK,CGP

3277       COMMON/EDDESOFT/ CP(3),DP(3),RP(3),RG(3),AP(3),

3278      &   T1MIN,T1MAX,T2MIN,T2MAX,FKK,CGP,NAPR,NFI  

3279 c---

3280 

3281       MU=MX*0.5D0

3282       AUX0=SQS*FQT2ISUD(MU,0.D0)/MX

3283       REBH=TSLOPEBH(AUX0)

3284       REBH2=REBH+REBH

3285       BETA=0.4D0*DLOG(SQS/MX**1.7D0)

3286       AUX1=DEXP(-REBH2*T1MIN)/REBH2

3287       AUX2=DEXP(-REBH2*T2MIN)/REBH2

3288       AUX3=DEXP(-REBH2*3.7D0)

3289       AUX4=DEXP(-(REBH2-BETA)*T1MAX-BETA*3.7D0)/(REBH2-BETA)

3290       AUX5=DEXP(-(REBH2-BETA)*T2MAX-BETA*3.7D0)/(REBH2-BETA)

3291       AUX6=AUX1-AUX3/REBH2

3292       AUX7=AUX2-AUX3/REBH2

3293       AUX8=AUX6+AUX3/(REBH2-BETA)-AUX4

3294       AUX9=AUX7+AUX3/(REBH2-BETA)-AUX5

3295       RF1=PYR(0)*AUX8

3296       RF2=PYR(0)*AUX9

3297       IF (RF1.LE.AUX6) THEN

3298       RT1=-DLOG((AUX1-RF1)*REBH2)/REBH2

3299       ELSE

3300       RT1=DLOG((AUX6+AUX3/(REBH2-BETA)-RF1)*(REBH2-BETA))

3301       RT1=(RT1+3.7D0*BETA)/(BETA-REBH2)

3302       ENDIF

3303       IF (RF2.LE.AUX7) THEN

3304       RT2=-DLOG((AUX2-RF2)*REBH2)/REBH2      

3305       ELSE

3306       RT2=DLOG((AUX7+AUX3/(REBH2-BETA)-RF2)*(REBH2-BETA))

3307       RT2=(RT2+3.7D0*BETA)/(BETA-REBH2)      

3308       ENDIF      

3309 

3310       RETURN

3311       END

3312 C-============================================================

3313 

3314 

3315 C-============================================================

3316 C- x-distribution for a particle production in EDDE  /R.Ryutin

3317 C-============================================================

3318 C--- check+

3319       FUNCTION EDDEX(MX)

3320 c-... xmax=1,xmin=MX**2/s - kinematical limit ..............................

3321 c-... interval xmin/0.1<x<0.1 plays the main role in the theoretical 

3322 c-... calculations

3323 c-... x is the usual kinematical variable, x=1-x_Feinm.

3324 c----------------------------------------------------------------------------c 

3325 c----------------------------------------------------------------------------c

3326 c-      maximal xi=1-xFeinm value (default = 0.1)                 

3327 c-      Region of the model applicability at LHC                           

3328 c----------------------------------------------------------------------------c

3329       IMPLICIT NONE

3330 

3331 c------ fundamental constants -----------------------------

3332       INTEGER NF,NC,NLOSW

3333       DOUBLE PRECISION PI,CSMB,LAMQCD,

3334      & TF,CF,BF0,BF1

3335       DOUBLE COMPLEX MNI,REI

3336       COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

3337      & TF,CF,BF0,BF1,NF,NC,NLOSW    

3338 c------ parameters for soft rescattering (trajectories)----

3339 c------ (t1,t2,fi0 dependence) ----------------------------

3340       INTEGER NAPR,NFI

3341       DOUBLE PRECISION CP,DP,RP,RG,AP,

3342      &   T1MIN,T1MAX,T2MIN,T2MAX,FKK,CGP

3343       COMMON/EDDESOFT/ CP(3),DP(3),RP(3),RG(3),AP(3),

3344      &   T1MIN,T1MAX,T2MIN,T2MAX,FKK,CGP,NAPR,NFI 

3345 c----- parameters for hard cross-sections -----------------

3346       DOUBLE PRECISION MGGCUT,ETJCUT,MXMAX,

3347      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

3348      & PSIDD1,PSIDD2

3349       COMMON/EDDEHARD/ MGGCUT,ETJCUT,MXMAX,

3350      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

3351      & PSIDD1,PSIDD2

3352      

3353       DOUBLE PRECISION EDDEX

3354       DOUBLE PRECISION MX,BTM,PYR

3355 c      DOUBLE PRECISION Y0,Y1,YSR,YSM,YGEN,FYGEN

3356       DOUBLE PRECISION Y0,Y1,YSR,YGEN,FYGEN

3357 C-     

3358        BTM=MX*MX/(SQS*SQS)

3359        Y1=DLOG(SQS/MX)

3360        Y0=Y1+DLOG(0.1D0)

3361        IF (SQS.LE.8.D+03) THEN

3362          Y0=Y1+DLOG(0.2D0)

3363        ENDIF       

3364        IF (SQS.LE.3.D+03) THEN

3365          Y0=Y1+DLOG(0.3D0)

3366        ENDIF

3367        YSR=1.2*Y0

3368   1    YGEN=Y1*PYR(0)  

3369        FYGEN=DEXP(-(YGEN/YSR)**10.D0)

3370       IF (PYR(0).GE.FYGEN) GOTO 1

3371        EDDEX = DSQRT(BTM)*DEXP(YGEN)

3372       RETURN

3373       END

3374 C-============================================================

3375       

3376 C-============================================================            

3377 C-Transformation from the X-rest frame to the lab. frame/R.Ryutin

3378 C-============================================================                    

3379 C--- check+

3380       SUBROUTINE XCMTOLAB(PMXP,PB3P,PVSP)

3381 C-

3382       IMPLICIT NONE

3383 C-       

3384       DOUBLE PRECISION PMXP(5),PB3P(5),PVSP(5),BETA(3),GAMMA,SCAL

3385       INTEGER I 

3386 C-

3387       DO I=1,3

3388       BETA(I)=-PMXP(I)/PMXP(4)

3389       ENDDO

3390 C-      

3391       GAMMA=1.D0/DSQRT(1-BETA(1)**2-BETA(2)**2-BETA(3)**2)

3392       SCAL=BETA(1)*PB3P(1)+BETA(2)*PB3P(2)+BETA(3)*PB3P(3)

3393 C-

3394       DO I=1,3

3395       PVSP(I)=PB3P(I)+GAMMA*BETA(I)*(GAMMA*SCAL/(GAMMA+1.D0)-PB3P(4))

3396       ENDDO

3397 C-      

3398       PVSP(4)=GAMMA*(PB3P(4)-SCAL)

3399       PVSP(5)=DSQRT(DABS(PVSP(4)**2-PVSP(1)**2-PVSP(2)**2-PVSP(3)**2))

3400 C-

3401       RETURN      

3402       END     

3403 C-============================================================

3404 

3405 c--------"HARD" FUNCTIONS and SUBROUTINES --------------------

3406 C-============================================================

3407 C-============ QCD coupling ==================================

3408 C-============================================================

3409 C--- check+

3410        FUNCTION ALPHAS(MU)

3411 

3412        IMPLICIT NONE

3413        DOUBLE PRECISION  ALPHAS,MU,AUXLOG

3414 c------ fundamental constants -----------------------------

3415       INTEGER NF,NC,NLOSW

3416       DOUBLE PRECISION PI,CSMB,LAMQCD,

3417      & TF,CF,BF0,BF1

3418       DOUBLE COMPLEX MNI,REI

3419       COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

3420      & TF,CF,BF0,BF1,NF,NC,NLOSW           

3421 

3422       AUXLOG=2.D0*DLOG(MU/LAMQCD)

3423       ALPHAS=(1.D0-NLOSW*BF1*DLOG(AUXLOG)/(BF0*AUXLOG))

3424       ALPHAS=ALPHAS/(BF0*AUXLOG)

3425       

3426        RETURN

3427        END

3428 C-============================================================

3429 C-============================================================

3430 C-==== 1st integral of QCD coupling in t=Ln(MU^2/LAMQCD^2) ===

3431 C-============================================================

3432 C--- check+

3433        FUNCTION IALPHAS(MU1,MU2)

3434 

3435        IMPLICIT NONE

3436        DOUBLE PRECISION IALPHAS,MU1,MU2

3437        DOUBLE PRECISION LN1,LN2,AUX1,AUX2

3438 c------ fundamental constants -----------------------------

3439       INTEGER NF,NC,NLOSW

3440       DOUBLE PRECISION PI,CSMB,LAMQCD,

3441      & TF,CF,BF0,BF1

3442       DOUBLE COMPLEX MNI,REI

3443       COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

3444      & TF,CF,BF0,BF1,NF,NC,NLOSW           

3445 

3446       LN1=2.D0*DLOG(MU1/LAMQCD)

3447       LN2=2.D0*DLOG(MU2/LAMQCD)

3448       AUX1=(1+DLOG(LN1))/LN1

3449       AUX2=(1+DLOG(LN2))/LN2

3450       IALPHAS=BF1*NLOSW*(AUX2-AUX1)/(BF0*BF0)

3451       IALPHAS=IALPHAS+(DLOG(LN2)-DLOG(LN1))/BF0      

3452       

3453        RETURN

3454        END

3455 C-============================================================

3456 C-============================================================

3457 C-= 1st integral of (QCD coupling)^2 in t=Ln(MU^2/LAMQCD^2) ==

3458 C-============================================================

3459 C--- check+

3460        FUNCTION IALPHAS2(MU1,MU2)

3461 

3462        IMPLICIT NONE

3463        DOUBLE PRECISION IALPHAS2,MU1,MU2

3464        DOUBLE PRECISION LN1,LN2,LLN1,LLN2

3465        DOUBLE PRECISION AUX1,AUX2,AXX1,AXX2

3466        DOUBLE PRECISION AYY1,AYY2

3467 c------ fundamental constants -----------------------------

3468       INTEGER NF,NC,NLOSW

3469       DOUBLE PRECISION PI,CSMB,LAMQCD,

3470      & TF,CF,BF0,BF1

3471       DOUBLE COMPLEX MNI,REI

3472       COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

3473      & TF,CF,BF0,BF1,NF,NC,NLOSW           

3474 

3475       LN1=2.D0*DLOG(MU1/LAMQCD)

3476       LN2=2.D0*DLOG(MU2/LAMQCD)

3477       LLN1=DLOG(LN1)

3478       LLN2=DLOG(LN2)

3479       AUX1=BF1*NLOSW*(2.D0+3.D0*LLN1)-9.D0*BF0*LN1

3480       AUX2=BF1*NLOSW*(2.D0+3.D0*LLN2)-9.D0*BF0*LN2

3481       AXX1=54.D0*BF0**2*LN1**2

3482       AXX1=AXX1+BF1*NLOSW*(4.D0*BF1-27.D0*BF0*LN1)

3483       AXX2=54.D0*BF0**2*LN2**2

3484       AXX2=AXX2+BF1*NLOSW*(4.D0*BF1-27.D0*BF0*LN2)

3485       AYY1=(AXX1+6.D0*BF1*NLOSW*LLN1*AUX1)

3486       AYY1=-AYY1/(54.D0*BF0**4*LN1**3)

3487       AYY2=(AXX2+6.D0*BF1*NLOSW*LLN2*AUX2)

3488       AYY2=-AYY2/(54.D0*BF0**4*LN2**3)

3489       IALPHAS2=AYY2-AYY1    

3490       

3491        RETURN

3492        END

3493 C-============================================================

3494 C-============================================================

3495 C-= Integral(x**N*Pgg(x,MU)/(ALPHAS(MU)/(2*PI)) dx:A->B ======

3496 C-============================================================

3497 C--- check+

3498        FUNCTION IPGG(N,A,B)

3499 

3500        IMPLICIT NONE

3501        INTEGER N

3502        DOUBLE PRECISION  IPGG,A,B

3503 c------ fundamental constants -----------------------------

3504       INTEGER NF,NC,NLOSW

3505       DOUBLE PRECISION PI,CSMB,LAMQCD,

3506      & TF,CF,BF0,BF1

3507       DOUBLE COMPLEX MNI,REI

3508       COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

3509      & TF,CF,BF0,BF1,NF,NC,NLOSW             

3510        

3511        IF (N.EQ.0) THEN

3512          IPGG=DLOG((1-A)*B/((1-B)*A))

3513          IPGG=IPGG-(B-A)*((B+A)**2/NC-(B+A)/2+2)

3514          IPGG=IPGG*2.D0*NC

3515        ENDIF

3516        

3517        IF (N.EQ.1) THEN

3518          IPGG=DLOG((1-A)/(1-B))

3519          IPGG=IPGG+0.5D0*(B-A)*(B**2+A**2+A*B)/NC

3520          IPGG=IPGG-0.5D0*(B-A)*((B+A)+(B**3+A**3+A*B*(B+A))/4.D0)

3521          IPGG=2.D0*NC*IPGG

3522        ENDIF

3523 

3524 C--- INTEGRAL OF NF*Pqg(X) dX X:0->1 -----       

3525        IF (N.GT.1) THEN

3526          IPGG=NF/3.D0

3527        ENDIF  

3528        

3529        RETURN

3530        END

3531 C-============================================================

3532 c-- gg-> a b and gg-> a b c cross-sections on partons level --

3533 c-- dsigma(Mgg,etaj*)/d(etaj*), ------------------------------ 

3534 c-- etaj*=(eta1-eta2)/2: -etamax->+etamax, -------------------

3535 c-- etamax=ArcCosh(Mgg/Mjcut) -------------------------------- 

3536 c-- functions for generation etaj*,Mgg in gg c.m.f. ----------

3537 C--- check+

3538 C--- in exclusive PLUM->PLUM-PSIDD2, ISUDGEN2->ISUD02 --------

3539 C-============================================================

3540 C-========= exclusive g g -> g g Jz=0 ========================

3541 C-============================================================

3542 

3543 c--- differential cross-section -----------------

3544 c--- and its upper limit for etaj* generation ---

3545 c--- N=0 exact, N>0 upper limit -----------------

3546        FUNCTION DCSGG(N,M,ETA)

3547 

3548        IMPLICIT NONE

3549        INTEGER N

3550        DOUBLE PRECISION DCSGG,ALPHAS

3551        DOUBLE PRECISION M,ETA,AUX1

3552 c------ fundamental constants -----------------------------

3553       INTEGER NF,NC,NLOSW

3554       DOUBLE PRECISION PI,CSMB,LAMQCD,

3555      & TF,CF,BF0,BF1

3556       DOUBLE COMPLEX MNI,REI

3557       COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

3558      & TF,CF,BF0,BF1,NF,NC,NLOSW         

3559       

3560       DCSGG=18.D0*PI*(ALPHAS(M/2.D0)/M)**2 

3561       IF (N.EQ.0) THEN

3562          DCSGG=DCSGG*DCOSH(ETA)*DCOSH(ETA)

3563       ELSE

3564          AUX1=(DCOSH(ETA)**3*(DCOSH(ETA)-1.D0))**(1/2.09D0-1.D0) 

3565          DCSGG=DCSGG*0.5D0*2.62108D0*DSINH(ETA)*DCOSH(ETA)

3566          DCSGG=DCSGG*DCOSH(ETA)*(4.D0*DCOSH(ETA)-3.D0)

3567          DCSGG=DCSGG*AUX1/2.09D0

3568       ENDIF 

3569       

3570        RETURN

3571        END

3572        

3573 c--- integrated cross-section -----------

3574        FUNCTION CSGG(M)

3575 

3576        IMPLICIT NONE

3577        DOUBLE PRECISION  CSGG,ALPHAS,M,U

3578 c------ fundamental constants -----------------------------

3579       INTEGER NF,NC,NLOSW

3580       DOUBLE PRECISION PI,CSMB,LAMQCD,

3581      & TF,CF,BF0,BF1

3582       DOUBLE COMPLEX MNI,REI

3583       COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

3584      & TF,CF,BF0,BF1,NF,NC,NLOSW         

3585 c----- parameters for hard cross-sections -----------------

3586       DOUBLE PRECISION MGGCUT,ETJCUT,MXMAX,

3587      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

3588      & PSIDD1,PSIDD2

3589       COMMON/EDDEHARD/ MGGCUT,ETJCUT,MXMAX,

3590      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

3591      & PSIDD1,PSIDD2

3592      

3593         U=DLOG(M/MGGCUT+DSQRT((M/MGGCUT)**2-1))

3594         CSGG=18.D0*PI*(ALPHAS(M/2.D0)/M)**2*(U+0.5D0*DSINH(U+U))

3595        

3596        RETURN

3597        END              

3598 

3599 c--- subroutine to generate upper curve --------- 

3600 c--- on etaj* dependence ------------------------

3601 c--- RF=PYR(0), MG=MGG/MGGCUT --------------------

3602        SUBROUTINE FINVUGG(RF,MG,GETA)

3603 

3604        IMPLICIT NONE

3605        DOUBLE PRECISION GETA,RF,R,MG

3606        DOUBLE PRECISION AUX1,AUX2,AUX3,AUX4

3607 

3608         R=RF**2.09D0*MG**3*(MG-1)

3609         AUX1=(DSQRT(768.D0*R+81.D0)-9.D0)**(1.D0/3.D0)

3610         AUX2=1-16.D0*(2.D0/3.D0)**(1.D0/3.D0)*R**(2.D0/3.D0)/AUX1

3611         AUX2=AUX2+2.D0*AUX1*R**(1.D0/3.D0)*(2.D0/3.D0)**(2.D0/3.D0)

3612         AUX3=1+8.D0*(2.D0/3.D0)**(1.D0/3.D0)*R**(2.D0/3.D0)/AUX1    

3613         AUX3=AUX3-AUX1*R**(1.D0/3.D0)*(2.D0/3.D0)**(2.D0/3.D0) 

3614         AUX4=0.25D0+0.25D0*DSQRT(AUX2)

3615         AUX4=AUX4+0.5D0*DSQRT(AUX3+1.D0/DSQRT(AUX2))/DSQRT(2.D0)    

3616         GETA=DLOG(AUX4+DSQRT(AUX4**2-1))

3617         

3618        RETURN

3619        END  

3620 

3621 c--- upper function for general MG=MGG/MGGCUTdependence ------

3622 c--- N=0 - exact function, N>0 - upper curve ----

3623        FUNCTION FMUGG(N,MG)

3624 

3625        IMPLICIT NONE

3626        INTEGER N

3627        DOUBLE PRECISION FMUGG,MG

3628        DOUBLE PRECISION AUX1,AUX2,AUX3

3629        DOUBLE PRECISION SOFTSURV,ISUD02

3630        DOUBLE PRECISION CSGG,POWCS

3631        DOUBLE PRECISION GFMGEN,STE1,STE2

3632 c------ fundamental constants -----------------------------

3633       INTEGER NF,NC,NLOSW

3634       DOUBLE PRECISION PI,CSMB,LAMQCD,

3635      & TF,CF,BF0,BF1

3636       DOUBLE COMPLEX MNI,REI

3637       COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

3638      & TF,CF,BF0,BF1,NF,NC,NLOSW                

3639 c----- parameters for hard cross-sections -----------------

3640       DOUBLE PRECISION MGGCUT,ETJCUT,MXMAX,

3641      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

3642      & PSIDD1,PSIDD2

3643       COMMON/EDDEHARD/ MGGCUT,ETJCUT,MXMAX,

3644      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

3645      & PSIDD1,PSIDD2

3646 

3647         IF (N.EQ.0) THEN

3648           FMUGG=CSGG(MG*MGGCUT)

3649           FMUGG=FMUGG*SOFTSURV(1,MG*MGGCUT)

3650           FMUGG=FMUGG*ISUD02(1,0.5D0*MG*MGGCUT)

3651           FMUGG=FMUGG/MG**(PLUM-PSURV-PSUD+PSIDD2)

3652         ELSE

3653           AUX1=0.236469D0*(1-NLOSW*0.14D0)/(0.5D0*MGGCUT)**0.15D0

3654           AUX1=AUX1/MGGCUT

3655           AUX2=18.D0*PI*AUX1*AUX1*2.62108D0

3656           POWCS=2.D0*0.15D0+2.D0

3657           STE1=(PLUM+PSIDD2)+POWCS-3.D0/2.09D0

3658           STE2=1.D0/2.09D0

3659           AUX3=GFMGEN(STE1,STE2,MG)  

3660           FMUGG=AUX2*AUX3

3661           FMUGG=FMUGG*SOFTSURV(2,MG*MGGCUT)*MG**PSURV

3662           FMUGG=FMUGG*ISUD02(2,0.5D0*MG*MGGCUT)*MG**PSUD

3663         ENDIF 

3664            

3665        RETURN

3666        END  

3667 

3668 c--- generator of (Mgg,etaj*) in c.m. of initial gg ----------

3669        SUBROUTINE GENEREXGG(GMGG,GETAJ)

3670        

3671        IMPLICIT NONE

3672       

3673        DOUBLE PRECISION PYR,GMG,GMGG,GETAJ

3674        DOUBLE PRECISION FMUGG,DCSGG

3675 c       DOUBLE PRECISION RMG,RMGG,RETAJ,RAT

3676        DOUBLE PRECISION RMG,RETAJ,RAT

3677        DOUBLE PRECISION POWCS,STE1,STE2

3678 c----- parameters for hard cross-sections -----------------

3679       DOUBLE PRECISION MGGCUT,ETJCUT,MXMAX,

3680      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

3681      & PSIDD1,PSIDD2

3682       COMMON/EDDEHARD/ MGGCUT,ETJCUT,MXMAX,

3683      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

3684      & PSIDD1,PSIDD2

3685 

3686       POWCS=2.D0*0.15D0+2.D0 

3687       STE1=(PLUM+PSIDD2)+POWCS-3.D0/2.09D0

3688       STE2=1.D0/2.09D0

3689  51   CALL GFMGENINV(STE1,STE2,PYR(0),RMG)  

3690       RAT=FMUGG(0,RMG)/FMUGG(1,RMG)

3691       IF (RAT.LE.PYR(0)) GOTO 51

3692       GMG=RMG

3693       GMGG=MGGCUT*GMG

3694 

3695  52   CALL FINVUGG(PYR(0),GMG,RETAJ)         

3696       RAT=DCSGG(0,GMGG,RETAJ)/DCSGG(1,GMGG,RETAJ)

3697       IF (RAT.LE.PYR(0)) GOTO 52

3698       IF (PYR(0).LE.0.5D0) THEN

3699        GETAJ=RETAJ

3700       ELSE

3701        GETAJ=-RETAJ

3702       ENDIF 

3703       

3704        RETURN

3705        END

3706  

3707 C-============================================================

3708 C-============================================================

3709 C-========= exclusive g g -> Q Qbar Jz=0 =====================

3710 C-============================================================

3711 

3712 c--- differential cross-section -----------------

3713 c--- and its upper limit for etaj* generation ---

3714 c--- N=0 exact, N>0 upper limit -----------------

3715        FUNCTION DCSQQ(MQ,N,M,ETA)

3716 

3717        IMPLICIT NONE

3718        INTEGER N

3719        DOUBLE PRECISION DCSQQ,ALPHAS

3720        DOUBLE PRECISION MQ,M,ETA,AUX1

3721 c------ fundamental constants -----------------------------

3722       INTEGER NF,NC,NLOSW

3723       DOUBLE PRECISION PI,CSMB,LAMQCD,

3724      & TF,CF,BF0,BF1

3725       DOUBLE COMPLEX MNI,REI

3726       COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

3727      & TF,CF,BF0,BF1,NF,NC,NLOSW         

3728       

3729       DCSQQ=4.D0*PI*(ALPHAS(M/2.D0)/M)**2/3.D0

3730       DCSQQ=DCSQQ*(MQ/M)**2*(1.D0-4.D0*(MQ/M)**2)

3731       IF (N.EQ.0) THEN

3732          DCSQQ=DCSQQ*DCOSH(ETA)*DCOSH(ETA)

3733       ELSE

3734          AUX1=(DCOSH(ETA)**3*(DCOSH(ETA)-1.D0))**(1/2.09D0-1.D0) 

3735          DCSQQ=DCSQQ*0.5D0*2.62108D0*DSINH(ETA)*DCOSH(ETA)

3736          DCSQQ=DCSQQ*DCOSH(ETA)*(4.D0*DCOSH(ETA)-3.D0)

3737          DCSQQ=DCSQQ*AUX1/2.09D0

3738       ENDIF 

3739       

3740        RETURN

3741        END

3742        

3743 c--- integrated cross-section -----------

3744        FUNCTION CSQQ(MQ,M)

3745 

3746        IMPLICIT NONE

3747        DOUBLE PRECISION  CSQQ,ALPHAS,MQ,M,U

3748 c------ fundamental constants -----------------------------

3749       INTEGER NF,NC,NLOSW

3750       DOUBLE PRECISION PI,CSMB,LAMQCD,

3751      & TF,CF,BF0,BF1

3752       DOUBLE COMPLEX MNI,REI

3753       COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

3754      & TF,CF,BF0,BF1,NF,NC,NLOSW         

3755 c----- parameters for hard cross-sections -----------------

3756       DOUBLE PRECISION MGGCUT,ETJCUT,MXMAX,

3757      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

3758      & PSIDD1,PSIDD2

3759       COMMON/EDDEHARD/ MGGCUT,ETJCUT,MXMAX,

3760      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

3761      & PSIDD1,PSIDD2

3762      

3763         U=DLOG(M/MGGCUT+DSQRT((M/MGGCUT)**2-1))

3764         CSQQ=4.D0*PI*(ALPHAS(M/2.D0)/M)**2/3.D0

3765         CSQQ=CSQQ*(MQ/M)**2*(1.D0-4.D0*(MQ/M)**2)

3766         CSQQ=CSQQ*(U+0.5D0*DSINH(U+U))

3767        

3768        RETURN

3769        END              

3770 

3771 c--- subroutine to generate upper curve --------- 

3772 c--- on etaj* dependence ------------------------

3773 c--- RF=PYR(0), MG=MGG/MGGCUT --------------------

3774 c---SUBROUTINE FINVUQQ(RF,MG,GETA)=FINVUGG(RF,MG,GETA)---

3775 

3776 c--- upper function for general MG=MGG/MGGCUTdependence ------

3777 c--- N=0 - exact function, N>0 - upper curve ----

3778        FUNCTION FMUQQ(MQ,N,MG)

3779 

3780        IMPLICIT NONE

3781        INTEGER N

3782        DOUBLE PRECISION FMUQQ,MG,MQ

3783        DOUBLE PRECISION AUX1,AUX2,AUX3

3784        DOUBLE PRECISION SOFTSURV,ISUD02

3785        DOUBLE PRECISION CSQQ,POWCS

3786        DOUBLE PRECISION GFMGEN,STE1,STE2

3787 c------ fundamental constants -----------------------------

3788       INTEGER NF,NC,NLOSW

3789       DOUBLE PRECISION PI,CSMB,LAMQCD,

3790      & TF,CF,BF0,BF1

3791       DOUBLE COMPLEX MNI,REI

3792       COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

3793      & TF,CF,BF0,BF1,NF,NC,NLOSW                

3794 c----- parameters for hard cross-sections -----------------

3795       DOUBLE PRECISION MGGCUT,ETJCUT,MXMAX,

3796      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

3797      & PSIDD1,PSIDD2

3798       COMMON/EDDEHARD/ MGGCUT,ETJCUT,MXMAX,

3799      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

3800      & PSIDD1,PSIDD2

3801 

3802         IF (N.EQ.0) THEN

3803           FMUQQ=CSQQ(MQ,MG*MGGCUT)

3804           FMUQQ=FMUQQ*SOFTSURV(1,MG*MGGCUT)

3805           FMUQQ=FMUQQ*ISUD02(1,0.5D0*MG*MGGCUT)

3806           FMUQQ=FMUQQ/MG**(PLUM-PSURV-PSUD+PSIDD2)

3807         ELSE

3808           AUX1=0.236469D0*(1-NLOSW*0.14D0)/(0.5D0*MGGCUT)**0.15D0

3809           AUX1=AUX1*MQ/MGGCUT**2

3810           AUX2=4.D0*PI*AUX1*AUX1*2.62108D0/3.D0

3811           POWCS=2.D0*0.15D0+2.D0+2.D0

3812           STE1=(PLUM+PSIDD2)+POWCS-3.D0/2.09D0

3813           STE2=1.D0/2.09D0

3814           AUX3=GFMGEN(STE1,STE2,MG)  

3815           FMUQQ=AUX2*AUX3

3816           FMUQQ=FMUQQ*SOFTSURV(2,MG*MGGCUT)*MG**PSURV

3817           FMUQQ=FMUQQ*ISUD02(2,0.5D0*MG*MGGCUT)*MG**PSUD

3818         ENDIF 

3819            

3820        RETURN

3821        END  

3822 

3823 c--- generator of (Mgg,etaj*) in c.m. of initial gg ----------

3824        SUBROUTINE GENEREXQQ(MQ,GMGG,GETAJ)

3825        

3826        IMPLICIT NONE

3827      

3828        DOUBLE PRECISION PYR,GMG,GMGG,GETAJ

3829        DOUBLE PRECISION FMUQQ,DCSQQ,MQ

3830 c       DOUBLE PRECISION RMG,RMGG,RETAJ,RAT

3831        DOUBLE PRECISION RMG,RETAJ,RAT

3832        DOUBLE PRECISION POWCS,STE1,STE2

3833 c----- parameters for hard cross-sections -----------------

3834       DOUBLE PRECISION MGGCUT,ETJCUT,MXMAX,

3835      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

3836      & PSIDD1,PSIDD2

3837       COMMON/EDDEHARD/ MGGCUT,ETJCUT,MXMAX,

3838      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

3839      & PSIDD1,PSIDD2           

3840 

3841       POWCS=2.D0*0.15D0+2.D0+2.D0 

3842       STE1=(PLUM+PSIDD2)+POWCS-3.D0/2.09D0

3843       STE2=1.D0/2.09D0

3844  61   CALL GFMGENINV(STE1,STE2,PYR(0),RMG)  

3845       RAT=FMUQQ(MQ,0,RMG)/FMUQQ(MQ,1,RMG)

3846       IF (RAT.LE.PYR(0)) GOTO 61

3847       GMG=RMG

3848       GMGG=MGGCUT*GMG

3849 

3850  62   CALL FINVUGG(PYR(0),GMG,RETAJ)         

3851       RAT=DCSQQ(MQ,0,GMGG,RETAJ)/DCSQQ(MQ,1,GMGG,RETAJ)

3852       IF (RAT.LE.PYR(0)) GOTO 62

3853       IF (PYR(0).LE.0.5D0) THEN

3854        GETAJ=RETAJ

3855       ELSE

3856        GETAJ=-RETAJ

3857       ENDIF 

3858       

3859        RETURN

3860        END

3861  

3862 C-============================================================

3863 C-============================================================

3864 C-============================================================

3865 C-========= exclusive g g -> gamma gamma Jz=0 ================

3866 C-============================================================

3867 

3868 c--- differential cross-section -----------------

3869 c--- and its upper limit for etaj* generation ---

3870 c--- N=0 exact, N>0 upper limit -----------------

3871        FUNCTION DCS2GAM(N,M,ETA)

3872 

3873        IMPLICIT NONE

3874        INTEGER N

3875        DOUBLE PRECISION DCS2GAM,ALPHAS

3876        DOUBLE PRECISION M,ETA,ALPHAE

3877        DOUBLE PRECISION AUX0,AUX1,AUX2

3878 c------ fundamental constants -----------------------------

3879       INTEGER NF,NC,NLOSW

3880       DOUBLE PRECISION PI,CSMB,LAMQCD,

3881      & TF,CF,BF0,BF1

3882       DOUBLE COMPLEX MNI,REI

3883       COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

3884      & TF,CF,BF0,BF1,NF,NC,NLOSW         

3885 

3886       ALPHAE=1.D0/128.D0      

3887       DCS2GAM=(11.D0*ALPHAS(M/2.D0)*ALPHAE/(18.D0*M))**2/PI

3888       AUX0=1.D0-2.D0*ETA*DTANH(ETA)

3889       AUX0=AUX0+(0.25D0*PI**2+ETA**2)*(1.D0+DTANH(ETA)**2)

3890       AUX1=(1+AUX0*AUX0)/DCOSH(ETA)**2

3891       IF (N.EQ.0) THEN

3892          DCS2GAM=DCS2GAM*AUX1

3893       ELSE

3894          AUX2=((DCOSH(ETA)-1.D0)**3/DCOSH(ETA)**2)**(1/6.D0-1.D0) 

3895          DCS2GAM=DCS2GAM*0.5D0*41.3772D0*DSINH(ETA)

3896          DCS2GAM=DCS2GAM*(DCOSH(ETA)+2.D0)/DCOSH(ETA)**3

3897          DCS2GAM=DCS2GAM*AUX2*(DCOSH(ETA)-1.D0)**2/6.D0

3898       ENDIF 

3899       

3900        RETURN

3901        END

3902        

3903 c--- integrated cross-section -----------

3904        FUNCTION CS2GAM(M)

3905 

3906        IMPLICIT NONE

3907        DOUBLE PRECISION  CS2GAM,ALPHAS,M,U

3908        DOUBLE PRECISION  ALPHAE,AUX0,AUX1,AUX2

3909 c------ fundamental constants -----------------------------

3910       INTEGER NF,NC,NLOSW

3911       DOUBLE PRECISION PI,CSMB,LAMQCD,

3912      & TF,CF,BF0,BF1

3913       DOUBLE COMPLEX MNI,REI

3914       COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

3915      & TF,CF,BF0,BF1,NF,NC,NLOSW         

3916 c----- parameters for hard cross-sections -----------------

3917       DOUBLE PRECISION MGGCUT,ETJCUT,MXMAX,

3918      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

3919      & PSIDD1,PSIDD2

3920       COMMON/EDDEHARD/ MGGCUT,ETJCUT,MXMAX,

3921      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

3922      & PSIDD1,PSIDD2

3923      

3924         ALPHAE=1.D0/128.D0 

3925         U=DLOG(M/MGGCUT+DSQRT((M/MGGCUT)**2-1))

3926         CS2GAM=(11.D0*ALPHAS(M/2.D0)*ALPHAE/(18.D0*M))**2/PI

3927 C--- using parametrization on U ---------------------------

3928 C--- U>2, <1%; 0.05<U<2, <3%; -----------------------------

3929 C--- 0.01<U<0.05, <8%; U<0.01,<0.001% ---------------------

3930         IF (U.GT.0.01D0) THEN

3931          AUX0=U-0.01D0

3932         ELSE

3933          AUX0=0.D0

3934         ENDIF 

3935         AUX1=1.D0+3.3D0*DEXP(-4.83D0*AUX0**0.53D0)

3936         AUX2=95.583D0*AUX1*U**1.37D0/(2.9D0+U**1.5614D0)

3937         IF (U.LE.0.01D0.AND.U.GT.0.D0) THEN

3938          AUX2=AUX2/(5.4408D0*U**0.37D0)

3939         ENDIF 

3940         IF (U.EQ.0.D0) THEN

3941          AUX2=0.D0

3942         ENDIF

3943         CS2GAM=CS2GAM*AUX2

3944          

3945        RETURN

3946        END              

3947 

3948 c--- subroutine to generate upper curve --------- 

3949 c--- on etaj* dependence ------------------------

3950 c--- RF=PYR(0), MG=MGG/MGGCUT --------------------

3951        SUBROUTINE FINVU2GAM(RF,MG,GETA)

3952 

3953        IMPLICIT NONE

3954        DOUBLE PRECISION GETA,RF,R,MG

3955        DOUBLE PRECISION AUX1,AUX2

3956 

3957         R=RF**6.D0*(MG-1)**3/MG**2

3958         AUX1=DSQRT(4.D0*R+27.D0)*R*3.D0*DSQRT(3.D0)

3959         AUX1=AUX1+27.D0*R+18.D0*R**2+2.D0*R**3

3960         AUX1=(0.5D0*AUX1)**(1.D0/3.D0)

3961         AUX2=((3.D0+R)+R*(6.D0+R)/AUX1+AUX1)/3.D0

3962         GETA=DLOG(AUX2+DSQRT(AUX2**2-1))

3963         

3964        RETURN

3965        END  

3966 

3967 c--- upper function for general MG=MGG/MGGCUTdependence ------

3968 c--- N=0 - exact function, N>0 - upper curve ----

3969        FUNCTION FMU2GAM(N,MG)

3970 

3971        IMPLICIT NONE

3972        INTEGER N

3973        DOUBLE PRECISION FMU2GAM,MG,ALPHAE

3974        DOUBLE PRECISION AUX1,AUX2,AUX3

3975        DOUBLE PRECISION SOFTSURV,ISUD02

3976        DOUBLE PRECISION CS2GAM,POWCS

3977        DOUBLE PRECISION GFMGEN,STE1,STE2

3978 c------ fundamental constants -----------------------------

3979       INTEGER NF,NC,NLOSW

3980       DOUBLE PRECISION PI,CSMB,LAMQCD,

3981      & TF,CF,BF0,BF1

3982       DOUBLE COMPLEX MNI,REI

3983       COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

3984      & TF,CF,BF0,BF1,NF,NC,NLOSW                

3985 c----- parameters for hard cross-sections -----------------

3986       DOUBLE PRECISION MGGCUT,ETJCUT,MXMAX,

3987      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

3988      & PSIDD1,PSIDD2

3989       COMMON/EDDEHARD/ MGGCUT,ETJCUT,MXMAX,

3990      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

3991      & PSIDD1,PSIDD2

3992 

3993         ALPHAE=1/128.D0

3994         IF (N.EQ.0) THEN

3995           FMU2GAM=CS2GAM(MG*MGGCUT)

3996           FMU2GAM=FMU2GAM*SOFTSURV(1,MG*MGGCUT)

3997           FMU2GAM=FMU2GAM*ISUD02(1,0.5D0*MG*MGGCUT)

3998           FMU2GAM=FMU2GAM/MG**(PLUM-PSURV-PSUD+PSIDD2)

3999         ELSE

4000           AUX1=0.236469D0*(1-NLOSW*0.14D0)/(0.5D0*MGGCUT)**0.15D0

4001           AUX1=AUX1/MGGCUT

4002           AUX2=(11.D0*ALPHAE/18.D0)**2*AUX1*AUX1*41.3772D0/PI

4003           POWCS=2.D0*0.15D0+2.D0

4004           STE1=(PLUM+PSIDD2)+POWCS+1.D0/3.D0

4005           STE2=0.5D0

4006           AUX3=GFMGEN(STE1,STE2,MG)  

4007           FMU2GAM=AUX2*AUX3

4008           FMU2GAM=FMU2GAM*SOFTSURV(2,MG*MGGCUT)*MG**PSURV

4009           FMU2GAM=FMU2GAM*ISUD02(2,0.5D0*MG*MGGCUT)*MG**PSUD

4010         ENDIF 

4011            

4012        RETURN

4013        END  

4014 

4015 c--- generator of (Mgg,etaj*) in c.m. of initial gg ----------

4016        SUBROUTINE GENEREX2GAM(GMGG,GETAJ)

4017        

4018        IMPLICIT NONE

4019      

4020        DOUBLE PRECISION PYR,GMG,GMGG,GETAJ

4021        DOUBLE PRECISION FMU2GAM,DCS2GAM

4022 c       DOUBLE PRECISION RMG,RMGG,RETAJ,RAT

4023         DOUBLE PRECISION RMG,RETAJ,RAT

4024       DOUBLE PRECISION POWCS,STE1,STE2

4025 c----- parameters for hard cross-sections -----------------

4026       DOUBLE PRECISION MGGCUT,ETJCUT,MXMAX,

4027      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

4028      & PSIDD1,PSIDD2

4029       COMMON/EDDEHARD/ MGGCUT,ETJCUT,MXMAX,

4030      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

4031      & PSIDD1,PSIDD2           

4032 

4033       POWCS=2.D0*0.15D0+2.D0 

4034       STE1=(PLUM+PSIDD2)+POWCS+1.D0/3.D0

4035       STE2=0.5D0

4036  71   CALL GFMGENINV(STE1,STE2,PYR(0),RMG)  

4037       RAT=FMU2GAM(0,RMG)/FMU2GAM(1,RMG)

4038       IF (RAT.LE.PYR(0)) GOTO 71

4039       GMG=RMG

4040       GMGG=MGGCUT*GMG

4041 

4042  72   CALL FINVU2GAM(PYR(0),GMG,RETAJ)         

4043       RAT=DCS2GAM(0,GMGG,RETAJ)/DCS2GAM(1,GMGG,RETAJ)

4044       IF (RAT.LE.PYR(0)) GOTO 72

4045       IF (PYR(0).LE.0.5D0) THEN

4046        GETAJ=RETAJ

4047       ELSE

4048        GETAJ=-RETAJ

4049       ENDIF 

4050       

4051        RETURN

4052        END

4053  

4054 C-============================================================

4055 C-============================================================

4056 C-============================================================

4057 C-========= exclusive g g -> g g g* Jz=0 =====================

4058 C-============================================================

4059 c--- aux. functions for differential cross-section -----------

4060 c--- phase space for the 3rd gluon dx3 dY3, integrated in fi3 --

4061 c--- in the C.M. of the initial g g system -------------------

4062 c--- pt3=LAMQCD*EXP(Y3/2), fi3 - isotropic -------------------

4063 

4064 c--- part of the amplitude for the 3rd gluon -----------------

4065        FUNCTION DXY3G(X3,Y3,M,ETA) 

4066 

4067        IMPLICIT NONE

4068        DOUBLE PRECISION DXY3G,ALPHAS

4069        DOUBLE PRECISION M,MU,ETA,X3,Y3,PT3,RDI

4070 c------ fundamental constants -----------------------------

4071       INTEGER NF,NC,NLOSW

4072       DOUBLE PRECISION PI,CSMB,LAMQCD,

4073      & TF,CF,BF0,BF1

4074       DOUBLE COMPLEX MNI,REI

4075       COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

4076      & TF,CF,BF0,BF1,NF,NC,NLOSW           

4077 c---- table for 3g ratio dIsud3g(x,mu)**2/Isud0(mu)**2 -------

4078       DOUBLE PRECISION RDI3G,FRDI3G,DX2,DY2,X02,Y02

4079       COMMON/EDDETAB2/ RDI3G(630),FRDI3G(30,21),

4080      & DX2,DY2,X02,Y02 

4081 

4082        MU=M/2.D0

4083        PT3=LAMQCD*DEXP(Y3/2.D0)

4084        IF (MU.LE.150.D0) THEN 

4085          CALL LINTERPOL2(FRDI3G,30,21,X02,Y02,DX2,DY2,MU,X3,RDI)

4086        ELSE 

4087          CALL LINTERPOL2(FRDI3G,30,21,X02,Y02,DX2,DY2,150.D0,X3,RDI)

4088        ENDIF       

4089        DXY3G=RDI*3.D0*ALPHAS(PT3)/(8.D0*PI*X3*(1-X3))

4090        DXY3G=DXY3G*(1.D0+(1-X3)**4+X3**4*(1.D0-0.5D0/DCOSH(ETA)**2))

4091 

4092        RETURN

4093        END

4094 

4095 c--- integrated in Y part of the 3rd gluon -------------------

4096 c--- N=0 exact, N>0 upper estimation for X3 generator --------

4097        FUNCTION DX3G(N,X3,M,ETA) 

4098 

4099        IMPLICIT NONE

4100        INTEGER N

4101        DOUBLE PRECISION DX3G,IALPHAS

4102 c       DOUBLE PRECISION M,MU,ETA,X3,PT3,RDI

4103        DOUBLE PRECISION M,MU,ETA,X3,RDI

4104        DOUBLE PRECISION PT3MIN,PT3MAX

4105 c       DOUBLE PRECISION AUX1,AUX2,AUX3

4106        DOUBLE PRECISION AUX1,AUX2

4107 c------ fundamental constants -----------------------------

4108       INTEGER NF,NC,NLOSW

4109       DOUBLE PRECISION PI,CSMB,LAMQCD,

4110      & TF,CF,BF0,BF1

4111       DOUBLE COMPLEX MNI,REI

4112       COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

4113      & TF,CF,BF0,BF1,NF,NC,NLOSW

4114 c----- parameters for hard cross-sections -----------------

4115       DOUBLE PRECISION MGGCUT,ETJCUT,MXMAX,

4116      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

4117      & PSIDD1,PSIDD2

4118       COMMON/EDDEHARD/ MGGCUT,ETJCUT,MXMAX,

4119      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

4120      & PSIDD1,PSIDD2

4121 c--- restrictions on the phase space of g-jet ---

4122 c--- DER3J - max. angle between g-jet and parallel jet ----

4123 c--- XMAX3J - max ratio 2*Eg/MJJ --------------------------

4124 c--- parameters for 3g functions -----------------------------

4125       DOUBLE PRECISION DER3J,XMAX3J,PAR3G

4126       COMMON/EDDE3JP/ DER3J,XMAX3J,PAR3G(5)        

4127 c---- table for 3g ratio dIsud3g(x,mu)**2/Isud0(mu)**2 -------

4128       DOUBLE PRECISION RDI3G,FRDI3G,DX2,DY2,X02,Y02

4129       COMMON/EDDETAB2/ RDI3G(630),FRDI3G(30,21),

4130      & DX2,DY2,X02,Y02 

4131 

4132        MU=M/2.D0

4133        PT3MAX=MU*X3/(1-X3)

4134        PT3MIN=MU*X3/DCOSH(ETASIMAX/2.D0)

4135        IF (X3.GT.0.5D0) THEN

4136         PT3MAX=MU*(1-X3)/X3

4137        ENDIF 

4138        IF (PT3MIN.LT.0.5D0) THEN

4139         PT3MIN=0.5D0

4140        ENDIF 

4141 

4142        IF (N.EQ.0) THEN

4143          IF (MU.LE.150.D0) THEN 

4144            CALL LINTERPOL2(FRDI3G,30,21,X02,Y02,DX2,DY2,MU,X3,RDI)

4145          ELSE 

4146            CALL LINTERPOL2(FRDI3G,30,21,X02,Y02,DX2,DY2,150.D0,X3,RDI)

4147          ENDIF

4148         DX3G=RDI*3.D0/(8.D0*PI*X3*(1-X3))

4149         DX3G=DX3G*(1.D0+(1-X3)**4+X3**4*(1.D0-0.5D0/DCOSH(ETA)**2))

4150         DX3G=DX3G*IALPHAS(PT3MIN,PT3MAX)

4151        ELSE

4152         AUX1=(MU/5.D0)**PAR3G(2)

4153         AUX1=AUX1*PAR3G(1)

4154         AUX2=PAR3G(3)

4155         DX3G=AUX1*AUX2/((1-X3)*DSQRT(X3))

4156        ENDIF

4157 

4158        RETURN

4159        END

4160 

4161 c--- differential cross-section -----------------

4162 c--- and its upper limit for etaj* generation ---

4163 c--- N=0 exact, N>0 upper limit -----------------

4164        FUNCTION DCS3G(N,M,ETA)

4165 

4166        IMPLICIT NONE

4167        INTEGER N

4168        DOUBLE PRECISION DCS3G,ALPHAS

4169        DOUBLE PRECISION M,MU,ETA

4170        DOUBLE PRECISION AUX1,RIAX,RIBX

4171 c------ fundamental constants -----------------------------

4172       INTEGER NF,NC,NLOSW

4173       DOUBLE PRECISION PI,CSMB,LAMQCD,

4174      & TF,CF,BF0,BF1

4175       DOUBLE COMPLEX MNI,REI

4176       COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

4177      & TF,CF,BF0,BF1,NF,NC,NLOSW

4178 c----- parameters for hard cross-sections -----------------

4179       DOUBLE PRECISION MGGCUT,ETJCUT,MXMAX,

4180      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

4181      & PSIDD1,PSIDD2

4182       COMMON/EDDEHARD/ MGGCUT,ETJCUT,MXMAX,

4183      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

4184      & PSIDD1,PSIDD2     

4185 c--- table for 3g ratio Isud3ga(etasimax,mu)**2/Isud0(mu)**2 -

4186 c--- table for 3g ratio Isud3gb(etasimax,mu)**2/Isud0(mu)**2 -

4187       DOUBLE PRECISION RI3GA,RI3GB,FRI3GA,FRI3GB,

4188      & DX3,DY3,X03,Y03

4189       COMMON/EDDETAB3/ RI3GA(480),RI3GB(480),

4190      & FRI3GA(30,16),FRI3GB(30,16),DX3,DY3,X03,Y03     

4191 

4192       MU=0.5D0*M

4193       IF (ETASIMAX.LE.15.D0.AND.MU.LE.150.D0) THEN

4194        CALL LINTERPOL2(FRI3GA,30,16,X03,Y03,DX3,DY3,MU,ETASIMAX,RIAX)

4195        CALL LINTERPOL2(FRI3GB,30,16,X03,Y03,DX3,DY3,MU,ETASIMAX,RIBX)

4196       ELSE

4197        IF (ETASIMAX.GT.15.D0.AND.MU.LE.150.D0) THEN

4198         CALL LINTERPOL2(FRI3GA,30,16,X03,Y03,DX3,DY3,MU,15.D0,RIAX)

4199         CALL LINTERPOL2(FRI3GB,30,16,X03,Y03,DX3,DY3,MU,15.D0,RIBX)      

4200        ENDIF

4201        IF (ETASIMAX.GT.15.D0.AND.MU.GT.150.D0) THEN

4202         CALL LINTERPOL2(FRI3GA,30,16,X03,Y03,DX3,DY3,150.D0,15.D0,RIAX)

4203         CALL LINTERPOL2(FRI3GB,30,16,X03,Y03,DX3,DY3,150.D0,15.D0,RIBX)

4204         RIAX=RIAX/MU

4205         RIBX=RIBX/MU

4206        ENDIF

4207        IF (ETASIMAX.LE.15.D0.AND.MU.GT.150.D0) THEN

4208         CALL LINTERPOL2(FRI3GA,30,16,X03,Y03,DX3,DY3,150.D0,ETASIMAX,

4209      &   RIAX)

4210         CALL LINTERPOL2(FRI3GB,30,16,X03,Y03,DX3,DY3,150.D0,ETASIMAX,

4211      &   RIBX)

4212         RIAX=RIAX/MU

4213         RIBX=RIBX/MU

4214        ENDIF

4215       ENDIF 

4216 

4217       DCS3G=18.D0*PI*(ALPHAS(M/2.D0)/M)**2 

4218       IF (N.EQ.0) THEN

4219          AUX1=(1.D0-0.5D0/DCOSH(ETA)**2)*RIAX+RIBX

4220          DCS3G=DCS3G*DCOSH(ETA)**2*AUX1

4221       ELSE

4222          AUX1=(DCOSH(ETA)**3*(DCOSH(ETA)-1.D0))**(1/2.09D0-1.D0) 

4223          DCS3G=DCS3G*0.5D0*2.62108D0*DSINH(ETA)*DCOSH(ETA)

4224          DCS3G=DCS3G*DCOSH(ETA)*(4.D0*DCOSH(ETA)-3.D0)

4225          DCS3G=DCS3G*(RIAX+RIBX)*AUX1/2.09D0

4226       ENDIF 

4227       

4228        RETURN

4229        END

4230        

4231 c--- integrated cross-section -----------

4232        FUNCTION CS3G(M)

4233 

4234        IMPLICIT NONE

4235        DOUBLE PRECISION CS3G,ALPHAS,M,U

4236        DOUBLE PRECISION MU,RIAX,RIBX,AUX1 

4237 c------ fundamental constants -----------------------------

4238       INTEGER NF,NC,NLOSW

4239       DOUBLE PRECISION PI,CSMB,LAMQCD,

4240      & TF,CF,BF0,BF1

4241       DOUBLE COMPLEX MNI,REI

4242       COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

4243      & TF,CF,BF0,BF1,NF,NC,NLOSW         

4244 c----- parameters for hard cross-sections -----------------

4245       DOUBLE PRECISION MGGCUT,ETJCUT,MXMAX,

4246      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

4247      & PSIDD1,PSIDD2

4248       COMMON/EDDEHARD/ MGGCUT,ETJCUT,MXMAX,

4249      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

4250      & PSIDD1,PSIDD2

4251 c--- table for 3g ratio Isud3ga(etasimax,mu)**2/Isud0(mu)**2 -

4252 c--- table for 3g ratio Isud3gb(etasimax,mu)**2/Isud0(mu)**2 -

4253       DOUBLE PRECISION RI3GA,RI3GB,FRI3GA,FRI3GB,

4254      & DX3,DY3,X03,Y03

4255       COMMON/EDDETAB3/ RI3GA(480),RI3GB(480),

4256      & FRI3GA(30,16),FRI3GB(30,16),DX3,DY3,X03,Y03     

4257 

4258       MU=0.5D0*M

4259       IF (ETASIMAX.LE.15.D0.AND.MU.LE.150.D0) THEN

4260        CALL LINTERPOL2(FRI3GA,30,16,X03,Y03,DX3,DY3,MU,ETASIMAX,RIAX)

4261        CALL LINTERPOL2(FRI3GB,30,16,X03,Y03,DX3,DY3,MU,ETASIMAX,RIBX)

4262       ELSE

4263        IF (ETASIMAX.GT.15.D0.AND.MU.LE.150.D0) THEN

4264         CALL LINTERPOL2(FRI3GA,30,16,X03,Y03,DX3,DY3,MU,15.D0,RIAX)

4265         CALL LINTERPOL2(FRI3GB,30,16,X03,Y03,DX3,DY3,MU,15.D0,RIBX)      

4266        ENDIF

4267        IF (ETASIMAX.GT.15.D0.AND.MU.GT.150.D0) THEN

4268         CALL LINTERPOL2(FRI3GA,30,16,X03,Y03,DX3,DY3,150.D0,15.D0,RIAX)

4269         CALL LINTERPOL2(FRI3GB,30,16,X03,Y03,DX3,DY3,150.D0,15.D0,RIBX)

4270         RIAX=RIAX/MU

4271         RIBX=RIBX/MU

4272        ENDIF

4273        IF (ETASIMAX.LE.15.D0.AND.MU.GT.150.D0) THEN

4274         CALL LINTERPOL2(FRI3GA,30,16,X03,Y03,DX3,DY3,150.D0,ETASIMAX,

4275      &   RIAX)

4276         CALL LINTERPOL2(FRI3GB,30,16,X03,Y03,DX3,DY3,150.D0,ETASIMAX,

4277      &   RIBX)

4278         RIAX=RIAX/MU

4279         RIBX=RIBX/MU

4280        ENDIF

4281       ENDIF

4282       U=DLOG(M/MGGCUT+DSQRT((M/MGGCUT)**2-1))

4283       AUX1=0.5D0*DSINH(U+U)*RIAX+(U+0.5D0*DSINH(U+U))*RIBX

4284       CS3G=18.D0*PI*(ALPHAS(M/2.D0)/M)**2*AUX1

4285        

4286        RETURN

4287        END              

4288 

4289 c--- subroutine to generate upper curve --------- 

4290 c--- on etaj* dependence ------------------------

4291 c--- RF=PYR(0), MG=MGG/MGGCUT --------------------

4292 c--- SUBROUTINE FINVU3G(RF,MG,GETA)=FINVUGG(RF,MG,GETA)

4293 

4294 c--- upper function for general MG=MGG/MGGCUTdependence ------

4295 c--- N=0 - exact function, N>0 - upper curve ----

4296        FUNCTION FMU3G(N,MG)

4297 

4298        IMPLICIT NONE

4299        INTEGER N

4300        DOUBLE PRECISION FMU3G,MG

4301 c       DOUBLE PRECISION AUX1,AUX2,AUX3,AUX4

4302        DOUBLE PRECISION AUX1,AUX2,AUX3

4303        DOUBLE PRECISION SOFTSURV,ISUD02

4304        DOUBLE PRECISION CS3G,POWCS

4305        DOUBLE PRECISION GFMGEN,STE1,STE2

4306 c------ fundamental constants -----------------------------

4307       INTEGER NF,NC,NLOSW

4308       DOUBLE PRECISION PI,CSMB,LAMQCD,

4309      & TF,CF,BF0,BF1

4310       DOUBLE COMPLEX MNI,REI

4311       COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

4312      & TF,CF,BF0,BF1,NF,NC,NLOSW                

4313 c----- parameters for hard cross-sections -----------------

4314       DOUBLE PRECISION MGGCUT,ETJCUT,MXMAX,

4315      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

4316      & PSIDD1,PSIDD2

4317       COMMON/EDDEHARD/ MGGCUT,ETJCUT,MXMAX,

4318      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

4319      & PSIDD1,PSIDD2

4320 c--- restrictions on the phase space of g-jet ---

4321 c--- DER3J - max. angle between g-jet and parallel jet ----

4322 c--- XMAX3J - max ratio 2*Eg/MJJ --------------------------

4323 c--- parameters for 3g functions -----------------------------

4324       DOUBLE PRECISION DER3J,XMAX3J,PAR3G

4325       COMMON/EDDE3JP/ DER3J,XMAX3J,PAR3G(5)    

4326       

4327         IF (N.EQ.0) THEN

4328           FMU3G=CS3G(MG*MGGCUT)

4329           FMU3G=FMU3G*SOFTSURV(1,MG*MGGCUT)

4330           FMU3G=FMU3G*ISUD02(1,0.5D0*MG*MGGCUT)

4331           FMU3G=FMU3G/MG**(PLUM-PSURV-PSUD+PSIDD2)

4332         ELSE

4333           AUX1=0.236469D0*(1-NLOSW*0.14D0)/(0.5D0*MGGCUT)**0.15D0

4334           AUX1=AUX1/MGGCUT

4335           AUX2=18.D0*PI*AUX1*AUX1*2.62108D0

4336           AUX2=AUX2*PAR3G(4)*(0.5D0*MGGCUT)**PAR3G(5)

4337           POWCS=2.D0*0.15D0+2.D0-PAR3G(5)

4338           STE1=(PLUM+PSIDD2)+POWCS-3.D0/2.09D0

4339           STE2=1.D0/2.09D0

4340           AUX3=GFMGEN(STE1,STE2,MG)  

4341           FMU3G=AUX2*AUX3

4342           FMU3G=FMU3G*SOFTSURV(2,MG*MGGCUT)*MG**PSURV

4343           FMU3G=FMU3G*ISUD02(2,0.5D0*MG*MGGCUT)*MG**PSUD

4344         ENDIF 

4345            

4346        RETURN

4347        END  

4348 

4349 c--- generator of (Mgg,etaj*) in c.m. of initial gg ----------

4350        SUBROUTINE GENEREX3G(GMGG,GETAJ,GX3,GPT3,GFI3)

4351        

4352        IMPLICIT NONE

4353    

4354        DOUBLE PRECISION PYR,GMG,GMGG,GETAJ

4355        DOUBLE PRECISION FMU3G,DCS3G,DX3G

4356 c       DOUBLE PRECISION RMG,RMGG,RETAJ,RAT

4357        DOUBLE PRECISION RMG,RETAJ,RAT

4358        DOUBLE PRECISION GX3,RX3,GPT3,RPT3,GFI3

4359        DOUBLE PRECISION X3GMIN,X3GMAX,X3GMAX0

4360        DOUBLE PRECISION PT3GMIN,PT3GMAX

4361        DOUBLE PRECISION POWCS,STE1,STE2

4362 c       DOUBLE PRECISION AUX1,AUX2,AUX3

4363        DOUBLE PRECISION AUX1,AUX2

4364 c------ fundamental constants -----------------------------

4365       INTEGER NF,NC,NLOSW

4366       DOUBLE PRECISION PI,CSMB,LAMQCD,

4367      & TF,CF,BF0,BF1

4368       DOUBLE COMPLEX MNI,REI

4369       COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

4370      & TF,CF,BF0,BF1,NF,NC,NLOSW                

4371 c----- parameters for hard cross-sections -----------------

4372       DOUBLE PRECISION MGGCUT,ETJCUT,MXMAX,

4373      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

4374      & PSIDD1,PSIDD2

4375       COMMON/EDDEHARD/ MGGCUT,ETJCUT,MXMAX,

4376      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

4377      & PSIDD1,PSIDD2           

4378 c--- restrictions on the phase space of g-jet ---

4379 c--- DER3J - max. angle between g-jet and parallel jet ----

4380 c--- XMAX3J - max ratio 2*Eg/MJJ --------------------------

4381 c--- parameters for 3g functions -----------------------------

4382       DOUBLE PRECISION DER3J,XMAX3J,PAR3G

4383       COMMON/EDDE3JP/ DER3J,XMAX3J,PAR3G(5)  

4384 

4385       POWCS=2.D0*0.15D0+2.D0-PAR3G(5) 

4386       STE1=(PLUM+PSIDD2)+POWCS-3.D0/2.09D0

4387       STE2=1.D0/2.09D0

4388  91   CALL GFMGENINV(STE1,STE2,PYR(0),RMG)  

4389       RAT=FMU3G(0,RMG)/FMU3G(1,RMG)

4390       IF (RAT.LE.PYR(0)) GOTO 91

4391       GMG=RMG

4392       GMGG=MGGCUT*GMG

4393 

4394  92   CALL FINVUGG(PYR(0),GMG,RETAJ)         

4395       RAT=DCS3G(0,GMGG,RETAJ)/DCS3G(1,GMGG,RETAJ)

4396       IF (RAT.LE.PYR(0)) GOTO 92

4397       IF (PYR(0).LE.0.5D0) THEN

4398        GETAJ=RETAJ

4399       ELSE

4400        GETAJ=-RETAJ

4401       ENDIF 

4402 

4403        X3GMIN=0.5D0/(0.5D0*GMGG+0.5D0)

4404 C-       X3GMAX0=1.D0-X3GMIN

4405        X3GMAX0=2.D0/3.D0

4406        X3GMAX=0.5D0*DCOSH(0.5D0*ETASIMAX)

4407        X3GMAX=X3GMAX*(DSQRT(1.D0+4.D0/DCOSH(0.5D0*ETASIMAX))-1.D0)

4408        IF (X3GMAX.GT.X3GMAX0) THEN

4409         X3GMAX=X3GMAX0

4410        ENDIF 

4411 c---- generation of 3rd jet variables

4412        GFI3=2.D0*PI*PYR(0)

4413        AUX1=(1.D0-DSQRT(X3GMIN))

4414        AUX2=(1.D0-DSQRT(X3GMAX))

4415  95   RX3=(1.D0-AUX1*(AUX2/AUX1)**PYR(0))**2

4416       RAT=DX3G(0,RX3,GMGG,GETAJ)/DX3G(1,RX3,GMGG,GETAJ)

4417       IF (RAT.LE.PYR(0)) GOTO 95 

4418       GX3=RX3

4419 c---

4420 c---was a BUG! 1-GX3 was changed to DSQRT(1-GX3)

4421        PT3GMAX=0.5D0*GMGG*GX3/DSQRT(1-GX3)

4422        PT3GMIN=0.5D0*GMGG*GX3/DCOSH(ETASIMAX/2.D0)

4423        IF (GX3.GT.0.5D0) THEN

4424         PT3GMAX=0.5D0*GMGG*(1-GX3)/GX3

4425        ENDIF 

4426        IF (PT3GMIN.LT.0.5D0) THEN

4427         PT3GMIN=0.5D0

4428        ENDIF 

4429        AUX1=DLOG(PT3GMAX/LAMQCD)/DLOG(PT3GMIN/LAMQCD)

4430        RPT3=LAMQCD*(PT3GMIN/LAMQCD)**(AUX1**PYR(0))

4431        IF (NLOSW.EQ.1) THEN

4432  96   RPT3=LAMQCD*(PT3GMIN/LAMQCD)**(AUX1**PYR(0))

4433         AUX2=BF1*DLOG(2.D0*DLOG(RPT3/LAMQCD))

4434         RAT=1.D0-AUX2/(BF0*2.D0*DLOG(RPT3/LAMQCD))

4435         IF (RAT.LE.PYR(0)) GOTO 96

4436        ENDIF

4437        GPT3=RPT3

4438       

4439        RETURN

4440        END

4441  

4442 C-============================================================

4443 C-============================================================

4444 C-============================================================

4445 C-========= exclusive g g -> Q Qbar g Jz=0; MQ=0 =============

4446 C-============================================================

4447 

4448 c--- differential cross-section -----------------

4449 c--- and its upper limit for etaj* generation ---

4450 c--- N=0 exact, N>0 upper limit -----------------

4451        FUNCTION DCSQQG(N,M,ETA)

4452 

4453        IMPLICIT NONE

4454        INTEGER N

4455        DOUBLE PRECISION DCSQQG,ALPHAS

4456        DOUBLE PRECISION M,ETA,AUX1

4457 c------ fundamental constants -----------------------------

4458       INTEGER NF,NC,NLOSW

4459       DOUBLE PRECISION PI,CSMB,LAMQCD,

4460      & TF,CF,BF0,BF1

4461       DOUBLE COMPLEX MNI,REI

4462       COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

4463      & TF,CF,BF0,BF1,NF,NC,NLOSW         

4464 c--- restrictions on the phase space of g-jet ---

4465 c--- DER3J - max. angle between g-jet and parallel jet ----

4466 c--- XMAX3J - max ratio 2*Eg/MJJ --------------------------

4467 c--- parameters for 3g functions -----------------------------

4468       DOUBLE PRECISION DER3J,XMAX3J,PAR3G

4469       COMMON/EDDE3JP/ DER3J,XMAX3J,PAR3G(5)

4470        

4471       DCSQQG=4.D0*PI*(ALPHAS(M/2.D0)/M)**2/3.D0

4472 c--- mult. by additional amplitude factor -------------------- 

4473 c--- of integrated phase space -------------------------------

4474 c--- of g-soft jet. ------------------------------------------

4475       DCSQQG=DCSQQG*4.D0*ALPHAS(M/2.D0)/(3.D0*PI)

4476       DCSQQG=DCSQQG*XMAX3J**4*DSIN(0.5D0*DER3J)**2

4477       IF (N.EQ.0) THEN

4478          DCSQQG=DCSQQG*DCOSH(ETA)*DCOSH(ETA)

4479       ELSE

4480          AUX1=(DCOSH(ETA)**3*(DCOSH(ETA)-1.D0))**(1/2.09D0-1.D0) 

4481          DCSQQG=DCSQQG*0.5D0*2.62108D0*DSINH(ETA)*DCOSH(ETA)

4482          DCSQQG=DCSQQG*DCOSH(ETA)*(4.D0*DCOSH(ETA)-3.D0)

4483          DCSQQG=DCSQQG*AUX1/2.09D0

4484       ENDIF 

4485       

4486        RETURN

4487        END

4488        

4489 c--- integrated cross-section -----------

4490        FUNCTION CSQQG(M)

4491 

4492        IMPLICIT NONE

4493        DOUBLE PRECISION  CSQQG,ALPHAS,M,U

4494 c------ fundamental constants -----------------------------

4495       INTEGER NF,NC,NLOSW

4496       DOUBLE PRECISION PI,CSMB,LAMQCD,

4497      & TF,CF,BF0,BF1

4498       DOUBLE COMPLEX MNI,REI

4499       COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

4500      & TF,CF,BF0,BF1,NF,NC,NLOSW         

4501 c----- parameters for hard cross-sections -----------------

4502       DOUBLE PRECISION MGGCUT,ETJCUT,MXMAX,

4503      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

4504      & PSIDD1,PSIDD2

4505       COMMON/EDDEHARD/ MGGCUT,ETJCUT,MXMAX,

4506      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

4507      & PSIDD1,PSIDD2

4508 c--- restrictions on the phase space of g-jet ---

4509 c--- DER3J - max. angle between g-jet and parallel jet ----

4510 c--- XMAX3J - max ratio 2*Eg/MJJ --------------------------

4511 c--- parameters for 3g functions -----------------------------

4512       DOUBLE PRECISION DER3J,XMAX3J,PAR3G

4513       COMMON/EDDE3JP/ DER3J,XMAX3J,PAR3G(5)

4514        

4515         U=DLOG(M/MGGCUT+DSQRT((M/MGGCUT)**2-1))

4516         CSQQG=4.D0*PI*(ALPHAS(M/2.D0)/M)**2/3.D0

4517 c--- mult. by additional amplitude factor -------------------- 

4518 c--- of integrated phase space -------------------------------

4519 c--- of g-soft jet. ------------------------------------------

4520         CSQQG=CSQQG*4.D0*ALPHAS(M/2.D0)/(3.D0*PI)

4521         CSQQG=CSQQG*XMAX3J**4*DSIN(0.5D0*DER3J)**2

4522         CSQQG=CSQQG*(U+0.5D0*DSINH(U+U))

4523        

4524        RETURN

4525        END              

4526 

4527 c--- subroutine to generate upper curve --------- 

4528 c--- on etaj* dependence ------------------------

4529 c--- RF=PYR(0), MG=MGG/MGGCUT --------------------

4530 c---SUBROUTINE FINVUQQG(RF,MG,GETA)=FINVUGG(RF,MG,GETA)---

4531 

4532 c--- upper function for general MG=MGG/MGGCUTdependence ------

4533 c--- N=0 - exact function, N>0 - upper curve ----

4534        FUNCTION FMUQQG(N,MG)

4535 

4536        IMPLICIT NONE

4537        INTEGER N

4538        DOUBLE PRECISION FMUQQG,MG

4539        DOUBLE PRECISION AUX1,AUX2,AUX3

4540        DOUBLE PRECISION SOFTSURV,ISUD02

4541        DOUBLE PRECISION CSQQG,POWCS

4542        DOUBLE PRECISION GFMGEN,STE1,STE2

4543 c------ fundamental constants -----------------------------

4544       INTEGER NF,NC,NLOSW

4545       DOUBLE PRECISION PI,CSMB,LAMQCD,

4546      & TF,CF,BF0,BF1

4547       DOUBLE COMPLEX MNI,REI

4548       COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

4549      & TF,CF,BF0,BF1,NF,NC,NLOSW                

4550 c----- parameters for hard cross-sections -----------------

4551       DOUBLE PRECISION MGGCUT,ETJCUT,MXMAX,

4552      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

4553      & PSIDD1,PSIDD2

4554       COMMON/EDDEHARD/ MGGCUT,ETJCUT,MXMAX,

4555      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

4556      & PSIDD1,PSIDD2

4557 c--- restrictions on the phase space of g-jet ---

4558 c--- DER3J - max. angle between g-jet and parallel jet ----

4559 c--- XMAX3J - max ratio 2*Eg/MJJ --------------------------

4560 c--- parameters for 3g functions -----------------------------

4561       DOUBLE PRECISION DER3J,XMAX3J,PAR3G

4562       COMMON/EDDE3JP/ DER3J,XMAX3J,PAR3G(5)

4563 

4564         IF (N.EQ.0) THEN

4565           FMUQQG=CSQQG(MG*MGGCUT)

4566           FMUQQG=FMUQQG*SOFTSURV(1,MG*MGGCUT)

4567           FMUQQG=FMUQQG*ISUD02(1,0.5D0*MG*MGGCUT)

4568           FMUQQG=FMUQQG/MG**(PLUM-PSURV-PSUD+PSIDD2)

4569         ELSE

4570           AUX1=0.236469D0*(1-NLOSW*0.14D0)/(0.5D0*MGGCUT)**0.15D0

4571           AUX1=AUX1**1.5D0/MGGCUT

4572           AUX2=4.D0*PI*AUX1*AUX1*2.62108D0/3.D0

4573           AUX2=AUX2*XMAX3J**4*DSIN(0.5D0*DER3J)**2

4574           AUX2=AUX2*4.D0/(3.D0*PI)

4575           POWCS=3.D0*0.15D0+2.D0

4576           STE1=(PLUM+PSIDD2)+POWCS-3.D0/2.09D0

4577           STE2=1.D0/2.09D0

4578           AUX3=GFMGEN(STE1,STE2,MG)  

4579           FMUQQG=AUX2*AUX3

4580           FMUQQG=FMUQQG*SOFTSURV(2,MG*MGGCUT)*MG**PSURV

4581           FMUQQG=FMUQQG*ISUD02(2,0.5D0*MG*MGGCUT)*MG**PSUD

4582         ENDIF 

4583            

4584        RETURN

4585        END  

4586 

4587 c--- generator of (Mgg,etaj*) in c.m. of initial gg ----------

4588        SUBROUTINE GENEREXQQG(GMGG,GETAJ,GX3,GFIS,GTHETAS)

4589        

4590        IMPLICIT NONE

4591   

4592        DOUBLE PRECISION PYR,GMG,GMGG,GETAJ

4593        DOUBLE PRECISION GX3,GFIS,GTHETAS

4594        DOUBLE PRECISION FMUQQG,DCSQQG

4595 c       DOUBLE PRECISION RMG,RMGG,RETAJ,RAT

4596        DOUBLE PRECISION RMG,RETAJ,RAT

4597        DOUBLE PRECISION POWCS,STE1,STE2,AUX1

4598 c------ fundamental constants -----------------------------

4599       INTEGER NF,NC,NLOSW

4600       DOUBLE PRECISION PI,CSMB,LAMQCD,

4601      & TF,CF,BF0,BF1

4602       DOUBLE COMPLEX MNI,REI

4603       COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

4604      & TF,CF,BF0,BF1,NF,NC,NLOSW              

4605 c----- parameters for hard cross-sections -----------------

4606       DOUBLE PRECISION MGGCUT,ETJCUT,MXMAX,

4607      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

4608      & PSIDD1,PSIDD2

4609       COMMON/EDDEHARD/ MGGCUT,ETJCUT,MXMAX,

4610      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

4611      & PSIDD1,PSIDD2

4612 c--- restrictions on the phase space of g-jet ---

4613 c--- DER3J - max. angle between g-jet and parallel jet ----

4614 c--- XMAX3J - max ratio 2*Eg/MJJ --------------------------

4615 c--- parameters for 3g functions -----------------------------

4616       DOUBLE PRECISION DER3J,XMAX3J,PAR3G

4617       COMMON/EDDE3JP/ DER3J,XMAX3J,PAR3G(5) 

4618 

4619       POWCS=3.D0*0.15D0+2.D0 

4620       STE1=(PLUM+PSIDD2)+POWCS-3.D0/2.09D0

4621       STE2=1.D0/2.09D0

4622  81   CALL GFMGENINV(STE1,STE2,PYR(0),RMG)  

4623       RAT=FMUQQG(0,RMG)/FMUQQG(1,RMG)

4624       IF (RAT.LE.PYR(0)) GOTO 81

4625       GMG=RMG

4626       GMGG=MGGCUT*GMG

4627 

4628  82   CALL FINVUGG(PYR(0),GMG,RETAJ)         

4629       RAT=DCSQQG(0,GMGG,RETAJ)/DCSQQG(1,GMGG,RETAJ)

4630       IF (RAT.LE.PYR(0)) GOTO 82

4631       IF (PYR(0).LE.0.5D0) THEN

4632        GETAJ=RETAJ

4633       ELSE

4634        GETAJ=-RETAJ

4635       ENDIF 

4636 

4637 c--- GX3,GFIS,GTHETAS -------

4638         GFIS=PYR(0)*2.D0*PI

4639         GX3=PYR(0)**0.25D0*XMAX3J

4640         AUX1=PYR(0)*DSIN(DER3J/2.D0)**2

4641         GTHETAS=2.D0*DATAN(1.D0/DSQRT(1.D0/AUX1-1.D0))

4642       

4643        RETURN

4644        END

4645  

4646 C-============================================================

4647 C-============================================================

4648 C-=============================================================

4649 C-========== semi-inclusive g g -> g g Jz!=0 ==================

4650 C-=============================================================

4651 

4652 c--- differential cross-section -----------------

4653 c--- and its upper limit for etaj* generation ---

4654 c--- N=0 exact, N>0 upper limit -----------------

4655        FUNCTION DCSGGSI(N,M,ETA)

4656 

4657        IMPLICIT NONE

4658        INTEGER N

4659        DOUBLE PRECISION DCSGGSI,ALPHAS

4660        DOUBLE PRECISION M,ETA,AUX1

4661 c------ fundamental constants -----------------------------

4662       INTEGER NF,NC,NLOSW

4663       DOUBLE PRECISION PI,CSMB,LAMQCD,

4664      & TF,CF,BF0,BF1

4665       DOUBLE COMPLEX MNI,REI

4666       COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

4667      & TF,CF,BF0,BF1,NF,NC,NLOSW         

4668       

4669       DCSGGSI=36.D0*PI*(ALPHAS(M/2.D0)/M)**2

4670       AUX1=DCOSH(ETA)*(1.D0-0.25D0/DCOSH(ETA)**2)

4671       DCSGGSI=DCSGGSI*AUX1*AUX1      

4672 c-      IF (N.EQ.0) THEN

4673 c-         AUX1=DCOSH(ETA)*(1.D0-0.25D0/DCOSH(ETA)**2)

4674 c-         DCSGGSI=DCSGGSI*AUX1*AUX1

4675 c-      ELSE

4676 c--- here we have exact inverse function of the integral -----

4677 c--- i.e. we need no upper estimation ------------------------

4678 c-         AUX1=DCOSH(ETA)*(1.D0-0.25D0/DCOSH(ETA)**2)

4679 c-         DCSGGSI=DCSGGSI*AUX1*AUX1

4680 c-      ENDIF 

4681       

4682        RETURN

4683        END

4684        

4685 c--- integrated cross-section -----------

4686        FUNCTION CSGGSI(M)

4687 

4688        IMPLICIT NONE

4689        DOUBLE PRECISION  CSGGSI,ALPHAS,M,U

4690 c------ fundamental constants -----------------------------

4691       INTEGER NF,NC,NLOSW

4692       DOUBLE PRECISION PI,CSMB,LAMQCD,

4693      & TF,CF,BF0,BF1

4694       DOUBLE COMPLEX MNI,REI

4695       COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

4696      & TF,CF,BF0,BF1,NF,NC,NLOSW         

4697 c----- parameters for hard cross-sections -----------------

4698       DOUBLE PRECISION MGGCUT,ETJCUT,MXMAX,

4699      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

4700      & PSIDD1,PSIDD2

4701       COMMON/EDDEHARD/ MGGCUT,ETJCUT,MXMAX,

4702      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

4703      & PSIDD1,PSIDD2

4704      

4705         U=DLOG(M/MGGCUT+DSQRT((M/MGGCUT)**2-1))

4706         CSGGSI=36.D0*PI*(ALPHAS(M/2.D0)/M)**2

4707         CSGGSI=CSGGSI*(0.125D0*DTANH(U)+0.5D0*DSINH(U+U))

4708        

4709        RETURN

4710        END              

4711 

4712 c--- subroutine to generate etaj* --------------- 

4713 c--- RF=PYR(0), MG=MGG/MGGCUT --------------------

4714        SUBROUTINE FINVUGGSI(RF,MG,GETA)

4715 

4716        IMPLICIT NONE

4717        DOUBLE PRECISION GETA,RF,R,MG

4718        DOUBLE PRECISION AUX1,AUX2,AUX3,AUX4

4719 c------ fundamental constants -----------------------------

4720       INTEGER NF,NC,NLOSW

4721       DOUBLE PRECISION PI,CSMB,LAMQCD,

4722      & TF,CF,BF0,BF1

4723       DOUBLE COMPLEX MNI,REI

4724       COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

4725      & TF,CF,BF0,BF1,NF,NC,NLOSW           

4726 

4727        AUX1=DLOG(MG+DSQRT(MG**2-1))

4728        R=RF*(0.125D0*DTANH(AUX1)+0.5D0*DSINH(AUX1+AUX1))

4729        AUX2=3.D0*DSQRT(3.D0)/DSQRT(27.D0+64.D0*R*R)

4730 c--- AUX3=DASIN(AUX2)/3.D0-PI/6.D0 ---       

4731        AUX3=2.D0*DATAN((1.D0-DSQRT(1.D0-AUX2**2))/AUX2)/3.D0-PI/6.D0

4732        AUX4=2.D0*DSIN(AUX3)*DSQRT(27.D0+64.D0*R*R)

4733        AUX4=AUX4+8.D0*R

4734 c-       GETA=DATANH(AUX4/3.D0)

4735        GETA=0.5D0*DLOG((1.D0+AUX4/3.D0)/(1.D0-AUX4/3.D0))    

4736         

4737        RETURN

4738        END  

4739 

4740 c--- upper function for general MG=MGG/MGGCUTdependence ------

4741 c--- N=0 - exact function, N>0 - upper curve ----

4742        FUNCTION FMUGGSI(N,MG)

4743 

4744        IMPLICIT NONE

4745        INTEGER N

4746        DOUBLE PRECISION FMUGGSI,MG

4747        DOUBLE PRECISION AUX1,AUX2,AUX3

4748        DOUBLE PRECISION SOFTSURV,ISUDGEN2

4749        DOUBLE PRECISION CSGGSI,POWCS

4750        DOUBLE PRECISION GFMGEN,STE1,STE2

4751 c------ fundamental constants -----------------------------

4752       INTEGER NF,NC,NLOSW

4753       DOUBLE PRECISION PI,CSMB,LAMQCD,

4754      & TF,CF,BF0,BF1

4755       DOUBLE COMPLEX MNI,REI

4756       COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

4757      & TF,CF,BF0,BF1,NF,NC,NLOSW                

4758 c----- parameters for hard cross-sections -----------------

4759       DOUBLE PRECISION MGGCUT,ETJCUT,MXMAX,

4760      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

4761      & PSIDD1,PSIDD2

4762       COMMON/EDDEHARD/ MGGCUT,ETJCUT,MXMAX,

4763      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

4764      & PSIDD1,PSIDD2

4765 

4766         IF (N.EQ.0) THEN

4767           FMUGGSI=CSGGSI(MG*MGGCUT)

4768           FMUGGSI=FMUGGSI*SOFTSURV(1,MG*MGGCUT)

4769           FMUGGSI=FMUGGSI*ISUDGEN2(1,0.5D0*MG*MGGCUT)

4770           FMUGGSI=FMUGGSI/MG**(PLUM-PSURV-PSUD+PSIDD2)

4771         ELSE

4772           AUX1=0.236469D0*(1-NLOSW*0.14D0)/(0.5D0*MGGCUT)**0.15D0

4773           AUX1=AUX1/MGGCUT

4774           AUX2=36.D0*PI*AUX1*AUX1*1.49332D0

4775           POWCS=2.D0*0.15D0+2.D0

4776           STE1=PLUM+POWCS-1.48D0

4777           STE2=0.48D0

4778           AUX3=GFMGEN(STE1,STE2,MG)  

4779           FMUGGSI=AUX2*AUX3

4780           FMUGGSI=FMUGGSI*SOFTSURV(2,MG*MGGCUT)*MG**PSURV

4781           FMUGGSI=FMUGGSI*ISUDGEN2(2,0.5D0*MG*MGGCUT)

4782           FMUGGSI=FMUGGSI*MG**(PSUD-PSIDD2)

4783         ENDIF 

4784            

4785        RETURN

4786        END  

4787 

4788 c--- generator of (Mgg,etaj*) in c.m. of initial gg ----------

4789        SUBROUTINE GENERSIGG(GMGG,GETAJ)

4790        

4791        IMPLICIT NONE

4792     

4793        DOUBLE PRECISION PYR,GMG,GMGG,GETAJ

4794 c       DOUBLE PRECISION FMUGGSI,DCSGGSI

4795        DOUBLE PRECISION FMUGGSI

4796 c       DOUBLE PRECISION RMG,RMGG,RETAJ,RAT

4797        DOUBLE PRECISION RMG,RETAJ,RAT

4798        DOUBLE PRECISION POWCS,STE1,STE2

4799 c----- parameters for hard cross-sections -----------------

4800       DOUBLE PRECISION MGGCUT,ETJCUT,MXMAX,

4801      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

4802      & PSIDD1,PSIDD2

4803       COMMON/EDDEHARD/ MGGCUT,ETJCUT,MXMAX,

4804      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

4805      & PSIDD1,PSIDD2           

4806 

4807       POWCS=2.D0*0.15D0+2.D0 

4808       STE1=PLUM+POWCS-1.48D0

4809       STE2=0.48D0

4810  53   CALL GFMGENINV(STE1,STE2,PYR(0),RMG)  

4811       RAT=FMUGGSI(0,RMG)/FMUGGSI(1,RMG)

4812       IF (RAT.LE.PYR(0)) GOTO 53

4813       GMG=RMG

4814       GMGG=MGGCUT*GMG

4815 

4816       CALL FINVUGGSI(PYR(0),GMG,RETAJ)         

4817       IF (PYR(0).LE.0.5D0) THEN

4818        GETAJ=RETAJ

4819       ELSE

4820        GETAJ=-RETAJ

4821       ENDIF 

4822       

4823        RETURN

4824        END

4825  

4826 C-=============================================================

4827 C-=============================================================

4828 C-=============================================================

4829 C-========== semi-inclusive g g -> Q Qbar Jz!=0 ===============

4830 C-=============================================================

4831 c--- differential cross-section -----------------

4832 c--- and its upper limit for etaj* generation ---

4833 c--- N=0 exact, N>0 upper limit -----------------

4834        FUNCTION DCSQQSI(MQ,N,M,ETA)

4835 

4836        IMPLICIT NONE

4837        INTEGER N

4838        DOUBLE PRECISION DCSQQSI,ALPHAS

4839        DOUBLE PRECISION MQ,M,ETA

4840        DOUBLE PRECISION AUX1,AUX2,AUX3

4841 c------ fundamental constants -----------------------------

4842       INTEGER NF,NC,NLOSW

4843       DOUBLE PRECISION PI,CSMB,LAMQCD,

4844      & TF,CF,BF0,BF1

4845       DOUBLE COMPLEX MNI,REI

4846       COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

4847      & TF,CF,BF0,BF1,NF,NC,NLOSW         

4848       

4849       DCSQQSI=PI*(ALPHAS(M/2.D0)/M)**2/3.D0

4850       IF (N.EQ.0) THEN

4851          AUX1=8.D0*(MQ*DCOSH(ETA)/M)**2

4852          AUX2=1.D0-1.D0/(2.D0*DCOSH(ETA)**2)

4853          AUX3=AUX2*(1.D0-AUX1)+AUX1*(1.D0-2.D0*(MQ/M)**2)

4854          DCSQQSI=DCSQQSI*AUX3

4855           IF (DCSQQSI.LE.0.D0) THEN

4856            DCSQQSI=0.D0

4857           ENDIF

4858       ELSE

4859          AUX1=((DCOSH(ETA)-1.D0)**4/DCOSH(ETA))**(1/8.05D0-1.D0)

4860          AUX2=(DCOSH(ETA)-1.D0)**3*DSINH(ETA)

4861          AUX2=AUX2*(3.D0*DCOSH(ETA)+1.D0)/DCOSH(ETA)**2

4862          DCSQQSI=DCSQQSI*0.5D0*2.7053D0*AUX1*AUX2/8.05D0

4863          DCSQQSI=DCSQQSI*1.005D0

4864       ENDIF 

4865       

4866        RETURN

4867        END

4868        

4869 c--- integrated cross-section -----------

4870        FUNCTION CSQQSI(MQ,M)

4871 

4872        IMPLICIT NONE

4873        DOUBLE PRECISION CSQQSI,ALPHAS

4874        DOUBLE PRECISION MQ,M,U,AUX1

4875 c------ fundamental constants -----------------------------

4876       INTEGER NF,NC,NLOSW

4877       DOUBLE PRECISION PI,CSMB,LAMQCD,

4878      & TF,CF,BF0,BF1

4879       DOUBLE COMPLEX MNI,REI

4880       COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

4881      & TF,CF,BF0,BF1,NF,NC,NLOSW         

4882 c----- parameters for hard cross-sections -----------------

4883       DOUBLE PRECISION MGGCUT,ETJCUT,MXMAX,

4884      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

4885      & PSIDD1,PSIDD2

4886       COMMON/EDDEHARD/ MGGCUT,ETJCUT,MXMAX,

4887      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

4888      & PSIDD1,PSIDD2

4889      

4890         U=DLOG(M/MGGCUT+DSQRT((M/MGGCUT)**2-1))

4891         AUX1=2.D0*U*(1.D0+(2.D0*MQ/M)**2-8.D0*(MQ/M)**4)

4892         AUX1=AUX1-8.D0*(MQ/M)**4*DSINH(U+U)

4893         AUX1=AUX1-DTANH(U)

4894         CSQQSI=PI*(ALPHAS(M/2.D0)/M)**2/3.D0

4895         CSQQSI=CSQQSI*AUX1

4896         IF (CSQQSI.LE.0.D0) THEN

4897          CSQQSI=0.D0

4898         ENDIF 

4899        

4900        RETURN

4901        END              

4902 

4903 c--- subroutine to generate upper curve --------- 

4904 c--- on etaj* dependence ------------------------

4905 c--- RF=PYR(0), MG=MGG/MGGCUT --------------------

4906       SUBROUTINE FINVUQQSI(RF,MG,GETA)

4907 

4908        IMPLICIT NONE

4909        DOUBLE PRECISION GETA,RF,R,MG

4910        DOUBLE PRECISION AUX1,AUX2,AUX3,AUX4

4911 c------ fundamental constants -----------------------------

4912       INTEGER NF,NC,NLOSW

4913       DOUBLE PRECISION PI,CSMB,LAMQCD,

4914      & TF,CF,BF0,BF1

4915       DOUBLE COMPLEX MNI,REI

4916       COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

4917      & TF,CF,BF0,BF1,NF,NC,NLOSW           

4918 

4919        R=RF**8.05D0*(MG-1.D0)**4/MG

4920        AUX1=9.D0*R*R+DSQRT(3.D0*R**3*(256.D0+27.D0*R))

4921        AUX2=(2.D0*AUX1)**(1.D0/3.D0)

4922        AUX2=AUX2-8.D0*R*(3.D0/AUX1)**(1.D0/3.D0)

4923        AUX3=DSQRT(AUX2)

4924        AUX4=(DSQRT(12.D0*R/AUX3-AUX2)+AUX3)/(2.D0*6.D0**(1.D0/3.D0))

4925        AUX4=AUX4+1.D0

4926        GETA=DLOG(AUX4+DSQRT(AUX4**2-1))

4927         

4928        RETURN

4929        END 

4930        

4931 c--- upper function for general MG=MGG/MGGCUTdependence ------

4932 c--- N=0 - exact function, N>0 - upper curve ----

4933        FUNCTION FMUQQSI(MQ,N,MG)

4934 

4935        IMPLICIT NONE

4936        INTEGER N

4937        DOUBLE PRECISION FMUQQSI,MG,MQ

4938        DOUBLE PRECISION AUX1,AUX2,AUX3

4939        DOUBLE PRECISION SOFTSURV,ISUDGEN2

4940        DOUBLE PRECISION CSQQSI,POWCS

4941        DOUBLE PRECISION GFMGEN,STE1,STE2

4942 c------ fundamental constants -----------------------------

4943       INTEGER NF,NC,NLOSW

4944       DOUBLE PRECISION PI,CSMB,LAMQCD,

4945      & TF,CF,BF0,BF1

4946       DOUBLE COMPLEX MNI,REI

4947       COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

4948      & TF,CF,BF0,BF1,NF,NC,NLOSW                

4949 c----- parameters for hard cross-sections -----------------

4950       DOUBLE PRECISION MGGCUT,ETJCUT,MXMAX,

4951      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

4952      & PSIDD1,PSIDD2

4953       COMMON/EDDEHARD/ MGGCUT,ETJCUT,MXMAX,

4954      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

4955      & PSIDD1,PSIDD2

4956 

4957         IF (N.EQ.0) THEN

4958           FMUQQSI=CSQQSI(MQ,MG*MGGCUT)

4959           FMUQQSI=FMUQQSI*SOFTSURV(1,MG*MGGCUT)

4960           FMUQQSI=FMUQQSI*ISUDGEN2(1,0.5D0*MG*MGGCUT)

4961           FMUQQSI=FMUQQSI/MG**(PLUM-PSURV-PSUD+PSIDD2)

4962         ELSE

4963           AUX1=0.236469D0*(1-NLOSW*0.14D0)/(0.5D0*MGGCUT)**0.15D0

4964           AUX1=AUX1/MGGCUT

4965           AUX2=PI*AUX1*AUX1*2.7053D0/3.D0

4966           POWCS=2.D0*0.15D0+2.D0

4967           STE1=PLUM+POWCS+1.D0/8.05D0

4968           STE2=4.D0/8.05D0

4969           AUX3=GFMGEN(STE1,STE2,MG)  

4970           FMUQQSI=AUX2*AUX3

4971           FMUQQSI=FMUQQSI*SOFTSURV(2,MG*MGGCUT)*MG**PSURV

4972           FMUQQSI=FMUQQSI*ISUDGEN2(2,0.5D0*MG*MGGCUT)

4973           FMUQQSI=FMUQQSI*MG**(PSUD-PSIDD2)

4974         ENDIF 

4975            

4976        RETURN

4977        END  

4978 

4979 c--- generator of (Mgg,etaj*) in c.m. of initial gg ----------

4980        SUBROUTINE GENERSIQQ(MQ,GMGG,GETAJ)

4981        

4982        IMPLICIT NONE

4983       

4984        DOUBLE PRECISION PYR,GMG,GMGG,GETAJ

4985        DOUBLE PRECISION FMUQQSI,DCSQQSI,MQ

4986 c       DOUBLE PRECISION RMG,RMGG,RETAJ,RAT

4987        DOUBLE PRECISION RMG,RETAJ,RAT

4988        DOUBLE PRECISION POWCS,STE1,STE2

4989 c----- parameters for hard cross-sections -----------------

4990       DOUBLE PRECISION MGGCUT,ETJCUT,MXMAX,

4991      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

4992      & PSIDD1,PSIDD2

4993       COMMON/EDDEHARD/ MGGCUT,ETJCUT,MXMAX,

4994      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

4995      & PSIDD1,PSIDD2           

4996 

4997       POWCS=2.D0*0.15D0+2.D0 

4998       STE1=PLUM+POWCS+1.D0/8.05D0

4999       STE2=4.D0/8.05D0

5000  63   CALL GFMGENINV(STE1,STE2,PYR(0),RMG)  

5001       RAT=FMUQQSI(MQ,0,RMG)/FMUQQSI(MQ,1,RMG)

5002       IF (RAT.LE.PYR(0)) GOTO 63

5003       GMG=RMG

5004       GMGG=MGGCUT*GMG

5005 

5006  64   CALL FINVUQQSI(PYR(0),GMG,RETAJ)         

5007       RAT=DCSQQSI(MQ,0,GMGG,RETAJ)/DCSQQSI(MQ,1,GMGG,RETAJ)

5008       IF (RAT.LE.PYR(0)) GOTO 64

5009       IF (PYR(0).LE.0.5D0) THEN

5010        GETAJ=RETAJ

5011       ELSE

5012        GETAJ=-RETAJ

5013       ENDIF 

5014       

5015        RETURN

5016        END

5017  

5018 C-=============================================================

5019 C-=============================================================

5020 C-=============================================================

5021 C-========== semi-inclusive g g -> gamma gamma Jz!=0 ==========

5022 C-=============================================================

5023 c--- aux function -----

5024       FUNCTION AU2GAMSI(ETA)

5025 

5026        IMPLICIT NONE

5027        DOUBLE PRECISION AU2GAMSI,ETA,TETA

5028        DOUBLE PRECISION AUX0,AUX1,AUX2,AUX3

5029 c------ fundamental constants -----------------------------

5030       INTEGER NF,NC,NLOSW

5031       DOUBLE PRECISION PI,CSMB,LAMQCD,

5032      & TF,CF,BF0,BF1

5033       DOUBLE COMPLEX MNI,REI

5034       COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

5035      & TF,CF,BF0,BF1,NF,NC,NLOSW         

5036 

5037        TETA=DTANH(ETA)

5038        AUX0=5.D0+(TETA+2.D0)*TETA

5039        AUX1=DLOG(0.5D0*(1+TETA))

5040        AUX2=1.D0+(3.D0+TETA)*AUX1/(1.D0-TETA)

5041        AUX2=AUX2+0.5D0*AUX0*(AUX1/(1.D0-TETA))**2

5042        AUX3=PI*((1.D0-TETA)*(3.D0+TETA)+AUX0*AUX1)/(1.D0-TETA)**2

5043        AU2GAMSI=AUX2*AUX2+AUX3*AUX3

5044       

5045        RETURN

5046        END

5047 

5048 c--- differential cross-section -----------------

5049 c--- and its upper limit for etaj* generation ---

5050 c--- N=0 exact, N>0 upper limit -----------------

5051        FUNCTION DCS2GAMSI(N,M,ETA)

5052 

5053        IMPLICIT NONE

5054        INTEGER N

5055        DOUBLE PRECISION DCS2GAMSI,ALPHAS

5056        DOUBLE PRECISION AU2GAMSI

5057        DOUBLE PRECISION M,ETA,ALPHAE

5058        DOUBLE PRECISION AUX0,AUX1,AUX2

5059 c------ fundamental constants -----------------------------

5060       INTEGER NF,NC,NLOSW

5061       DOUBLE PRECISION PI,CSMB,LAMQCD,

5062      & TF,CF,BF0,BF1

5063       DOUBLE COMPLEX MNI,REI

5064       COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

5065      & TF,CF,BF0,BF1,NF,NC,NLOSW         

5066 

5067       ALPHAE=1.D0/128.D0      

5068       DCS2GAMSI=(11.D0*ALPHAS(M/2.D0)*ALPHAE/(18.D0*M))**2/PI

5069       AUX0=1.D0-2.D0*ETA*DTANH(ETA)

5070       AUX0=AUX0+(0.25D0*PI**2+ETA**2)*(1.D0+DTANH(ETA)**2)

5071       AUX1=(1+AUX0*AUX0+AU2GAMSI(ETA)+AU2GAMSI(-ETA))/DCOSH(ETA)**2

5072       IF (N.EQ.0) THEN

5073          DCS2GAMSI=DCS2GAMSI*AUX1

5074       ELSE

5075          AUX2=((DCOSH(ETA)-1.D0)**3/DCOSH(ETA)**2)**(1/6.D0-1.D0) 

5076          DCS2GAMSI=DCS2GAMSI*0.5D0*72.0894D0*DSINH(ETA)

5077          DCS2GAMSI=DCS2GAMSI*(DCOSH(ETA)+2.D0)/DCOSH(ETA)**3

5078          DCS2GAMSI=DCS2GAMSI*AUX2*(DCOSH(ETA)-1.D0)**2/6.D0

5079          DCS2GAMSI=DCS2GAMSI*1.265D0

5080       ENDIF 

5081       

5082        RETURN

5083        END

5084        

5085 c--- integrated cross-section -----------

5086        FUNCTION CS2GAMSI(M)

5087 

5088        IMPLICIT NONE

5089        DOUBLE PRECISION  CS2GAMSI,ALPHAS,M,U

5090        DOUBLE PRECISION  ALPHAE,AUX0,AUX1

5091        DOUBLE PRECISION  AUX2,AUX3

5092 c------ fundamental constants -----------------------------

5093       INTEGER NF,NC,NLOSW

5094       DOUBLE PRECISION PI,CSMB,LAMQCD,

5095      & TF,CF,BF0,BF1

5096       DOUBLE COMPLEX MNI,REI

5097       COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

5098      & TF,CF,BF0,BF1,NF,NC,NLOSW         

5099 c----- parameters for hard cross-sections -----------------

5100       DOUBLE PRECISION MGGCUT,ETJCUT,MXMAX,

5101      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

5102      & PSIDD1,PSIDD2

5103       COMMON/EDDEHARD/ MGGCUT,ETJCUT,MXMAX,

5104      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

5105      & PSIDD1,PSIDD2

5106      

5107         ALPHAE=1.D0/128.D0 

5108         U=DLOG(M/MGGCUT+DSQRT((M/MGGCUT)**2-1))

5109         CS2GAMSI=(11.D0*ALPHAS(M/2.D0)*ALPHAE/(18.D0*M))**2/PI

5110 C--- using parametrization on U ---------------------------

5111 C--- U>2, <1%; 0.05<U<2, <3%; -----------------------------

5112 C--- 0.01<U<0.05, <8%; U<0.01,<0.001% ---------------------

5113         IF (U.GT.0.01D0) THEN

5114          AUX0=U-0.01D0

5115         ELSE

5116          AUX0=0.D0

5117         ENDIF 

5118         AUX1=1.D0+3.3D0*DEXP(-4.83D0*AUX0**0.53D0)

5119         AUX2=95.583D0*AUX1*U**1.37D0/(2.9D0+U**1.5614D0)

5120         IF (U.LE.0.01D0.AND.U.GT.0.D0) THEN

5121          AUX2=AUX2/(5.4408D0*U**0.37D0)

5122         ENDIF

5123         IF (U.EQ.0.D0) THEN

5124          AUX2=0.D0

5125         ENDIF 

5126 c------------------        

5127         IF (U.LE.0.05D0) THEN

5128          AUX3=0.8765D0*9.85D0*U

5129         ENDIF

5130         IF (U.GT.0.05D0.AND.U.LE.0.33D0) THEN

5131          AUX3=9.85D0*U**1.05D0

5132         ENDIF

5133         IF (U.GT.0.33D0.AND.U.LE.1.8D0) THEN

5134          AUX3=0.97D0*14.15D0*U**1.36D0

5135         ENDIF

5136         IF (U.GT.1.8D0) THEN

5137          AUX3=33.D0+13.D0*(U-1.8D0)**0.45D0

5138         ENDIF

5139         IF (U.GT.1.7D0.AND.U.LE.2.8D0) THEN

5140          AUX3=AUX3*0.87

5141         ENDIF

5142         

5143         CS2GAMSI=CS2GAMSI*(AUX2+AUX3)

5144          

5145        RETURN

5146        END              

5147 

5148 c--- subroutine to generate upper curve --------- 

5149 c--- on etaj* dependence ------------------------

5150 c--- RF=PYR(0), MG=MGG/MGGCUT --------------------

5151 c---SUBROUTINE FINVU2GAMSI(RF,MG,GETA)=FINVU2GAM(RF,MG,GETA) - 

5152 

5153 c--- upper function for general MG=MGG/MGGCUTdependence ------

5154 c--- N=0 - exact function, N>0 - upper curve ----

5155        FUNCTION FMU2GAMSI(N,MG)

5156 

5157        IMPLICIT NONE

5158        INTEGER N

5159        DOUBLE PRECISION FMU2GAMSI,MG,ALPHAE

5160        DOUBLE PRECISION AUX1,AUX2,AUX3

5161        DOUBLE PRECISION SOFTSURV,ISUDGEN2

5162        DOUBLE PRECISION CS2GAMSI,POWCS

5163        DOUBLE PRECISION GFMGEN,STE1,STE2

5164 c------ fundamental constants -----------------------------

5165       INTEGER NF,NC,NLOSW

5166       DOUBLE PRECISION PI,CSMB,LAMQCD,

5167      & TF,CF,BF0,BF1

5168       DOUBLE COMPLEX MNI,REI

5169       COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

5170      & TF,CF,BF0,BF1,NF,NC,NLOSW                

5171 c----- parameters for hard cross-sections -----------------

5172       DOUBLE PRECISION MGGCUT,ETJCUT,MXMAX,

5173      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

5174      & PSIDD1,PSIDD2

5175       COMMON/EDDEHARD/ MGGCUT,ETJCUT,MXMAX,

5176      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

5177      & PSIDD1,PSIDD2

5178 

5179         ALPHAE=1/128.D0

5180         IF (N.EQ.0) THEN

5181           FMU2GAMSI=CS2GAMSI(MG*MGGCUT)

5182           FMU2GAMSI=FMU2GAMSI*SOFTSURV(1,MG*MGGCUT)

5183           FMU2GAMSI=FMU2GAMSI*ISUDGEN2(1,0.5D0*MG*MGGCUT)

5184           FMU2GAMSI=FMU2GAMSI/MG**(PLUM-PSURV-PSUD+PSIDD2)

5185         ELSE

5186           AUX1=0.236469D0*(1-NLOSW*0.14D0)/(0.5D0*MGGCUT)**0.15D0

5187           AUX1=AUX1/MGGCUT

5188           AUX2=(11.D0*ALPHAE/18.D0)**2*AUX1*AUX1*72.0894D0/PI

5189           POWCS=2.D0*0.15D0+2.D0

5190           STE1=PLUM+POWCS+1.D0/3.D0

5191           STE2=0.5D0

5192           AUX3=GFMGEN(STE1,STE2,MG)  

5193           FMU2GAMSI=AUX2*AUX3

5194           FMU2GAMSI=FMU2GAMSI*SOFTSURV(2,MG*MGGCUT)*MG**PSURV

5195           FMU2GAMSI=FMU2GAMSI*ISUDGEN2(2,0.5D0*MG*MGGCUT)

5196           FMU2GAMSI=FMU2GAMSI*MG**(PSUD-PSIDD2)

5197         ENDIF 

5198            

5199        RETURN

5200        END  

5201 

5202 c--- generator of (Mgg,etaj*) in c.m. of initial gg ----------

5203        SUBROUTINE GENERSI2GAM(GMGG,GETAJ)

5204        

5205        IMPLICIT NONE

5206     

5207        DOUBLE PRECISION PYR,GMG,GMGG,GETAJ

5208        DOUBLE PRECISION FMU2GAMSI,DCS2GAMSI

5209 c       DOUBLE PRECISION RMG,RMGG,RETAJ,RAT

5210        DOUBLE PRECISION RMG,RETAJ,RAT

5211        DOUBLE PRECISION POWCS,STE1,STE2

5212 c----- parameters for hard cross-sections -----------------

5213       DOUBLE PRECISION MGGCUT,ETJCUT,MXMAX,

5214      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

5215      & PSIDD1,PSIDD2

5216       COMMON/EDDEHARD/ MGGCUT,ETJCUT,MXMAX,

5217      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

5218      & PSIDD1,PSIDD2           

5219 

5220       POWCS=2.D0*0.15D0+2.D0 

5221       STE1=PLUM+POWCS+1.D0/3.D0

5222       STE2=0.5D0

5223  73   CALL GFMGENINV(STE1,STE2,PYR(0),RMG)  

5224       RAT=FMU2GAMSI(0,RMG)/FMU2GAMSI(1,RMG)

5225       IF (RAT.LE.PYR(0)) GOTO 73

5226       GMG=RMG

5227       GMGG=MGGCUT*GMG

5228 

5229  74   CALL FINVU2GAM(PYR(0),GMG,RETAJ)         

5230       RAT=DCS2GAMSI(0,GMGG,RETAJ)/DCS2GAMSI(1,GMGG,RETAJ)

5231       IF (RAT.LE.PYR(0)) GOTO 74

5232       IF (PYR(0).LE.0.5D0) THEN

5233        GETAJ=RETAJ

5234       ELSE

5235        GETAJ=-RETAJ

5236       ENDIF 

5237       

5238        RETURN

5239        END

5240  

5241 C-=============================================================

5242 C-=============================================================

5243 

5244 C-============================================================

5245 C-== functions for most processes ============================

5246 c--- general aux. upper function for MG dependence -----------

5247        FUNCTION GFMGEN(ST1,ST2,MG)

5248 

5249        IMPLICIT NONE

5250        DOUBLE PRECISION GFMGEN,MG,ST1,ST2

5251        DOUBLE PRECISION V1,V2,VM,FVM

5252      

5253           VM=ST1/(ST1-ST2)

5254           FVM=(VM-1.D0)**ST2/VM**ST1

5255           V1=1.D0+FVM**(1.D0/ST2)

5256           V2=1.D0/FVM**(1.D0/(ST1-ST2))

5257           IF (MG.LT.V1) THEN                   

5258             GFMGEN=(MG-1.D0)**ST2

5259           ELSE 

5260             IF (MG.LE.V2) THEN 

5261              GFMGEN=FVM

5262             ELSE

5263              GFMGEN=1.D0/MG**(ST1-ST2)

5264             ENDIF

5265           ENDIF  

5266                      

5267        RETURN

5268        END  

5269 

5270 c--- general aux. subroutine for MG generation ---------------

5271 c--- RF=PYR(0) in PYTHIA -------------------------------------

5272        SUBROUTINE GFMGENINV(ST1,ST2,RF,GMG)

5273 

5274        IMPLICIT NONE

5275        DOUBLE PRECISION GMG,ST1,ST2,RF,R

5276        DOUBLE PRECISION V1,V2,VM,V3

5277        DOUBLE PRECISION FVM,FV1,FV2,FV3

5278 c----- parameters for hard cross-sections -----------------

5279       DOUBLE PRECISION MGGCUT,ETJCUT,MXMAX,

5280      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

5281      & PSIDD1,PSIDD2

5282       COMMON/EDDEHARD/ MGGCUT,ETJCUT,MXMAX,

5283      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

5284      & PSIDD1,PSIDD2       

5285      

5286           VM=ST1/(ST1-ST2)

5287           FVM=(VM-1.D0)**ST2/VM**ST1

5288           V1=1.D0+FVM**(1.D0/ST2)

5289           V2=1.D0/FVM**(1.D0/(ST1-ST2))

5290           V3=MXMAX/MGGCUT

5291           FV1=(V1-1.D0)**(ST2+1.D0)/(ST2+1.D0)

5292           FV2=FV1+(V2-V1)*FVM

5293           FV3=FV2+(V2**(ST2+1.D0-ST1)-V3**(ST2+1.D0-ST1))/(ST1-ST2-1.D0)

5294           R=RF*FV3

5295           

5296           IF (R.LT.FV1) THEN                   

5297             GMG=1.D0+((ST2+1.D0)*R)**(1.D0/(ST2+1.D0))

5298           ELSE 

5299             IF (R.LE.FV2) THEN 

5300              GMG=(R+V1*FVM+FV1)/FVM

5301             ELSE

5302              GMG=1.D0/((FV2-R)*(ST1-ST2-1.D0)+V2**(ST2+1.D0-ST1))

5303              GMG=GMG**(1.D0/(ST1-ST2-1.D0))

5304             ENDIF

5305           ENDIF  

5306                      

5307        RETURN

5308        END   

5309 C-============================================================

5310 C-============================================================

5311 

5312 C-++================== B E G I N  C A S C A D ================

5313 c- mass correction subroutine

5314       SUBROUTINE SIMXCOR(N,MO,MN,PO,PN)

5315       

5316       IMPLICIT NONE

5317       INTEGER N

5318       DOUBLE PRECISION MO,MN,PO(5),PN(5),PPL,PMI,PT,X

5319 

5320       PPL=(PO(4)+PO(3))/DSQRT(2.D0)

5321       PMI=(PO(4)-PO(3))/DSQRT(2.D0)

5322       PT=DSQRT(PO(1)**2+PO(2)**2)

5323       PN(1)=PO(1)

5324       PN(2)=PO(2)

5325       PN(5)=PO(5)

5326       IF (N.EQ.1) THEN

5327        X=DSQRT(2.D0)*PPL/MO

5328        PN(4)=0.5D0*MN*X*(1.D0+(PT/(MN*X))**2)

5329        PN(3)=0.5D0*MN*X*(1.D0-(PT/(MN*X))**2)

5330       ELSE

5331        X=DSQRT(2.D0)*PMI/MO

5332        PN(4)=0.5D0*MN*X*(1.D0+(PT/(MN*X))**2)

5333        PN(3)=-0.5D0*MN*X*(1.D0-(PT/(MN*X))**2)

5334       ENDIF

5335      

5336       RETURN

5337       END

5338 

5339 C-============================================================

5340 C-= combinatorics of singlets N -> 2*N2+3*N3 all events ======

5341 C-============================================================

5342 c-check+

5343        SUBROUTINE COMBSING(N,N2,N3,CEVENT)

5344        

5345        IMPLICIT NONE

5346        

5347        INTEGER FACTN

5348 c- numbers of gluons, parity, 

5349 c- max. number of 2*N2+3*N3 (N2,N3-INTEGER) combinations minus 1, 

5350 c- and number of possible combinations

5351        INTEGER N,INDC,KMAX,NSUMEV

5352 c- generated event,

5353 c- corresponding K to the generated event,

5354 c- corresponding N2 and N3 to the event.

5355        INTEGER NRK,K,N2,N3

5356 c- vars, for distribution of N numbers between 2*N2 and 3*N3 cells:

5357 c- generators for probability for 2*N2 cell and 3*N3 cell, their sum,

5358 c- index of massives for both cells

5359        INTEGER I2,I3,I23,K2,K3

5360 c- massiv of cell 2*N2, massive of cell 3*N3,

5361 c- indexes of indexes for C2 and C3.

5362 c- use only 2*N2 elements from C2 and IC2, 3*N3 from C3 and IC3

5363 c-       INTEGER C2(N),C3(N),IC2(N),IC3(N)

5364 c- order of numbers of gluons=event for PYTHIA

5365        INTEGER CEVENT(2,500),CAUX(500),CAUX2(500)

5366 c- number of events at each K=0->KMAX => KEVE(K+1),

5367 c- check points for K generation KEVES(K+1)=SUM[0->K][KEVE(K+1)]

5368 c- for even:N!/{([N/2]-3K)!2^([N/2]-3K)(2K)! 6^(2K)} -------------

5369 c- for add: N!/{([(N-3)/2]-3K)!2^([(N-3)/2]-3K)(2K+1)!6^(2K+1)} ---

5370 c- NEVE23 number of events in 2*N2 (or 3*N3) from N: N!/(2*N2)!/(3*N3)! --

5371 c- number of events inside couples and triples --------------------

5372 c- NEVE2=(2*N2)!/N2!/2**N2, NEVE3=(3*N3)!/N3!/6**N3 ---------------

5373        INTEGER KEVE(500),KEVES(500)

5374 c- random 0->1

5375        DOUBLE PRECISION PYR 

5376 c- indexes,probability, aux. vars.

5377 c       INTEGER I,J,L,II,JJ,LL,IC,III 

5378        INTEGER I,J,L,II,JJ,LL,IC 

5379 c       DOUBLE PRECISION PROB,AUX1,AUX2

5380        DOUBLE PRECISION PROB,AUX1

5381 

5382        K=0

5383 c- definition N - even or add  

5384 c- and to fill CEVENT(2,N) 1rst iteration

5385         DO I=1,N

5386          CEVENT(1,I)=I

5387          CAUX(I)=I

5388         ENDDO

5389         AUX1=0.5D0*N-DBLE(INT(N/2))

5390 c-        WRITE(*,*)' N=',N,' AUX1=',AUX1

5391         IF (AUX1.EQ.0.D0) THEN

5392          INDC=0

5393          KMAX=INT(N/6)

5394          J=INT(N/2)         

5395          N2=INT(N/2)

5396          N3=0

5397          DO I=1,J

5398           CEVENT(2,2*I-1)=2

5399           CEVENT(2,2*I)=1

5400          ENDDO         

5401         ELSE

5402          INDC=1

5403          KMAX=INT((N-3)/6)

5404          J=INT((N-3)/2)

5405          N3=1

5406          N2=N-3*N3

5407          CEVENT(2,N)=1

5408          CEVENT(2,N-1)=2

5409          CEVENT(2,N-2)=2

5410          IF (J.GE.1) THEN

5411           DO I=1,J

5412            CEVENT(2,2*I-1)=2

5413            CEVENT(2,2*I)=1

5414           ENDDO

5415          ENDIF

5416         ENDIF        

5417 c- definition of total number of indep. events.

5418        NSUMEV=0

5419        IF (INDC.EQ.0) THEN

5420         DO I=0,KMAX

5421          KEVE(I+1)=FACTN(N)/(FACTN(INT(N/2)-3*I)*

5422      &    2**(INT(N/2)-3*I)*FACTN(2*I)*6**(2*I))

5423          NSUMEV=NSUMEV+KEVE(I+1)

5424          KEVES(I+1)=NSUMEV

5425         ENDDO

5426        ELSE

5427         DO I=0,KMAX

5428          KEVE(I+1)=FACTN(N)/(FACTN(INT((N-3)/2)-3*I)*

5429      &   2**(INT((N-3)/2)-3*I)*FACTN(2*I+1)*6**(2*I+1))

5430          NSUMEV=NSUMEV+KEVE(I+1)

5431          KEVES(I+1)=NSUMEV

5432         ENDDO 

5433        ENDIF       

5434 c- generation of random number 1->NRK

5435        IF (N.EQ.6.OR.N.GT.7) THEN

5436  1       NRK=DINT(PYR(0)*NSUMEV)+1

5437         IF (NRK.EQ.(NSUMEV+1)) GOTO 1

5438         DO I=1,KMAX

5439          IF (NRK.LE.KEVES(I+1).AND.NRK.GT.KEVES(I)) THEN

5440           K=I

5441          ELSE 

5442           K=0 

5443          ENDIF

5444         ENDDO

5445        ELSE

5446         K=0

5447        ENDIF

5448 c- number of couples and triples       

5449        IF (INDC.EQ.0) THEN

5450         N2=INT(N/2)-3*K

5451         N3=2*K

5452        ELSE

5453         N2=INT((N-3)/2)-3*K

5454         N3=2*K+1

5455        ENDIF

5456 c- massive CEVENT(2,I)

5457        IF (N2.GE.1) THEN

5458         DO I=1,N2

5459         CEVENT(2,2*I-1)=2

5460         CEVENT(2,2*I)=1

5461         ENDDO

5462        ENDIF

5463        IF (N3.GE.1) THEN

5464         DO I=1,N3

5465         CEVENT(2,2*N2+3*I-2)=2

5466         CEVENT(2,2*N2+3*I-1)=2

5467         CEVENT(2,2*N2+3*I)=1

5468         ENDDO

5469        ENDIF 

5470 c- fragmentation into 2 cells of 2*N2 and 3*N3 elements

5471        IF (N2.GT.0.AND.N3.GT.0) THEN 

5472 c-

5473         I2=2*N2

5474         I3=3*N3

5475         K2=1

5476         K3=1

5477 c-        WRITE(*,*)'I2=',I2,'I3=',I3,'K2=',K2,'K3=',K3

5478 c- J - number to put into one of cells

5479         J=1

5480  2      I23=I2+I3

5481         PROB=DBLE(I2)/DBLE(I23)

5482         IF (PYR(0).LE.PROB) THEN

5483          CEVENT(1,K2)=J

5484          K2=K2+1  

5485          I2=I2-1

5486         ELSE

5487          CEVENT(1,2*N2+K3)=J

5488          K3=K3+1 

5489          I3=I3-1

5490         ENDIF

5491 c-        WRITE(*,*)'---------------'        

5492 c-        WRITE(*,*)'PROB=',PROB,'J=',J

5493 c-        WRITE(*,*)'I2=',I2,'I3=',I3,'K2=',K2,'K3=',K3        

5494         J=J+1

5495         IF (I2.GT.0.AND.I3.GT.0) GOTO 2

5496         IF (I2.EQ.0.AND.I3.GT.0) THEN

5497          DO I=K3,3*N3

5498           CEVENT(1,2*N2+I)=J

5499           J=J+1

5500          ENDDO

5501         ENDIF

5502         IF (I2.GT.0.AND.I3.EQ.0) THEN

5503          DO I=K2,2*N2

5504           CEVENT(1,I)=J

5505           J=J+1

5506          ENDDO

5507         ENDIF        

5508 c- numbers are distributed in CELL2(2*N2 elements)

5509 c- and CELL3(3*N3) elements        

5510        ENDIF

5511   

5512 c- distribution of numbers between couples in CELL2

5513        IF (N2.GT.1)THEN

5514         DO I=1,2*N2

5515          CAUX(I)=CEVENT(1,I)

5516         ENDDO    

5517         DO I=0,N2-2

5518 c- generate 2 numbers 1 <= II < JJ <= 2*(N2-I)        

5519           J=2*(N2-I)         

5520  3        II=INT(PYR(0)*(J-1))+1

5521           IF (II.EQ.J) GOTO 3 

5522           J=J+1   

5523  4        JJ=INT(PYR(0)*(J-II-1))+II+1

5524           IF (JJ.EQ.J) GOTO 4

5525 c- take these 2 numbers from CAUX and put to CEVENT

5526          CEVENT(1,2*(I+1)-1)=CAUX(II)

5527          CEVENT(1,2*(I+1))=CAUX(JJ)

5528 c- set to 0 elements, that we have taken

5529          CAUX(II)=0

5530          CAUX(JJ)=0

5531 c- reformat CAUX

5532          IC=1

5533          DO L=1,2*(N2-I)

5534           IF (CAUX(L).GT.0) THEN

5535            CAUX2(IC)=CAUX(L)

5536            IC=IC+1

5537           ENDIF

5538          ENDDO

5539          DO L=1,2*(N2-I-1)

5540           CAUX(L)=CAUX2(L)

5541          ENDDO         

5542         ENDDO

5543 c- last 2 elements        

5544         CEVENT(1,2*N2-1)=CAUX(1)

5545         CEVENT(1,2*N2)=CAUX(2)

5546        ENDIF

5547 

5548 c- distribution of numbers between triples in CELL3

5549        IF (N3.GT.1) THEN

5550         DO I=1,3*N3

5551          CAUX(I)=CEVENT(1,2*N2+I)

5552         ENDDO    

5553 

5554         DO I=0,N3-2

5555 c- generate 3 numbers 1 <= II < JJ < LL<= 3*(N3-I)        

5556           J=3*(N3-I)-1         

5557  5        II=INT(PYR(0)*(J-1))+1

5558           IF (II.EQ.J) GOTO 5 

5559           J=J+1   

5560  6        JJ=INT(PYR(0)*(J-II-1))+II+1

5561           IF (JJ.EQ.J) GOTO 6

5562           J=J+1 

5563  7        LL=INT(PYR(0)*(J-JJ-1))+JJ+1         

5564 c- take these 2 numbers from CAUX and put to CEVENT

5565          CEVENT(1,2*N2+3*(I+1)-2)=CAUX(II)

5566          CEVENT(1,2*N2+3*(I+1)-1)=CAUX(JJ)

5567          CEVENT(1,2*N2+3*(I+1))=CAUX(LL)

5568 c- set to 0 elements, that we have taken

5569          CAUX(II)=0

5570          CAUX(JJ)=0

5571          CAUX(LL)=0

5572         

5573 c- reformat CAUX

5574          IC=1

5575          DO L=1,3*(N3-I)

5576           IF (CAUX(L).GT.0) THEN

5577            CAUX2(IC)=CAUX(L)

5578            IC=IC+1

5579           ENDIF

5580          ENDDO

5581          DO L=1,3*(N3-I-1)

5582           CAUX(L)=CAUX2(L)

5583          ENDDO                

5584         ENDDO

5585 c- last 3 elements        

5586         CEVENT(1,N-2)=CAUX(1)

5587         CEVENT(1,N-1)=CAUX(2)

5588         CEVENT(1,N)=CAUX(3)

5589        ENDIF    

5590        

5591        RETURN

5592        END

5593          

5594 c------------cycles for combinatorics--------

5595 c--- general cycle from NA to NB elements of massive

5596 c--- of N elements, 1<=NA<NB<=N

5597        SUBROUTINE CYCLGEN(N,CEVENT1,NA,NB,CEVENT2)

5598 

5599        IMPLICIT NONE

5600        

5601        INTEGER N,CEVENT1(2,N),CEVENT2(2,N),NA,NB

5602        INTEGER I,CSAVE

5603        

5604        DO I=1,N

5605        CEVENT2(1,I)=CEVENT1(1,I)

5606        CEVENT2(2,I)=CEVENT1(2,I)

5607        ENDDO       

5608        

5609        CSAVE=CEVENT2(1,NA)

5610        DO I=NA,NB-1

5611         CEVENT2(1,I)=CEVENT2(1,I+1)        

5612        ENDDO

5613        CEVENT2(1,NB)=CSAVE

5614        

5615        RETURN

5616        END

5617 

5618 C-============================================================

5619 C-= 2 gluon cascades from colliding gluons in C.M.X. =========

5620 C-============================================================

5621        SUBROUTINE SICASCAD2(MC,N1,PG1,P1,N2,PG2,P2,MX,NFAIL)

5622        

5623        IMPLICIT NONE

5624 c- number of gluons in both cascads

5625 c       INTEGER I,J,N1,N2,IAU,NFAIL

5626        INTEGER I,N1,N2,IAU,NFAIL

5627 c- jj mass, {X+jj+Y} mass,momenta of cascad gluons,

5628 c- momenta of final colliding hard gluons

5629        DOUBLE PRECISION MC,MX,PG1(5,500),PG2(5,500),

5630      & P1(5),P2(5)

5631 c- P1(5)=DSQRT(ABS(P1(4)**2-P1(3)**2-P1(2)**2-P1(1)**2))

5632 c- P2(5)=DSQRT(ABS(P2(4)**2-P2(3)**2-P2(2)**2-P2(1)**2))

5633 c- because virtuality is negative!

5634 c- variables for any cascad

5635        DOUBLE PRECISION MU,XG1(500),PTG1(500),FIG1(500),FX1,

5636      & FPT1,FFI1,XG2(500),PTG2(500),FIG2(500),FX2,FPT2,FFI2

5637 c- parameter of Rj**2=(MC/MX)**2>RJMIN**2, 

5638 c- RJMIN2=1/RJMIN**2 restriction

5639        DOUBLE PRECISION RJMIN2

5640 c- aux.

5641        DOUBLE PRECISION A1,A2,AQ,ASRP,ASRM,AC,AB,KORP,KORM,

5642      & AUX1,AUX2

5643        

5644        MU=0.5D0*MC

5645        RJMIN2=100.D0

5646 c-       WRITE(*,*)'point cascad2 1'

5647        IAU=0

5648        NFAIL=0

5649  1     CONTINUE       

5650        CALL SICASCAD(MU,N1,XG1,PTG1,FIG1,FX1,FPT1,FFI1)

5651 c-       WRITE(*,*)'point cascad2 1.5'

5652  2     CALL SICASCAD(MU,N2,XG2,PTG2,FIG2,FX2,FPT2,FFI2)

5653 c-       WRITE(*,*)'MU=',MU,' => attempt N ',IAU,': N1=',N1,' N2=',N2 

5654 c- singlet restriction

5655 c-       IF (N1.EQ.0.AND.N2.EQ.0.OR.N1.EQ.0.AND.N2.EQ.1.OR.

5656 c-     & N1.EQ.1.AND.N2.EQ.0) THEN

5657 c-        WRITE(*,*)'FAIL'

5658 c-       ENDIF 

5659        IAU=IAU+1

5660        IF (IAU.GT.3000) THEN

5661         NFAIL=1

5662        ELSE

5663         NFAIL=0

5664        ENDIF 

5665        IF (IAU.GT.3000) GOTO 3

5666        IF (N1.EQ.0.AND.N2.EQ.0) GOTO 1

5667        IF (N1.EQ.0.AND.N2.EQ.1.OR.N1.EQ.1.AND.N2.EQ.0) GOTO 2

5668        

5669 c-         WRITE(*,*)'point cascad2 2'

5670 c-       WRITE(*,*)IAU,' STEPS to generate 2 cascads '

5671 c-       WRITE(*,*)'X1=',FX1,' X2=',FX2

5672 c-       WRITE(*,*)'PT1=',FPT1,' PT2=',FPT2

5673 c- full procedure of MX extraction

5674        A1=0.D0

5675        A2=0.D0

5676        AQ=0.D0

5677       IF (N1.GT.0) THEN  

5678        DO I=1,N1

5679        A1=A1+PTG1(I)**2/XG1(I) 

5680        ENDDO

5681       ENDIF

5682       IF (N2.GT.0) THEN

5683        DO I=1,N2

5684        A2=A2+PTG2(I)**2/XG2(I) 

5685        ENDDO

5686       ENDIF 

5687       IF (N1.EQ.0) THEN

5688        FPT1=0.D0

5689        FFI1=0.D0

5690        FX1=1.D0

5691       ENDIF

5692       IF (N2.EQ.0) THEN

5693        FPT2=0.D0

5694        FFI2=0.D0

5695        FX2=1.D0

5696       ENDIF

5697        A1=A1/MU**2

5698        A2=A2/MU**2

5699        AQ=(FPT1**2+FPT2**2+2*FPT1*FPT2*DCOS(FFI1-FFI2))/MU**2

5700        AB=(1.D0+0.25D0*((FX2*A2+FX1*A1)+AQ))

5701 c- discriminant of the equation

5702        AC=AB*AB-A1*A2*FX1*FX2/4.D0

5703 c- roots (MX/MC)**2=KORP OR KORM?

5704        KORM=0.5D0*(AB-DSQRT(AC))/(FX1*FX2)

5705        KORP=0.5D0*(AB+DSQRT(AC))/(FX1*FX2)

5706 c- if KORM is possible? Comparison. P1(4)+P2(4)>=MC! gives

5707        ASRM=KORM-((1.D0+DSQRT(1.D0+0.25D0*(A1+A2)*(FX1+FX2)))

5708      &  /(FX1+FX2))**2

5709        ASRP=KORP-((1.D0+DSQRT(1.D0+0.25D0*(A1+A2)*(FX1+FX2)))

5710      &  /(FX1+FX2))**2

5711 c- (MX/MC)**2>AUX1 AND >AUX2: from P1(4)>0,P2(4)>0.

5712        AUX1=0.25D0*A1/FX1

5713        AUX2=0.25D0*A2/FX2

5714 c-       WRITE(*,*)'AUX OUTPUT from CASCAD2============'

5715 c-       WRITE(*,*)'A1=',A1,'  A2=',A2

5716 c-       WRITE(*,*)'AQ=',AQ,'  AB=',AB,' AC=',AC

5717 c-       WRITE(*,*)'KORM=',KORM,'  KORP=',KORP

5718 c-       WRITE(*,*)'ASRM=',ASRM,' ASRP=',ASRP

5719 c-       WRITE(*,*)'AUX1=',AUX1,' AUX2=',AUX2

5720 c- verification discriminant>=0, (MX/MC)**2<RJMIN2 (~10-100)

5721 c- and P1(4)+P2(4)>=MC for KORP solution

5722 c-       WRITE(*,*)'point 1'

5723        IF (AC.LT.0.D0.OR.KORM.GT.RJMIN2.OR.ASRP.LT.0.D0) GOTO 1

5724 c-       WRITE(*,*)'point 2'

5725        IF (KORP.LE.AUX1.OR.KORP.LE.AUX2) GOTO 1 

5726 c- verification of P1(4)+P2(4)>=MC,

5727 c- P1(4)>0,P2(4)>0 for KORM solution

5728        IF (ASRM.LT.0.D0.OR.KORM.LE.AUX1.OR.KORM.LE.AUX2) THEN 

5729         KORM=0.D0

5730        ENDIF

5731 c- determination of MX

5732 c-        WRITE(*,*)'point 3' 

5733         IF (KORP.GT.RJMIN2.AND.KORM.EQ.0.D0) GOTO 1

5734 c-        WRITE(*,*)'point 4'

5735 c- choose KORP anyway if KORP.LE.RJMIN2

5736 c-        IF (KORP.LE.RJMIN2.AND.KORM.EQ.0.D0) THEN

5737 c-         MX=MC*DSQRT(KORP)

5738 c-        ENDIF

5739 c- in this case both roots satisfy relations!

5740 c-        IF (KORP.LE.RJMIN2.AND.KORM.GT.0.D0) THEN

5741 c-        MX=MC*DSQRT(KORP)

5742 c-        ENDIF

5743 c-         WRITE(*,*)'point cascad2 3'

5744         IF (KORP.LE.RJMIN2) THEN

5745          MX=MC*DSQRT(KORP)

5746         ENDIF

5747 c- only in this case KORM!

5748         IF (KORP.GT.RJMIN2.AND.KORM.GT.0.D0) THEN

5749          MX=MC*DSQRT(KORM)

5750         ENDIF    

5751 c-       WRITE(*,*)'MX=',MX,' MC=',MC

5752 c-       WRITE(*,*)'AUX OUTPUT from CASCAD2============'

5753 c- determination of all momenta in X C.M. frame

5754 c- hard gluons

5755       IF (N1.GT.0) THEN 

5756        P1(1)=FPT1*DCOS(FFI1) 

5757        P1(2)=FPT1*DSIN(FFI1)

5758        P1(3)=0.5D0*MX*(FX1+A1*0.25D0*(MC/MX)**2)

5759        P1(4)=0.5D0*MX*(FX1-A1*0.25D0*(MC/MX)**2)

5760        P1(5)=DSQRT(DABS(P1(4)**2-P1(3)**2-P1(2)**2-P1(1)**2))

5761       ENDIF

5762       IF (N2.GT.0) THEN

5763        P2(1)=FPT2*DCOS(FFI2) 

5764        P2(2)=FPT2*DSIN(FFI2)

5765        P2(3)=-0.5D0*MX*(FX2+A2*0.25D0*(MC/MX)**2)

5766        P2(4)=0.5D0*MX*(FX2-A2*0.25D0*(MC/MX)**2)

5767        P2(5)=DSQRT(DABS(P2(4)**2-P2(3)**2-P2(2)**2-P2(1)**2))       

5768       ENDIF 

5769       IF (N1.EQ.0) THEN

5770        P1(1)=0.D0 

5771        P1(2)=0.D0

5772        P1(3)=0.5D0*MX

5773        P1(4)=0.5D0*MX

5774        P1(5)=DSQRT(DABS(P1(4)**2-P1(3)**2-P1(2)**2-P1(1)**2))      

5775       ENDIF

5776       IF (N2.EQ.0) THEN

5777        P2(1)=0.D0 

5778        P2(2)=0.D0

5779        P2(3)=-0.5D0*MX

5780        P2(4)=0.5D0*MX

5781        P2(5)=DSQRT(DABS(P2(4)**2-P2(3)**2-P2(2)**2-P2(1)**2))       

5782       ENDIF

5783 c- cascade gluons

5784 c-       WRITE(*,*)' direct output from cascad 2---------'       

5785 c-       WRITE(*,*)'N1=',N1,' N2=',N2,' MX=',MX

5786       IF (N1.GT.0) THEN 

5787        DO I=1,N1

5788         PG1(1,I)=PTG1(I)*DCOS(FIG1(I))

5789         PG1(2,I)=PTG1(I)*DSIN(FIG1(I))

5790         PG1(3,I)=0.5D0*MX*XG1(I)*(1.D0-(PTG1(I)/MX/XG1(I))**2)

5791         PG1(4,I)=0.5D0*MX*XG1(I)*(1.D0+(PTG1(I)/MX/XG1(I))**2)

5792         PG1(5,I)=0.D0

5793 c-        WRITE(*,*)'XG1(',I,')=',XG1(I),' PTG1(',I,')=',PTG1(I)

5794 c-        WRITE(*,*)I,'. mg**2=',(PG1(4,I)**2-PG1(3,I)**2-

5795 c-     &  PG1(2,I)**2-PG1(1,I)**2)

5796 c-        WRITE(*,*)'PG1(',I,'): ',PG1(4,I),' ',PG1(1,I),' ',

5797 c-     &  PG1(2,I),' ',PG1(3,I)   

5798        ENDDO       

5799       ENDIF

5800       IF (N2.GT.0) THEN

5801        DO I=1,N2

5802         PG2(1,I)=PTG2(I)*DCOS(FIG2(I))

5803         PG2(2,I)=PTG2(I)*DSIN(FIG2(I))

5804         PG2(3,I)=-0.5D0*MX*XG2(I)*(1.D0-(PTG2(I)/MX/XG2(I))**2)

5805         PG2(4,I)=0.5D0*MX*XG2(I)*(1.D0+(PTG2(I)/MX/XG2(I))**2)

5806         PG2(5,I)=0.D0

5807 c-        WRITE(*,*)'XG2(',I,')=',XG2(I),' PTG2(',I,')=',PTG2(I)

5808 c-        WRITE(*,*)I+N1,'. mg**2=',(PG2(4,I)**2-PG2(3,I)**2-

5809 c-     &  PG2(2,I)**2-PG2(1,I)**2)

5810 c-        WRITE(*,*)'PG2(',I,'): ',PG2(4,I),' ',PG2(1,I),' ',

5811 c-     &  PG2(2,I),' ',PG2(3,I)     

5812        ENDDO       

5813       ENDIF

5814 c-        WRITE(*,*)'final hard gluons'

5815 c-        WRITE(*,*)'Pf1: ',P1(4),' ',P1(1),' ',

5816 c-     &  P1(2),' ',P1(3),' ',P1(5)

5817 c-        WRITE(*,*)'Pf2: ',P2(4),' ',P2(1),' ',

5818 c-     &  P2(2),' ',P2(3),' ',P2(5)

5819 c-        AUX1=((P1(4)+P2(4))**2-

5820 c-     & (P1(3)+P2(3))**2-(P1(2)+P2(2))**2-(P1(1)+P2(1))**2)  

5821 c-        WRITE(*,*)'central mass**2 => ',AUX1  

5822 c-       WRITE(*,*)' direct output from cascad 2---------'      

5823       

5824  3     RETURN

5825        END

5826 

5827 C-============================================================

5828 C-= 1 gluon cascade from colliding gluon in C.M.X. ===========

5829 C-============================================================

5830        SUBROUTINE SICASCAD(MU,NG,XG,PTG,FIG,FX,FPT,FFI)

5831        

5832        IMPLICIT NONE

5833 c------ fundamental constants -----------------------------

5834       INTEGER NF,NC,NLOSW

5835       DOUBLE PRECISION PI,CSMB,LAMQCD,

5836      & TF,CF,BF0,BF1

5837       DOUBLE COMPLEX MNI,REI

5838       COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

5839      & TF,CF,BF0,BF1,NF,NC,NLOSW

5840 c----- parameters for hard cross-sections -----------------

5841       DOUBLE PRECISION MGGCUT,ETJCUT,MXMAX,

5842      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

5843      & PSIDD1,PSIDD2

5844       COMMON/EDDEHARD/ MGGCUT,ETJCUT,MXMAX,

5845      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

5846      & PSIDD1,PSIDD2     

5847 C-number of generated gluons and turn on/off parameter       

5848        INTEGER NG,NKON

5849 C-generated kinematical variables for hard gluons

5850        DOUBLE PRECISION XGH(500),PTGH(500),FIGH(500)

5851 C-for soft gluons

5852        DOUBLE PRECISION XG(500),PTG(500),FIG(500)

5853 C-generated final gluon variables

5854        DOUBLE PRECISION MU,FX,FPT,FFI

5855 C- aux vars. -----------------       

5856        INTEGER I,ISAVE

5857        DOUBLE PRECISION PYR,AUX1,AUX2,AUX3,AUX4 

5858 

5859        DO I=1,500

5860        XG(I)=0.D0

5861        XGH(I)=0.D0

5862        PTG(I)=0.D0

5863        PTGH(I)=0.D0

5864        FIG(I)=0.D0

5865        FIGH(I)=0.D0

5866        ENDDO

5867 

5868  22    NKON=0

5869        NG=0

5870        I=1

5871 

5872 c- begin iterations

5873 c-       WRITE(*,*)'begin iterations'

5874 c-      WRITE(*,*)'point cascad 1'

5875       CALL GENERFINAL(MU,FX,FPT,FFI,NKON)

5876 c-      WRITE(*,*)'point cascad 1.5'

5877 c-      

5878 c-      WRITE(*,*)'X_f=',FX,' PT_f=',FPT,' NKON=',NKON

5879 c-

5880        IF (NKON.EQ.0) THEN 

5881         PTGH(1)=FPT

5882         XGH(1)=FX

5883         FIGH(1)=FFI

5884        ENDIF

5885  

5886 c- here XG,PTG -> for hard virtual gluons

5887  1     CONTINUE

5888 c-       WRITE(*,*)'label 1'

5889        ISAVE=I 

5890        I=I+1 

5891 c-       WRITE(*,*)'ISAVE=',ISAVE,' I=',I

5892 c- PYTHIA restriction -----       

5893 c- in this case compensate momentum to conserve 4-mom.

5894        IF (I.GT.80) THEN

5895        NKON=1

5896        ENDIF

5897  2     CONTINUE

5898 c-       WRITE(*,*)'label 2'

5899        IF (NKON.EQ.0) THEN        

5900 c- generation of next gluon

5901 c-       WRITE(*,*)'NKON=',NKON

5902 c-       WRITE(*,*)'call genercptx -----------'

5903        CALL GENERCPTX(MU,XGH(ISAVE),PTGH(ISAVE),PTGH(I),XGH(I),NKON)

5904 c-       WRITE(*,*)'XGH(',ISAVE,')=',XGH(ISAVE)

5905 c-       WRITE(*,*)'PTGH(',ISAVE,')=',PTGH(ISAVE)

5906 c-       WRITE(*,*)'PTGH(',I,')=',PTGH(I)

5907 c-       WRITE(*,*)'XGH(',I,')=',XGH(I)

5908 c-       WRITE(*,*)'NKON=',NKON

5909        ENDIF

5910        IF (NKON.EQ.0) THEN

5911        FIGH(I)=2*PI*PYR(0) 

5912        ENDIF

5913 c- check point for current gluon

5914 c- rap. gap. constr.

5915 c-       WRITE(*,*)'NKON=',NKON  

5916        IF (NKON.EQ.0) THEN

5917         AUX1=DSQRT(PTGH(I)**2+PTGH(ISAVE)**2-

5918      &  2.D0*PTGH(I)*PTGH(ISAVE)*DCOS(FIGH(I)-FIGH(ISAVE)))

5919         AUX1=AUX1*DCOSH(0.5D0*ETASIMAX)/MU

5920         AUX1=AUX1/(XGH(I)-XGH(ISAVE))

5921        ELSE

5922         AUX1=PTGH(ISAVE)*DCOSH(0.5D0*ETASIMAX)/MU

5923         AUX1=AUX1/(1.D0-XGH(ISAVE))

5924        ENDIF

5925 c-       WRITE(*,*)'rap.gap. check=>',AUX1 

5926        IF (NKON.EQ.0.AND.AUX1.LT.1.D0) GOTO 2

5927        IF (NKON.EQ.0.AND.AUX1.GE.1.D0) GOTO 1

5928 c-       WRITE(*,*)'point cascad 2' 

5929 c-       

5930 c- number of generated gluons

5931        NG=ISAVE-1

5932 c- end of iterations

5933 c- initial hard gluons and conservation lows  

5934        PTGH(NG+1)=0.D0

5935        XGH(NG+1)=1.D0   

5936        FIGH(NG+1)=0.D0 

5937 c- check point for sum of all gluons

5938 c- and

5939 c- transform hard virtual to soft momenta

5940        IF (NG.GT.0) THEN

5941         AUX3=0.D0

5942         DO I=1,NG

5943          XG(I)=XGH(I+1)-XGH(I)

5944          PTG(I)=DSQRT(PTGH(I+1)**2+PTGH(I)**2-2*PTGH(I+1)*PTGH(I)*

5945      &   DCOS(FIGH(I+1)-FIGH(I)))

5946          AUX1=PTGH(I+1)*DCOS(FIGH(I+1))-PTGH(I)*DCOS(FIGH(I))

5947          AUX2=PTGH(I+1)*DSIN(FIGH(I+1))-PTGH(I)*DSIN(FIGH(I))

5948           IF (AUX2.GE.0.D0) THEN

5949            IF (AUX1.EQ.0.D0) THEN

5950             FIG(I)=0.5D0*PI

5951            ELSE

5952             FIG(I)=DACOS(AUX1/PTG(I))

5953            ENDIF

5954           ELSE

5955            IF (AUX1.EQ.0.D0) THEN

5956             FIG(I)=1.5D0*PI

5957            ELSE

5958             FIG(I)=-DACOS(AUX1/PTG(I))

5959            ENDIF       

5960           ENDIF

5961           AUX3=AUX3+PTG(I)*PTG(I)/XG(I)

5962         ENDDO

5963         AUX3=AUX3*FX+FPT*FPT

5964         AUX4=MU*MU

5965        ELSE

5966         AUX3=0.D0

5967         AUX4=1.D0

5968        ENDIF 

5969 c- check, that virtuality of final hard gluon > or =(-MU**2)

5970        IF (AUX3.GT.AUX4) GOTO 22

5971        

5972        RETURN

5973        END

5974 

5975 C-============================================================

5976 C-= generation of final X,PT,FI for hard colliding gluon  ====

5977 C-============================================================

5978        SUBROUTINE GENERFINAL(MU,FX,FPT,FFI,NKON)

5979        

5980        IMPLICIT NONE

5981 c- functions and variables

5982 c      INTEGER N,NKON,IAU,IBU

5983       INTEGER NKON,IAU,IBU

5984       DOUBLE PRECISION CFUNX,CFUNPT,MU,FX,RX,FPT,RPT,FFI,RAT 

5985 c------ fundamental constants -----------------------------

5986       INTEGER NF,NC,NLOSW

5987       DOUBLE PRECISION PI,CSMB,LAMQCD,

5988      & TF,CF,BF0,BF1

5989       DOUBLE COMPLEX MNI,REI

5990       COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

5991      & TF,CF,BF0,BF1,NF,NC,NLOSW  

5992 c- rnd. generator     

5993       DOUBLE PRECISION PYR

5994 c- commons for cascad generation      

5995       DOUBLE PRECISION FGGQ0,FGGQS

5996       COMMON/EDDEFGG/FGGQ0,FGGQS

5997 c- aux. vars.

5998       DOUBLE PRECISION FGGQ0P,QMIN 

5999  

6000        NKON=0 

6001        IAU=0

6002        IBU=0

6003  1     CALL CFUNXUINV(MU,PYR(0),RX) 

6004        RAT=CFUNX(0,MU,RX)/CFUNX(2,MU,RX)

6005        IAU=IAU+1

6006        IF (RAT.EQ.0.D0) THEN

6007        IBU=IBU+1

6008        ENDIF

6009        IF (IBU.GT.10.AND.IAU.GT.10.OR.IAU.GT.1000) THEN

6010         NKON=1

6011         FX=1.D0

6012         FPT=0.D0

6013         FFI=0.D0

6014        ENDIF

6015        IF (IBU.GT.10.AND.IAU.GT.10.OR.IAU.GT.1000) GOTO 3

6016        IF (RAT.LE.PYR(0)) GOTO 1

6017        FX=RX

6018        IF (FX.LT.0.25D0) THEN

6019         FGGQ0P=(0.5D0+DSQRT(0.25D0-FX))/(0.5D0-DSQRT(0.25D0-FX))

6020        ELSE

6021         FGGQ0P=DSQRT(FX)/(1.D0-DSQRT(FX))

6022        ENDIF

6023        IF (FGGQ0P.GT.FGGQS) THEN

6024         QMIN=FGGQ0P

6025        ELSE

6026         QMIN=FGGQS

6027        ENDIF

6028        

6029        IAU=0

6030        IBU=0

6031  2     CALL CFUNPTUINV(FX,MU,PYR(0),RPT)

6032        RAT=CFUNPT(0,FX,RPT)/CFUNPT(2,FX,RPT)

6033        IAU=IAU+1

6034        IF (RAT.EQ.0.D0) THEN

6035        IBU=IBU+1

6036        ENDIF

6037        IF (IBU.GT.10.AND.IAU.GT.10.OR.IAU.GT.1000) THEN

6038         NKON=1

6039         FX=1.D0

6040         FPT=0.D0

6041         FFI=0.D0

6042        ENDIF

6043        IF (IBU.GT.10.AND.IAU.GT.10.OR.IAU.GT.1000) GOTO 3

6044        IF (RAT.LE.PYR(0)) GOTO 2

6045        FPT=RPT

6046        IF (FPT.LT.QMIN) THEN

6047        NKON=1

6048        ENDIF

6049       

6050        FFI=2.D0*PI*PYR(0)

6051        

6052  3      RETURN

6053        END

6054 

6055 C-============================================================

6056 C-= generation step backward X,PT of previous hard gluon =====

6057 C-============================================================

6058        SUBROUTINE GENERCPTX(MU,XFIX,PTFIX,GPT,GX,NKON)

6059        

6060        IMPLICIT NONE

6061        INTEGER IAU,IBU

6062 c- functions and variables

6063 c      INTEGER N,NKON

6064       INTEGER NKON

6065 c      DOUBLE PRECISION CFUNPT,CFUNZ,MU,XFIX,PTFIX,GPT,GX,

6066 c     & RPT,RX,RZ,RAT 

6067       DOUBLE PRECISION CFUNPT,CFUNZ,MU,XFIX,PTFIX,GPT,GX,

6068      & RPT,RZ,RAT 

6069 c------ fundamental constants -----------------------------

6070       INTEGER NF,NC,NLOSW

6071       DOUBLE PRECISION PI,CSMB,LAMQCD,

6072      & TF,CF,BF0,BF1

6073       DOUBLE COMPLEX MNI,REI

6074       COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

6075      & TF,CF,BF0,BF1,NF,NC,NLOSW  

6076 c- rnd. generator     

6077       DOUBLE PRECISION PYR

6078 c- commons for cascad generation      

6079       DOUBLE PRECISION FGGQ0,FGGQS

6080       COMMON/EDDEFGG/FGGQ0,FGGQS

6081 c- aux. vars.

6082       DOUBLE PRECISION FGGQ0P,QMIN,FZMAX,FZMIN,AUX1 

6083 

6084        NKON=0 

6085 c- check pt-lower limit

6086        IF (XFIX.LT.0.25D0) THEN

6087         FGGQ0P=(0.5D0+DSQRT(0.25D0-XFIX))/(0.5D0-DSQRT(0.25D0-XFIX))

6088         FGGQ0P=FGGQ0P*FGGQ0

6089        ELSE

6090         FGGQ0P=DSQRT(XFIX)/(1.D0-DSQRT(XFIX))

6091         FGGQ0P=FGGQ0P*FGGQ0

6092        ENDIF

6093        IF (FGGQ0P.GT.FGGQS) THEN

6094         QMIN=FGGQ0P

6095        ELSE

6096         QMIN=FGGQS

6097        ENDIF

6098        IF (QMIN.GE.PTFIX) THEN

6099         NKON=1

6100         GPT=0.D0

6101         GX=1.D0

6102        ENDIF

6103        IF (NKON.EQ.1) GOTO 3

6104 c--- pt generation

6105        IAU=0

6106        IBU=0

6107  1     CALL CFUNPTUINV(XFIX,PTFIX,PYR(0),RPT)

6108        RAT=CFUNPT(0,XFIX,RPT)/CFUNPT(2,XFIX,RPT)

6109        IAU=IAU+1

6110        IF (RAT.EQ.0.D0) THEN

6111        IBU=IBU+1

6112        ENDIF

6113        IF (IBU.GT.10.AND.IAU.GT.10.OR.IAU.GT.1000) THEN

6114 c-        WRITE(*,*)'!!!!!!! exit from pt generation !!!!!!!'

6115 c-        WRITE(*,*)' XFIX=',XFIX,' PTFIX=',PTFIX

6116 c-        WRITE(*,*)'++++++++++++++++++++++++++++'

6117         NKON=1

6118         GPT=0.D0

6119         GX=1.D0

6120        ENDIF

6121        IF (IBU.GT.10.AND.IAU.GT.10.OR.IAU.GT.1000) GOTO 3

6122        IF (RAT.LE.PYR(0)) GOTO 1

6123 c- 

6124        IF (RPT.LT.QMIN) THEN

6125         NKON=1

6126        ENDIF

6127        GPT=RPT 

6128 c--- z-generation 

6129        IAU=0

6130        IBU=0

6131        IF (NKON.EQ.0) THEN

6132  2      CALL CFUNZUINV(MU,XFIX,GPT,PYR(0),RZ)

6133         RAT=CFUNZ(0,MU,XFIX,GPT,RZ)/CFUNZ(2,MU,XFIX,GPT,RZ) 

6134         IAU=IAU+1 

6135        IF (RAT.EQ.0.D0) THEN

6136        IBU=IBU+1

6137        ENDIF

6138        IF (IBU.GT.10.AND.IAU.GT.10.OR.IAU.GT.1000) THEN

6139 c-         WRITE(*,*)'!!!!!!! exit from pt generation !!!!!!!'

6140 c-         WRITE(*,*)' XFIX=',XFIX,' PTFIX=',PTFIX

6141 c-         WRITE(*,*)'++++++++++++++++++++++++++++'

6142          NKON=1

6143          GPT=0.D0

6144          GX=1.D0

6145         ENDIF

6146         IF (IBU.GT.10.AND.IAU.GT.10.OR.IAU.GT.1000) GOTO 4

6147         IF (RAT.LE.PYR(0)) GOTO 2

6148 c- check point for exit

6149         GX=XFIX/RZ

6150         AUX1=FGGQ0/(GPT+FGGQ0)

6151         FZMIN=XFIX*(GPT+FGGQ0)/GPT

6152         IF (AUX1.GT.FZMIN) THEN

6153          FZMIN=AUX1

6154         ENDIF

6155         AUX1=GPT/(GPT+FGGQ0)

6156         FZMAX=XFIX*(GPT+FGGQ0)/FGGQ0

6157         IF (AUX1.LT.FZMAX) THEN

6158          FZMAX=AUX1

6159         ENDIF 

6160 c-       

6161         IF (RZ.LT.FZMIN.OR.RZ.GT.FZMAX) THEN

6162          NKON=1

6163         ENDIF             

6164  4     CONTINUE       

6165        ENDIF

6166        

6167  3     RETURN

6168        END

6169 

6170 C- generation of upper functions -----------------------------

6171 C-============================================================

6172 C-= inverse of integrated upper function for x**(2*DP(3))* ===

6173 C-= *(fM(x,MU)-fM(x,ptmin(x)))                  ==============

6174 C-= limits for x are inserted ================================

6175 C-============================================================

6176        SUBROUTINE CFUNXUINV(MU,RF,RX)

6177        

6178        IMPLICIT NONE

6179        

6180 c- RF=PYR(0) ----------------------

6181        DOUBLE PRECISION MU,RF,RX,R

6182 c------ fundamental constants -----------------------------

6183        INTEGER NF,NC,NLOSW

6184        DOUBLE PRECISION PI,CSMB,LAMQCD,

6185      & TF,CF,BF0,BF1

6186        DOUBLE COMPLEX MNI,REI

6187        COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

6188      & TF,CF,BF0,BF1,NF,NC,NLOSW    

6189 c------ parameters for soft rescattering (trajectories)----

6190 c------ (t1,t2,fi0 dependence) ----------------------------

6191        INTEGER NAPR,NFI

6192        DOUBLE PRECISION CP,DP,RP,RG,AP,

6193      &   T1MIN,T1MAX,T2MIN,T2MAX,FKK,CGP

6194        COMMON/EDDESOFT/ CP(3),DP(3),RP(3),RG(3),AP(3),

6195      &   T1MIN,T1MAX,T2MIN,T2MAX,FKK,CGP,NAPR,NFI      

6196 c- commons for cascad generation      

6197        DOUBLE PRECISION FGGQ0,FGGQS

6198        COMMON/EDDEFGG/FGGQ0,FGGQS

6199 c- aux. vars.

6200 c       DOUBLE PRECISION LIM1,LIM2,YMU,FMIN,FMAX

6201        DOUBLE PRECISION LIM1,LIM2,FMIN,FMAX

6202 

6203 c- upper and lower limits of generation

6204        LIM1=FGGQ0/(MU+FGGQ0)

6205        LIM2=(1.D0-LIM1)*(1.D0-LIM1)

6206 c-       YMU=2.D0*DLOG(MU/LAMQCD)

6207 c- R=RF*(Ifun(LIM2)-Ifun(LIM1))+Ifun(LIM1)

6208 c- Ifun - direct integral,

6209 c- inverse function of the Ifun

6210        FMIN=DLOG((1.D0+DSQRT(1.D0-LIM1))/(1.D0-DSQRT(1.D0-LIM1)))

6211        FMAX=DLOG((1.D0+DSQRT(1.D0-LIM2))/(1.D0-DSQRT(1.D0-LIM2)))

6212        R=RF*(FMAX-FMIN)+FMIN              

6213 c- temporary flat distribution       

6214        RX=1.D0-DTANH(0.5D0*R)**2 

6215        

6216        RETURN

6217        END

6218 

6219 C-============================================================

6220 C-= inverse of integrated upper function for =================

6221 C-= dfM(x,pt)/dLog(pt**2/LAMQCD**2) ==========================

6222 C-============================================================       

6223        SUBROUTINE CFUNPTUINV(X,PT,RF,RPT)

6224        

6225        IMPLICIT NONE

6226 c- RF=PYR(0) ----------------------

6227        DOUBLE PRECISION RF,X,PT,RPT,RY,R

6228 c------ fundamental constants -----------------------------

6229        INTEGER NF,NC,NLOSW

6230        DOUBLE PRECISION PI,CSMB,LAMQCD,

6231      & TF,CF,BF0,BF1

6232        DOUBLE COMPLEX MNI,REI

6233        COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

6234      & TF,CF,BF0,BF1,NF,NC,NLOSW         

6235 c- commons for cascad generation      

6236        DOUBLE PRECISION FGGQ0,FGGQS

6237        COMMON/EDDEFGG/FGGQ0,FGGQS

6238 c- aux. vars.

6239        DOUBLE PRECISION LIM1,LIM2,LIM1Y,LIM2Y,FMIN,FMAX

6240 

6241 c- upper and lower limits of generation

6242        LIM1=FGGQ0

6243        LIM2=PT

6244        LIM1Y=2.D0*DLOG(LIM1/LAMQCD)

6245        LIM2Y=2.D0*DLOG(LIM2/LAMQCD)

6246        FMIN=LIM1Y**4.D0

6247        FMAX=LIM2Y**4.D0

6248 c- R=RF*(Ifun(LIM2)-Ifun(LIM1))

6249 c- Ifun - direct integral,

6250 c- inverse function of the Ifun

6251        R=RF*(FMAX-FMIN)+FMIN

6252 c- temporary flat distribution        

6253        RY=R**0.25D0 

6254        RPT=LAMQCD*DEXP(0.5D0*RY)

6255        

6256        RETURN

6257        END

6258        

6259 C-============================================================

6260 C-= inverse of integrated upper function for =================

6261 C-= fM(z,pt)*Pgg(x/z)/z ======================================

6262 C-============================================================         

6263        SUBROUTINE CFUNZUINV(MU,X,PT,RF,RZ)

6264        

6265        IMPLICIT NONE

6266 c- RF=PYR(0) ----------------------

6267        DOUBLE PRECISION RF,MU,X,PT,RZ,R  

6268 c------ fundamental constants -----------------------------

6269        INTEGER NF,NC,NLOSW

6270        DOUBLE PRECISION PI,CSMB,LAMQCD,

6271      & TF,CF,BF0,BF1

6272        DOUBLE COMPLEX MNI,REI

6273        COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

6274      & TF,CF,BF0,BF1,NF,NC,NLOSW 

6275 c- commons for cascad generation      

6276        DOUBLE PRECISION FGGQ0,FGGQS

6277        COMMON/EDDEFGG/FGGQ0,FGGQS

6278 c- aux. vars.

6279 c       DOUBLE PRECISION LIM1,LIM2,FMIN,FMAX,YPT,DFMAX,AUX1,AUX2

6280        DOUBLE PRECISION LIM1,LIM2,DFMAX,AUX1,AUX2

6281 

6282 c- upper and lower limits of generation

6283        LIM1=X*(MU+FGGQ0)/MU

6284        LIM2=MU/(MU+FGGQ0)

6285 c- R=RF*(Ifun(LIM2)-Ifun(LIM1))

6286 c- Ifun - direct integral,

6287 c- inverse function of the Ifun

6288        IF (LIM1.LT.0.67D0.AND.X.LT.0.67D0) THEN

6289          AUX1=DLOG(0.67D0-X)-DLOG(LIM1-X)

6290          DFMAX=DLOG(DSQRT(1.D0-X)-DSQRT(1.D0-LIM2))

6291          DFMAX=DFMAX-DLOG(DSQRT(1.D0-X)+DSQRT(1.D0-LIM2))

6292          DFMAX=DFMAX-DLOG(DSQRT(1.D0-X)-DSQRT(1.D0-0.67D0))

6293          DFMAX=DFMAX+DLOG(DSQRT(1.D0-X)+DSQRT(1.D0-0.67D0))

6294          DFMAX=DFMAX/DSQRT(1.D0-X)

6295          DFMAX=DFMAX+AUX1

6296          R=RF*DFMAX+DLOG(LIM1-X)

6297          IF (R.LT.AUX1) THEN

6298           RZ=X+DEXP(R)*(LIM1-X)           

6299          ELSE

6300           AUX2=(R-AUX1)*DSQRT(1.D0-X)

6301           AUX2=AUX2+DLOG(DSQRT(1.D0-X)-DSQRT(1.D0-0.67D0))

6302           AUX2=AUX2-DLOG(DSQRT(1.D0-X)+DSQRT(1.D0-0.67D0))

6303           RZ=1.D0-(1.D0-X)*DTANH(-0.5D0*AUX2)**2.D0

6304          ENDIF         

6305        ELSE

6306          AUX1=DLOG(DSQRT(1.D0-X)-DSQRT(1.D0-LIM1))

6307          AUX1=AUX1-DLOG(DSQRT(1.D0-X)+DSQRT(1.D0-LIM1))

6308          AUX1=AUX1/DSQRT(1.D0-X)

6309          DFMAX=DLOG(DSQRT(1.D0-X)-DSQRT(1.D0-LIM2))

6310          DFMAX=DFMAX-DLOG(DSQRT(1.D0-X)+DSQRT(1.D0-LIM2))

6311          DFMAX=DFMAX/DSQRT(1.D0-X)-AUX1

6312          R=RF*DFMAX+AUX1

6313          RZ=1.D0-(1.D0-X)*DTANH(-0.5D0*R*DSQRT(1.D0-X))**2.D0

6314        ENDIF

6315        

6316        RETURN

6317        END

6318 

6319 c- functions for the above cascad generators -----------------

6320 C-============================================================

6321 C-= interpol.and upper function for x**(2*DP(3))* ============

6322 C-= *(fM(x,YMU)-fM(x,Yptmin(x))), Y=DLOG(pt**2/LAMQCD**2)  ===

6323 C-============================================================       

6324        FUNCTION CFUNX(N,MU,FX)

6325 

6326        IMPLICIT NONE

6327        

6328        INTEGER N

6329        DOUBLE PRECISION CFUNX,MU,FX

6330 c------ fundamental constants -----------------------------

6331        INTEGER NF,NC,NLOSW

6332        DOUBLE PRECISION PI,CSMB,LAMQCD,

6333      & TF,CF,BF0,BF1

6334        DOUBLE COMPLEX MNI,REI

6335        COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

6336      & TF,CF,BF0,BF1,NF,NC,NLOSW  

6337 c-- tables for fM used in x**(2*DP(3))*(fM(x,MU)-fM(x,minpt(x))) 

6338 c- tables for fM(x,pt)

6339        DOUBLE PRECISION FT4,FMT4,DX4,DY4,X04,Y04

6340        COMMON/EDDETAB4/ FT4(10201),FMT4(101,101),

6341      & DX4,DY4,X04,Y04

6342 c------ parameters for soft rescattering (trajectories)----

6343 c------ (t1,t2,fi0 dependence) ----------------------------

6344        INTEGER NAPR,NFI

6345        DOUBLE PRECISION CP,DP,RP,RG,AP,

6346      &   T1MIN,T1MAX,T2MIN,T2MAX,FKK,CGP

6347        COMMON/EDDESOFT/ CP(3),DP(3),RP(3),RG(3),AP(3),

6348      &   T1MIN,T1MAX,T2MIN,T2MAX,FKK,CGP,NAPR,NFI      

6349 c- commons for cascad generation      

6350        DOUBLE PRECISION FGGQ0,FGGQS

6351        COMMON/EDDEFGG/FGGQ0,FGGQS

6352 c- aux. vars.

6353        DOUBLE PRECISION FGGQ0P,QMIN,AUX1,AUX2,YMU,YQMIN

6354       

6355 c- check pt-lower limit

6356        IF (FX.LT.0.25D0) THEN

6357         FGGQ0P=(0.5D0+DSQRT(0.25D0-FX))/(0.5D0-DSQRT(0.25D0-FX))

6358        ELSE

6359         FGGQ0P=DSQRT(FX)/(1.D0-DSQRT(FX))

6360        ENDIF

6361        IF (FGGQ0P.GT.FGGQS) THEN

6362         QMIN=FGGQ0P

6363        ELSE

6364         QMIN=FGGQS

6365        ENDIF

6366        YMU=2.D0*DLOG(MU/LAMQCD)

6367        YQMIN=2.D0*DLOG(QMIN/LAMQCD)

6368        

6369        IF (N.LE.1) THEN        

6370         IF (YMU.GT.YQMIN) THEN

6371          CALL LINTERPOL2(FMT4,101,101,X04,Y04,DX4,DY4,FX,YMU,AUX1)

6372          CALL LINTERPOL2(FMT4,101,101,X04,Y04,DX4,DY4,FX,YQMIN,AUX2)

6373          IF (AUX1.LE.0.D0) THEN

6374           AUX1=0.D0

6375 c-          WRITE(*,*)'AUX1<=0',' X=',FX,' YMU=',YMU,' YMIN=',YQMIN

6376          ENDIF

6377          IF (AUX2.LE.0.D0) THEN

6378           AUX2=0.D0

6379 c-          WRITE(*,*)'AUX2<=0',' X=',FX,' YMU=',YMU,' YMIN=',YQMIN

6380          ENDIF         

6381         CFUNX=FX**(2.D0*DP(3))*(AUX1-AUX2)

6382          IF (AUX2.GT.AUX1) THEN

6383           CFUNX=0.D0

6384 c-          WRITE(*,*)'AUX2>AUX1',' X=',FX,' YMU=',YMU,' YMIN=',YQMIN

6385          ENDIF

6386         ELSE

6387          CFUNX=0.D0

6388         ENDIF

6389        ELSE

6390 c--- change to upper function!       

6391         CFUNX=0.285052D-02*YMU**2.05D0/(FX*DSQRT(1.D0-FX))

6392         CFUNX=CFUNX*1.02505D0

6393        ENDIF

6394        

6395        RETURN

6396        END

6397        

6398 C-============================================================

6399 C-= interp. and upper function for ===========================

6400 C-= dfM(x,Y)/dY, Y=Log(pt**2/LAMQCD**2) =====================

6401 C-============================================================  

6402        FUNCTION CFUNPT(N,X,PT)

6403 

6404        IMPLICIT NONE

6405 

6406        INTEGER N

6407        DOUBLE PRECISION CFUNPT,X,PT

6408 c------ fundamental constants -----------------------------

6409        INTEGER NF,NC,NLOSW

6410        DOUBLE PRECISION PI,CSMB,LAMQCD,

6411      & TF,CF,BF0,BF1

6412        DOUBLE COMPLEX MNI,REI

6413        COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

6414      & TF,CF,BF0,BF1,NF,NC,NLOSW  

6415 c-- tables for dfM_g/g(x,Y)/dY, Y=DLOG(PT**2/LAMQCD**2) ---

6416        DOUBLE PRECISION DFT5,DFMT5,DX5,DY5,X05,Y05

6417        COMMON/EDDETAB5/ DFT5(10201),DFMT5(101,101),

6418      & DX5,DY5,X05,Y05    

6419 c- aux. vars.

6420        DOUBLE PRECISION YPT 

6421        YPT=2.D0*DLOG(PT/LAMQCD)

6422        

6423        IF (N.LE.1) THEN        

6424         CALL LINTERPOL2(DFMT5,101,101,X05,Y05,DX5,DY5,X,YPT,CFUNPT)

6425         IF (CFUNPT.LT.0.D0) THEN

6426          CFUNPT=0.D0

6427         ENDIF

6428        ELSE

6429 c--- change to upper function!       

6430         CFUNPT=0.50544D-04*YPT**3.D0/(X**1.5D0*(1.D0-X)**0.47D0)

6431        ENDIF

6432        

6433        RETURN

6434        END 

6435 

6436 C-============================================================

6437 C-= interp. and upper function for ===========================

6438 C-= fM(z,pt)*Pgg(x/z)/z ======================================

6439 C-============================================================         

6440        FUNCTION CFUNZ(N,MU,X,PT,Z)

6441 

6442        IMPLICIT NONE

6443        INTEGER N

6444        DOUBLE PRECISION CFUNZ,X,PT,Z

6445 c------ fundamental constants -----------------------------

6446        INTEGER NF,NC,NLOSW

6447        DOUBLE PRECISION PI,CSMB,LAMQCD,

6448      & TF,CF,BF0,BF1

6449        DOUBLE COMPLEX MNI,REI

6450        COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

6451      & TF,CF,BF0,BF1,NF,NC,NLOSW  

6452 c-- tables for fM used in Pgg(x/z)*fM(z,pt)/z 

6453 c- tables for fM(x,pt)

6454        DOUBLE PRECISION FT4,FMT4,DX4,DY4,X04,Y04

6455        COMMON/EDDETAB4/ FT4(10201),FMT4(101,101),

6456      & DX4,DY4,X04,Y04

6457 c- commons for cascad generation      

6458        DOUBLE PRECISION FGGQ0,FGGQS

6459        COMMON/EDDEFGG/FGGQ0,FGGQS     

6460 c- aux. vars.

6461        DOUBLE PRECISION AUX1,AUX2,AUX3,YPT,MU,ZMAX

6462        DOUBLE PRECISION AUX4,AUX5

6463        

6464        AUX4=X04+100.D0*DX4

6465        AUX5=Y04+100.D0*DY4

6466        ZMAX=MU/(MU+FGGQ0)

6467        YPT=2.D0*DLOG(PT/LAMQCD)

6468        IF (N.LE.1) THEN

6469         IF (Z.GE.X04.AND.Z.LE.AUX4.AND.YPT.GE.Y04.AND.YPT.LE.AUX5)

6470      &  THEN

6471          CALL LINTERPOL2(FMT4,101,101,X04,Y04,DX4,DY4,Z,YPT,AUX1)

6472         ELSE

6473          AUX1=0.D0

6474         ENDIF

6475         IF (AUX1.LE.0.D0) THEN

6476          AUX1=0.D0

6477         ENDIF

6478         AUX2=X/Z

6479         AUX3=(1.D0-AUX2*(1-AUX2))**2/(AUX2*(1-AUX2))

6480         CFUNZ=AUX1*AUX3/Z

6481        ELSE

6482          CFUNZ=0.012726D0*YPT**1.65D0/X**1.3D0/(Z-X)

6483         IF (Z.GE.0.67D0) THEN        

6484          CFUNZ=CFUNZ*X**0.3D0*ZMAX/DSQRT(1.D0-Z)        

6485         ENDIF        

6486        ENDIF

6487        

6488        RETURN

6489        END

6490 C-============================================================

6491 

6492 C-++================== E N D  C A S C A D ====================

6493 

6494 c--------TOTAL CROSS-SECTIONS FUNCTIONS AND SUBS. ------------

6495 C-===========================================================

6496 C-==== qt-loop integral with exclusive sudakov Isud0(MU)**2 ==

6497 C-==== N=1 - parametrization, N>=2 - upper function ==========

6498 C-==== N=0 - exact value (reserved, now the same as N=1) =====

6499 C-============================================================

6500        FUNCTION ISUD02(N,MU)

6501 

6502        IMPLICIT NONE

6503        INTEGER N

6504        DOUBLE PRECISION  ISUD02,MU

6505       

6506        IF (N.LT.2) THEN

6507          ISUD02=12.7244D0*DLOG(MU)**3.55D0

6508          ISUD02=ISUD02/(MU**1.118D0*(1.2D0+MU**1.23D0))

6509        ELSE

6510          ISUD02=5.0746D0/MU**0.6795D0

6511        ENDIF

6512        

6513        RETURN

6514        END

6515 C-============================================================

6516 C-============================================================

6517 C- qt-loop integral with semi-incl. correction due to rad. ===

6518 C- Isudeta2(MU,etamax)=Integral[Deltafgg*x**(2*DP(3)))]**2* ==

6519 C- *Isud0(MU)**2 ============================================= 

6520 C-==== N=1 - parametrization, N>=2 - upper function ==========

6521 C-==== N=0 - exact value (reserved, now the same as N=1) =====

6522 C-============================================================

6523 C--- check+

6524        FUNCTION ISUDGEN2(N,MU)

6525 

6526        IMPLICIT NONE

6527        INTEGER N

6528 c       DOUBLE PRECISION ISUD02,A1,AUX2,AUX3

6529        DOUBLE PRECISION ISUD02,A1

6530        DOUBLE PRECISION ISUDGEN2,MU

6531 c------ fundamental constants -----------------------------

6532       INTEGER NF,NC,NLOSW

6533       DOUBLE PRECISION PI,CSMB,LAMQCD,

6534      & TF,CF,BF0,BF1

6535       DOUBLE COMPLEX MNI,REI

6536       COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

6537      & TF,CF,BF0,BF1,NF,NC,NLOSW    

6538 c------ parameters for soft rescattering (trajectories)----

6539 c------ (t1,t2,fi0 dependence) ----------------------------

6540       INTEGER NAPR,NFI

6541       DOUBLE PRECISION CP,DP,RP,RG,AP,

6542      &   T1MIN,T1MAX,T2MIN,T2MAX,FKK,CGP

6543       COMMON/EDDESOFT/ CP(3),DP(3),RP(3),RG(3),AP(3),

6544      &   T1MIN,T1MAX,T2MIN,T2MAX,FKK,CGP,NAPR,NFI 

6545 c----- parameters for hard cross-sections -----------------

6546       DOUBLE PRECISION MGGCUT,ETJCUT,MXMAX,

6547      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

6548      & PSIDD1,PSIDD2

6549       COMMON/EDDEHARD/ MGGCUT,ETJCUT,MXMAX,

6550      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

6551      & PSIDD1,PSIDD2

6552 c---- table for Intfgg**2 for Lum_sidde=Lum_excl*Intfgg**2 ---

6553       DOUBLE PRECISION LUM1,FLUM1,DX1,DY1,X01,Y01

6554       COMMON/EDDETAB1/ LUM1(480),FLUM1(30,16),

6555      & DX1,DY1,X01,Y01         

6556 

6557 c---    CALL EDDEPUTDAT  ! call one time from the main program

6558        IF (N.LT.2) THEN

6559 c-         IF (MU.LE.150.D0.AND.ETASIMAX.LE.30.D0) THEN  

6560 c-      CALL LINTERPOL2(FLUM1,30,16,X01,Y01,DX1,DY1,MU,ETASIMAX,A1)

6561 c-         ELSE

6562 c-          IF (MU.GT.150.D0.AND.ETASIMAX.LE.30.D0) THEN

6563 c-      CALL LINTERPOL2(FLUM1,30,16,X01,Y01,DX1,DY1,150.D0,ETASIMAX,A1)

6564 c-           A1=A1*150.D0/MU

6565 c-          ENDIF

6566 c-          IF (MU.GT.150.D0.AND.ETASIMAX.GT.30.D0) THEN

6567 c-      CALL LINTERPOL2(FLUM1,30,16,X01,Y01,DX1,DY1,150.D0,30.D0,A1)

6568 c-           A1=A1*150.D0/MU

6569 c-          ENDIF

6570 c-          IF (MU.LE.150.D0.AND.ETASIMAX.GT.30.D0) THEN

6571 c-      CALL LINTERPOL2(FLUM1,30,16,X01,Y01,DX1,DY1,MU,30.D0,A1)

6572 c-          ENDIF

6573 c-         ENDIF

6574 c- 3-4% parametrization for new semi-inclusive correction (see math)

6575         IF (MU.LT.30.D0) THEN

6576          A1=0.015D0*(MU-1.D0)**1.42D0

6577         ELSE

6578          A1=0.221739D-01*MU**1.3D0

6579         ENDIF 

6580         ISUDGEN2=A1*ISUD02(1,MU)

6581        ELSE

6582         ISUDGEN2=PSIDD1*MU**PSIDD2*ISUD02(2,MU)

6583 c-        IF (MU.GT.150.D0) THEN

6584 c-         ISUDGEN2=PSIDD1*150.D0**PSIDD2*ISUD02(2,150.D0)*150.D0/MU

6585 c-        ENDIF

6586        ENDIF

6587        

6588        RETURN

6589        END

6590 C-============================================================

6591 

6592 C-============================================================

6593 C-====== soft surv. prob. (soft rescattering effects) ========

6594 C-== N=0 exact(reserved, now like N=1), N=1 parametrization ==

6595 C-== N>1 upper function ======================================

6596 C-============================================================

6597 C--- check+

6598        FUNCTION SOFTSURV(N,MGG)

6599 

6600        IMPLICIT NONE

6601        INTEGER N

6602        DOUBLE PRECISION SOFTSURV,MGG

6603        DOUBLE PRECISION TSLOPEBH,VAR  

6604 c----- parameters for hard cross-sections -----------------

6605       DOUBLE PRECISION MGGCUT,ETJCUT,MXMAX,

6606      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

6607      & PSIDD1,PSIDD2

6608       COMMON/EDDEHARD/ MGGCUT,ETJCUT,MXMAX,

6609      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

6610      & PSIDD1,PSIDD2      

6611 

6612        VAR=SQS/MGG 

6613        IF (N.LE.1) THEN

6614 c-        SOFTSURV=2.43617D0/SQS**0.46232D0/MGG**0.066D0

6615 c-        SOFTSURV=SOFTSURV-0.53D-03

6616 c-        SOFTSURV=SOFTSURV-0.0538D0*(MGG/SQS)**4.262D0

6617 c-        SOFTSURV=SOFTSURV-1.0538D-13*MGG**0.25935D0*SQS**2.35394D0

6618 c-        SOFTSURV=SOFTSURV*1.03D0

6619         SOFTSURV=0.388D0/TSLOPEBH(VAR)**2

6620         SOFTSURV=SOFTSURV/MGG**0.23D0

6621         SOFTSURV=SOFTSURV*DEXP(-0.001055D0*(SQS**2-10000.D0)**0.4D0)

6622         SOFTSURV=SOFTSURV*(1.D0+3.04D0*(SQS/20000.D0)**2)

6623        ELSE

6624 c-        SOFTSURV=1.03D0*2.43617D0/SQS**0.46232D0/MGG**0.066D0

6625           SOFTSURV=6.6678D0/(SQS**0.57D0*MGG**0.066D0)

6626        ENDIF

6627        

6628        RETURN

6629        END

6630 C-============================================================

6631 

6632 C-============================================================

6633 C-====== integral in rapidity of X system ========

6634 C-== N=0 for resonance production ============================

6635 C-== N=1 for other processes =================================

6636 C-============================================================

6637 C--- check+

6638        FUNCTION IRAPX(N,MGG)

6639 

6640        IMPLICIT NONE

6641        INTEGER N

6642        DOUBLE PRECISION IRAPX,MGG

6643        DOUBLE PRECISION AUX1,AUX2,AUX3,AUX4

6644        DOUBLE PRECISION AUX5,AUX6,AUX7,AUX8

6645 c----- parameters for hard cross-sections -----------------

6646       DOUBLE PRECISION MGGCUT,ETJCUT,MXMAX,

6647      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

6648      & PSIDD1,PSIDD2

6649       COMMON/EDDEHARD/ MGGCUT,ETJCUT,MXMAX,

6650      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

6651      & PSIDD1,PSIDD2      

6652 c----- parameters to calculate overall s-dependence -------

6653       DOUBLE PRECISION XI1MIN,XI2MIN,XI1MAX,XI2MAX

6654       COMMON/EDDETOT/ XI1MIN,XI2MIN,XI1MAX,XI2MAX

6655  

6656        IF (N.EQ.0) THEN        

6657          AUX1=1.21D0*MGG**2/SQS**2/XI2MIN

6658          IF (AUX1.LT.XI1MIN) THEN

6659           AUX1=XI1MIN

6660          ENDIF

6661          AUX2=1.21D0*MGG**2/SQS**2/XI1MIN

6662          IF (AUX2.LT.XI2MIN) THEN

6663           AUX2=XI2MIN

6664          ENDIF

6665          AUX3=0.81D0*MGG**2/SQS**2/XI1MAX

6666          IF (AUX3.GT.XI2MAX) THEN

6667           AUX3=XI2MAX

6668          ENDIF

6669          AUX4=0.81D0*MGG**2/SQS**2/XI2MAX

6670          IF (AUX4.GT.XI1MAX) THEN

6671           AUX4=XI1MAX

6672          ENDIF

6673         

6674          IF (AUX1.GT.XI1MAX) THEN

6675           AUX1=XI1MAX

6676          ENDIF

6677          IF (AUX2.GT.XI2MAX) THEN

6678           AUX2=XI2MAX

6679          ENDIF       

6680          IF (AUX3.LT.XI2MIN) THEN

6681           AUX3=XI2MIN

6682          ENDIF       

6683          IF (AUX4.LT.XI1MIN) THEN

6684           AUX4=XI1MIN

6685          ENDIF

6686        ENDIF  

6687 

6688        IF (N.EQ.1) THEN

6689          AUX1=MGG**2/SQS**2/XI2MIN

6690          IF (AUX1.LT.XI1MIN) THEN

6691           AUX1=XI1MIN

6692          ENDIF

6693          AUX2=MGG**2/SQS**2/XI1MIN

6694          IF (AUX2.LT.XI2MIN) THEN

6695           AUX2=XI2MIN

6696          ENDIF

6697          AUX3=MGG**2/SQS**2/XI1MAX

6698          IF (AUX3.GT.XI2MAX) THEN

6699           AUX3=XI2MAX

6700          ENDIF

6701          AUX4=MGG**2/SQS**2/XI2MAX

6702          IF (AUX4.GT.XI1MAX) THEN

6703           AUX4=XI1MAX

6704          ENDIF

6705 

6706          AUX5=0.8D0*MGG**2*XI1MAX/MGGCUT**2

6707          IF (AUX5.LT.XI1MIN) THEN

6708           AUX5=XI1MIN

6709          ENDIF

6710          AUX6=0.8D0*MGG**2*XI2MAX/MGGCUT**2

6711          IF (AUX6.LT.XI2MIN) THEN

6712           AUX6=XI2MIN

6713          ENDIF

6714          AUX7=MGGCUT**2/(0.8D0*XI1MAX*SQS**2)

6715          IF (AUX7.GT.XI2MAX) THEN

6716           AUX7=XI2MAX

6717          ENDIF

6718          AUX8=MGGCUT**2/(0.8D0*XI2MAX*SQS**2)

6719          IF (AUX8.GT.XI1MAX) THEN

6720           AUX8=XI1MAX

6721          ENDIF

6722  

6723         IF (AUX5.LT.AUX1.AND.AUX5.LT.XI1MAX) THEN

6724          AUX1=AUX5

6725         ENDIF 

6726         IF (XI1MAX.LT.AUX1.AND.XI1MAX.LT.AUX5) THEN

6727          AUX1=XI1MAX

6728         ENDIF

6729         IF (AUX6.LT.AUX2.AND.AUX6.LT.XI2MAX) THEN

6730          AUX2=AUX6

6731         ENDIF 

6732         IF (XI2MAX.LT.AUX2.AND.XI2MAX.LT.AUX6) THEN

6733          AUX2=XI2MAX

6734         ENDIF

6735         IF (AUX7.GT.AUX3.AND.AUX7.LT.XI2MIN) THEN

6736          AUX3=AUX7

6737         ENDIF 

6738         IF (XI2MIN.GT.AUX3.AND.XI2MIN.GT.AUX7) THEN

6739          AUX3=XI2MIN

6740         ENDIF

6741         IF (AUX8.GT.AUX4.AND.AUX8.LT.XI1MIN) THEN

6742          AUX4=AUX8

6743         ENDIF 

6744         IF (XI1MIN.GT.AUX4.AND.XI1MIN.GT.AUX8) THEN

6745          AUX4=XI1MIN

6746         ENDIF              

6747        ENDIF

6748 

6749        IRAPX=0.5D0*(DLOG(AUX1*AUX2/(AUX3*AUX4)))       

6750 

6751        RETURN

6752        END

6753 C-============================================================

6754 

6755 C-============================================================

6756 C-====== integrated gg luminosity ============================

6757 C- N1=0 exclusive, N1=1 semiinclusive ========================

6758 C- N2=0 resonance, N2=1 other processes ======================

6759 C- MGG=mass of the central system  ===========================

6760 C-============================================================

6761        FUNCTION M2DLUMDM2(N1,N2,MGG)

6762 

6763        IMPLICIT NONE 

6764 

6765        INTEGER N1,N2

6766        DOUBLE PRECISION M2DLUMDM2,MGG,MU

6767        DOUBLE PRECISION SOFTSURV,TSLOPEBH

6768        DOUBLE PRECISION ISUDGEN2,ISUD02,IRAPX

6769        DOUBLE COMPLEX SGNTR

6770        DOUBLE PRECISION AUX1,AUX2,AUX3

6771        DOUBLE PRECISION AUX4,AUX5

6772 c------ fundamental constants -----------------------------

6773       INTEGER NF,NC,NLOSW

6774       DOUBLE PRECISION PI,CSMB,LAMQCD,

6775      & TF,CF,BF0,BF1

6776       DOUBLE COMPLEX MNI,REI

6777       COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

6778      & TF,CF,BF0,BF1,NF,NC,NLOSW    

6779 c------ parameters for soft rescattering (trajectories)----

6780 c------ (t1,t2,fi0 dependence) ----------------------------

6781       INTEGER NAPR,NFI

6782       DOUBLE PRECISION CP,DP,RP,RG,AP,

6783      &   T1MIN,T1MAX,T2MIN,T2MAX,FKK,CGP

6784       COMMON/EDDESOFT/ CP(3),DP(3),RP(3),RG(3),AP(3),

6785      &   T1MIN,T1MAX,T2MIN,T2MAX,FKK,CGP,NAPR,NFI 

6786 c----- parameters to calculate overall s-dependence -------

6787       DOUBLE PRECISION XI1MIN,XI2MIN,XI1MAX,XI2MAX

6788       COMMON/EDDETOT/ XI1MIN,XI2MIN,XI1MAX,XI2MAX

6789 c----- parameters for hard cross-sections -----------------

6790       DOUBLE PRECISION MGGCUT,ETJCUT,MXMAX,

6791      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

6792      & PSIDD1,PSIDD2

6793       COMMON/EDDEHARD/ MGGCUT,ETJCUT,MXMAX,

6794      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

6795      & PSIDD1,PSIDD2 

6796       

6797        MU=MGG*0.5D0

6798        SGNTR=MNI+REI*DTAN(PI*DP(3)/2.D0)

6799 

6800        AUX1=(SGNTR*DCONJG(SGNTR))**2

6801        AUX1=AUX1*CGP**4/(32.D0*PI**6)

6802        AUX1=AUX1*(SQS/MGG)**(4.D0*DP(3))

6803        

6804        AUX2=DEXP(-2.D0*TSLOPEBH(SQS/MGG)*T1MIN)

6805        AUX2=AUX2-DEXP(-2.D0*TSLOPEBH(SQS/MGG)*T1MAX)

6806        AUX3=DEXP(-2.D0*TSLOPEBH(SQS/MGG)*T2MIN)

6807        AUX3=AUX2-DEXP(-2.D0*TSLOPEBH(SQS/MGG)*T2MAX)       

6808        AUX4=AUX2*AUX3/(2.D0*TSLOPEBH(SQS/MGG))**2

6809        AUX4=AUX4*AUX1*SOFTSURV(1,MGG)

6810        

6811        IF (N1.EQ.0) THEN

6812         AUX5=ISUD02(1,MU)

6813        ENDIF

6814        IF (N1.GT.0) THEN

6815         AUX5=ISUDGEN2(1,MU)

6816        ENDIF

6817        

6818        M2DLUMDM2=AUX4*AUX5*IRAPX(N2,MGG)

6819        

6820        RETURN

6821        END

6822 C-============================================================

6823 

6824 C--- parton level -- c.-s. for resonances --------------------

6825 C-============================================================

6826 C-========SM Higgs functions =================================

6827 C-============================================================

6828 c------------------ VAR=MH**2/(4*Mt**2) ---------

6829        FUNCTION FSMH(VAR)

6830 

6831        IMPLICIT NONE

6832        DOUBLE PRECISION VAR,AUX0

6833        DOUBLE COMPLEX FSMH,AUX1,AUX2,AUX3

6834 c------ fundamental constants -----------------------------

6835       INTEGER NF,NC,NLOSW

6836       DOUBLE PRECISION PI,CSMB,LAMQCD,

6837      & TF,CF,BF0,BF1

6838       DOUBLE COMPLEX MNI,REI

6839       COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

6840      & TF,CF,BF0,BF1,NF,NC,NLOSW    

6841 

6842        IF(VAR.GE.1.D0) THEN

6843         AUX0=DSQRT(1.D0-1.D0/VAR)

6844         AUX1=REI*DSQRT(1.D0-1.D0/VAR)

6845         AUX2=REI*DLOG((1.D0+AUX0)/(1.D0-AUX0))-MNI*PI

6846         AUX3=AUX2*AUX2

6847        ELSE

6848         AUX0=DSQRT(1.D0/VAR-1.D0)

6849         AUX1=REI*DSQRT(1.D0/VAR-1.D0)

6850         AUX2=REI*DATAN(1.D0/AUX0)

6851         AUX3=-4.D0*AUX2*AUX2

6852        ENDIF

6853 C-   

6854        FSMH=(1.D0-0.25D0*(1.D0-1.D0/VAR)*AUX3)/VAR  

6855               

6856        RETURN

6857        END

6858 

6859 c---- Higgs gg-width ----------------------------

6860        FUNCTION WIDTHSMH(MH)

6861 

6862        IMPLICIT NONE

6863        DOUBLE PRECISION MH,GF,MTOP,WIDTHSMH

6864        DOUBLE PRECISION ALPHAS,MU,VAR

6865        DOUBLE COMPLEX FSMH

6866 c------ fundamental constants -----------------------------

6867       INTEGER NF,NC,NLOSW

6868       DOUBLE PRECISION PI,CSMB,LAMQCD,

6869      & TF,CF,BF0,BF1

6870       DOUBLE COMPLEX MNI,REI

6871       COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

6872      & TF,CF,BF0,BF1,NF,NC,NLOSW    

6873 

6874        MU=MH*0.5D0

6875        MTOP=174.D0

6876        GF=1.17D-05 

6877        VAR=0.25D0*(MH/MTOP)**2

6878        WIDTHSMH=FSMH(VAR)*DCONJG(FSMH(VAR))

6879        WIDTHSMH=WIDTHSMH*(ALPHAS(MU)/(2.D0*PI))**2

6880        WIDTHSMH=WIDTHSMH*MH**3*GF/(4.D0*PI*DSQRT(2.D0))

6881        WIDTHSMH=WIDTHSMH*(1.2D0+(PI*PI+5.5D0)*ALPHAS(MU)/PI)

6882               

6883        RETURN

6884        END

6885 C-============================================================

6886 C-============================================================

6887 C-======== RS1 functions  and subs. ==========================

6888 C-============================================================

6889 c-subroutine to calc. obs. mass and width --------------------

6890       SUBROUTINE EDDERS1C(NRS,RSXI,RSGAM,RSMH,RSMR,RSMOBS,RSWD,BR)

6891 

6892        IMPLICIT NONE

6893        INTEGER NRS       

6894        DOUBLE PRECISION RSXI,RSGAM,RSMH,RSMR,RSMOBS,RSWD,BR

6895        DOUBLE PRECISION ALPHAS,GF,MTOP,MU

6896        DOUBLE COMPLEX FSMH 

6897 c--- additional variables -----------------------

6898 c       DOUBLE PRECISION AUX1,AUX2,AUX3,AUX4,AUX5,AUX6

6899        DOUBLE PRECISION AUX1,AUX2

6900        DOUBLE PRECISION RSXIMIN,RSXIMAX

6901        DOUBLE PRECISION RSZ,RSTHETA,RSAF,RSBF,RSCF,RSDF

6902        DOUBLE PRECISION RSA34F,RSA12F,RSMEDGE2,RSMEDGE3

6903        DOUBLE COMPLEX RSFMIXH,RSFMIXR

6904        DOUBLE PRECISION VARH,VARR 

6905 c------ fundamental constants -----------------------------

6906       INTEGER NF,NC,NLOSW

6907       DOUBLE PRECISION PI,CSMB,LAMQCD,

6908      & TF,CF,BF0,BF1

6909       DOUBLE COMPLEX MNI,REI

6910       COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

6911      & TF,CF,BF0,BF1,NF,NC,NLOSW           

6912 c----- RS1 parameters -------------------------------------

6913       INTEGER NRS0 

6914       DOUBLE PRECISION RSXI0,RSGAM0,RSMH0,RSMR0 

6915       COMMON/EDDERS1/ RSXI0,RSGAM0,RSMH0,RSMR0,NRS0

6916 

6917        GF=1.17D-05

6918        MTOP=174.D0

6919        RSXIMIN=-(1.D0+DSQRT(1.D0+4.D0/RSGAM**2))/12.D0

6920        RSXIMAX=(-1.D0+DSQRT(1.D0+4.D0/RSGAM**2))/12.D0

6921        IF (RSMH.GT.RSMR) THEN

6922        RSXIMIN=-(1.D0+DSQRT(1.D0+8.D0*(1.D0-(RSMR/RSMH)**2)/RSGAM**2))

6923        RSXIMIN=RSXIMIN/24.D0

6924        RSXIMAX=(-1.D0+DSQRT(1.D0+8.D0*(1.D0-(RSMR/RSMH)**2)/RSGAM**2))

6925        RSXIMAX=RSXIMAX/24.D0

6926        ENDIF

6927        IF (RSXI.LT.RSXIMIN.OR.RSXI.GT.RSXIMAX) THEN

6928           PRINT*,'Attention: RS1 parameters are out of the range'

6929        ENDIF

6930        

6931         RSZ=DSQRT(1-6.D0*RSXI*RSGAM**2*(1.D0+6.D0*RSXI))

6932         AUX1=12.D0*RSXI*RSGAM*RSZ*RSMH**2

6933         AUX2=(RSMH**2*(RSZ**2-36.D0*(RSXI*RSGAM)**2)-RSMR**2)

6934         IF (AUX2.EQ.0.D0) THEN

6935          RSTHETA=PI/4.D0

6936          PRINT*,'ATTENTION: MIXING ANGLE IS INDEFINITE +-PI/4'

6937         ELSE

6938          RSTHETA=0.5D0*DATAN(AUX1/AUX2)       

6939         ENDIF

6940        

6941        RSAF=DCOS(RSTHETA)/RSZ

6942        RSBF=-DSIN(RSTHETA)/RSZ

6943        RSCF=DSIN(RSTHETA)-6.D0*RSXI*RSGAM*DCOS(RSTHETA)/RSZ

6944        RSDF=DCOS(RSTHETA)+6.D0*RSXI*RSGAM*DSIN(RSTHETA)/RSZ

6945        RSA34F=RSDF+RSBF*RSGAM

6946        RSA12F=RSAF+RSCF/RSGAM

6947        

6948        RSMEDGE2=RSMR/DSQRT(RSZ**2-36.D0*(RSXI*RSGAM)**2)

6949        RSMEDGE3=RSMH*DSQRT(RSZ**2-36.D0*(RSXI*RSGAM)**2)

6950 

6951        VARH=0.25D0*(RSMH/MTOP)**2

6952        VARR=0.25D0*(RSMR/MTOP)**2

6953        RSFMIXH=FSMH(VARH)*RSA34F+REI*7.D0*RSGAM*RSBF

6954        RSFMIXR=(FSMH(VARR)*RSA12F+7.D0*RSAF)*RSGAM 

6955 c--- mass of the observable particle NRS=1 H*,NRS=2 R* -------

6956 c--- BR is the coefficient to multiply branching of SM Higgs -

6957 c- to obtain a branching for RS1 particle --------------------

6958 c- (or simply mult. the total c.-s.) ---------------------------

6959 c- use the generator for SM Higgs with new c.-s. or branchings -

6960        IF (NRS.EQ.1) THEN

6961         RSMOBS=DSQRT((RSDF*RSMH)**2+(RSBF*RSMR)**2)

6962         RSWD=RSFMIXH*DCONJG(RSFMIXH)

6963         BR=RSA34F**2

6964        ENDIF 

6965        IF (NRS.EQ.2) THEN

6966         RSMOBS=DSQRT((RSCF*RSMH)**2+(RSAF*RSMR)**2)

6967         RSWD=RSFMIXR*DCONJG(RSFMIXR)

6968         BR=(RSGAM*RSA12F)**2

6969        ENDIF

6970        IF (NRS.EQ.0.OR.NRS.GT.2) THEN

6971         PRINT*,'RS ID PARAMETER IS OUT OF THE RANGE'

6972         PRINT*,'SET AUTOMATICALLY TO RADION ID->2'

6973         NRS=2

6974         RSMOBS=DSQRT((RSCF*RSMH)**2+(RSAF*RSMR)**2)

6975         RSWD=RSFMIXR*DCONJG(RSFMIXR)

6976         BR=(RSGAM*RSA12F)**2

6977        ENDIF

6978 

6979         MU=RSMOBS*0.5D0

6980         RSWD=RSWD*RSMOBS**3*GF/(4.D0*PI*DSQRT(2.D0))

6981         RSWD=RSWD*(ALPHAS(MU)/(2.D0*PI))**2

6982         RSWD=RSWD*(1.2D0+(PI*PI+5.5D0)*ALPHAS(MU)/PI)       

6983        

6984        RETURN

6985        END

6986 C-============================================================

6987 

6988 C--- dSigma/dMc functions for different systems --------------

6989 C-============================================================

6990 C-============ exclusive pp->p+gg+p (fb/GeV)==================

6991 C-============================================================

6992        FUNCTION TOTEXGG(M)

6993 

6994        IMPLICIT NONE

6995        DOUBLE PRECISION CSGG,TOTEXGG,M,KFAC

6996        DOUBLE PRECISION M2DLUMDM2

6997 c------ fundamental constants -----------------------------

6998       INTEGER NF,NC,NLOSW

6999       DOUBLE PRECISION PI,CSMB,LAMQCD,

7000      & TF,CF,BF0,BF1

7001       DOUBLE COMPLEX MNI,REI

7002       COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

7003      & TF,CF,BF0,BF1,NF,NC,NLOSW          

7004 c----- parameters for hard cross-sections -----------------

7005       DOUBLE PRECISION MGGCUT,ETJCUT,MXMAX,

7006      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

7007      & PSIDD1,PSIDD2

7008       COMMON/EDDEHARD/ MGGCUT,ETJCUT,MXMAX,

7009      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

7010      & PSIDD1,PSIDD2

7011 c----- additional global parameters -----

7012       INTEGER KCP,IPROC

7013       DOUBLE PRECISION AM0,AMP,S,MQ

7014       COMMON/EDDEOTHER/ KCP,IPROC,AM0,AMP,S,MQ     

7015 

7016        KFAC=1.3D0

7017        TOTEXGG=M2DLUMDM2(0,1,M)*KFAC*CSGG(M)

7018        TOTEXGG=TOTEXGG*CSMB*1.0D+12*2.D0/M

7019       

7020        

7021        RETURN

7022        END

7023 C-============================================================

7024 C-============================================================

7025 C-============ exclusive pp->p+QQbar+p (fb/GeV) ==============

7026 C-============================================================

7027        FUNCTION TOTEXQQ(M)

7028 

7029        IMPLICIT NONE

7030        DOUBLE PRECISION CSQQ,TOTEXQQ,M,KFAC

7031        DOUBLE PRECISION M2DLUMDM2

7032 c------ fundamental constants -----------------------------

7033       INTEGER NF,NC,NLOSW

7034       DOUBLE PRECISION PI,CSMB,LAMQCD,

7035      & TF,CF,BF0,BF1

7036       DOUBLE COMPLEX MNI,REI

7037       COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

7038      & TF,CF,BF0,BF1,NF,NC,NLOSW          

7039 c----- parameters for hard cross-sections -----------------

7040       DOUBLE PRECISION MGGCUT,ETJCUT,MXMAX,

7041      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

7042      & PSIDD1,PSIDD2

7043       COMMON/EDDEHARD/ MGGCUT,ETJCUT,MXMAX,

7044      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

7045      & PSIDD1,PSIDD2

7046 c----- additional global parameters -----

7047       INTEGER KCP,IPROC

7048       DOUBLE PRECISION AM0,AMP,S,MQ

7049       COMMON/EDDEOTHER/ KCP,IPROC,AM0,AMP,S,MQ

7050 

7051        KFAC=1.3D0

7052        TOTEXQQ=M2DLUMDM2(0,1,M)*KFAC*CSQQ(MQ,M)

7053        TOTEXQQ=TOTEXQQ*CSMB*1.0D+12*2.D0/M

7054        

7055        RETURN

7056        END

7057 C-============================================================

7058 C-============================================================

7059 C-============ exclusive pp->p+gamma gamma+p (fb/GeV)=========

7060 C-============================================================

7061        FUNCTION TOTEX2GAM(M)

7062 

7063        IMPLICIT NONE

7064        DOUBLE PRECISION CS2GAM,TOTEX2GAM,M,KFAC

7065        DOUBLE PRECISION M2DLUMDM2

7066 c------ fundamental constants -----------------------------

7067       INTEGER NF,NC,NLOSW

7068       DOUBLE PRECISION PI,CSMB,LAMQCD,

7069      & TF,CF,BF0,BF1

7070       DOUBLE COMPLEX MNI,REI

7071       COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

7072      & TF,CF,BF0,BF1,NF,NC,NLOSW          

7073 c----- parameters for hard cross-sections -----------------

7074       DOUBLE PRECISION MGGCUT,ETJCUT,MXMAX,

7075      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

7076      & PSIDD1,PSIDD2

7077       COMMON/EDDEHARD/ MGGCUT,ETJCUT,MXMAX,

7078      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

7079      & PSIDD1,PSIDD2

7080 c----- additional global parameters -----

7081       INTEGER KCP,IPROC

7082       DOUBLE PRECISION AM0,AMP,S,MQ

7083       COMMON/EDDEOTHER/ KCP,IPROC,AM0,AMP,S,MQ     

7084 

7085        KFAC=1.3D0

7086        TOTEX2GAM=M2DLUMDM2(0,1,M)*KFAC*CS2GAM(M)

7087        TOTEX2GAM=TOTEX2GAM*CSMB*1.0D+12*2.D0/M

7088       

7089        

7090        RETURN

7091        END

7092 C-============================================================

7093 C-============================================================

7094 C-============ exclusive pp->p+gg g*+p (fb/GeV)===============

7095 C-============================================================

7096        FUNCTION TOTEX3G(M)

7097 

7098        IMPLICIT NONE

7099        DOUBLE PRECISION CS3G,TOTEX3G,M,KFAC

7100        DOUBLE PRECISION M2DLUMDM2

7101 c------ fundamental constants -----------------------------

7102       INTEGER NF,NC,NLOSW

7103       DOUBLE PRECISION PI,CSMB,LAMQCD,

7104      & TF,CF,BF0,BF1

7105       DOUBLE COMPLEX MNI,REI

7106       COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

7107      & TF,CF,BF0,BF1,NF,NC,NLOSW          

7108 c----- parameters for hard cross-sections -----------------

7109       DOUBLE PRECISION MGGCUT,ETJCUT,MXMAX,

7110      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

7111      & PSIDD1,PSIDD2

7112       COMMON/EDDEHARD/ MGGCUT,ETJCUT,MXMAX,

7113      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

7114      & PSIDD1,PSIDD2

7115 c----- additional global parameters -----

7116       INTEGER KCP,IPROC

7117       DOUBLE PRECISION AM0,AMP,S,MQ

7118       COMMON/EDDEOTHER/ KCP,IPROC,AM0,AMP,S,MQ     

7119 

7120        KFAC=1.3D0

7121        TOTEX3G=M2DLUMDM2(0,1,M)*KFAC*CS3G(M)

7122        TOTEX3G=TOTEX3G*CSMB*1.0D+12*2.D0/M

7123       

7124        

7125        RETURN

7126        END

7127 C-============================================================

7128 C-============================================================

7129 C-============ exclusive pp->p+QQbar g*+p (fb/GeV)== (MQ=0) ==

7130 C-============================================================

7131        FUNCTION TOTEXQQG(M)

7132 

7133        IMPLICIT NONE

7134        DOUBLE PRECISION CSQQG,TOTEXQQG,M,KFAC

7135        DOUBLE PRECISION M2DLUMDM2

7136 c------ fundamental constants -----------------------------

7137       INTEGER NF,NC,NLOSW

7138       DOUBLE PRECISION PI,CSMB,LAMQCD,

7139      & TF,CF,BF0,BF1

7140       DOUBLE COMPLEX MNI,REI

7141       COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

7142      & TF,CF,BF0,BF1,NF,NC,NLOSW          

7143 c----- parameters for hard cross-sections -----------------

7144       DOUBLE PRECISION MGGCUT,ETJCUT,MXMAX,

7145      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

7146      & PSIDD1,PSIDD2

7147       COMMON/EDDEHARD/ MGGCUT,ETJCUT,MXMAX,

7148      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

7149      & PSIDD1,PSIDD2

7150 c----- additional global parameters -----

7151       INTEGER KCP,IPROC

7152       DOUBLE PRECISION AM0,AMP,S,MQ

7153       COMMON/EDDEOTHER/ KCP,IPROC,AM0,AMP,S,MQ     

7154 

7155        KFAC=1.3D0

7156        TOTEXQQG=M2DLUMDM2(0,1,M)*KFAC*CSQQG(M)

7157        TOTEXQQG=TOTEXQQG*CSMB*1.0D+12*2.D0/M

7158       

7159        

7160        RETURN

7161        END

7162 C-============================================================

7163 C-++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

7164 C-============================================================

7165 C-============ semi-inclusive pp->p+{X gg Y}+p (fb/GeV)=======

7166 C-============================================================

7167        FUNCTION TOTSIGG(M)

7168 

7169        IMPLICIT NONE

7170        DOUBLE PRECISION CSGGSI,TOTSIGG,M,KFAC

7171        DOUBLE PRECISION M2DLUMDM2

7172 c------ fundamental constants -----------------------------

7173       INTEGER NF,NC,NLOSW

7174       DOUBLE PRECISION PI,CSMB,LAMQCD,

7175      & TF,CF,BF0,BF1

7176       DOUBLE COMPLEX MNI,REI

7177       COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

7178      & TF,CF,BF0,BF1,NF,NC,NLOSW          

7179 c----- parameters for hard cross-sections -----------------

7180       DOUBLE PRECISION MGGCUT,ETJCUT,MXMAX,

7181      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

7182      & PSIDD1,PSIDD2

7183       COMMON/EDDEHARD/ MGGCUT,ETJCUT,MXMAX,

7184      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

7185      & PSIDD1,PSIDD2

7186 c----- additional global parameters -----

7187       INTEGER KCP,IPROC

7188       DOUBLE PRECISION AM0,AMP,S,MQ

7189       COMMON/EDDEOTHER/ KCP,IPROC,AM0,AMP,S,MQ     

7190 

7191        KFAC=1.3D0

7192        TOTSIGG=M2DLUMDM2(1,1,M)*KFAC*CSGGSI(M)

7193        TOTSIGG=TOTSIGG*CSMB*1.0D+12*2.D0/M

7194             

7195        RETURN

7196        END

7197 C-============================================================

7198 C-============================================================

7199 C-============ semi-inclusive pp->p+{X QQbar Y}+p (fb/GeV) ===

7200 C-============================================================

7201        FUNCTION TOTSIQQ(M)

7202 

7203        IMPLICIT NONE

7204        DOUBLE PRECISION CSQQSI,TOTSIQQ,M,KFAC

7205        DOUBLE PRECISION M2DLUMDM2

7206 c------ fundamental constants -----------------------------

7207       INTEGER NF,NC,NLOSW

7208       DOUBLE PRECISION PI,CSMB,LAMQCD,

7209      & TF,CF,BF0,BF1

7210       DOUBLE COMPLEX MNI,REI

7211       COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

7212      & TF,CF,BF0,BF1,NF,NC,NLOSW          

7213 c----- parameters for hard cross-sections -----------------

7214       DOUBLE PRECISION MGGCUT,ETJCUT,MXMAX,

7215      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

7216      & PSIDD1,PSIDD2

7217       COMMON/EDDEHARD/ MGGCUT,ETJCUT,MXMAX,

7218      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

7219      & PSIDD1,PSIDD2

7220 c----- additional global parameters -----

7221       INTEGER KCP,IPROC

7222       DOUBLE PRECISION AM0,AMP,S,MQ

7223       COMMON/EDDEOTHER/ KCP,IPROC,AM0,AMP,S,MQ

7224 

7225        KFAC=1.3D0

7226        TOTSIQQ=M2DLUMDM2(1,1,M)*KFAC*CSQQSI(MQ,M)

7227        TOTSIQQ=TOTSIQQ*CSMB*1.0D+12*2.D0/M

7228        

7229        RETURN

7230        END

7231 C-============================================================

7232 C-============================================================

7233 C-======= semi-inclusive pp->p+{X gamma gamma Y}+p (fb/GeV)===

7234 C-============================================================

7235        FUNCTION TOTSI2GAM(M)

7236 

7237        IMPLICIT NONE

7238        DOUBLE PRECISION CS2GAMSI,TOTSI2GAM,M,KFAC

7239        DOUBLE PRECISION M2DLUMDM2

7240 c------ fundamental constants -----------------------------

7241       INTEGER NF,NC,NLOSW

7242       DOUBLE PRECISION PI,CSMB,LAMQCD,

7243      & TF,CF,BF0,BF1

7244       DOUBLE COMPLEX MNI,REI

7245       COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

7246      & TF,CF,BF0,BF1,NF,NC,NLOSW          

7247 c----- parameters for hard cross-sections -----------------

7248       DOUBLE PRECISION MGGCUT,ETJCUT,MXMAX,

7249      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

7250      & PSIDD1,PSIDD2

7251       COMMON/EDDEHARD/ MGGCUT,ETJCUT,MXMAX,

7252      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

7253      & PSIDD1,PSIDD2

7254 c----- additional global parameters -----

7255       INTEGER KCP,IPROC

7256       DOUBLE PRECISION AM0,AMP,S,MQ

7257       COMMON/EDDEOTHER/ KCP,IPROC,AM0,AMP,S,MQ     

7258 

7259        KFAC=1.3D0

7260        TOTSI2GAM=M2DLUMDM2(1,1,M)*KFAC*CS2GAMSI(M)

7261        TOTSI2GAM=TOTSI2GAM*CSMB*1.0D+12*2.D0/M

7262              

7263        RETURN

7264        END

7265 C-============================================================

7266 

7267 C-============================================================

7268 c-    ------------------------- 

7269 c-.. integrated cross section of the SM Higgs production in 

7270 c-.. EDDE and SI DDE(in fb), 

7271 c-.. M_H=30-300 GeV (and RS1 also)

7272 c-    ------------------------- 

7273 c-.. integrated cross sections (in fb) 

7274 c-.. in EDDE and SI DDE at MX=30-300 GeV, X=gg,QQbar,2gamma,3g,QQbarg

7275 c-...........................................................................

7276 C-============================================================

7277       FUNCTION EDDECS(IP)

7278 

7279       IMPLICIT NONE

7280 

7281 c------ dSigma/dMc functions for different systems -----------      

7282       EXTERNAL TOTEXGG,TOTEXQQ,TOTEX2GAM,TOTEX3G,TOTEXQQG

7283       EXTERNAL TOTSIGG,TOTSIQQ,TOTSI2GAM

7284       

7285       DOUBLE PRECISION TOTEXGG,TOTEXQQ,TOTEX2GAM,TOTEX3G,TOTEXQQG

7286       DOUBLE PRECISION TOTSIGG,TOTSIQQ,TOTSI2GAM

7287 c-----------------

7288       INTEGER IP

7289       

7290       DOUBLE PRECISION DISIMP,EDDECS

7291 c-----------------

7292 c------ integrated gg luminocity -----------------------------      

7293       DOUBLE PRECISION M2DLUMDM2

7294       

7295 c      DOUBLE PRECISION LIM1,LIM2,AUX1,AUX2,AUX3

7296       DOUBLE PRECISION LIM1,LIM2,AUX1,AUX2

7297 c----- for resonances -------------------------------------

7298       DOUBLE PRECISION WIDTHSMH

7299       DOUBLE PRECISION RSMOBS,RSWD,RSBR

7300 c------ fundamental constants -----------------------------

7301       INTEGER NF,NC,NLOSW

7302       DOUBLE PRECISION PI,CSMB,LAMQCD,

7303      & TF,CF,BF0,BF1

7304       DOUBLE COMPLEX MNI,REI

7305       COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

7306      & TF,CF,BF0,BF1,NF,NC,NLOSW          

7307 c----- parameters for hard cross-sections -----------------

7308       DOUBLE PRECISION MGGCUT,ETJCUT,MXMAX,

7309      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

7310      & PSIDD1,PSIDD2

7311       COMMON/EDDEHARD/ MGGCUT,ETJCUT,MXMAX,

7312      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

7313      & PSIDD1,PSIDD2

7314 c------ parameters for soft rescattering (trajectories)----

7315 c------ (t1,t2,fi0 dependence) ----------------------------

7316       INTEGER NAPR,NFI

7317       DOUBLE PRECISION CP,DP,RP,RG,AP,

7318      &   T1MIN,T1MAX,T2MIN,T2MAX,FKK,CGP

7319       COMMON/EDDESOFT/ CP(3),DP(3),RP(3),RG(3),AP(3),

7320      &   T1MIN,T1MAX,T2MIN,T2MAX,FKK,CGP,NAPR,NFI

7321 c----- parameters to calculate overall s-dependence -------

7322       DOUBLE PRECISION XI1MIN,XI2MIN,XI1MAX,XI2MAX

7323       COMMON/EDDETOT/ XI1MIN,XI2MIN,XI1MAX,XI2MAX          

7324 c----- RS1 parameters -------------------------------------

7325       INTEGER NRS0

7326       DOUBLE PRECISION RSXI0,RSGAM0,RSMH0,RSMR0 

7327       COMMON/EDDERS1/ RSXI0,RSGAM0,RSMH0,RSMR0,NRS0      

7328 c----- additional global parameters -----

7329       INTEGER KCP,IPROC

7330       DOUBLE PRECISION AM0,AMP,S,MQ

7331       COMMON/EDDEOTHER/ KCP,IPROC,AM0,AMP,S,MQ    

7332      

7333        IF (IP.EQ.400) THEN                    

7334         IF(AM0.LT.90.D0.OR.AM0.GT.300.D0) THEN

7335          PRINT*,'EDDECS SM Higgs--------->Attention:'

7336        PRINT*,'generator works good in the Higgs mass region',

7337      & 90.D0,'---',300.D0

7338          PRINT*,'you define mass of the Higgs = ',AM0

7339         ENDIF

7340         IF (NRS0.EQ.0) THEN

7341          WRITE(*,*)'XXXXXXXXXXXXXXXXXXXXX'

7342          EDDECS=M2DLUMDM2(0,0,AM0)*WIDTHSMH(AM0)*2.D0*PI**2/AM0**3

7343          WRITE(*,*)'M2DLUMDM2=',M2DLUMDM2(0,0,AM0)

7344          WRITE(*,*)'WIDTH=',WIDTHSMH(AM0)

7345          WRITE(*,*)'CS=',EDDECS

7346          WRITE(*,*)'XXXXXXXXXXXXXXXXXXXXX'

7347 c-!!!

7348 c-        AUX3=WIDTHSMH(AM0)   

7349 c-        PRINT*,'MH=',AM0,'   WIDTH=',AUX3

7350         ELSE          

7351        CALL EDDERS1C(NRS0,RSXI0,RSGAM0,RSMH0,RSMR0,RSMOBS,RSWD,RSBR)

7352          EDDECS=M2DLUMDM2(0,0,RSMOBS)*RSWD*2.D0*PI**2*RSBR/RSMOBS**3 

7353 c-!!!

7354 c-        PRINT*,'MRS1=',RSMOBS,'   WIDTH=',RSWD,'  BR=',RSBR

7355 C---- TAKE OUT RSBR IF BRANCHING IS RENORMALIZED ----------

7356           IF(RSMOBS.LT.30.D0.OR.RSMOBS.GT.300.D0) THEN

7357           PRINT*,'EDDECS RS1 --------->Attention:'

7358           PRINT*,'generator works good in the mass region',30.D0,'---',300.D0

7359           PRINT*,'calculation gives mass of the central particle = '

7360      &    ,RSMOBS

7361           ENDIF

7362         ENDIF

7363         EDDECS=EDDECS*CSMB*1.0D+12

7364        ENDIF

7365        

7366        IF (IP.EQ.406) THEN                    

7367         IF(AM0.LT.90.D0.OR.AM0.GT.300.D0) THEN

7368          PRINT*,'EDDECS SM Higgs--------->Attention:'

7369          PRINT*,'generator works good in the Higgs mass region',

7370      &   90.D0,'---',300.D0

7371          PRINT*,'you define mass of the Higgs = ',AM0

7372         ENDIF

7373         IF (NRS0.EQ.0) THEN

7374          EDDECS=M2DLUMDM2(1,0,AM0)*WIDTHSMH(AM0)

7375          EDDECS=EDDECS*2.D0*PI**2/AM0**3/2.D0

7376 c-!!!

7377 c-        AUX3=WIDTHSMH(AM0)   

7378 c-        PRINT*,'MH=',AM0,'   WIDTH=',AUX3

7379         ELSE

7380        CALL EDDERS1C(NRS0,RSXI0,RSGAM0,RSMH0,RSMR0,RSMOBS,RSWD,RSBR)

7381          EDDECS=M2DLUMDM2(1,0,RSMOBS)*RSWD 

7382          EDDECS=EDDECS*2.D0*PI**2*RSBR/RSMOBS**3/2.D0   

7383 c-!!!

7384 c-        PRINT*,'MRS1=',RSMOBS,'   WIDTH=',RSWD,'  BR=',RSBR

7385 C---- TAKE OUT RSBR IF BRANCHING IS RENORMALIZED ----------

7386           IF(RSMOBS.LT.30.D0.OR.RSMOBS.GT.300.D0) THEN

7387           PRINT*,'EDDECS RS1 --------->Attention:'

7388           PRINT*,'generator works good in the mass region',30.D0,'---',300.D0

7389           PRINT*,'calculation gives mass of the central particle = '

7390      &    ,RSMOBS

7391           ENDIF

7392         ENDIF

7393         EDDECS=EDDECS*CSMB*1.0D+12

7394        ENDIF

7395 

7396 C----limits for the integration in MGG -----------------------

7397         LIM1=DSQRT(XI1MIN*XI2MIN)*SQS

7398         LIM2=DSQRT(XI1MAX*XI2MAX)*SQS

7399         AUX1=LIM2

7400         IF (AUX1.GT.MGGCUT) THEN

7401          AUX1=MGGCUT

7402         ENDIF

7403         IF (LIM1.LE.AUX1) THEN

7404          LIM1=MGGCUT

7405         ENDIF               

7406 

7407        AUX2=0.001D0 

7408        IF (IP.EQ.401) THEN

7409         EDDECS=DISIMP(TOTEXQQ,LIM1,LIM2,AUX2)              

7410        ENDIF

7411        

7412        IF (IP.EQ.402) THEN

7413         EDDECS=DISIMP(TOTEXGG,LIM1,LIM2,AUX2) 

7414        ENDIF       

7415 

7416        IF (IP.EQ.403) THEN

7417         EDDECS=DISIMP(TOTEX2GAM,LIM1,LIM2,AUX2)              

7418        ENDIF

7419 

7420        IF (IP.EQ.404) THEN

7421         EDDECS=DISIMP(TOTEXQQG,LIM1,LIM2,AUX2)              

7422        ENDIF

7423 

7424        IF (IP.EQ.405) THEN

7425         EDDECS=DISIMP(TOTEX3G,LIM1,LIM2,AUX2)              

7426        ENDIF

7427 

7428        IF (IP.EQ.407) THEN

7429         EDDECS=DISIMP(TOTSIQQ,LIM1,LIM2,AUX2)             

7430        ENDIF

7431 

7432        IF (IP.EQ.408) THEN

7433         EDDECS=DISIMP(TOTSIGG,LIM1,LIM2,AUX2)              

7434        ENDIF

7435 

7436        IF (IP.EQ.409) THEN

7437         EDDECS=DISIMP(TOTSI2GAM,LIM1,LIM2,AUX2)              

7438        ENDIF

7439 

7440 c-        PRINT*,'c.-s. is calculated with accuracy',AUX2*100.D0,'%'

7441 c-        PRINT*,'LIM1=',LIM1,' LIM2=',LIM2,' IP=',IP

7442         

7443       RETURN

7444       END

7445 

7446 C-============================================================ 

7447       SUBROUTINE EDDEPUTDAT

7448       

7449       IMPLICIT NONE

7450     

7451 C-... model parameters

7452       EXTERNAL EDDEDATA,EDDETABLES

7453 c-...global EDDE parameters from FFR file

7454       INTEGER MXGLPAR

7455       REAL EDDEPAR

7456       PARAMETER   (MXGLPAR=200)

7457       COMMON /EDDEGLPAR/ EDDEPAR(MXGLPAR)

7458       

7459       INTEGER I,J,IJ

7460       DOUBLE PRECISION AUX1,AUX2,AUX3

7461 c---- tables ------------------------------------      

7462 c---- table for Intfgg**2 for Lum_sidde=Lum_excl*Intfgg**2 ---

7463       DOUBLE PRECISION LUM1,FLUM1,DX1,DY1,X01,Y01

7464       COMMON/EDDETAB1/ LUM1(480),FLUM1(30,16),

7465      & DX1,DY1,X01,Y01

7466 c---- table for 3g ratio dIsud3g(x,mu)**2/Isud0(mu)**2 -------

7467       DOUBLE PRECISION RDI3G,FRDI3G,DX2,DY2,X02,Y02

7468       COMMON/EDDETAB2/ RDI3G(630),FRDI3G(30,21),

7469      & DX2,DY2,X02,Y02 

7470 c--- table for 3g ratio Isud3ga(etasimax,mu)**2/Isud0(mu)**2 -

7471 c--- table for 3g ratio Isud3gb(etasimax,mu)**2/Isud0(mu)**2 -

7472       DOUBLE PRECISION RI3GA,RI3GB,FRI3GA,FRI3GB,

7473      & DX3,DY3,X03,Y03

7474       COMMON/EDDETAB3/ RI3GA(480),RI3GB(480),

7475      & FRI3GA(30,16),FRI3GB(30,16),DX3,DY3,X03,Y03

7476 c- tables for fM(x,pt)

7477        DOUBLE PRECISION FT4,FMT4,DX4,DY4,X04,Y04

7478        COMMON/EDDETAB4/ FT4(10201),FMT4(101,101),

7479      & DX4,DY4,X04,Y04 

7480 c-- tables for dfM_g/g(x,Y)/dY, Y=DLOG(PT**2/LAMQCD**2) ---

7481        DOUBLE PRECISION DFT5,DFMT5,DX5,DY5,X05,Y05

7482        COMMON/EDDETAB5/ DFT5(10201),DFMT5(101,101),

7483      & DX5,DY5,X05,Y05     

7484 c------ fundamental constants -----------------------------

7485       INTEGER NF,NC,NLOSW

7486       DOUBLE PRECISION PI,CSMB,LAMQCD,

7487      & TF,CF,BF0,BF1

7488       DOUBLE COMPLEX MNI,REI

7489       COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

7490      & TF,CF,BF0,BF1,NF,NC,NLOSW    

7491 c------ parameters for soft rescattering (trajectories)----

7492 c------ (t1,t2,fi0 dependence) ----------------------------

7493       INTEGER NAPR,NFI

7494       DOUBLE PRECISION CP,DP,RP,RG,AP,

7495      &   T1MIN,T1MAX,T2MIN,T2MAX,FKK,CGP

7496       COMMON/EDDESOFT/ CP(3),DP(3),RP(3),RG(3),AP(3),

7497      &   T1MIN,T1MAX,T2MIN,T2MAX,FKK,CGP,NAPR,NFI 

7498 c----- parameters to calculate overall s-dependence -------

7499       DOUBLE PRECISION XI1MIN,XI2MIN,XI1MAX,XI2MAX

7500       COMMON/EDDETOT/ XI1MIN,XI2MIN,XI1MAX,XI2MAX

7501 c----- parameters for hard cross-sections -----------------

7502       DOUBLE PRECISION MGGCUT,ETJCUT,MXMAX,

7503      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

7504      & PSIDD1,PSIDD2

7505       COMMON/EDDEHARD/ MGGCUT,ETJCUT,MXMAX,

7506      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

7507      & PSIDD1,PSIDD2

7508 c--- restrictions on the phase space of g-jet ---

7509 c--- DER3J - max. angle between g-jet and parallel jet ----

7510 c--- XMAX3J - max ratio 2*Eg/MJJ --------------------------

7511 c--- parameters for 3g functions -----------------------------

7512       DOUBLE PRECISION DER3J,XMAX3J,PAR3G

7513       COMMON/EDDE3JP/ DER3J,XMAX3J,PAR3G(5)     

7514 c----- parameters to calculate total cross-sections -------      

7515 c----- RS1 parameters -------------------------------------

7516       INTEGER NRS0 

7517       DOUBLE PRECISION RSXI0,RSGAM0,RSMH0,RSMR0 

7518       COMMON/EDDERS1/ RSXI0,RSGAM0,RSMH0,RSMR0,NRS0

7519 c----- additional global parameters -----

7520       INTEGER KCP,IPROC

7521       DOUBLE PRECISION AM0,AMP,S,MQ

7522       COMMON/EDDEOTHER/ KCP,IPROC,AM0,AMP,S,MQ

7523 c- commons for cascad generation      

7524       DOUBLE PRECISION FGGQ0,FGGQS

7525       COMMON/EDDEFGG/FGGQ0,FGGQS

7526 c----- data that needs calculation

7527 c----- f_g/g lower limit and minimal generated PT_soft_g

7528        FGGQ0=0.3D0

7529        FGGQS=1.D0

7530 c--- RS1 data from FFR ----------------

7531        NRS0=EDDEPAR(9) ! FFRDAT EDDEPAR(6)

7532        RSXI0=EDDEPAR(10) ! FFRDAT EDDEPAR(5)

7533        RSGAM0=EDDEPAR(11) ! FFRDAT EDDEPAR(6)

7534        RSMH0=EDDEPAR(12) ! FFRDAT EDDEPAR(7)

7535        RSMR0=EDDEPAR(13) ! FFRDAT EDDEPAR(8)

7536 c--- other parameters

7537 c--- code of central particle

7538        KCP=EDDEPAR(5) ! FFRDAT EDDEPAR(4)

7539 c--- code of the process

7540        IPROC=EDDEPAR(1) ! FFRDAT EDDEPAR(1)

7541 c--- mass of the central particle

7542        AM0=EDDEPAR(6) ! FFRDAT EDDEPAR(3)

7543       IF (NRS0.GT.0) THEN

7544       CALL EDDERS1C(NRS0,RSXI0,RSGAM0,RSMH0,RSMR0,AUX1,AUX2,AUX3)

7545       AM0=AUX1

7546       ENDIF

7547 c--- phi dependence code

7548        NFI=EDDEPAR(7) ! FFRDAT EDDEPAR(5)

7549 c------ constants -----------------------------------------

7550        CF=(NC*NC-1)*TF/NC

7551        BF0=(11.D0*NC-2.D0*NF)/(12.D0*PI)

7552        BF1=34.D0*NC*NC/3.D0-20.D0*NC*NF*TF/3.D0

7553        BF1=(BF1-4.D0*CF*TF*NF)/(BF0*16.D0*PI*PI)      

7554 c------ cuts for hard c.-s. variables

7555 c- external input SQS ---

7556        SQS=EDDEPAR(4)  ! FFRDAT EDDEPAR(1)

7557        S=SQS*SQS

7558        MQ=4.8D0 ! FFRDAT EDDEPAR(10)

7559        MXMAX=500.D0

7560 c------ additional par. for c.-s. calculations ------------

7561        FKK=0.0196721D0+0.737705D-06*SQS 

7562 c- external input MGGCUT -------

7563 c- cut on the central mass ----- 

7564        ETJCUT=EDDEPAR(8) ! FFRDAT EDDEPAR(2)

7565        MGGCUT=2.D0*ETJCUT

7566        ETAJMAX=DLOG(MXMAX/MGGCUT+DSQRT((MXMAX/MGGCUT)**2-1))

7567 c- external input ETASIMAX -----------------

7568 c- cut on semi-incl. |eta_smth|<ETASIMAX/2 -

7569 c- rap-gap constraint ----------------------

7570 c- parameter is relevant only for exclusive 3j case,

7571 c- SIDDE calculations for all rapidities by def.

7572        ETASIMAX=EDDEPAR(14) ! FFRDAT EDDEPAR(9)     

7573        PSURV=0.66D-01

7574        PSUD=0.6795D0 ! for exclusive case

7575 c--- calculation of estimation pars for ISUDGEN2 -------------

7576 c-       IF (ETASIMAX.LE.0.D0) THEN

7577 c-        PSIDD1=0.D0

7578 c-        PSIDD2=0.D0

7579 c-       ENDIF 

7580 c-       IF (ETASIMAX.LE.2.D0.AND.ETASIMAX.GT.0.D0) THEN

7581 c-        PSIDD1=(0.9D-05+0.5D0*ETASIMAX*(0.02023D0-0.9D-05))*5.D0**0.7D0

7582 c-        PSIDD2=-0.7D0

7583 c-       ENDIF

7584 c-       IF (ETASIMAX.LE.4.D0.AND.ETASIMAX.GT.2.D0) THEN

7585 c-        PSIDD1=(0.02023D0+0.123D0*(ETASIMAX-2.D0))*5.D0**0.7D0

7586 c-        PSIDD2=-0.7D0

7587 c-       ENDIF

7588 c-       IF (ETASIMAX.LE.6.D0.AND.ETASIMAX.GT.4.D0) THEN

7589 c-        PSIDD1=(0.215D0+0.3D0*(ETASIMAX-4.D0))*5.D0**0.5D0

7590 c-        PSIDD2=-0.5D0

7591 c-       ENDIF       

7592 c-       IF (ETASIMAX.LE.8.D0.AND.ETASIMAX.GT.6.D0) THEN

7593 c-        PSIDD1=(0.5D0+0.27D0*(ETASIMAX-6.D0))*5.D0**0.1D0

7594 c-        PSIDD2=-0.1D0

7595 c-       ENDIF

7596 c-       IF (ETASIMAX.LE.12.D0.AND.ETASIMAX.GT.8.D0) THEN

7597 c-        PSIDD1=(0.673D0+0.17D0*(ETASIMAX-8.D0))/5.D0**0.35D0

7598 c-        PSIDD2=0.35D0

7599 c-       ENDIF

7600 c-       IF (ETASIMAX.LE.16.D0.AND.ETASIMAX.GT.12.D0) THEN

7601 c-        PSIDD1=(1.032D0+0.05D0*(ETASIMAX-12.D0))/5.D0**0.6D0

7602 c-        PSIDD2=0.6D0

7603 c-       ENDIF

7604 c-       IF (ETASIMAX.GT.16.D0) THEN

7605 c-        PSIDD1=0.9173/5.D0**0.8D0

7606 c-        PSIDD2=0.8D0

7607 c-       ENDIF

7608 c- all the above PSIDDN for old semi-inclusive estimations.

7609 c- for new sidde etamax->Infinity,is not required

7610        PSIDD1=0.112732D-01

7611        PSIDD2=1.5D0

7612 c- overall gg-lum. negative power in MJJ for the dsig/dMJJ --- 

7613        PLUM=4.D0*DP(3)+1.D0+PSURV+PSUD-PSIDD2

7614 c--- data for 3 jets

7615 c--- model restrictions on the phase space of g-jet -------

7616 c--- DER3J - max. angle between g-jet and parallel jet ----

7617 c--- XMAX3J - max ratio 2*Eg/MJJ --------------------------

7618        DER3J=0.75D0

7619        XMAX3J=0.72D0

7620        PAR3G(1)=0.22D0

7621        PAR3G(2)=(0.13D0*DLOG(DCOSH(ETASIMAX/2.D0))-0.2D0)

7622 c---

7623        AUX1=0.61D0+2.42D0*(ETASIMAX*0.5D0-0.5D0)**0.7D0

7624         IF (ETASIMAX.GE.4.4D0.AND.ETASIMAX.LT.7.D0) THEN

7625          AUX1=4.16D0 

7626         ENDIF 

7627         IF (ETASIMAX.GE.7.D0.AND.ETASIMAX.LT.15.D0) THEN

7628          AUX1=1.D0+5.65D0/(0.5D0*ETASIMAX-2.D0)**1.6D0

7629         ENDIF

7630         IF (ETASIMAX.GE.15.D0) THEN

7631          AUX1=1.D0+5.65D0/5.5D0**1.6D0

7632         ENDIF

7633         IF (ETASIMAX.GT.10.D0) THEN

7634          AUX1=AUX1-0.2D0

7635         ENDIF

7636         PAR3G(3)=AUX1

7637 c---

7638         AUX2=0.128D0*ETASIMAX/2.D0

7639         IF (ETASIMAX.GT.4.D0) THEN

7640          AUX2=AUX2+0.01D0*ETASIMAX/2.D0-0.09D0

7641         ENDIF

7642         IF (ETASIMAX.GT.8.D0) THEN

7643          AUX2=AUX2-0.05D0*ETASIMAX/2.D0-0.08D0

7644         ENDIF

7645         IF (ETASIMAX.GT.12.D0) THEN

7646          AUX2=AUX2-0.1D0*(ETASIMAX/2.D0-6.D0)-0.21D0

7647         ENDIF

7648         IF (ETASIMAX.GT.15.D0) THEN

7649          AUX2=AUX2-0.1D0*(15.D0/2.D0-6.D0)-0.21D0

7650         ENDIF        

7651         PAR3G(4)=AUX2

7652 c---

7653         AUX3=0.2D0

7654         IF (ETASIMAX.GT.4.D0) THEN

7655          AUX3=AUX3+0.12D0

7656         ENDIF

7657         IF (ETASIMAX.GT.8.D0) THEN

7658          AUX3=AUX3+0.3D0

7659         ENDIF

7660         IF (ETASIMAX.GT.12.D0) THEN

7661          AUX3=AUX3+0.2D0

7662         ENDIF

7663         PAR3G(5)=AUX3

7664 

7665 c--- manipulation with tables

7666        I=1

7667        J=1

7668        IJ=1

7669        DO I=1,30

7670          DO J=1,16

7671            FLUM1(I,J)=LUM1(IJ) 

7672            FRI3GA(I,J)=RI3GA(IJ)

7673            FRI3GB(I,J)=RI3GB(IJ)

7674            IJ=IJ+1

7675          ENDDO

7676        ENDDO

7677        

7678        I=1

7679        J=1

7680        IJ=1

7681        DO I=1,30

7682          DO J=1,21 

7683            FRDI3G(I,J)=RDI3G(IJ)

7684            IJ=IJ+1

7685          ENDDO

7686        ENDDO       

7687 

7688        I=1

7689        J=1

7690        IJ=1

7691        DO I=1,101

7692          DO J=1,101

7693            FMT4(I,J)=FT4(IJ) 

7694            DFMT5(I,J)=DFT5(IJ)

7695            IJ=IJ+1

7696          ENDDO

7697        ENDDO

7698 

7699       RETURN

7700       END

7701 

7702 c-------------------------------------------------------------              

7703 c- ... model parameters !R.Ryutin

7704 c-------------------------------------------------------------              

7705       BLOCK DATA EDDEDATA

7706       IMPLICIT NONE        

7707 c------ fundamental constants -----------------------------

7708       INTEGER NF,NC,NLOSW

7709       DOUBLE PRECISION PI,CSMB,LAMQCD,

7710      & TF,CF,BF0,BF1

7711       DOUBLE COMPLEX MNI,REI

7712       COMMON/EDDEFUND/ MNI,REI,PI,CSMB,LAMQCD,

7713      & TF,CF,BF0,BF1,NF,NC,NLOSW    

7714 c------ parameters for soft rescattering (trajectories)----

7715 c------ (t1,t2,fi0 dependence) ----------------------------

7716       INTEGER NAPR,NFI

7717       DOUBLE PRECISION CP,DP,RP,RG,AP,

7718      &   T1MIN,T1MAX,T2MIN,T2MAX,FKK,CGP

7719       COMMON/EDDESOFT/ CP(3),DP(3),RP(3),RG(3),AP(3),

7720      &   T1MIN,T1MAX,T2MIN,T2MAX,FKK,CGP,NAPR,NFI 

7721 c----- parameters to calculate overall s-dependence -------

7722       DOUBLE PRECISION XI1MIN,XI2MIN,XI1MAX,XI2MAX

7723       COMMON/EDDETOT/ XI1MIN,XI2MIN,XI1MAX,XI2MAX   

7724 c----- parameters for hard cross-sections -----------------

7725       DOUBLE PRECISION MGGCUT,ETJCUT,MXMAX,

7726      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

7727      & PSIDD1,PSIDD2

7728       COMMON/EDDEHARD/ MGGCUT,ETJCUT,MXMAX,

7729      & ETAJMAX,PLUM,PSURV,PSUD,ETASIMAX,SQS,

7730      & PSIDD1,PSIDD2

7731 c--- restrictions on the phase space of g-jet ---

7732 c--- DER3J - max. angle between g-jet and parallel jet ----

7733 c--- XMAX3J - max ratio 2*Eg/MJJ --------------------------

7734 c--- parameters for 3g functions -----------------------------

7735       DOUBLE PRECISION DER3J,XMAX3J,PAR3G

7736       COMMON/EDDE3JP/ DER3J,XMAX3J,PAR3G(5) 

7737 c----- RS1 parameters -------------------------------------

7738       INTEGER NRS0 

7739       DOUBLE PRECISION RSXI0,RSGAM0,RSMH0,RSMR0 

7740       COMMON/EDDERS1/ RSXI0,RSGAM0,RSMH0,RSMR0,NRS0      

7741 c----- additional global parameters -----

7742       INTEGER KCP,IPROC

7743       DOUBLE PRECISION AM0,AMP,S,MQ

7744       COMMON/EDDEOTHER/ KCP,IPROC,AM0,AMP,S,MQ

7745 

7746 c----- parameters to calculate total cross-sections -------

7747       DATA XI1MIN/0.1D-04/,XI2MIN/0.1D-04/

7748       DATA XI1MAX/0.1D0/,XI2MAX/0.1D0/

7749 c----- data------------------------------------------------     

7750 c------ constants -----------------------------------------

7751       DATA PI/3.141592654D0/, CSMB/0.38D+00/

7752       DATA REI/(1.D0,0.D0)/,MNI/(0.D0,1.D0)/

7753       DATA NC/3/,NF/5/,NLOSW/1/,LAMQCD/0.5D-01/

7754       DATA TF/0.5D0/ 

7755 c------ IPomeron linear trajectories: constants, ----------

7756 c------ intercepts-1, pp-radii, gp-radii, alpha_primes ----  

7757       DATA CP/0.5300D+02,0.9700D+01,0.1670D+01/

7758       DATA DP/0.5800D-01,0.1670D+00,0.2030D+00/

7759       DATA RP/0.6300D+01,0.3100D+01,0.2480D+01/

7760       DATA RG/0.6300D+01,0.3100D+01,0.2540D+01/

7761       DATA AP/0.5600D+00,0.2730D+00,0.9400D-01/

7762 c------ default values: |t_i| from 0.01 to 5 GeV**2 -------                  

7763       DATA T1MIN/0.1D-02/, T1MAX/0.7D+01/

7764       DATA T2MIN/0.1D-02/, T2MAX/0.7D+01/

7765 c------ approximation: number of soft terms ---------------

7766       DATA NAPR/9/

7767 c------ main constant gp-gp amplitude ---------------------

7768       DATA CGP/0.316D+01/ ! 3.16D0(2.7->3.8) for new data from CDF

7769 

7770        END    

7771       

7772 c-------------------------------------------------------------              

7773 c-... tables for interpolation !R.Ryutin

7774 c-------------------------------------------------------------              

7775       BLOCK DATA EDDETABLES

7776 

7777       IMPLICIT NONE            

7778 c---- table for Intfgg**2 for Lum_sidde=Lum_excl*Intfgg**2 ---

7779       DOUBLE PRECISION LUM1,FLUM1,DX1,DY1,X01,Y01

7780       COMMON/EDDETAB1/ LUM1(480),FLUM1(30,16),

7781      & DX1,DY1,X01,Y01

7782 c---- table for 3g ratio dIsud3g(x,mu)**2/Isud0(mu)**2 -------

7783       DOUBLE PRECISION RDI3G,FRDI3G,DX2,DY2,X02,Y02

7784       COMMON/EDDETAB2/ RDI3G(630),FRDI3G(30,21),

7785      & DX2,DY2,X02,Y02 

7786 c--- table for 3g ratio Isud3ga(etasimax,mu)**2/Isud0(mu)**2 -

7787 c--- table for 3g ratio Isud3gb(etasimax,mu)**2/Isud0(mu)**2 -

7788       DOUBLE PRECISION RI3GA,RI3GB,FRI3GA,FRI3GB,

7789      & DX3,DY3,X03,Y03

7790       COMMON/EDDETAB3/ RI3GA(480),RI3GB(480),

7791      & FRI3GA(30,16),FRI3GB(30,16),DX3,DY3,X03,Y03     

7792 c- tables for fM_g/g(x,pt)=g(x,pt)*Tsud(pt,mu)

7793        DOUBLE PRECISION FT4,FMT4,DX4,DY4,X04,Y04

7794        COMMON/EDDETAB4/ FT4(10201),FMT4(101,101),

7795      & DX4,DY4,X04,Y04 

7796 c-- tables for dfM_g/g(x,Y)/dY, Y=DLOG(PT**2/LAMQCD**2) ---

7797        DOUBLE PRECISION DFT5,DFMT5,DX5,DY5,X05,Y05

7798        COMMON/EDDETAB5/ DFT5(10201),DFMT5(101,101),

7799      & DX5,DY5,X05,Y05    

7800       

7801       DATA DX1/5.D0/,DY1/2.D0/,X01/5.D0/,Y01/0.D0/

7802       DATA  LUM1/0.D0,0.01514D0,0.13131D0,0.33366D0,

7803      &  0.55813D0,0.6785D0,0.68486D0,0.68486D0,

7804      &  0.68486D0,0.68486D0,0.68486D0,0.68486D0,

7805      &  0.68486D0,0.68486D0,0.68486D0,0.68486D0,

7806      &  0.D0,0.0124D0,0.14447D0,0.44316D0,

7807      &  0.8491D0,1.26662D0,1.51587D0,1.56017D0,

7808      &  1.56017D0,1.56017D0,1.56017D0,1.56017D0,

7809      &  1.56017D0,1.56017D0,1.56017D0,1.56017D0,

7810      &  0.D0,0.00853D0,0.12174D0,0.4405D0,0.91081D0,

7811      &  1.48394D0,1.95785D0,2.18438D0,2.20792D0,

7812      &  2.20792D0,2.20792D0,2.20792D0,2.20792D0,

7813      &  2.20792D0,2.20792D0,2.20792D0,0.D0,0.00574D0,

7814      &  0.09705D0,0.40424D0,0.90146D0,1.55077D0,

7815      &  2.18262D0,2.58063D0,2.70382D0,2.70426D0,

7816      &  2.70426D0,2.70426D0,2.70426D0,2.70426D0,

7817      &  2.70426D0,2.70426D0,0.D0,0.0043D0,0.07622D0,

7818      &  0.35995D0,0.86601D0,1.55117D0,2.29222D0,

7819      &  2.83432D0,3.07586D0,3.1015D0,3.1015D0,3.1015D0,

7820      &  3.1015D0,3.1015D0,3.1015D0,3.1015D0,0.D0,0.00357D0,

7821      &  0.05963D0,0.31645D0,0.81955D0,1.52056D0,2.33685D0,

7822      &  2.99805D0,3.35059D0,3.43041D0,3.43041D0,

7823      &  3.43041D0,3.43041D0,3.43041D0,3.43041D0,3.43041D0,

7824      &  0.D0,0.0031D0,0.04663D0,0.27665D0,0.76919D0,

7825      &  1.47543D0,2.34316D0,3.10253D0,3.55679D0,

7826      &  3.7069D0,3.70999D0,3.70999D0,3.70999D0,

7827      &  3.70999D0,3.70999D0,3.70999D0,0.D0,0.00277D0,

7828      &  0.03857D0,0.24132D0,0.7185D0,1.424D0,2.32617D0,

7829      &  3.1666D0,3.71324D0,3.93374D0,3.95253D0,

7830      &  3.95253D0,3.95253D0,3.95253D0,3.95253D0,

7831      &  3.95253D0,0.D0,0.00252D0,0.03338D0,0.21035D0,

7832      &  0.66931D0,1.37055D0,2.29489D0,3.20237D0,

7833      &  3.83258D0,4.1213D0,4.16637D0,4.16637D0,

7834      &  4.16637D0,4.16637D0,4.16637D0,4.16637D0,

7835      &  0.D0,0.00232D0,0.02961D0,0.18337D0,

7836      &  0.62253D0,1.31736D0,2.25482D0,3.21787D0,

7837      &  3.92364D0,4.27788D0,4.35741D0,4.35741D0,

7838      &  4.35741D0,4.35741D0,4.35741D0,4.35741D0,

7839      &  0.D0,0.00217D0,0.0267D0,0.15991D0,0.57856D0,

7840      &  1.26553D0,2.20949D0,3.21864D0,3.99275D0,

7841      &  4.40956D0,4.52926D0,4.52994D0,4.52994D0,4.52994D0,

7842      &  4.52994D0,4.52994D0,0.D0,0.00204D0,0.02438D0,

7843      &  0.1395D0,0.5375D0,1.21542D0,2.16123D0,

7844      &  3.20859D0,4.04459D0,4.52096D0,4.68147D0, 

7845      &  4.6872D0,4.6872D0,4.6872D0,4.6872D0,4.6872D0,

7846      &  0.D0,0.00193D0,0.02248D0,0.12174D0,0.49933D0,

7847      &  1.1672D0,2.11151D0,3.19053D0,4.08264D0,

7848      &  4.61561D0,4.81656D0,4.83165D0,4.83165D0,4.83165D0,

7849      &  4.83165D0,4.83165D0,0.D0,0.00183D0,0.02089D0,

7850      &  0.10634D0,0.46393D0,1.12092D0,2.06138D0,

7851      &  3.16652D0,4.10956D0,4.69627D0,4.93714D0,4.96521D0,

7852      &  4.96521D0,4.96521D0,4.96521D0,4.96521D0,0.D0,

7853      &  0.00175D0,0.01954D0,0.09505D0,0.43115D0,1.07659D0,

7854      &  2.01152D0,3.13808D0,4.12744D0,4.76515D0,5.0452D0,

7855      &  5.08942D0,5.08942D0,5.08942D0,5.08942D0,5.08942D0,

7856      &  0.D0,0.00168D0,0.01838D0,0.08629D0,0.4008D0,

7857      &  1.03418D0,1.96238D0,3.10637D0,4.13789D0,4.82402D0,

7858      &  5.1425D0,5.20553D0,5.20553D0,5.20553D0,5.20553D0,

7859      &  5.20553D0,0.D0,0.00162D0,0.01737D0,0.07911D0,

7860      &  0.37273D0,0.99364D0,1.91425D0,3.07228D0,

7861      &  4.14223D0,4.8743D0,5.23035D0,5.31453D0,5.31453D0,

7862      &  5.31453D0,5.31453D0,5.31453D0,0.D0,0.00156D0,

7863      &  0.01648D0,0.07307D0,0.34674D0,0.95491D0,1.86733D0,

7864      &  3.03648D0,4.14148D0,4.91719D0,5.30992D0,5.41685D0,

7865      &  5.41728D0,5.41728D0,5.41728D0,5.41728D0,0.D0,0.00151D0,

7866      &  0.01569D0,0.0679D0,0.32267D0,0.9179D0,1.82173D0,

7867      &  2.99949D0,4.1365D0,4.95366D0,5.38219D0,5.51199D0,

7868      &  5.51446D0,5.51446D0,5.51446D0,5.51446D0,0.D0,

7869      &  0.00146D0,0.01499D0,0.06342D0,0.30038D0,0.88254D0,

7870      &  1.77752D0,2.96172D0,4.12799D0,4.98455D0,5.44796D0,

7871      &  5.60063D0,5.60668D0,5.60668D0,5.60668D0,5.60668D0,

7872      &  0.D0,0.00142D0,0.01435D0,0.0595D0,0.27971D0,

7873      &  0.84876D0,1.73473D0,2.92348D0,4.1165D0,5.01054D0,

7874      &  5.50793D0,5.68342D0,5.69443D0,5.69443D0,5.69443D0,

7875      &  5.69443D0,0.D0,0.00139D0,0.01378D0,0.05603D0,

7876      &  0.26054D0,0.81649D0,1.69337D0,2.88504D0,4.10253D0,

7877      &  5.03222D0,5.56272D0,5.76083D0,5.77814D0,5.77814D0,

7878      &  5.77814D0,5.77814D0,0.D0,0.00136D0,0.01326D0,0.05294D0,

7879      &  0.24274D0,0.78564D0,1.6534D0,2.84659D0,4.08644D0,

7880      &  5.0501D0,5.61283D0,5.83357D0,5.85819D0,5.85819D0,

7881      &  5.85819D0,5.85819D0,0.D0,0.00133D0,0.01278D0,0.05017D0,

7882      &  0.22621D0,0.75614D0,1.61481D0,2.80827D0,4.0686D0,

7883      &  5.06461D0,5.65872D0,5.90185D0,5.93489D0,5.93489D0,

7884      &  5.93489D0,5.93489D0,0.D0,0.00131D0,0.01234D0,0.04766D0,

7885      &  0.21084D0,0.72793D0,1.57757D0,2.77021D0,4.04928D0,

7886      &  5.07612D0,5.70077D0,5.96611D0,6.00854D0,6.00854D0,

7887      &  6.00854D0,6.00854D0,0.D0,0.00128D0,0.01194D0,0.04539D0,

7888      &  0.19654D0,0.70094D0,1.54162D0,2.73251D0,4.02871D0,

7889      &  5.08496D0,5.73936D0,6.02668D0,6.07938D0,6.07938D0,

7890      &  6.07938D0,6.07938D0,0.D0,0.00126D0,0.01156D0,

7891      &  0.04333D0,0.18323D0,0.67511D0,1.50692D0,2.69524D0,

7892      &  4.0071D0,5.0912D0,5.77476D0,6.08385D0,6.14764D0,

7893      &  6.14764D0,6.14764D0,6.14764D0,0.D0,0.D0,0.01122D0,

7894      &  0.04144D0,0.17083D0,0.65038D0,1.47343D0,2.65846D0,

7895      &  3.98462D0,5.09573D0,5.80727D0,6.13788D0,6.2135D0,

7896      &  6.2135D0,6.2135D0,6.2135D0,0.D0,0.D0,0.01089D0,

7897      &  0.0397D0,0.15928D0,0.62669D0,1.44106D0,2.6222D0,

7898      &  3.96141D0,5.09812D0,5.8371D0,6.18902D0,6.27707D0,

7899      &  6.27713D0,6.27713D0,6.27713D0,0.D0,0.D0,0.0106D0,

7900      &  0.0381D0,0.14863D0,0.604D0,1.40977D0,2.58656D0,

7901      &  3.93762D0,5.09879D0,5.8645D0,6.23745D0,6.33809D0,

7902      &  6.33871D0,6.33871D0,6.33871D0/

7903       DATA DX2/5.D0/,DY2/0.0497D0/,X02/5.D0/,Y02/0.003D0/      

7904       DATA RDI3G/1.D0,1.D0,1.D0,1.00001D0,1.00007D0,1.00027D0,

7905      &  1.00068D0,1.00139D0,1.00247D0,1.00405D0,

7906      &  1.00631D0,1.00913D0,1.01218D0,1.01535D0,1.01853D0,

7907      &  1.02154D0,1.02409D0,1.02582D0,1.02641D0,1.02642D0,

7908      &  1.02642D0,1.D0,1.D0,1.00003D0,1.00029D0,1.00101D0,

7909      &  1.00229D0,1.00421D0,1.00684D0,1.01029D0,1.01472D0,

7910      &  1.02041D0,1.02718D0,1.03459D0,1.04266D0,1.05147D0,

7911      &  1.06096D0,1.07093D0,1.08066D0,1.0884D0,1.0913D0,

7912      &  1.09131D0,1.D0,1.D0,1.00021D0,1.00113D0,1.00299D0,

7913      &  1.00583D0,1.00964D0,1.01448D0,1.02046D0,1.02778D0,

7914      &  1.03683D0,1.04739D0,1.05901D0,1.0719D0,1.08632D0,

7915      &  1.10259D0,1.12095D0,1.14113D0,1.16115D0,1.1743D0,

7916      &  1.17527D0,1.D0,1.00002D0,1.0006D0,1.00247D0,1.00574D0,

7917      &  1.01032D0,1.01613D0,1.0232D0,1.03166D0,1.04178D0,

7918      &  1.05402D0,1.06818D0,1.0838D0,1.10128D0,1.12114D0,

7919      &  1.14412D0,1.17103D0,1.20253D0,1.23763D0,1.26768D0,

7920      &  1.27289D0,1.D0,1.00006D0,1.00118D0,1.0042D0,1.00902D0,

7921      &  1.01541D0,1.02323D0,1.0325D0,1.04337D0,1.05617D0,

7922      &  1.07145D0,1.08903D0,1.10848D0,1.13037D0,1.15552D0,

7923      &  1.18507D0,1.22056D0,1.26381D0,1.31568D0,1.36814D0,

7924      &  1.38253D0,1.D0,1.00014D0,1.00195D0,1.00624D0,1.01268D0,

7925      &  1.0209D0,1.03071D0,1.04212D0,1.05532D0,1.07069D0,

7926      &  1.08889D0,1.10976D0,1.13289D0,1.15906D0,1.18936D0,

7927      &  1.22539D0,1.26944D0,1.3247D0,1.39454D0,1.474D0,

7928      &  1.50387D0,1.D0,1.00025D0,1.00287D0,1.00853D0,1.01662D0,

7929      &  1.02665D0,1.03842D0,1.05191D0,1.06737D0,1.08524D0,

7930      &  1.10625D0,1.13029D0,1.15699D0,1.18732D0,1.22268D0,

7931      &  1.26511D0,1.31772D0,1.3852D0,1.47394D0,1.58436D0,1.63714D0,

7932      &  1.D0,1.0004D0,1.00393D0,1.01101D0,1.02076D0,1.03259D0,

7933      &  1.04627D0,1.0618D0,1.07945D0,1.09973D0,1.12347D0,

7934      &  1.15059D0,1.18078D0,1.21519D0,1.25551D0,1.30429D0,

7935      &  1.36546D0,1.44535D0,1.55381D0,1.6987D0,1.78287D0,1.D0,

7936      &  1.0006D0,1.00511D0,1.01364D0,1.02504D0,1.03866D0,1.0542D0,

7937      &  1.07172D0,1.09151D0,1.11414D0,1.14054D0,1.17066D0,1.20426D0,

7938      &  1.24267D0,1.28791D0,1.34299D0,1.41274D0,1.50522D0,1.63414D0,

7939      &  1.81671D0,1.94177D0,1.D0,1.00082D0,1.00639D0,1.01639D0,

7940      &  1.02944D0,1.04481D0,1.06219D0,1.08165D0,1.10353D0,1.12845D0,

7941      &  1.15745D0,1.19051D0,1.22745D0,1.26982D0,1.31991D0,1.38127D0,

7942      &  1.45963D0,1.56488D0,1.71494D0,1.93821D0,2.11472D0,1.D0,

7943      &  1.00109D0,1.00775D0,1.01923D0,1.03393D0,1.05101D0,1.0702D0,

7944      &  1.09156D0,1.11548D0,1.14265D0,1.17419D0,1.21014D0,1.25038D0,

7945      &  1.29665D0,1.35157D0,1.41919D0,1.5062D0,1.62439D0,1.79625D0,

7946      &  2.06309D0,2.30268D0,1.D0,1.00139D0,1.00919D0,1.02216D0,

7947      &  1.03848D0,1.05726D0,1.07821D0,1.10144D0,1.12736D0,1.15674D0,

7948      &  1.19078D0,1.22957D0,1.27307D0,1.32321D0,1.38291D0,1.45678D0,

7949      &  1.55248D0,1.68382D0,1.87811D0,2.19127D0,2.50671D0,1.D0,

7950      &  1.00172D0,1.01069D0,1.02515D0,1.04307D0,1.06352D0,1.08622D0,

7951      &  1.11128D0,1.13917D0,1.17072D0,1.20722D0,1.24881D0,1.29553D0,

7952      &  1.3495D0,1.41398D0,1.4941D0,1.59854D0,1.74319D0,1.96055D0,

7953      &  2.32273D0,2.72799D0,1.D0,1.00208D0,1.01224D0,1.02819D0,

7954      &  1.0477D0,

7955      &  1.0698D0,1.09421D0,1.12107D0,1.1509D0,1.18459D0,1.22351D0,

7956      &  1.26788D0,1.31778D0,1.37556D0,1.44479D0,1.53117D0,1.6444D0,

7957      &  1.80257D0,2.0436D0,2.45745D0,2.96775D0,1.D0,1.00247D0,

7958      &  1.01384D0,

7959      &  1.03127D0,1.05236D0,1.07608D0,1.10217D0,1.13081D0,1.16255D0,

7960      &  1.19834D0,1.23966D0,1.28677D0,1.33983D0,1.4014D0,1.47538D0,

7961      &  1.56803D0,1.69012D0,1.86198D0,2.12729D0,2.59541D0,3.22734D0,

7962      &  1.D0,1.00288D0,1.01549D0,1.03439D0,1.05703D0,1.08236D0,

7963      &  1.11011D0,1.1405D0,1.17413D0,1.212D0,1.25569D0,1.30551D0,

7964      &  1.36171D0,1.42705D0,1.50577D0,1.60471D0,1.73571D0,1.92147D0,

7965      &  2.21166D0,2.73663D0,3.50817D0,1.D0,1.00332D0,1.01717D0,

7966      &  1.03754D0,1.06171D0,1.08862D0,1.11802D0,1.15014D0,1.18563D0,

7967      &  1.22556D0,1.27159D0,1.32411D0,1.38343D0,1.45253D0,1.53598D0,

7968      &  1.64122D0,1.78121D0,1.98105D0,2.29672D0,2.88111D0,3.81177D0,

7969      &  1.D0,1.00379D0,1.01888D0,1.04071D0,1.0664D0,1.09488D0,

7970      &  1.12589D0,1.15972D0,1.19705D0,1.23902D0,1.28738D0,1.34257D0,

7971      &  1.40499D0,1.47784D0,1.56603D0,1.67759D0,1.82663D0,2.04075D0,

7972      &  2.3825D0,3.02887D0,4.13975D0,1.D0,1.00427D0,1.02062D0,

7973      &  1.0439D0,1.07109D0,1.10111D0,1.13373D0,1.16925D0,1.2084D0,

7974      &  1.25239D0,1.30305D0,1.3609D0,1.42642D0,1.50301D0,1.59594D0,

7975      &  1.71384D0,1.87201D0,2.10059D0,2.46902D0,3.17993D0,4.49381D0,

7976      &  1.D0,1.00478D0,1.02239D0,1.0471D0,1.07579D0,1.10733D0,

7977      &  1.14154D0,1.17873D0,1.21969D0,1.26567D0,1.31862D0,1.37911D0,

7978      &  1.44771D0,1.52803D0,1.62571D0,1.74999D0,1.91736D0,2.1606D0,

7979      &  2.55629D0,3.33429D0,4.87576D0,1.D0,1.0053D0,1.02418D0,

7980      &  1.05031D0,1.08047D0,1.11354D0,1.14931D0,1.18815D0,1.2309D0,

7981      &  1.27887D0,1.3341D0,1.39721D0,1.46888D0,1.55294D0,1.65536D0,

7982      &  1.78604D0,1.96269D0,2.2208D0,2.64433D0,3.49198D0,5.28752D0,

7983      &  1.D0,1.00584D0,1.02598D0,1.05353D0,1.08516D0,1.11972D0,

7984      &  1.15704D0,1.19753D0,1.24205D0,1.29199D0,1.34948D0,1.41521D0,

7985      &  1.48994D0,1.57773D0,1.68491D0,1.82202D0,2.00802D0,2.28119D0,

7986      &  2.73317D0,3.65301D0,5.73111D0,1.D0,1.00639D0,1.02781D0,

7987      &  1.05676D0,1.08983D0,1.12587D0,1.16474D0,1.20685D0,1.25313D0,

7988      &  1.30504D0,1.36477D0,1.43311D0,1.51089D0,1.60241D0,1.71437D0,

7989      &  1.85794D0,2.05337D0,2.34181D0,2.8228D0,3.81742D0,6.20865D0,

7990      &  1.D0,1.00696D0,1.02964D0,1.05999D0,1.0945D0,1.13201D0,

7991      &  1.1724D0,1.21613D0,1.26416D0,1.31801D0,1.37998D0,1.45091D0,

7992      &  1.53175D0,1.627D0,1.74374D0,1.89381D0,2.09874D0,2.40264D0,

7993      &  2.91325D0,3.98522D0,6.72239D0,1.D0,1.00755D0,1.03149D0,

7994      &  1.06323D0,1.09916D0,1.13812D0,1.18002D0,1.22536D0,1.27512D0,

7995      &  1.33091D0,1.39511D0,1.46863D0,1.55252D0,1.6515D0,1.77303D0,

7996      &  1.92963D0,2.14415D0,2.46371D0,3.00452D0,4.15642D0,7.2747D0,

7997      &  1.D0,1.00815D0,1.03335D0,1.06647D0,1.1038D0,1.14421D0,

7998      &  1.18762D0,1.23454D0,1.28603D0,1.34375D0,1.41016D0,1.48627D0,

7999      &  1.5732D0,1.67591D0,1.80226D0,1.96542D0,2.18962D0,2.52503D0,

8000      &  3.09663D0,4.33105D0,7.86807D0,1.D0,1.00876D0,1.03523D0,

8001      &  1.0697D0,1.10844D0,1.15028D0,1.19517D0,1.24368D0,1.29689D0,

8002      &  1.35652D0,1.42515D0,1.50383D0,1.5938D0,1.70026D0,1.83142D0,

8003      &  2.00119D0,2.23514D0,2.58661D0,3.18958D0,4.50914D0,8.50513D0,

8004      &  1.D0,1.00938D0,1.03711D0,1.07294D0,1.11306D0,1.15633D0,

8005      &  1.2027D0,1.25277D0,1.30769D0,1.36923D0,1.44006D0,1.52132D0,

8006      &  1.61433D0,1.72453D0,1.86054D0,2.03694D0,2.28072D0,2.64846D0,

8007      &  3.28339D0,4.6907D0,9.18863D0,1.D0,1.01001D0,1.03899D0,

8008      &  1.07617D0,1.11767D0,1.16235D0,1.21019D0,1.26182D0,1.31844D0,

8009      &  1.38189D0,1.45492D0,1.53874D0,1.63479D0,1.74874D0,1.8896D0,

8010      &  2.07268D0,2.32638D0,2.71058D0,3.37806D0,4.87575D0,9.92145D0,

8011      &  1.D0,1.01065D0,1.04088D0,1.0794D0,1.12227D0,1.16835D0,

8012      &  1.21765D0,1.27084D0,1.32915D0,1.39449D0,1.46971D0,1.55609D0,

8013      &  1.65518D0,1.77289D0,1.91863D0,2.10842D0,2.37213D0,2.77299D0,

8014      &  3.4736D0,5.06432D0,10.7066D0/

8015       DATA DX3/5.D0/,DY3/1.D0/,X03/5.D0/,Y03/0.D0/            

8016       DATA RI3GA/0.D0,0.00186D0,0.0037D0,0.00802D0,0.01695D0,

8017      &  0.03333D0,0.04732D0,0.04732D0,0.04732D0,0.04732D0,

8018      &  0.04732D0,0.04732D0,0.04732D0,0.04732D0,

8019      &  0.04732D0,0.04732D0,0.D0,0.00161D0,0.00319D0,

8020      &  0.00688D0,0.01448D0,0.02894D0,0.05445D0,0.09271D0,

8021      &  0.09977D0,0.09977D0,0.09977D0,0.09977D0,0.09977D0,

8022      &  0.09977D0,0.09977D0,0.09977D0,0.D0,0.00151D0,

8023      &  0.00299D0,0.00643D0,0.01351D0,0.02696D0,0.0508D0,

8024      &  0.09034D0,0.1443D0,0.14729D0,0.14729D0,

8025      &  0.14729D0,0.14729D0,0.14729D0,0.14729D0,0.14729D0,

8026      &  0.D0,0.00145D0,0.00287D0,0.00619D0,0.01302D0,

8027      &  0.026D0,0.04901D0,0.08744D0,0.1474D0,

8028      &  0.1929D0,0.1929D0,0.1929D0,0.1929D0,0.1929D0,

8029      &  0.1929D0,0.1929D0,0.D0,0.00142D0,

8030      &  0.00281D0,0.00605D0,0.01275D0,0.0255D0,0.04815D0,

8031      &  0.08606D0,0.14619D0,0.22959D0,0.2382D0,

8032      &  0.2382D0,0.2382D0,0.2382D0,0.2382D0,0.2382D0,

8033      &  0.D0,0.00139D0,0.00277D0,0.00597D0,0.0126D0,

8034      &  0.02526D0,0.0478D0,0.08563D0,0.14592D0,

8035      &  0.23598D0,0.28414D0,0.28414D0,0.28414D0,0.28414D0,

8036      &  0.28414D0,0.28414D0,0.D0,0.00138D0,0.00274D0,

8037      &  0.00593D0,0.01253D0,0.02517D0,0.04776D0,

8038      &  0.08579D0,0.14659D0,0.23905D0,0.33133D0,

8039      &  0.33133D0,0.33133D0,0.33133D0,0.33133D0,0.33133D0,

8040      &  0.D0,0.00137D0,0.00273D0,0.0059D0,0.0125D0,

8041      &  0.02518D0,0.04792D0,0.08634D0,0.14795D0,

8042      &  0.24232D0,0.37082D0,0.38022D0,0.38022D0,0.38022D0,

8043      &  0.38022D0,0.38022D0,0.D0,0.00137D0,0.00272D0,

8044      &  0.00589D0,0.01251D0,0.02526D0,0.04822D0,

8045      &  0.08717D0,0.14983D0,0.24621D0,0.38536D0,

8046      &  0.4312D0,0.4312D0,0.4312D0,0.4312D0,0.4312D0,

8047      &  0.D0,0.00136D0,0.00271D0,0.00589D0,0.01254D0,

8048      &  0.02539D0,0.04862D0,0.08819D0,0.1521D0,

8049      &  0.25072D0,0.39602D0,0.48462D0,0.48462D0,0.48462D0,

8050      &  0.48462D0,0.48462D0,0.D0,0.00136D0,0.00271D0,

8051      &  0.00591D0,0.01259D0,0.02556D0,0.0491D0,

8052      &  0.08937D0,0.15466D0,0.25577D0,0.40621D0,

8053      &  0.54079D0,0.54079D0,0.54079D0,0.54079D0,0.54079D0,

8054      &  0.D0,0.00136D0,0.00272D0,0.00592D0,0.01266D0,

8055      &  0.02576D0,0.04963D0,0.09066D0,0.15747D0,

8056      &  0.2613D0,0.41671D0,0.60004D0,0.60004D0,0.60004D0,

8057      &  0.60004D0,0.60004D0,0.D0,0.00137D0,0.00273D0,

8058      &  0.00595D0,0.01273D0,0.02598D0,0.05021D0,

8059      &  0.09204D0,0.16047D0,0.26723D0,0.42777D0,

8060      &  0.64814D0,0.66268D0,0.66268D0,0.66268D0,0.66268D0,

8061      &  0.D0,0.00137D0,0.00273D0,0.00597D0,0.01282D0,

8062      &  0.02622D0,0.05082D0,0.09351D0,0.16363D0,

8063      &  0.27352D0,0.43946D0,0.67619D0,0.72906D0,0.72906D0,

8064      &  0.72906D0,0.72906D0,0.D0,0.00137D0,0.00274D0,

8065      &  0.00601D0,0.01291D0,0.02647D0,0.05147D0,

8066      &  0.09504D0,0.16694D0,0.28014D0,0.45178D0,

8067      &  0.70102D0,0.7995D0,0.7995D0,0.7995D0,0.7995D0,

8068      &  0.D0,0.00138D0,0.00276D0,0.00604D0,0.01301D0,

8069      &  0.02674D0,0.05214D0,0.09662D0,0.17038D0,

8070      &  0.28707D0,0.46475D0,0.72544D0,0.87438D0,0.87438D0,

8071      &  0.87438D0,0.87438D0,0.D0,0.00138D0,0.00277D0,

8072      &  0.00608D0,0.01311D0,0.02702D0,0.05283D0,

8073      &  0.09825D0,0.17392D0,0.29429D0,0.47835D0,0.75034D0,

8074      &  0.95408D0,0.95408D0,0.95408D0,0.95408D0,0.D0,

8075      &  0.00139D0,0.00278D0,0.00611D0,0.01322D0,

8076      &  0.0273D0,0.05355D0,0.09992D0,0.17758D0,

8077      &  0.30178D0,0.49258D0,0.77612D0,1.03901D0,1.03901D0,

8078      &  1.03901D0,1.03901D0,0.D0,0.00139D0,0.0028D0,

8079      &  0.00615D0,0.01333D0,0.02759D0,0.05427D0,

8080      &  0.10163D0,0.18132D0,0.30954D0,0.50745D0,

8081      &  0.80297D0,1.12959D0,1.12959D0,1.12959D0,1.12959D0,

8082      &  0.D0,0.0014D0,0.00281D0,0.0062D0,0.01344D0,

8083      &  0.02789D0,0.05502D0,0.10338D0,0.18516D0,

8084      &  0.31755D0,0.52297D0,0.83102D0,1.2263D0,1.2263D0,

8085      &  1.2263D0,1.2263D0,0.D0,0.00141D0,

8086      &  0.00283D0,0.00624D0,0.01356D0,0.0282D0,0.05577D0,

8087      &  0.10515D0,0.18908D0,0.32583D0,0.53915D0,

8088      &  0.86038D0,1.30964D0,1.32961D0,1.32961D0,1.32961D0,

8089      &  0.D0,0.00141D0,0.00284D0,0.00628D0,0.01368D0,

8090      &  0.02851D0,0.05654D0,0.10696D0,0.19309D0,

8091      &  0.33437D0,0.55599D0,0.89111D0,1.37219D0,1.44004D0,

8092      &  1.44004D0,1.44004D0,0.D0,0.00142D0,0.00286D0,

8093      &  0.00633D0,0.0138D0,0.02882D0,0.05731D0,

8094      &  0.10879D0,0.19717D0,0.34316D0,0.57351D0,

8095      &  0.92328D0,1.43238D0,1.55816D0,1.55816D0,1.55816D0,

8096      &  0.D0,0.00143D0,0.00288D0,0.00637D0,0.01392D0,

8097      &  0.02914D0,0.0581D0,0.11064D0,0.20134D0,

8098      &  0.35222D0,0.59174D0,0.95696D0,1.49335D0,1.68456D0,

8099      &  1.68456D0,1.68456D0,0.D0,0.00144D0,0.0029D0,0.00642D0,

8100      &  0.01404D0,0.02946D0,0.05889D0,0.11252D0,

8101      &  0.20558D0,0.36155D0,0.6107D0,0.99223D0,1.55624D0,

8102      &  1.81983D0,1.81983D0,1.81983D0,0.D0,

8103      &  0.00144D0,0.00291D0,0.00646D0,0.01417D0,0.02978D0,

8104      &  0.05969D0,0.11443D0,0.20989D0,0.37115D0,0.63041D0,

8105      &  1.02915D0,1.62165D0,1.96468D0,1.96468D0,

8106      &  1.96468D0,0.D0,0.00145D0,0.00293D0,0.00651D0,

8107      &  0.0143D0,0.03011D0,0.0605D0,0.11635D0,0.21428D0,

8108      &  0.38103D0,0.6509D0,1.0678D0,1.68997D0,2.11979D0,

8109      &  2.11979D0,2.11979D0,0.D0,0.00146D0,0.00295D0,

8110      &  0.00656D0,0.01442D0,0.03044D0,0.06132D0,0.1183D0,

8111      &  0.21874D0,0.39119D0,0.67221D0,1.10826D0,1.76151D0,

8112      &  2.28593D0,2.28593D0,2.28593D0,0.D0,0.00147D0,

8113      &  0.00297D0,0.00661D0,0.01455D0,0.03077D0,0.06214D0,

8114      &  0.12026D0,0.22328D0,0.40165D0,0.69435D0,1.1506D0,

8115      &  1.83651D0,2.46389D0,2.46389D0,2.46389D0,0.D0,

8116      &  0.00148D0,0.00299D0,0.00666D0,0.01468D0,0.03111D0,

8117      &  0.06297D0,0.12225D0,0.22789D0,0.41242D0,0.71737D0,

8118      &  1.19493D0,1.91521D0,2.6545D0,2.6545D0,2.6545D0/

8119       DATA RI3GB/0.D0,0.08401D0,0.14638D0,0.22297D0,0.29921D0,

8120      &  0.3667D0,0.39779D0,0.39779D0,0.39779D0,0.39779D0,

8121      &  0.39779D0,0.39779D0,0.39779D0,0.39779D0,0.39779D0,

8122      &  0.39779D0,0.D0,0.08822D0,0.16918D0,0.27107D0,

8123      &  0.37626D0,0.47827D0,0.57519D0,0.65659D0,0.66657D0,

8124      &  0.66657D0,0.66657D0,0.66657D0,0.66657D0,0.66657D0,

8125      &  0.66657D0,0.66657D0,0.D0,0.0897D0,0.18101D0,0.29714D0,

8126      &  0.41849D0,0.53772D0,0.65403D0,0.76747D0,0.86138D0,

8127      &  0.86503D0,0.86503D0,0.86503D0,0.86503D0,0.86503D0,

8128      &  0.86503D0,0.86503D0,0.D0,0.09062D0,0.18907D0,

8129      &  0.31513D0,0.4479D0,0.57937D0,0.70871D0,0.83782D0,

8130      &  0.96514D0,1.03075D0,1.03075D0,1.03075D0,1.03075D0,

8131      &  1.03075D0,1.03075D0,1.03075D0,0.D0,0.09135D0,

8132      &  0.19524D0,0.32891D0,0.47056D0,0.61167D0,0.75128D0,

8133      &  0.8919D0,1.0358D0,1.16789D0,1.17802D0,1.17802D0,

8134      &  1.17802D0,1.17802D0,1.17802D0,1.17802D0,0.D0,

8135      &  0.09199D0,0.20027D0,0.34013D0,0.48906D0,0.63818D0,

8136      &  0.78643D0,0.9366D0,1.09257D0,1.25149D0,1.31392D0,

8137      &  1.31392D0,1.31392D0,1.31392D0,1.31392D0,1.31392D0,

8138      &  0.D0,0.09257D0,0.20454D0,0.34961D0,0.50472D0,

8139      &  0.66073D0,0.81651D0,0.97506D0,1.14113D0,1.31665D0,

8140      &  1.44255D0,1.44255D0,1.44255D0,1.44255D0,

8141      &  1.44255D0,1.44255D0,0.D0,0.09312D0,0.20827D0,

8142      &  0.35785D0,0.51835D0,0.68042D0,0.84293D0,1.00903D0,

8143      &  1.1841D0,1.37257D0,1.55605D0,1.56653D0,

8144      &  1.56653D0,1.56653D0,1.56653D0,1.56653D0,0.D0,

8145      &  0.09365D0,0.21159D0,0.36516D0,0.53044D0,

8146      &  0.69794D0,0.86655D0,1.0396D0,1.22295D0,1.42262D0,

8147      &  1.63327D0,1.68771D0,1.68771D0,1.68771D0,

8148      &  1.68771D0,1.68771D0,0.D0,0.09416D0,0.21459D0,

8149      &  0.37173D0,0.54132D0,0.71376D0,0.88797D0,1.06751D0,

8150      &  1.25863D0,1.46853D0,1.69818D0,1.80743D0,1.80743D0,

8151      &  1.80743D0,1.80743D0,1.80743D0,0.D0,0.09465D0,

8152      &  0.21734D0,0.37772D0,0.55124D0,0.72821D0,0.90763D0,

8153      &  1.09326D0,1.29177D0,1.5113D0,1.75673D0,1.92679D0,

8154      &  1.92679D0,1.92679D0,1.92679D0,1.92679D0,0.D0,

8155      &  0.09513D0,0.21988D0,0.38324D0,0.56038D0,0.74154D0,

8156      &  0.92584D0,1.11725D0,1.32286D0,1.55164D0,1.8112D0,

8157      &  2.04668D0,2.04668D0,2.04668D0,2.04668D0,

8158      &  2.04668D0,0.D0,0.0956D0,0.22226D0,0.38835D0,

8159      &  0.56885D0,0.75394D0,0.94282D0,1.13974D0,

8160      &  1.35221D0,1.58999D0,1.8628D0,2.15217D0,2.16786D0,

8161      &  2.16786D0,2.16786D0,2.16786D0,0.D0,0.09606D0,

8162      &  0.22448D0,0.39313D0,0.57676D0,0.76554D0,

8163      &  0.95877D0,1.16098D0,1.38011D0,1.62672D0,1.91229D0,

8164      &  2.2318D0,2.29105D0,2.29105D0,2.29105D0,

8165      &  2.29105D0,0.D0,0.09651D0,0.22658D0,0.39762D0,

8166      &  0.5842D0,0.77646D0,0.97383D0,1.18113D0,

8167      &  1.40676D0,1.66209D0,1.96017D0,2.30384D0,

8168      &  2.41683D0,2.41683D0,2.41683D0,2.41683D0,0.D0,

8169      &  0.09695D0,0.22856D0,0.40185D0,0.59121D0,0.78678D0,

8170      &  0.98811D0,1.20034D0,1.43234D0,1.69633D0,2.00682D0,

8171      &  2.37216D0,2.54588D0,2.54588D0,2.54588D0,

8172      &  2.54588D0,0.D0,0.09739D0,0.23046D0,0.40587D0,

8173      &  0.59787D0,0.79659D0,1.00173D0,1.21872D0,

8174      &  1.45697D0,1.72961D0,2.05252D0,2.43832D0,2.67876D0,

8175      &  2.67876D0,2.67876D0,2.67876D0,0.D0,0.09781D0,

8176      &  0.23227D0,0.40969D0,0.60421D0,0.80595D0,

8177      &  1.01474D0,1.23638D0,1.48079D0,1.76206D0,2.0975D0,

8178      &  2.50321D0,2.81605D0,2.81605D0,2.81605D0,

8179      &  2.81605D0,0.D0,0.09823D0,0.234D0,0.41334D0,

8180      &  0.61026D0,0.81489D0,1.02723D0,1.2534D0,

8181      &  1.50388D0,1.7938D0,2.14192D0,2.56741D0,2.95834D0,

8182      &  2.95834D0,2.95834D0,2.95834D0,0.D0,

8183      &  0.09865D0,0.23566D0,0.41684D0,0.61605D0,0.82347D0,

8184      &  1.03924D0,1.26983D0,1.52633D0,1.82496D0,2.18597D0,

8185      &  2.63133D0,3.10624D0,3.10624D0,3.10624D0,

8186      &  3.10624D0,0.D0,0.09906D0,0.23727D0,0.4202D0,

8187      &  0.62162D0,0.83172D0,1.05082D0,1.28575D0,

8188      &  1.5482D0,1.8556D0,2.22976D0,2.69528D0,3.23944D0,

8189      &  3.26037D0,3.26037D0,3.26037D0,0.D0,

8190      &  0.09946D0,0.23882D0,0.42343D0,0.62697D0,

8191      &  0.83968D0,1.06202D0,1.30119D0,1.56956D0,

8192      &  1.88581D0,2.27341D0,2.75952D0,3.34852D0,3.42133D0,

8193      &  3.42133D0,3.42133D0,0.D0,0.09986D0,

8194      &  0.24031D0,0.42655D0,0.63214D0,0.84737D0,1.07286D0,

8195      &  1.31621D0,1.59046D0,1.91567D0,2.31705D0,

8196      &  2.82428D0,3.45289D0,3.58982D0,3.58982D0,3.58982D0,

8197      &  0.D0,0.10025D0,0.24177D0,0.42957D0,0.63714D0,

8198      &  0.85481D0,1.08338D0,1.33085D0,1.61094D0,

8199      &  1.94523D0,2.36075D0,2.88975D0,3.55625D0,3.76652D0,

8200      &  3.76652D0,3.76652D0,0.D0,0.10064D0,

8201      &  0.24318D0,0.43248D0,0.64198D0,0.86202D0,1.09361D0,

8202      &  1.34513D0,1.63106D0,1.97455D0,2.40461D0,

8203      &  2.95609D0,3.6601D0,3.95212D0,3.95212D0,3.95212D0,

8204      &  0.D0,0.10103D0,0.24455D0,0.43531D0,0.64667D0,

8205      &  0.86903D0,1.10358D0,1.35909D0,1.65083D0,

8206      &  2.00368D0,2.44872D0,3.02349D0,3.76532D0,4.14741D0,

8207      &  4.14741D0,4.14741D0,0.D0,0.10141D0,0.24588D0,

8208      &  0.43807D0,0.65123D0,0.87585D0,1.11329D0,

8209      &  1.37275D0,1.67031D0,2.03267D0,2.49317D0,

8210      &  3.0921D0,3.87253D0,4.35317D0,4.35317D0,4.35317D0,

8211      &  0.D0,0.10179D0,0.24718D0,0.44074D0,0.65567D0,

8212      &  0.88245D0,1.12277D0,1.38614D0,1.68951D0,2.06156D0,

8213      &  2.53801D0,3.16207D0,3.98217D0,4.57024D0,

8214      &  4.57024D0,4.57024D0,0.D0,0.10216D0,0.24845D0,

8215      &  0.44334D0,0.65998D0,0.88896D0,1.13204D0,

8216      &  1.39928D0,1.70846D0,2.09039D0,2.58334D0,

8217      &  3.23353D0,4.09464D0,4.79949D0,4.79949D0,4.79949D0,

8218      &  0.D0,0.10253D0,0.24969D0,0.44588D0,0.66419D0,

8219      &  0.89528D0,1.14111D0,1.41218D0,1.7272D0,2.11921D0,

8220      &  2.62922D0,3.30664D0,4.21031D0,5.04184D0,

8221      &  5.04184D0,5.04184D0/     

8222       DATA DX4/0.996D-02/,DY4/0.124292D0/,X04/0.2D-02/,Y04/3.58352D0/      

8223       DATA FT4/0.0D+00,0.0D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8224      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8225      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8226      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8227      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8228      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8229      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8230      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8231      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8232      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8233      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8234      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8235      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8236      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8237      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8238      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8239      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8240      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8241      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8242      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8243      & 0.67391D+02,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8244      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8245      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8246      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8247      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8248      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8249      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8250      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8251      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8252      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8253      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8254      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8255      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8256      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8257      & 0.00000D+00,0.00000D+00,0.00000D+00,0.39393D+02,0.42077D+02,

8258      & 0.45088D+02,0.48520D+02,0.52316D+02,0.56383D+02,0.60690D+02,

8259      & 0.65223D+02,0.69972D+02,0.74933D+02,0.80103D+02,0.85480D+02,

8260      & 0.91061D+02,0.96847D+02,0.10284D+03,0.10903D+03,0.11542D+03,

8261      & 0.12202D+03,0.12882D+03,0.13583D+03,0.14304D+03,0.15045D+03,

8262      & 0.15807D+03,0.16591D+03,0.17646D+03,0.18440D+03,0.18687D+03,

8263      & 0.18103D+03,0.15688D+03,0.00000D+00,0.00000D+00,0.00000D+00,

8264      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8265      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8266      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8267      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8268      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8269      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8270      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8271      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8272      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8273      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8274      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8275      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.16969D+02,

8276      & 0.18150D+02,0.19477D+02,0.20902D+02,0.22416D+02,0.24014D+02,

8277      & 0.25693D+02,0.27453D+02,0.29294D+02,0.31215D+02,0.33216D+02,

8278      & 0.35296D+02,0.37453D+02,0.39679D+02,0.41983D+02,0.44370D+02,

8279      & 0.46846D+02,0.49412D+02,0.52071D+02,0.54825D+02,0.57677D+02,

8280      & 0.60630D+02,0.63684D+02,0.66844D+02,0.70111D+02,0.73488D+02,

8281      & 0.76977D+02,0.80580D+02,0.84302D+02,0.88143D+02,0.92107D+02,

8282      & 0.96193D+02,0.10041D+03,0.10478D+03,0.11240D+03,0.11664D+03,

8283      & 0.11393D+03,0.10074D+03,0.69647D+02,0.00000D+00,0.00000D+00,

8284      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8285      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8286      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8287      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8288      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8289      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8290      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8291      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8292      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8293      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8294      & 0.00000D+00,0.00000D+00,0.00000D+00,0.90052D+01,0.94235D+01,

8295      & 0.99804D+01,0.10859D+02,0.12038D+02,0.13256D+02,0.14192D+02,

8296      & 0.15080D+02,0.16008D+02,0.17009D+02,0.18056D+02,0.19151D+02,

8297      & 0.20296D+02,0.21492D+02,0.22741D+02,0.24046D+02,0.25407D+02,

8298      & 0.26826D+02,0.28305D+02,0.29847D+02,0.31451D+02,0.33121D+02,

8299      & 0.34859D+02,0.36665D+02,0.38542D+02,0.40492D+02,0.42517D+02,

8300      & 0.44619D+02,0.46800D+02,0.49062D+02,0.51410D+02,0.53839D+02,

8301      & 0.56358D+02,0.58968D+02,0.61670D+02,0.64467D+02,0.67362D+02,

8302      & 0.70357D+02,0.73451D+02,0.76651D+02,0.79970D+02,0.86246D+02,

8303      & 0.89434D+02,0.86312D+02,0.73658D+02,0.45611D+02,0.00000D+00,

8304      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8305      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8306      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8307      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8308      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8309      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8310      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8311      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8312      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8313      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8314      & 0.68600D+01,0.72406D+01,0.76356D+01,0.80552D+01,0.84924D+01,

8315      & 0.89159D+01,0.93890D+01,0.99931D+01,0.10721D+02,0.11477D+02,

8316      & 0.12135D+02,0.12788D+02,0.13470D+02,0.14194D+02,0.14949D+02,

8317      & 0.15737D+02,0.16559D+02,0.17415D+02,0.18307D+02,0.19236D+02,

8318      & 0.20204D+02,0.21211D+02,0.22258D+02,0.23347D+02,0.24480D+02,

8319      & 0.25656D+02,0.26878D+02,0.28149D+02,0.29465D+02,0.30832D+02,

8320      & 0.32250D+02,0.33721D+02,0.35245D+02,0.36826D+02,0.38463D+02,

8321      & 0.40158D+02,0.41914D+02,0.43732D+02,0.45613D+02,0.47560D+02,

8322      & 0.49573D+02,0.51655D+02,0.53805D+02,0.56027D+02,0.58332D+02,

8323      & 0.62752D+02,0.64956D+02,0.62628D+02,0.53451D+02,0.33115D+02,

8324      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8325      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8326      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8327      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8328      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8329      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8330      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8331      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8332      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8333      & 0.00000D+00,0.00000D+00,0.49956D+01,0.53037D+01,0.56835D+01,

8334      & 0.60757D+01,0.64064D+01,0.67298D+01,0.70686D+01,0.74294D+01,

8335      & 0.78059D+01,0.82032D+01,0.86113D+01,0.90204D+01,0.94327D+01,

8336      & 0.98629D+01,0.10328D+02,0.10815D+02,0.11321D+02,0.11844D+02,

8337      & 0.12387D+02,0.12949D+02,0.13532D+02,0.14137D+02,0.14762D+02,

8338      & 0.15410D+02,0.16081D+02,0.16775D+02,0.17494D+02,0.18236D+02,

8339      & 0.19004D+02,0.19798D+02,0.20619D+02,0.21467D+02,0.22343D+02,

8340      & 0.23248D+02,0.24183D+02,0.25148D+02,0.26145D+02,0.27173D+02,

8341      & 0.28234D+02,0.29329D+02,0.30458D+02,0.31623D+02,0.32824D+02,

8342      & 0.34062D+02,0.35338D+02,0.36654D+02,0.38008D+02,0.39404D+02,

8343      & 0.40846D+02,0.43549D+02,0.44924D+02,0.43589D+02,0.38158D+02,

8344      & 0.25652D+02,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8345      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8346      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8347      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8348      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8349      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8350      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8351      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8352      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8353      & 0.41564D+01,0.43425D+01,0.45280D+01,0.47293D+01,0.49696D+01,

8354      & 0.52493D+01,0.55407D+01,0.58079D+01,0.60767D+01,0.63572D+01,

8355      & 0.66531D+01,0.69615D+01,0.72888D+01,0.76226D+01,0.79473D+01,

8356      & 0.82648D+01,0.85951D+01,0.89632D+01,0.93517D+01,0.97541D+01,

8357      & 0.10169D+02,0.10598D+02,0.11042D+02,0.11501D+02,0.11976D+02,

8358      & 0.12467D+02,0.12975D+02,0.13499D+02,0.14041D+02,0.14601D+02,

8359      & 0.15179D+02,0.15777D+02,0.16393D+02,0.17029D+02,0.17686D+02,

8360      & 0.18363D+02,0.19062D+02,0.19783D+02,0.20527D+02,0.21294D+02,

8361      & 0.22084D+02,0.22899D+02,0.23739D+02,0.24604D+02,0.25496D+02,

8362      & 0.26415D+02,0.27361D+02,0.28336D+02,0.29340D+02,0.30373D+02,

8363      & 0.31436D+02,0.32534D+02,0.34596D+02,0.35641D+02,0.34610D+02,

8364      & 0.30443D+02,0.20756D+02,0.00000D+00,0.00000D+00,0.00000D+00,

8365      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8366      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8367      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8368      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8369      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8370      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8371      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8372      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.35918D+01,

8373      & 0.37597D+01,0.39205D+01,0.40839D+01,0.42582D+01,0.44393D+01,

8374      & 0.46262D+01,0.48196D+01,0.50213D+01,0.52329D+01,0.54533D+01,

8375      & 0.56823D+01,0.59201D+01,0.61669D+01,0.64232D+01,0.66890D+01,

8376      & 0.69649D+01,0.72516D+01,0.75476D+01,0.78549D+01,0.81727D+01,

8377      & 0.85021D+01,0.88434D+01,0.91955D+01,0.95603D+01,0.99375D+01,

8378      & 0.10327D+02,0.10731D+02,0.11147D+02,0.11578D+02,0.12022D+02,

8379      & 0.12481D+02,0.12956D+02,0.13445D+02,0.13951D+02,0.14472D+02,

8380      & 0.15011D+02,0.15566D+02,0.16140D+02,0.16730D+02,0.17340D+02,

8381      & 0.17969D+02,0.18617D+02,0.19285D+02,0.19974D+02,0.20684D+02,

8382      & 0.21416D+02,0.22170D+02,0.22947D+02,0.23747D+02,0.24572D+02,

8383      & 0.25420D+02,0.26293D+02,0.27195D+02,0.28899D+02,0.29756D+02,

8384      & 0.28889D+02,0.25416D+02,0.17324D+02,0.00000D+00,0.00000D+00,

8385      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8386      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8387      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8388      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8389      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8390      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8391      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8392      & 0.00000D+00,0.00000D+00,0.29802D+01,0.30922D+01,0.32229D+01,

8393      & 0.33613D+01,0.35004D+01,0.36386D+01,0.37811D+01,0.39327D+01,

8394      & 0.40892D+01,0.42472D+01,0.44072D+01,0.45737D+01,0.47521D+01,

8395      & 0.49388D+01,0.51326D+01,0.53331D+01,0.55410D+01,0.57565D+01,

8396      & 0.59799D+01,0.62115D+01,0.64510D+01,0.66992D+01,0.69566D+01,

8397      & 0.72222D+01,0.74974D+01,0.77821D+01,0.80766D+01,0.83811D+01,

8398      & 0.86959D+01,0.90213D+01,0.93576D+01,0.97051D+01,0.10064D+02,

8399      & 0.10435D+02,0.10818D+02,0.11214D+02,0.11622D+02,0.12044D+02,

8400      & 0.12479D+02,0.12928D+02,0.13392D+02,0.13870D+02,0.14364D+02,

8401      & 0.14873D+02,0.15398D+02,0.15939D+02,0.16498D+02,0.17073D+02,

8402      & 0.17667D+02,0.18278D+02,0.18909D+02,0.19559D+02,0.20228D+02,

8403      & 0.20918D+02,0.21627D+02,0.22358D+02,0.23114D+02,0.24541D+02,

8404      & 0.25260D+02,0.24532D+02,0.21622D+02,0.14800D+02,0.00000D+00,

8405      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8406      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8407      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8408      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8409      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8410      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8411      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8412      & 0.00000D+00,0.26312D+01,0.27281D+01,0.28242D+01,0.29231D+01,

8413      & 0.30267D+01,0.31349D+01,0.32478D+01,0.33655D+01,0.34883D+01,

8414      & 0.36163D+01,0.37496D+01,0.38877D+01,0.40303D+01,0.41779D+01,

8415      & 0.43319D+01,0.44920D+01,0.46579D+01,0.48299D+01,0.50081D+01,

8416      & 0.51926D+01,0.53836D+01,0.55816D+01,0.57863D+01,0.59982D+01,

8417      & 0.62174D+01,0.64443D+01,0.66788D+01,0.69214D+01,0.71721D+01,

8418      & 0.74312D+01,0.76990D+01,0.79756D+01,0.82615D+01,0.85568D+01,

8419      & 0.88617D+01,0.91767D+01,0.95017D+01,0.98374D+01,0.10184D+02,

8420      & 0.10542D+02,0.10910D+02,0.11291D+02,0.11684D+02,0.12090D+02,

8421      & 0.12508D+02,0.12939D+02,0.13384D+02,0.13842D+02,0.14315D+02,

8422      & 0.14803D+02,0.15305D+02,0.15823D+02,0.16357D+02,0.16907D+02,

8423      & 0.17474D+02,0.18057D+02,0.18658D+02,0.19278D+02,0.19917D+02,

8424      & 0.21123D+02,0.21732D+02,0.21121D+02,0.18668D+02,0.12874D+02,

8425      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8426      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8427      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8428      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8429      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8430      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8431      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8432      & 0.00000D+00,0.24035D+01,0.24850D+01,0.25685D+01,0.26535D+01,

8433      & 0.27411D+01,0.28311D+01,0.29246D+01,0.30227D+01,0.31256D+01,

8434      & 0.32328D+01,0.33440D+01,0.34595D+01,0.35795D+01,0.37040D+01,

8435      & 0.38332D+01,0.39672D+01,0.41061D+01,0.42501D+01,0.43993D+01,

8436      & 0.45538D+01,0.47137D+01,0.48793D+01,0.50506D+01,0.52280D+01,

8437      & 0.54114D+01,0.56012D+01,0.57974D+01,0.60003D+01,0.62100D+01,

8438      & 0.64268D+01,0.66508D+01,0.68823D+01,0.71214D+01,0.73685D+01,

8439      & 0.76236D+01,0.78871D+01,0.81592D+01,0.84402D+01,0.87302D+01,

8440      & 0.90296D+01,0.93386D+01,0.96575D+01,0.99866D+01,0.10326D+02,

8441      & 0.10676D+02,0.11038D+02,0.11410D+02,0.11795D+02,0.12191D+02,

8442      & 0.12600D+02,0.13022D+02,0.13456D+02,0.13904D+02,0.14366D+02,

8443      & 0.14842D+02,0.15332D+02,0.15837D+02,0.16358D+02,0.16894D+02,

8444      & 0.17448D+02,0.18490D+02,0.19017D+02,0.18493D+02,0.16381D+02,

8445      & 0.11361D+02,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8446      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8447      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8448      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8449      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8450      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8451      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8452      & 0.21434D+01,0.22103D+01,0.22761D+01,0.23439D+01,0.24147D+01,

8453      & 0.24890D+01,0.25664D+01,0.26471D+01,0.27310D+01,0.28182D+01,

8454      & 0.29090D+01,0.30034D+01,0.31014D+01,0.32031D+01,0.33087D+01,

8455      & 0.34182D+01,0.35319D+01,0.36495D+01,0.37714D+01,0.38977D+01,

8456      & 0.40286D+01,0.41640D+01,0.43042D+01,0.44493D+01,0.45993D+01,

8457      & 0.47545D+01,0.49151D+01,0.50810D+01,0.52526D+01,0.54300D+01,

8458      & 0.56132D+01,0.58026D+01,0.59983D+01,0.62004D+01,0.64092D+01,

8459      & 0.66248D+01,0.68475D+01,0.70774D+01,0.73148D+01,0.75599D+01,

8460      & 0.78128D+01,0.80739D+01,0.83434D+01,0.86214D+01,0.89083D+01,

8461      & 0.92043D+01,0.95097D+01,0.98247D+01,0.10150D+02,0.10485D+02,

8462      & 0.10830D+02,0.11187D+02,0.11554D+02,0.11933D+02,0.12323D+02,

8463      & 0.12726D+02,0.13141D+02,0.13568D+02,0.14009D+02,0.14462D+02,

8464      & 0.14929D+02,0.15412D+02,0.16318D+02,0.16778D+02,0.16330D+02,

8465      & 0.14509D+02,0.10143D+02,0.00000D+00,0.00000D+00,0.00000D+00,

8466      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8467      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8468      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8469      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8470      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8471      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.19277D+01,

8472      & 0.19804D+01,0.20359D+01,0.20936D+01,0.21518D+01,0.22119D+01,

8473      & 0.22749D+01,0.23410D+01,0.24100D+01,0.24817D+01,0.25563D+01,

8474      & 0.26339D+01,0.27145D+01,0.27983D+01,0.28853D+01,0.29755D+01,

8475      & 0.30693D+01,0.31662D+01,0.32669D+01,0.33712D+01,0.34792D+01,

8476      & 0.35911D+01,0.37069D+01,0.38268D+01,0.39508D+01,0.40792D+01,

8477      & 0.42119D+01,0.43492D+01,0.44912D+01,0.46379D+01,0.47896D+01,

8478      & 0.49464D+01,0.51084D+01,0.52758D+01,0.54487D+01,0.56273D+01,

8479      & 0.58118D+01,0.60023D+01,0.61989D+01,0.64020D+01,0.66116D+01,

8480      & 0.68280D+01,0.70514D+01,0.72819D+01,0.75199D+01,0.77654D+01,

8481      & 0.80187D+01,0.82802D+01,0.85498D+01,0.88280D+01,0.91151D+01,

8482      & 0.94110D+01,0.97162D+01,0.10031D+02,0.10356D+02,0.10690D+02,

8483      & 0.11035D+02,0.11391D+02,0.11758D+02,0.12135D+02,0.12525D+02,

8484      & 0.12926D+02,0.13339D+02,0.13766D+02,0.14564D+02,0.14971D+02,

8485      & 0.14583D+02,0.12992D+02,0.91437D+01,0.00000D+00,0.00000D+00,

8486      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8487      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8488      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8489      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8490      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8491      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.17935D+01,

8492      & 0.18391D+01,0.18858D+01,0.19333D+01,0.19829D+01,0.20350D+01,

8493      & 0.20894D+01,0.21462D+01,0.22055D+01,0.22671D+01,0.23314D+01,

8494      & 0.23981D+01,0.24676D+01,0.25398D+01,0.26146D+01,0.26924D+01,

8495      & 0.27730D+01,0.28567D+01,0.29434D+01,0.30333D+01,0.31263D+01,

8496      & 0.32227D+01,0.33225D+01,0.34258D+01,0.35327D+01,0.36433D+01,

8497      & 0.37577D+01,0.38760D+01,0.39983D+01,0.41247D+01,0.42554D+01,

8498      & 0.43905D+01,0.45301D+01,0.46743D+01,0.48233D+01,0.49772D+01,

8499      & 0.51361D+01,0.53003D+01,0.54699D+01,0.56449D+01,0.58257D+01,

8500      & 0.60123D+01,0.62049D+01,0.64038D+01,0.66091D+01,0.68209D+01,

8501      & 0.70395D+01,0.72652D+01,0.74979D+01,0.77380D+01,0.79858D+01,

8502      & 0.82416D+01,0.85051D+01,0.87770D+01,0.90575D+01,0.93467D+01,

8503      & 0.96450D+01,0.99525D+01,0.10269D+02,0.10596D+02,0.10933D+02,

8504      & 0.11281D+02,0.11638D+02,0.12007D+02,0.12388D+02,0.13096D+02,

8505      & 0.13460D+02,0.13123D+02,0.11724D+02,0.83103D+01,0.00000D+00,

8506      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8507      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8508      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8509      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8510      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8511      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.16748D+01,

8512      & 0.17127D+01,0.17526D+01,0.17939D+01,0.18366D+01,0.18812D+01,

8513      & 0.19281D+01,0.19771D+01,0.20283D+01,0.20815D+01,0.21371D+01,

8514      & 0.21948D+01,0.22550D+01,0.23174D+01,0.23823D+01,0.24496D+01,

8515      & 0.25196D+01,0.25921D+01,0.26673D+01,0.27452D+01,0.28260D+01,

8516      & 0.29096D+01,0.29962D+01,0.30859D+01,0.31786D+01,0.32747D+01,

8517      & 0.33740D+01,0.34766D+01,0.35828D+01,0.36926D+01,0.38061D+01,

8518      & 0.39234D+01,0.40446D+01,0.41698D+01,0.42992D+01,0.44329D+01,

8519      & 0.45710D+01,0.47136D+01,0.48608D+01,0.50129D+01,0.51700D+01,

8520      & 0.53321D+01,0.54995D+01,0.56724D+01,0.58508D+01,0.60349D+01,

8521      & 0.62249D+01,0.64211D+01,0.66237D+01,0.68324D+01,0.70479D+01,

8522      & 0.72703D+01,0.74997D+01,0.77364D+01,0.79805D+01,0.82324D+01,

8523      & 0.84921D+01,0.87599D+01,0.90361D+01,0.93209D+01,0.96146D+01,

8524      & 0.99174D+01,0.10229D+02,0.10551D+02,0.10882D+02,0.11225D+02,

8525      & 0.11858D+02,0.12186D+02,0.11891D+02,0.10654D+02,0.76053D+01,

8526      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8527      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8528      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8529      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8530      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8531      & 0.00000D+00,0.00000D+00,0.00000D+00,0.15394D+01,0.15700D+01,

8532      & 0.16024D+01,0.16358D+01,0.16709D+01,0.17077D+01,0.17465D+01,

8533      & 0.17870D+01,0.18295D+01,0.18737D+01,0.19200D+01,0.19682D+01,

8534      & 0.20185D+01,0.20706D+01,0.21249D+01,0.21814D+01,0.22401D+01,

8535      & 0.23010D+01,0.23642D+01,0.24297D+01,0.24977D+01,0.25681D+01,

8536      & 0.26410D+01,0.27166D+01,0.27948D+01,0.28758D+01,0.29596D+01,

8537      & 0.30463D+01,0.31360D+01,0.32287D+01,0.33246D+01,0.34237D+01,

8538      & 0.35262D+01,0.36321D+01,0.37416D+01,0.38547D+01,0.39715D+01,

8539      & 0.40922D+01,0.42169D+01,0.43457D+01,0.44787D+01,0.46161D+01,

8540      & 0.47581D+01,0.49044D+01,0.50557D+01,0.52118D+01,0.53731D+01,

8541      & 0.55394D+01,0.57112D+01,0.58884D+01,0.60714D+01,0.62602D+01,

8542      & 0.64551D+01,0.66562D+01,0.68637D+01,0.70778D+01,0.72986D+01,

8543      & 0.75264D+01,0.77615D+01,0.80039D+01,0.82539D+01,0.85118D+01,

8544      & 0.87777D+01,0.90518D+01,0.93345D+01,0.96258D+01,0.99261D+01,

8545      & 0.10237D+02,0.10807D+02,0.11105D+02,0.10845D+02,0.97435D+01,

8546      & 0.70016D+01,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8547      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8548      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8549      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8550      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8551      & 0.00000D+00,0.00000D+00,0.00000D+00,0.14514D+01,0.14769D+01,

8552      & 0.15040D+01,0.15327D+01,0.15629D+01,0.15947D+01,0.16280D+01,

8553      & 0.16631D+01,0.16999D+01,0.17384D+01,0.17786D+01,0.18205D+01,

8554      & 0.18642D+01,0.19098D+01,0.19572D+01,0.20066D+01,0.20578D+01,

8555      & 0.21111D+01,0.21664D+01,0.22238D+01,0.22833D+01,0.23450D+01,

8556      & 0.24090D+01,0.24752D+01,0.25438D+01,0.26149D+01,0.26884D+01,

8557      & 0.27645D+01,0.28432D+01,0.29246D+01,0.30088D+01,0.30959D+01,

8558      & 0.31859D+01,0.32789D+01,0.33751D+01,0.34744D+01,0.35771D+01,

8559      & 0.36831D+01,0.37927D+01,0.39059D+01,0.40229D+01,0.41436D+01,

8560      & 0.42684D+01,0.43973D+01,0.45302D+01,0.46675D+01,0.48093D+01,

8561      & 0.49557D+01,0.51068D+01,0.52628D+01,0.54239D+01,0.55901D+01,

8562      & 0.57617D+01,0.59388D+01,0.61216D+01,0.63102D+01,0.65048D+01,

8563      & 0.67056D+01,0.69128D+01,0.71265D+01,0.73470D+01,0.75745D+01,

8564      & 0.78091D+01,0.80511D+01,0.83007D+01,0.85581D+01,0.88232D+01,

8565      & 0.90967D+01,0.93795D+01,0.98961D+01,0.10168D+02,0.99394D+01,

8566      & 0.89547D+01,0.64789D+01,0.00000D+00,0.00000D+00,0.00000D+00,

8567      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8568      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8569      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8570      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8571      & 0.00000D+00,0.00000D+00,0.00000D+00,0.13724D+01,0.13941D+01,

8572      & 0.14171D+01,0.14415D+01,0.14673D+01,0.14946D+01,0.15235D+01,

8573      & 0.15538D+01,0.15857D+01,0.16192D+01,0.16541D+01,0.16906D+01,

8574      & 0.17288D+01,0.17687D+01,0.18102D+01,0.18534D+01,0.18984D+01,

8575      & 0.19451D+01,0.19937D+01,0.20441D+01,0.20965D+01,0.21507D+01,

8576      & 0.22070D+01,0.22653D+01,0.23258D+01,0.23883D+01,0.24531D+01,

8577      & 0.25202D+01,0.25896D+01,0.26614D+01,0.27357D+01,0.28125D+01,

8578      & 0.28919D+01,0.29740D+01,0.30589D+01,0.31466D+01,0.32373D+01,

8579      & 0.33311D+01,0.34278D+01,0.35278D+01,0.36311D+01,0.37379D+01,

8580      & 0.38481D+01,0.39620D+01,0.40796D+01,0.42011D+01,0.43265D+01,

8581      & 0.44560D+01,0.45897D+01,0.47278D+01,0.48703D+01,0.50175D+01,

8582      & 0.51694D+01,0.53262D+01,0.54881D+01,0.56551D+01,0.58276D+01,

8583      & 0.60055D+01,0.61892D+01,0.63787D+01,0.65742D+01,0.67760D+01,

8584      & 0.69842D+01,0.71989D+01,0.74205D+01,0.76490D+01,0.78847D+01,

8585      & 0.81276D+01,0.83782D+01,0.86374D+01,0.91078D+01,0.93573D+01,

8586      & 0.91552D+01,0.82704D+01,0.60221D+01,0.00000D+00,0.00000D+00,

8587      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8588      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8589      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8590      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8591      & 0.00000D+00,0.00000D+00,0.00000D+00,0.13018D+01,0.13199D+01,

8592      & 0.13394D+01,0.13602D+01,0.13823D+01,0.14058D+01,0.14307D+01,

8593      & 0.14570D+01,0.14846D+01,0.15136D+01,0.15441D+01,0.15760D+01,

8594      & 0.16094D+01,0.16443D+01,0.16806D+01,0.17186D+01,0.17581D+01,

8595      & 0.17992D+01,0.18420D+01,0.18864D+01,0.19326D+01,0.19805D+01,

8596      & 0.20301D+01,0.20816D+01,0.21350D+01,0.21904D+01,0.22477D+01,

8597      & 0.23070D+01,0.23684D+01,0.24320D+01,0.24977D+01,0.25658D+01,

8598      & 0.26361D+01,0.27089D+01,0.27841D+01,0.28619D+01,0.29423D+01,

8599      & 0.30253D+01,0.31112D+01,0.31999D+01,0.32915D+01,0.33862D+01,

8600      & 0.34841D+01,0.35851D+01,0.36895D+01,0.37973D+01,0.39087D+01,

8601      & 0.40237D+01,0.41425D+01,0.42652D+01,0.43918D+01,0.45226D+01,

8602      & 0.46576D+01,0.47971D+01,0.49410D+01,0.50897D+01,0.52431D+01,

8603      & 0.54014D+01,0.55649D+01,0.57336D+01,0.59078D+01,0.60875D+01,

8604      & 0.62730D+01,0.64644D+01,0.66618D+01,0.68656D+01,0.70758D+01,

8605      & 0.72927D+01,0.75163D+01,0.77469D+01,0.79855D+01,0.84157D+01,

8606      & 0.86460D+01,0.84669D+01,0.76691D+01,0.56194D+01,0.00000D+00,

8607      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8608      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8609      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8610      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8611      & 0.00000D+00,0.00000D+00,0.00000D+00,0.12382D+01,0.12534D+01,

8612      & 0.12698D+01,0.12874D+01,0.13063D+01,0.13264D+01,0.13479D+01,

8613      & 0.13706D+01,0.13945D+01,0.14198D+01,0.14464D+01,0.14743D+01,

8614      & 0.15035D+01,0.15341D+01,0.15660D+01,0.15994D+01,0.16342D+01,

8615      & 0.16705D+01,0.17082D+01,0.17474D+01,0.17882D+01,0.18306D+01,

8616      & 0.18745D+01,0.19202D+01,0.19675D+01,0.20166D+01,0.20674D+01,

8617      & 0.21200D+01,0.21746D+01,0.22310D+01,0.22894D+01,0.23499D+01,

8618      & 0.24125D+01,0.24771D+01,0.25440D+01,0.26132D+01,0.26847D+01,

8619      & 0.27587D+01,0.28351D+01,0.29141D+01,0.29957D+01,0.30800D+01,

8620      & 0.31672D+01,0.32572D+01,0.33502D+01,0.34463D+01,0.35456D+01,

8621      & 0.36482D+01,0.37541D+01,0.38635D+01,0.39765D+01,0.40932D+01,

8622      & 0.42137D+01,0.43381D+01,0.44666D+01,0.45993D+01,0.47363D+01,

8623      & 0.48778D+01,0.50239D+01,0.51746D+01,0.53303D+01,0.54910D+01,

8624      & 0.56569D+01,0.58281D+01,0.60048D+01,0.61871D+01,0.63753D+01,

8625      & 0.65695D+01,0.67699D+01,0.69765D+01,0.71897D+01,0.74103D+01,

8626      & 0.78054D+01,0.80187D+01,0.78597D+01,0.71377D+01,0.52614D+01,

8627      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8628      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8629      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8630      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8631      & 0.00000D+00,0.00000D+00,0.00000D+00,0.11807D+01,0.11932D+01,

8632      & 0.12069D+01,0.12218D+01,0.12378D+01,0.12550D+01,0.12734D+01,

8633      & 0.12930D+01,0.13138D+01,0.13358D+01,0.13589D+01,0.13833D+01,

8634      & 0.14090D+01,0.14358D+01,0.14640D+01,0.14934D+01,0.15241D+01,

8635      & 0.15561D+01,0.15895D+01,0.16242D+01,0.16604D+01,0.16980D+01,

8636      & 0.17370D+01,0.17775D+01,0.18196D+01,0.18632D+01,0.19085D+01,

8637      & 0.19553D+01,0.20039D+01,0.20542D+01,0.21062D+01,0.21601D+01,

8638      & 0.22159D+01,0.22736D+01,0.23333D+01,0.23950D+01,0.24589D+01,

8639      & 0.25249D+01,0.25931D+01,0.26637D+01,0.27366D+01,0.28119D+01,

8640      & 0.28898D+01,0.29703D+01,0.30535D+01,0.31394D+01,0.32282D+01,

8641      & 0.33200D+01,0.34148D+01,0.35127D+01,0.36138D+01,0.37183D+01,

8642      & 0.38262D+01,0.39376D+01,0.40528D+01,0.41717D+01,0.42945D+01,

8643      & 0.44213D+01,0.45522D+01,0.46875D+01,0.48271D+01,0.49713D+01,

8644      & 0.51202D+01,0.52739D+01,0.54325D+01,0.55964D+01,0.57654D+01,

8645      & 0.59400D+01,0.61201D+01,0.63060D+01,0.64977D+01,0.66956D+01,

8646      & 0.69004D+01,0.72648D+01,0.74632D+01,0.73216D+01,0.66657D+01,

8647      & 0.49412D+01,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8648      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8649      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8650      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8651      & 0.00000D+00,0.00000D+00,0.00000D+00,0.11285D+01,0.11386D+01,

8652      & 0.11499D+01,0.11623D+01,0.11758D+01,0.11904D+01,0.12061D+01,

8653      & 0.12229D+01,0.12409D+01,0.12599D+01,0.12801D+01,0.13014D+01,

8654      & 0.13239D+01,0.13475D+01,0.13722D+01,0.13982D+01,0.14253D+01,

8655      & 0.14537D+01,0.14833D+01,0.15141D+01,0.15462D+01,0.15796D+01,

8656      & 0.16144D+01,0.16505D+01,0.16880D+01,0.17269D+01,0.17672D+01,

8657      & 0.18091D+01,0.18525D+01,0.18974D+01,0.19439D+01,0.19921D+01,

8658      & 0.20420D+01,0.20937D+01,0.21471D+01,0.22024D+01,0.22595D+01,

8659      & 0.23187D+01,0.23798D+01,0.24430D+01,0.25084D+01,0.25759D+01,

8660      & 0.26458D+01,0.27180D+01,0.27926D+01,0.28696D+01,0.29493D+01,

8661      & 0.30316D+01,0.31167D+01,0.32046D+01,0.32954D+01,0.33892D+01,

8662      & 0.34861D+01,0.35863D+01,0.36897D+01,0.37965D+01,0.39069D+01,

8663      & 0.40209D+01,0.41387D+01,0.42603D+01,0.43860D+01,0.45157D+01,

8664      & 0.46497D+01,0.47880D+01,0.49309D+01,0.50784D+01,0.52308D+01,

8665      & 0.53880D+01,0.55504D+01,0.57180D+01,0.58910D+01,0.60695D+01,

8666      & 0.62538D+01,0.64445D+01,0.67817D+01,0.69668D+01,0.68405D+01,

8667      & 0.62431D+01,0.46533D+01,0.00000D+00,0.00000D+00,0.00000D+00,

8668      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8669      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8670      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8671      & 0.00000D+00,0.00000D+00,0.00000D+00,0.10806D+01,0.10886D+01,

8672      & 0.10977D+01,0.11078D+01,0.11191D+01,0.11314D+01,0.11447D+01,

8673      & 0.11590D+01,0.11745D+01,0.11909D+01,0.12084D+01,0.12270D+01,

8674      & 0.12466D+01,0.12673D+01,0.12891D+01,0.13120D+01,0.13360D+01,

8675      & 0.13611D+01,0.13873D+01,0.14147D+01,0.14433D+01,0.14730D+01,

8676      & 0.15040D+01,0.15362D+01,0.15697D+01,0.16044D+01,0.16405D+01,

8677      & 0.16780D+01,0.17168D+01,0.17571D+01,0.17988D+01,0.18420D+01,

8678      & 0.18867D+01,0.19331D+01,0.19810D+01,0.20306D+01,0.20820D+01,

8679      & 0.21351D+01,0.21900D+01,0.22469D+01,0.23056D+01,0.23663D+01,

8680      & 0.24292D+01,0.24941D+01,0.25612D+01,0.26306D+01,0.27023D+01,

8681      & 0.27764D+01,0.28530D+01,0.29321D+01,0.30139D+01,0.30984D+01,

8682      & 0.31857D+01,0.32760D+01,0.33692D+01,0.34655D+01,0.35651D+01,

8683      & 0.36679D+01,0.37741D+01,0.38838D+01,0.39972D+01,0.41143D+01,

8684      & 0.42353D+01,0.43602D+01,0.44892D+01,0.46225D+01,0.47602D+01,

8685      & 0.49023D+01,0.50491D+01,0.52007D+01,0.53572D+01,0.55188D+01,

8686      & 0.56856D+01,0.58578D+01,0.60360D+01,0.63490D+01,0.65224D+01,

8687      & 0.64095D+01,0.58634D+01,0.43924D+01,0.00000D+00,0.00000D+00,

8688      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8689      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8690      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8691      & 0.00000D+00,0.00000D+00,0.00000D+00,0.10359D+01,0.10420D+01,

8692      & 0.10491D+01,0.10573D+01,0.10665D+01,0.10767D+01,0.10879D+01,

8693      & 0.11001D+01,0.11133D+01,0.11274D+01,0.11425D+01,0.11587D+01,

8694      & 0.11758D+01,0.11939D+01,0.12130D+01,0.12331D+01,0.12543D+01,

8695      & 0.12765D+01,0.12997D+01,0.13240D+01,0.13494D+01,0.13759D+01,

8696      & 0.14036D+01,0.14323D+01,0.14622D+01,0.14933D+01,0.15256D+01,

8697      & 0.15592D+01,0.15940D+01,0.16301D+01,0.16676D+01,0.17064D+01,

8698      & 0.17466D+01,0.17882D+01,0.18314D+01,0.18760D+01,0.19222D+01,

8699      & 0.19700D+01,0.20195D+01,0.20707D+01,0.21236D+01,0.21783D+01,

8700      & 0.22349D+01,0.22935D+01,0.23540D+01,0.24165D+01,0.24812D+01,

8701      & 0.25481D+01,0.26172D+01,0.26886D+01,0.27624D+01,0.28387D+01,

8702      & 0.29176D+01,0.29991D+01,0.30833D+01,0.31704D+01,0.32603D+01,

8703      & 0.33533D+01,0.34493D+01,0.35485D+01,0.36511D+01,0.37570D+01,

8704      & 0.38665D+01,0.39796D+01,0.40964D+01,0.42171D+01,0.43418D+01,

8705      & 0.44706D+01,0.46037D+01,0.47411D+01,0.48830D+01,0.50296D+01,

8706      & 0.51809D+01,0.53371D+01,0.54985D+01,0.56655D+01,0.59570D+01,

8707      & 0.61198D+01,0.60188D+01,0.55184D+01,0.41533D+01,0.00000D+00,

8708      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8709      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8710      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8711      & 0.00000D+00,0.00000D+00,0.00000D+00,0.99295D+00,0.99731D+00,

8712      & 0.10027D+01,0.10091D+01,0.10164D+01,0.10247D+01,0.10341D+01,

8713      & 0.10442D+01,0.10554D+01,0.10675D+01,0.10805D+01,0.10945D+01,

8714      & 0.11093D+01,0.11251D+01,0.11420D+01,0.11596D+01,0.11782D+01,

8715      & 0.11978D+01,0.12184D+01,0.12399D+01,0.12624D+01,0.12861D+01,

8716      & 0.13108D+01,0.13363D+01,0.13630D+01,0.13908D+01,0.14198D+01,

8717      & 0.14499D+01,0.14811D+01,0.15135D+01,0.15470D+01,0.15819D+01,

8718      & 0.16180D+01,0.16556D+01,0.16945D+01,0.17347D+01,0.17763D+01,

8719      & 0.18194D+01,0.18639D+01,0.19100D+01,0.19577D+01,0.20071D+01,

8720      & 0.20582D+01,0.21111D+01,0.21658D+01,0.22224D+01,0.22809D+01,

8721      & 0.23413D+01,0.24038D+01,0.24684D+01,0.25352D+01,0.26042D+01,

8722      & 0.26755D+01,0.27493D+01,0.28255D+01,0.29042D+01,0.29857D+01,

8723      & 0.30698D+01,0.31568D+01,0.32467D+01,0.33396D+01,0.34357D+01,

8724      & 0.35349D+01,0.36374D+01,0.37434D+01,0.38529D+01,0.39661D+01,

8725      & 0.40830D+01,0.42038D+01,0.43286D+01,0.44575D+01,0.45907D+01,

8726      & 0.47283D+01,0.48705D+01,0.50172D+01,0.51688D+01,0.53257D+01,

8727      & 0.55979D+01,0.57512D+01,0.56605D+01,0.52004D+01,0.39294D+01,

8728      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8729      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8730      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8731      & 0.00000D+00,0.00000D+00,0.00000D+00,0.94744D+00,0.95009D+00,

8732      & 0.95402D+00,0.95843D+00,0.96446D+00,0.97068D+00,0.97857D+00,

8733      & 0.98667D+00,0.99620D+00,0.10065D+01,0.10173D+01,0.10298D+01,

8734      & 0.10421D+01,0.10560D+01,0.10710D+01,0.10859D+01,0.11024D+01,

8735      & 0.11202D+01,0.11379D+01,0.11568D+01,0.11772D+01,0.11985D+01,

8736      & 0.12200D+01,0.12426D+01,0.12667D+01,0.12919D+01,0.13180D+01,

8737      & 0.13445D+01,0.13722D+01,0.14014D+01,0.14318D+01,0.14635D+01,

8738      & 0.14962D+01,0.15298D+01,0.15644D+01,0.16005D+01,0.16379D+01,

8739      & 0.16769D+01,0.17173D+01,0.17592D+01,0.18025D+01,0.18472D+01,

8740      & 0.18935D+01,0.19412D+01,0.19905D+01,0.20413D+01,0.20941D+01,

8741      & 0.21487D+01,0.22052D+01,0.22637D+01,0.23242D+01,0.23869D+01,

8742      & 0.24516D+01,0.25186D+01,0.25878D+01,0.26594D+01,0.27334D+01,

8743      & 0.28099D+01,0.28890D+01,0.29707D+01,0.30552D+01,0.31425D+01,

8744      & 0.32328D+01,0.33261D+01,0.34225D+01,0.35221D+01,0.36251D+01,

8745      & 0.37315D+01,0.38415D+01,0.39551D+01,0.40725D+01,0.41939D+01,

8746      & 0.43192D+01,0.44487D+01,0.45826D+01,0.47207D+01,0.48635D+01,

8747      & 0.50113D+01,0.52664D+01,0.54110D+01,0.53292D+01,0.49043D+01,

8748      & 0.37162D+01,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8749      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8750      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8751      & 0.00000D+00,0.00000D+00,0.00000D+00,0.89934D+00,0.90054D+00,

8752      & 0.90276D+00,0.90596D+00,0.91010D+00,0.91517D+00,0.92114D+00,

8753      & 0.92800D+00,0.93572D+00,0.94431D+00,0.95372D+00,0.96399D+00,

8754      & 0.97510D+00,0.98703D+00,0.99985D+00,0.10134D+01,0.10279D+01,

8755      & 0.10432D+01,0.10593D+01,0.10763D+01,0.10942D+01,0.11129D+01,

8756      & 0.11325D+01,0.11530D+01,0.11745D+01,0.11969D+01,0.12202D+01,

8757      & 0.12445D+01,0.12697D+01,0.12961D+01,0.13234D+01,0.13518D+01,

8758      & 0.13812D+01,0.14117D+01,0.14434D+01,0.14762D+01,0.15103D+01,

8759      & 0.15456D+01,0.15822D+01,0.16200D+01,0.16592D+01,0.16997D+01,

8760      & 0.17417D+01,0.17851D+01,0.18300D+01,0.18765D+01,0.19247D+01,

8761      & 0.19744D+01,0.20259D+01,0.20792D+01,0.21343D+01,0.21913D+01,

8762      & 0.22502D+01,0.23112D+01,0.23741D+01,0.24393D+01,0.25066D+01,

8763      & 0.25763D+01,0.26483D+01,0.27228D+01,0.27998D+01,0.28794D+01,

8764      & 0.29617D+01,0.30469D+01,0.31349D+01,0.32258D+01,0.33199D+01,

8765      & 0.34171D+01,0.35176D+01,0.36216D+01,0.37290D+01,0.38400D+01,

8766      & 0.39547D+01,0.40733D+01,0.41958D+01,0.43225D+01,0.44533D+01,

8767      & 0.45885D+01,0.47285D+01,0.49686D+01,0.51059D+01,0.50319D+01,

8768      & 0.46380D+01,0.35229D+01,0.00000D+00,0.00000D+00,0.00000D+00,

8769      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8770      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8771      & 0.00000D+00,0.00000D+00,0.00000D+00,0.85773D+00,0.85748D+00,

8772      & 0.85826D+00,0.86004D+00,0.86276D+00,0.86640D+00,0.87094D+00,

8773      & 0.87634D+00,0.88258D+00,0.88967D+00,0.89758D+00,0.90629D+00,

8774      & 0.91582D+00,0.92614D+00,0.93726D+00,0.94918D+00,0.96189D+00,

8775      & 0.97540D+00,0.98971D+00,0.10048D+01,0.10208D+01,0.10375D+01,

8776      & 0.10551D+01,0.10735D+01,0.10928D+01,0.11130D+01,0.11340D+01,

8777      & 0.11560D+01,0.11788D+01,0.12026D+01,0.12273D+01,0.12531D+01,

8778      & 0.12798D+01,0.13075D+01,0.13363D+01,0.13662D+01,0.13971D+01,

8779      & 0.14292D+01,0.14625D+01,0.14970D+01,0.15326D+01,0.15696D+01,

8780      & 0.16079D+01,0.16475D+01,0.16885D+01,0.17309D+01,0.17749D+01,

8781      & 0.18203D+01,0.18673D+01,0.19160D+01,0.19663D+01,0.20184D+01,

8782      & 0.20722D+01,0.21279D+01,0.21855D+01,0.22451D+01,0.23068D+01,

8783      & 0.23705D+01,0.24364D+01,0.25046D+01,0.25751D+01,0.26480D+01,

8784      & 0.27234D+01,0.28014D+01,0.28821D+01,0.29654D+01,0.30517D+01,

8785      & 0.31408D+01,0.32330D+01,0.33283D+01,0.34268D+01,0.35287D+01,

8786      & 0.36340D+01,0.37429D+01,0.38555D+01,0.39718D+01,0.40921D+01,

8787      & 0.42163D+01,0.43447D+01,0.44778D+01,0.47047D+01,0.48353D+01,

8788      & 0.47682D+01,0.44015D+01,0.33511D+01,0.00000D+00,0.00000D+00,

8789      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8790      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8791      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.82026D+00,

8792      & 0.81966D+00,0.82007D+00,0.82144D+00,0.82374D+00,0.82692D+00,

8793      & 0.83097D+00,0.83586D+00,0.84157D+00,0.84808D+00,0.85539D+00,

8794      & 0.86347D+00,0.87233D+00,0.88195D+00,0.89234D+00,0.90349D+00,

8795      & 0.91540D+00,0.92807D+00,0.94151D+00,0.95572D+00,0.97070D+00,

8796      & 0.98647D+00,0.10030D+01,0.10204D+01,0.10386D+01,0.10576D+01,

8797      & 0.10774D+01,0.10981D+01,0.11197D+01,0.11422D+01,0.11655D+01,

8798      & 0.11898D+01,0.12150D+01,0.12413D+01,0.12685D+01,0.12967D+01,

8799      & 0.13260D+01,0.13563D+01,0.13878D+01,0.14204D+01,0.14541D+01,

8800      & 0.14891D+01,0.15253D+01,0.15628D+01,0.16016D+01,0.16418D+01,

8801      & 0.16834D+01,0.17265D+01,0.17710D+01,0.18171D+01,0.18648D+01,

8802      & 0.19141D+01,0.19651D+01,0.20180D+01,0.20726D+01,0.21291D+01,

8803      & 0.21876D+01,0.22480D+01,0.23106D+01,0.23753D+01,0.24422D+01,

8804      & 0.25114D+01,0.25830D+01,0.26571D+01,0.27337D+01,0.28129D+01,

8805      & 0.28948D+01,0.29796D+01,0.30672D+01,0.31578D+01,0.32515D+01,

8806      & 0.33485D+01,0.34487D+01,0.35523D+01,0.36594D+01,0.37702D+01,

8807      & 0.38847D+01,0.40030D+01,0.41254D+01,0.42521D+01,0.44672D+01,

8808      & 0.45919D+01,0.45309D+01,0.41886D+01,0.31964D+01,0.00000D+00,

8809      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8810      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8811      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.78828D+00,

8812      & 0.78632D+00,0.78540D+00,0.78547D+00,0.78647D+00,0.78838D+00,

8813      & 0.79116D+00,0.79477D+00,0.79920D+00,0.80442D+00,0.81042D+00,

8814      & 0.81718D+00,0.82469D+00,0.83295D+00,0.84195D+00,0.85167D+00,

8815      & 0.86213D+00,0.87332D+00,0.88524D+00,0.89790D+00,0.91129D+00,

8816      & 0.92542D+00,0.94030D+00,0.95594D+00,0.97234D+00,0.98952D+00,

8817      & 0.10075D+01,0.10263D+01,0.10459D+01,0.10663D+01,0.10875D+01,

8818      & 0.11096D+01,0.11327D+01,0.11566D+01,0.11814D+01,0.12072D+01,

8819      & 0.12339D+01,0.12617D+01,0.12905D+01,0.13203D+01,0.13512D+01,

8820      & 0.13833D+01,0.14165D+01,0.14508D+01,0.14864D+01,0.15233D+01,

8821      & 0.15614D+01,0.16009D+01,0.16418D+01,0.16841D+01,0.17279D+01,

8822      & 0.17732D+01,0.18201D+01,0.18686D+01,0.19188D+01,0.19708D+01,

8823      & 0.20245D+01,0.20801D+01,0.21376D+01,0.21971D+01,0.22587D+01,

8824      & 0.23224D+01,0.23883D+01,0.24565D+01,0.25270D+01,0.26000D+01,

8825      & 0.26754D+01,0.27535D+01,0.28343D+01,0.29178D+01,0.30042D+01,

8826      & 0.30936D+01,0.31860D+01,0.32816D+01,0.33805D+01,0.34827D+01,

8827      & 0.35884D+01,0.36977D+01,0.38107D+01,0.39276D+01,0.40487D+01,

8828      & 0.42530D+01,0.43723D+01,0.43168D+01,0.39965D+01,0.30568D+01,

8829      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8830      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8831      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.76109D+00,

8832      & 0.75776D+00,0.75552D+00,0.75430D+00,0.75405D+00,0.75473D+00,

8833      & 0.75628D+00,0.75868D+00,0.76190D+00,0.76591D+00,0.77069D+00,

8834      & 0.77622D+00,0.78249D+00,0.78949D+00,0.79720D+00,0.80563D+00,

8835      & 0.81476D+00,0.82460D+00,0.83514D+00,0.84638D+00,0.85832D+00,

8836      & 0.87098D+00,0.88434D+00,0.89842D+00,0.91322D+00,0.92876D+00,

8837      & 0.94504D+00,0.96207D+00,0.97987D+00,0.99845D+00,0.10178D+01,

8838      & 0.10380D+01,0.10590D+01,0.10809D+01,0.11036D+01,0.11272D+01,

8839      & 0.11517D+01,0.11771D+01,0.12035D+01,0.12308D+01,0.12592D+01,

8840      & 0.12886D+01,0.13191D+01,0.13507D+01,0.13834D+01,0.14172D+01,

8841      & 0.14523D+01,0.14886D+01,0.15262D+01,0.15652D+01,0.16055D+01,

8842      & 0.16472D+01,0.16903D+01,0.17350D+01,0.17812D+01,0.18291D+01,

8843      & 0.18786D+01,0.19298D+01,0.19828D+01,0.20377D+01,0.20945D+01,

8844      & 0.21532D+01,0.22140D+01,0.22769D+01,0.23420D+01,0.24093D+01,

8845      & 0.24790D+01,0.25511D+01,0.26256D+01,0.27028D+01,0.27826D+01,

8846      & 0.28652D+01,0.29506D+01,0.30390D+01,0.31305D+01,0.32250D+01,

8847      & 0.33228D+01,0.34240D+01,0.35286D+01,0.36368D+01,0.37487D+01,

8848      & 0.38647D+01,0.40593D+01,0.41737D+01,0.41232D+01,0.38227D+01,

8849      & 0.29304D+01,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8850      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8851      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.73837D+00,

8852      & 0.73362D+00,0.73003D+00,0.72752D+00,0.72603D+00,0.72549D+00,

8853      & 0.72585D+00,0.72708D+00,0.72913D+00,0.73199D+00,0.73561D+00,

8854      & 0.73999D+00,0.74510D+00,0.75092D+00,0.75745D+00,0.76468D+00,

8855      & 0.77259D+00,0.78118D+00,0.79045D+00,0.80040D+00,0.81103D+00,

8856      & 0.82233D+00,0.83431D+00,0.84698D+00,0.86033D+00,0.87438D+00,

8857      & 0.88913D+00,0.90460D+00,0.92079D+00,0.93771D+00,0.95537D+00,

8858      & 0.97380D+00,0.99300D+00,0.10130D+01,0.10338D+01,0.10554D+01,

8859      & 0.10779D+01,0.11012D+01,0.11255D+01,0.11506D+01,0.11767D+01,

8860      & 0.12037D+01,0.12318D+01,0.12608D+01,0.12909D+01,0.13221D+01,

8861      & 0.13544D+01,0.13879D+01,0.14226D+01,0.14584D+01,0.14956D+01,

8862      & 0.15341D+01,0.15739D+01,0.16151D+01,0.16578D+01,0.17019D+01,

8863      & 0.17476D+01,0.17949D+01,0.18439D+01,0.18946D+01,0.19470D+01,

8864      & 0.20013D+01,0.20575D+01,0.21156D+01,0.21758D+01,0.22380D+01,

8865      & 0.23025D+01,0.23691D+01,0.24381D+01,0.25096D+01,0.25834D+01,

8866      & 0.26599D+01,0.27390D+01,0.28209D+01,0.29056D+01,0.29932D+01,

8867      & 0.30838D+01,0.31776D+01,0.32746D+01,0.33750D+01,0.34788D+01,

8868      & 0.35861D+01,0.36975D+01,0.38833D+01,0.39933D+01,0.39472D+01,

8869      & 0.36648D+01,0.28156D+01,0.00000D+00,0.00000D+00,0.00000D+00,

8870      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8871      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8872      & 0.71364D+00,0.70864D+00,0.70481D+00,0.70204D+00,0.70028D+00,

8873      & 0.69946D+00,0.69954D+00,0.70046D+00,0.70220D+00,0.70472D+00,

8874      & 0.70799D+00,0.71200D+00,0.71672D+00,0.72214D+00,0.72824D+00,

8875      & 0.73501D+00,0.74246D+00,0.75056D+00,0.75932D+00,0.76873D+00,

8876      & 0.77880D+00,0.78951D+00,0.80089D+00,0.81292D+00,0.82561D+00,

8877      & 0.83898D+00,0.85302D+00,0.86774D+00,0.88316D+00,0.89929D+00,

8878      & 0.91612D+00,0.93369D+00,0.95201D+00,0.97108D+00,0.99092D+00,

8879      & 0.10116D+01,0.10330D+01,0.10553D+01,0.10784D+01,0.11024D+01,

8880      & 0.11274D+01,0.11532D+01,0.11800D+01,0.12077D+01,0.12365D+01,

8881      & 0.12664D+01,0.12973D+01,0.13292D+01,0.13624D+01,0.13967D+01,

8882      & 0.14323D+01,0.14691D+01,0.15072D+01,0.15466D+01,0.15875D+01,

8883      & 0.16297D+01,0.16735D+01,0.17188D+01,0.17657D+01,0.18143D+01,

8884      & 0.18645D+01,0.19165D+01,0.19704D+01,0.20261D+01,0.20838D+01,

8885      & 0.21435D+01,0.22053D+01,0.22692D+01,0.23354D+01,0.24039D+01,

8886      & 0.24748D+01,0.25482D+01,0.26242D+01,0.27028D+01,0.27841D+01,

8887      & 0.28683D+01,0.29554D+01,0.30455D+01,0.31388D+01,0.32353D+01,

8888      & 0.33350D+01,0.34383D+01,0.35454D+01,0.37232D+01,0.38291D+01,

8889      & 0.37872D+01,0.35210D+01,0.27110D+01,0.00000D+00,0.00000D+00,

8890      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8891      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8892      & 0.69766D+00,0.69116D+00,0.68593D+00,0.68185D+00,0.67883D+00,

8893      & 0.67682D+00,0.67574D+00,0.67554D+00,0.67618D+00,0.67762D+00,

8894      & 0.67983D+00,0.68278D+00,0.68644D+00,0.69080D+00,0.69585D+00,

8895      & 0.70156D+00,0.70792D+00,0.71494D+00,0.72259D+00,0.73088D+00,

8896      & 0.73980D+00,0.74936D+00,0.75954D+00,0.77036D+00,0.78181D+00,

8897      & 0.79391D+00,0.80665D+00,0.82004D+00,0.83409D+00,0.84881D+00,

8898      & 0.86420D+00,0.88029D+00,0.89708D+00,0.91458D+00,0.93281D+00,

8899      & 0.95179D+00,0.97153D+00,0.99205D+00,0.10134D+01,0.10355D+01,

8900      & 0.10585D+01,0.10824D+01,0.11071D+01,0.11327D+01,0.11593D+01,

8901      & 0.11869D+01,0.12155D+01,0.12451D+01,0.12757D+01,0.13075D+01,

8902      & 0.13404D+01,0.13745D+01,0.14098D+01,0.14463D+01,0.14841D+01,

8903      & 0.15233D+01,0.15639D+01,0.16059D+01,0.16493D+01,0.16944D+01,

8904      & 0.17409D+01,0.17892D+01,0.18391D+01,0.18908D+01,0.19444D+01,

8905      & 0.19998D+01,0.20571D+01,0.21165D+01,0.21780D+01,0.22416D+01,

8906      & 0.23075D+01,0.23757D+01,0.24463D+01,0.25193D+01,0.25950D+01,

8907      & 0.26732D+01,0.27543D+01,0.28381D+01,0.29249D+01,0.30147D+01,

8908      & 0.31076D+01,0.32037D+01,0.33032D+01,0.34064D+01,0.35769D+01,

8909      & 0.36792D+01,0.36409D+01,0.33897D+01,0.26156D+01,0.00000D+00,

8910      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8911      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8912      & 0.68562D+00,0.67749D+00,0.67075D+00,0.66526D+00,0.66094D+00,

8913      & 0.65768D+00,0.65542D+00,0.65409D+00,0.65363D+00,0.65400D+00,

8914      & 0.65516D+00,0.65708D+00,0.65972D+00,0.66307D+00,0.66710D+00,

8915      & 0.67180D+00,0.67715D+00,0.68314D+00,0.68976D+00,0.69700D+00,

8916      & 0.70486D+00,0.71333D+00,0.72242D+00,0.73212D+00,0.74243D+00,

8917      & 0.75336D+00,0.76490D+00,0.77707D+00,0.78987D+00,0.80330D+00,

8918      & 0.81738D+00,0.83211D+00,0.84751D+00,0.86358D+00,0.88035D+00,

8919      & 0.89781D+00,0.91600D+00,0.93492D+00,0.95459D+00,0.97503D+00,

8920      & 0.99626D+00,0.10183D+01,0.10412D+01,0.10649D+01,0.10895D+01,

8921      & 0.11150D+01,0.11415D+01,0.11689D+01,0.11974D+01,0.12268D+01,

8922      & 0.12573D+01,0.12889D+01,0.13216D+01,0.13555D+01,0.13907D+01,

8923      & 0.14270D+01,0.14647D+01,0.15036D+01,0.15440D+01,0.15858D+01,

8924      & 0.16291D+01,0.16739D+01,0.17203D+01,0.17684D+01,0.18181D+01,

8925      & 0.18696D+01,0.19230D+01,0.19782D+01,0.20354D+01,0.20946D+01,

8926      & 0.21559D+01,0.22193D+01,0.22850D+01,0.23530D+01,0.24234D+01,

8927      & 0.24964D+01,0.25718D+01,0.26499D+01,0.27308D+01,0.28145D+01,

8928      & 0.29011D+01,0.29908D+01,0.30836D+01,0.31796D+01,0.32792D+01,

8929      & 0.34430D+01,0.35419D+01,0.35071D+01,0.32695D+01,0.25283D+01,

8930      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8931      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8932      & 0.67757D+00,0.66763D+00,0.65922D+00,0.65222D+00,0.64648D+00,

8933      & 0.64191D+00,0.63841D+00,0.63590D+00,0.63432D+00,0.63362D+00,

8934      & 0.63373D+00,0.63463D+00,0.63627D+00,0.63863D+00,0.64169D+00,

8935      & 0.64541D+00,0.64979D+00,0.65480D+00,0.66044D+00,0.66669D+00,

8936      & 0.67356D+00,0.68102D+00,0.68908D+00,0.69774D+00,0.70699D+00,

8937      & 0.71684D+00,0.72728D+00,0.73832D+00,0.74996D+00,0.76222D+00,

8938      & 0.77509D+00,0.78858D+00,0.80270D+00,0.81747D+00,0.83289D+00,

8939      & 0.84898D+00,0.86574D+00,0.88320D+00,0.90137D+00,0.92026D+00,

8940      & 0.93990D+00,0.96030D+00,0.98148D+00,0.10035D+01,0.10263D+01,

8941      & 0.10500D+01,0.10745D+01,0.10999D+01,0.11263D+01,0.11536D+01,

8942      & 0.11820D+01,0.12113D+01,0.12417D+01,0.12732D+01,0.13059D+01,

8943      & 0.13397D+01,0.13747D+01,0.14109D+01,0.14484D+01,0.14873D+01,

8944      & 0.15276D+01,0.15693D+01,0.16125D+01,0.16572D+01,0.17035D+01,

8945      & 0.17515D+01,0.18011D+01,0.18526D+01,0.19058D+01,0.19610D+01,

8946      & 0.20181D+01,0.20772D+01,0.21385D+01,0.22019D+01,0.22675D+01,

8947      & 0.23355D+01,0.24059D+01,0.24788D+01,0.25543D+01,0.26324D+01,

8948      & 0.27133D+01,0.27970D+01,0.28837D+01,0.29734D+01,0.30663D+01,

8949      & 0.31626D+01,0.33202D+01,0.34160D+01,0.33843D+01,0.31593D+01,

8950      & 0.24483D+01,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8951      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8952      & 0.00000D+00,0.66165D+00,0.65140D+00,0.64271D+00,0.63542D+00,

8953      & 0.62942D+00,0.62460D+00,0.62085D+00,0.61810D+00,0.61629D+00,

8954      & 0.61533D+00,0.61520D+00,0.61585D+00,0.61723D+00,0.61932D+00,

8955      & 0.62210D+00,0.62553D+00,0.62961D+00,0.63432D+00,0.63963D+00,

8956      & 0.64555D+00,0.65206D+00,0.65916D+00,0.66684D+00,0.67510D+00,

8957      & 0.68394D+00,0.69336D+00,0.70335D+00,0.71393D+00,0.72509D+00,

8958      & 0.73685D+00,0.74920D+00,0.76215D+00,0.77572D+00,0.78991D+00,

8959      & 0.80473D+00,0.82020D+00,0.83632D+00,0.85311D+00,0.87059D+00,

8960      & 0.88876D+00,0.90766D+00,0.92730D+00,0.94769D+00,0.96886D+00,

8961      & 0.99083D+00,0.10136D+01,0.10373D+01,0.10618D+01,0.10872D+01,

8962      & 0.11135D+01,0.11408D+01,0.11691D+01,0.11984D+01,0.12288D+01,

8963      & 0.12602D+01,0.12928D+01,0.13266D+01,0.13616D+01,0.13978D+01,

8964      & 0.14353D+01,0.14742D+01,0.15144D+01,0.15561D+01,0.15993D+01,

8965      & 0.16440D+01,0.16903D+01,0.17382D+01,0.17879D+01,0.18394D+01,

8966      & 0.18927D+01,0.19478D+01,0.20050D+01,0.20642D+01,0.21255D+01,

8967      & 0.21890D+01,0.22547D+01,0.23228D+01,0.23933D+01,0.24664D+01,

8968      & 0.25420D+01,0.26202D+01,0.27013D+01,0.27852D+01,0.28721D+01,

8969      & 0.29620D+01,0.30554D+01,0.32073D+01,0.33002D+01,0.32714D+01,

8970      & 0.30581D+01,0.23748D+01,0.00000D+00,0.00000D+00,0.00000D+00,

8971      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8972      & 0.00000D+00,0.65973D+00,0.64740D+00,0.63681D+00,0.62781D+00,

8973      & 0.62023D+00,0.61396D+00,0.60887D+00,0.60488D+00,0.60189D+00,

8974      & 0.59983D+00,0.59864D+00,0.59827D+00,0.59867D+00,0.59980D+00,

8975      & 0.60164D+00,0.60416D+00,0.60732D+00,0.61112D+00,0.61553D+00,

8976      & 0.62054D+00,0.62615D+00,0.63233D+00,0.63909D+00,0.64642D+00,

8977      & 0.65432D+00,0.66277D+00,0.67180D+00,0.68138D+00,0.69153D+00,

8978      & 0.70225D+00,0.71355D+00,0.72542D+00,0.73788D+00,0.75093D+00,

8979      & 0.76459D+00,0.77886D+00,0.79375D+00,0.80928D+00,0.82546D+00,

8980      & 0.84230D+00,0.85982D+00,0.87804D+00,0.89697D+00,0.91664D+00,

8981      & 0.93706D+00,0.95825D+00,0.98023D+00,0.10030D+01,0.10267D+01,

8982      & 0.10512D+01,0.10767D+01,0.11030D+01,0.11303D+01,0.11586D+01,

8983      & 0.11879D+01,0.12183D+01,0.12498D+01,0.12824D+01,0.13162D+01,

8984      & 0.13512D+01,0.13875D+01,0.14250D+01,0.14639D+01,0.15042D+01,

8985      & 0.15460D+01,0.15892D+01,0.16340D+01,0.16804D+01,0.17285D+01,

8986      & 0.17782D+01,0.18298D+01,0.18832D+01,0.19386D+01,0.19959D+01,

8987      & 0.20552D+01,0.21167D+01,0.21804D+01,0.22464D+01,0.23147D+01,

8988      & 0.23854D+01,0.24587D+01,0.25346D+01,0.26132D+01,0.26946D+01,

8989      & 0.27789D+01,0.28661D+01,0.29567D+01,0.31033D+01,0.31936D+01,

8990      & 0.31675D+01,0.29649D+01,0.23073D+01,0.00000D+00,0.00000D+00,

8991      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

8992      & 0.00000D+00,0.66215D+00,0.64744D+00,0.63471D+00,0.62376D+00,

8993      & 0.61443D+00,0.60654D+00,0.59998D+00,0.59463D+00,0.59038D+00,

8994      & 0.58714D+00,0.58484D+00,0.58341D+00,0.58281D+00,0.58297D+00,

8995      & 0.58386D+00,0.58546D+00,0.58772D+00,0.59063D+00,0.59416D+00,

8996      & 0.59829D+00,0.60303D+00,0.60834D+00,0.61422D+00,0.62066D+00,

8997      & 0.62767D+00,0.63522D+00,0.64333D+00,0.65198D+00,0.66119D+00,

8998      & 0.67094D+00,0.68125D+00,0.69212D+00,0.70356D+00,0.71556D+00,

8999      & 0.72814D+00,0.74130D+00,0.75506D+00,0.76943D+00,0.78441D+00,

9000      & 0.80003D+00,0.81629D+00,0.83320D+00,0.85079D+00,0.86908D+00,

9001      & 0.88807D+00,0.90780D+00,0.92827D+00,0.94952D+00,0.97156D+00,

9002      & 0.99443D+00,0.10181D+01,0.10427D+01,0.10682D+01,0.10946D+01,

9003      & 0.11220D+01,0.11503D+01,0.11797D+01,0.12102D+01,0.12418D+01,

9004      & 0.12744D+01,0.13083D+01,0.13434D+01,0.13798D+01,0.14174D+01,

9005      & 0.14565D+01,0.14969D+01,0.15388D+01,0.15821D+01,0.16271D+01,

9006      & 0.16737D+01,0.17219D+01,0.17719D+01,0.18237D+01,0.18773D+01,

9007      & 0.19329D+01,0.19904D+01,0.20501D+01,0.21119D+01,0.21758D+01,

9008      & 0.22421D+01,0.23108D+01,0.23819D+01,0.24556D+01,0.25319D+01,

9009      & 0.26110D+01,0.26928D+01,0.27775D+01,0.28655D+01,0.30073D+01,

9010      & 0.30951D+01,0.30715D+01,0.28789D+01,0.22451D+01,0.00000D+00,

9011      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

9012      & 0.00000D+00,0.00000D+00,0.00000D+00,0.63665D+00,0.62349D+00,

9013      & 0.61216D+00,0.60247D+00,0.59426D+00,0.58739D+00,0.58176D+00,

9014      & 0.57724D+00,0.57375D+00,0.57121D+00,0.56954D+00,0.56870D+00,

9015      & 0.56863D+00,0.56929D+00,0.57065D+00,0.57267D+00,0.57533D+00,

9016      & 0.57861D+00,0.58249D+00,0.58695D+00,0.59199D+00,0.59759D+00,

9017      & 0.60374D+00,0.61043D+00,0.61767D+00,0.62545D+00,0.63377D+00,

9018      & 0.64262D+00,0.65201D+00,0.66194D+00,0.67242D+00,0.68344D+00,

9019      & 0.69502D+00,0.70717D+00,0.71988D+00,0.73317D+00,0.74705D+00,

9020      & 0.76152D+00,0.77662D+00,0.79234D+00,0.80869D+00,0.82571D+00,

9021      & 0.84339D+00,0.86177D+00,0.88085D+00,0.90067D+00,0.92123D+00,

9022      & 0.94257D+00,0.96470D+00,0.98765D+00,0.10115D+01,0.10361D+01,

9023      & 0.10617D+01,0.10882D+01,0.11157D+01,0.11442D+01,0.11737D+01,

9024      & 0.12043D+01,0.12359D+01,0.12688D+01,0.13028D+01,0.13381D+01,

9025      & 0.13746D+01,0.14124D+01,0.14516D+01,0.14922D+01,0.15343D+01,

9026      & 0.15779D+01,0.16231D+01,0.16699D+01,0.17184D+01,0.17687D+01,

9027      & 0.18208D+01,0.18747D+01,0.19306D+01,0.19886D+01,0.20486D+01,

9028      & 0.21107D+01,0.21752D+01,0.22419D+01,0.23110D+01,0.23827D+01,

9029      & 0.24569D+01,0.25337D+01,0.26133D+01,0.26957D+01,0.27813D+01,

9030      & 0.29185D+01,0.30041D+01,0.29829D+01,0.27996D+01,0.21877D+01,

9031      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

9032      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.62731D+00,

9033      & 0.61369D+00,0.60193D+00,0.59186D+00,0.58330D+00,0.57611D+00,

9034      & 0.57018D+00,0.56538D+00,0.56163D+00,0.55884D+00,0.55693D+00,

9035      & 0.55585D+00,0.55555D+00,0.55598D+00,0.55711D+00,0.55890D+00,

9036      & 0.56133D+00,0.56437D+00,0.56800D+00,0.57221D+00,0.57699D+00,

9037      & 0.58232D+00,0.58819D+00,0.59460D+00,0.60154D+00,0.60902D+00,

9038      & 0.61702D+00,0.62554D+00,0.63459D+00,0.64417D+00,0.65428D+00,

9039      & 0.66493D+00,0.67612D+00,0.68786D+00,0.70015D+00,0.71300D+00,

9040      & 0.72643D+00,0.74045D+00,0.75506D+00,0.77027D+00,0.78611D+00,

9041      & 0.80259D+00,0.81973D+00,0.83753D+00,0.85602D+00,0.87523D+00,

9042      & 0.89516D+00,0.91584D+00,0.93730D+00,0.95955D+00,0.98263D+00,

9043      & 0.10066D+01,0.10314D+01,0.10571D+01,0.10837D+01,0.11114D+01,

9044      & 0.11400D+01,0.11697D+01,0.12004D+01,0.12323D+01,0.12653D+01,

9045      & 0.12995D+01,0.13350D+01,0.13717D+01,0.14098D+01,0.14493D+01,

9046      & 0.14901D+01,0.15325D+01,0.15764D+01,0.16219D+01,0.16691D+01,

9047      & 0.17179D+01,0.17685D+01,0.18210D+01,0.18754D+01,0.19317D+01,

9048      & 0.19901D+01,0.20506D+01,0.21132D+01,0.21782D+01,0.22455D+01,

9049      & 0.23152D+01,0.23874D+01,0.24622D+01,0.25397D+01,0.26200D+01,

9050      & 0.27034D+01,0.28364D+01,0.29199D+01,0.29009D+01,0.27263D+01,

9051      & 0.21348D+01,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

9052      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

9053      & 0.00000D+00,0.60523D+00,0.59302D+00,0.58253D+00,0.57359D+00,

9054      & 0.56607D+00,0.55981D+00,0.55473D+00,0.55070D+00,0.54765D+00,

9055      & 0.54550D+00,0.54419D+00,0.54366D+00,0.54386D+00,0.54476D+00,

9056      & 0.54632D+00,0.54852D+00,0.55133D+00,0.55473D+00,0.55870D+00,

9057      & 0.56323D+00,0.56830D+00,0.57392D+00,0.58006D+00,0.58673D+00,

9058      & 0.59391D+00,0.60162D+00,0.60984D+00,0.61857D+00,0.62782D+00,

9059      & 0.63759D+00,0.64789D+00,0.65872D+00,0.67008D+00,0.68198D+00,

9060      & 0.69443D+00,0.70744D+00,0.72102D+00,0.73519D+00,0.74994D+00,

9061      & 0.76530D+00,0.78129D+00,0.79791D+00,0.81518D+00,0.83313D+00,

9062      & 0.85176D+00,0.87111D+00,0.89119D+00,0.91202D+00,0.93362D+00,

9063      & 0.95604D+00,0.97928D+00,0.10034D+01,0.10283D+01,0.10543D+01,

9064      & 0.10811D+01,0.11089D+01,0.11377D+01,0.11676D+01,0.11986D+01,

9065      & 0.12307D+01,0.12640D+01,0.12984D+01,0.13342D+01,0.13712D+01,

9066      & 0.14096D+01,0.14493D+01,0.14905D+01,0.15332D+01,0.15775D+01,

9067      & 0.16234D+01,0.16709D+01,0.17202D+01,0.17713D+01,0.18242D+01,

9068      & 0.18791D+01,0.19359D+01,0.19948D+01,0.20559D+01,0.21192D+01,

9069      & 0.21847D+01,0.22527D+01,0.23231D+01,0.23960D+01,0.24716D+01,

9070      & 0.25499D+01,0.26312D+01,0.27603D+01,0.28418D+01,0.28248D+01,

9071      & 0.26584D+01,0.20859D+01,0.00000D+00,0.00000D+00,0.00000D+00,

9072      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

9073      & 0.00000D+00,0.00000D+00,0.59807D+00,0.58536D+00,0.57443D+00,

9074      & 0.56510D+00,0.55720D+00,0.55061D+00,0.54522D+00,0.54090D+00,

9075      & 0.53759D+00,0.53518D+00,0.53363D+00,0.53286D+00,0.53284D+00,

9076      & 0.53352D+00,0.53486D+00,0.53683D+00,0.53941D+00,0.54259D+00,

9077      & 0.54633D+00,0.55062D+00,0.55546D+00,0.56082D+00,0.56671D+00,

9078      & 0.57312D+00,0.58004D+00,0.58746D+00,0.59540D+00,0.60384D+00,

9079      & 0.61278D+00,0.62224D+00,0.63221D+00,0.64270D+00,0.65371D+00,

9080      & 0.66525D+00,0.67733D+00,0.68995D+00,0.70313D+00,0.71688D+00,

9081      & 0.73120D+00,0.74612D+00,0.76165D+00,0.77779D+00,0.79457D+00,

9082      & 0.81201D+00,0.83012D+00,0.84892D+00,0.86844D+00,0.88869D+00,

9083      & 0.90970D+00,0.93149D+00,0.95409D+00,0.97752D+00,0.10018D+01,

9084      & 0.10270D+01,0.10531D+01,0.10802D+01,0.11082D+01,0.11373D+01,

9085      & 0.11675D+01,0.11987D+01,0.12311D+01,0.12646D+01,0.12994D+01,

9086      & 0.13355D+01,0.13728D+01,0.14116D+01,0.14517D+01,0.14933D+01,

9087      & 0.15364D+01,0.15811D+01,0.16275D+01,0.16755D+01,0.17253D+01,

9088      & 0.17769D+01,0.18303D+01,0.18858D+01,0.19432D+01,0.20028D+01,

9089      & 0.20645D+01,0.21285D+01,0.21948D+01,0.22634D+01,0.23347D+01,

9090      & 0.24084D+01,0.24849D+01,0.25642D+01,0.26897D+01,0.27693D+01,

9091      & 0.27543D+01,0.25956D+01,0.20406D+01,0.00000D+00,0.00000D+00,

9092      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

9093      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.57894D+00,

9094      & 0.56752D+00,0.55775D+00,0.54947D+00,0.54252D+00,0.53679D+00,

9095      & 0.53218D+00,0.52858D+00,0.52592D+00,0.52411D+00,0.52311D+00,

9096      & 0.52286D+00,0.52331D+00,0.52443D+00,0.52619D+00,0.52855D+00,

9097      & 0.53150D+00,0.53502D+00,0.53909D+00,0.54370D+00,0.54883D+00,

9098      & 0.55448D+00,0.56064D+00,0.56730D+00,0.57447D+00,0.58213D+00,

9099      & 0.59030D+00,0.59896D+00,0.60812D+00,0.61778D+00,0.62796D+00,

9100      & 0.63864D+00,0.64984D+00,0.66157D+00,0.67384D+00,0.68664D+00,

9101      & 0.70001D+00,0.71393D+00,0.72844D+00,0.74354D+00,0.75924D+00,

9102      & 0.77557D+00,0.79253D+00,0.81015D+00,0.82845D+00,0.84745D+00,

9103      & 0.86716D+00,0.88761D+00,0.90882D+00,0.93083D+00,0.95365D+00,

9104      & 0.97731D+00,0.10018D+01,0.10273D+01,0.10536D+01,0.10810D+01,

9105      & 0.11093D+01,0.11387D+01,0.11691D+01,0.12007D+01,0.12334D+01,

9106      & 0.12673D+01,0.13024D+01,0.13388D+01,0.13766D+01,0.14157D+01,

9107      & 0.14563D+01,0.14984D+01,0.15420D+01,0.15872D+01,0.16340D+01,

9108      & 0.16826D+01,0.17330D+01,0.17852D+01,0.18393D+01,0.18954D+01,

9109      & 0.19535D+01,0.20138D+01,0.20762D+01,0.21410D+01,0.22081D+01,

9110      & 0.22777D+01,0.23497D+01,0.24245D+01,0.25020D+01,0.26240D+01,

9111      & 0.27020D+01,0.26889D+01,0.25373D+01,0.19988D+01,0.00000D+00,

9112      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

9113      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

9114      & 0.57371D+00,0.56177D+00,0.55153D+00,0.54282D+00,0.53549D+00,

9115      & 0.52942D+00,0.52448D+00,0.52059D+00,0.51765D+00,0.51559D+00,

9116      & 0.51434D+00,0.51386D+00,0.51408D+00,0.51499D+00,0.51652D+00,

9117      & 0.51867D+00,0.52141D+00,0.52471D+00,0.52856D+00,0.53295D+00,

9118      & 0.53786D+00,0.54328D+00,0.54921D+00,0.55563D+00,0.56255D+00,

9119      & 0.56997D+00,0.57787D+00,0.58626D+00,0.59515D+00,0.60453D+00,

9120      & 0.61440D+00,0.62478D+00,0.63567D+00,0.64708D+00,0.65901D+00,

9121      & 0.67147D+00,0.68447D+00,0.69803D+00,0.71215D+00,0.72685D+00,

9122      & 0.74214D+00,0.75805D+00,0.77457D+00,0.79174D+00,0.80957D+00,

9123      & 0.82808D+00,0.84729D+00,0.86722D+00,0.88790D+00,0.90935D+00,

9124      & 0.93160D+00,0.95466D+00,0.97858D+00,0.10034D+01,0.10291D+01,

9125      & 0.10558D+01,0.10834D+01,0.11120D+01,0.11417D+01,0.11725D+01,

9126      & 0.12044D+01,0.12375D+01,0.12718D+01,0.13074D+01,0.13442D+01,

9127      & 0.13824D+01,0.14220D+01,0.14631D+01,0.15057D+01,0.15498D+01,

9128      & 0.15956D+01,0.16431D+01,0.16923D+01,0.17433D+01,0.17961D+01,

9129      & 0.18510D+01,0.19078D+01,0.19667D+01,0.20278D+01,0.20911D+01,

9130      & 0.21567D+01,0.22248D+01,0.22952D+01,0.23684D+01,0.24443D+01,

9131      & 0.25630D+01,0.26394D+01,0.26280D+01,0.24833D+01,0.19602D+01,

9132      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

9133      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

9134      & 0.00000D+00,0.00000D+00,0.55716D+00,0.54641D+00,0.53724D+00,

9135      & 0.52950D+00,0.52305D+00,0.51777D+00,0.51357D+00,0.51034D+00,

9136      & 0.50801D+00,0.50652D+00,0.50579D+00,0.50579D+00,0.50647D+00,

9137      & 0.50779D+00,0.50973D+00,0.51225D+00,0.51534D+00,0.51899D+00,

9138      & 0.52316D+00,0.52785D+00,0.53306D+00,0.53876D+00,0.54496D+00,

9139      & 0.55164D+00,0.55882D+00,0.56647D+00,0.57462D+00,0.58324D+00,

9140      & 0.59236D+00,0.60196D+00,0.61205D+00,0.62265D+00,0.63375D+00,

9141      & 0.64536D+00,0.65750D+00,0.67017D+00,0.68338D+00,0.69715D+00,

9142      & 0.71148D+00,0.72639D+00,0.74190D+00,0.75802D+00,0.77476D+00,

9143      & 0.79216D+00,0.81021D+00,0.82896D+00,0.84841D+00,0.86859D+00,

9144      & 0.88952D+00,0.91123D+00,0.93375D+00,0.95710D+00,0.98132D+00,

9145      & 0.10064D+01,0.10324D+01,0.10594D+01,0.10874D+01,0.11164D+01,

9146      & 0.11465D+01,0.11777D+01,0.12100D+01,0.12435D+01,0.12782D+01,

9147      & 0.13142D+01,0.13516D+01,0.13903D+01,0.14304D+01,0.14721D+01,

9148      & 0.15152D+01,0.15600D+01,0.16064D+01,0.16545D+01,0.17044D+01,

9149      & 0.17561D+01,0.18097D+01,0.18653D+01,0.19230D+01,0.19828D+01,

9150      & 0.20447D+01,0.21090D+01,0.21756D+01,0.22446D+01,0.23162D+01,

9151      & 0.23905D+01,0.25062D+01,0.25812D+01,0.25715D+01,0.24332D+01,

9152      & 0.19244D+01,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

9153      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

9154      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.54236D+00,

9155      & 0.53271D+00,0.52452D+00,0.51767D+00,0.51203D+00,0.50749D+00,

9156      & 0.50395D+00,0.50135D+00,0.49959D+00,0.49862D+00,0.49838D+00,

9157      & 0.49883D+00,0.49994D+00,0.50166D+00,0.50398D+00,0.50687D+00,

9158      & 0.51030D+00,0.51427D+00,0.51875D+00,0.52374D+00,0.52924D+00,

9159      & 0.53522D+00,0.54168D+00,0.54863D+00,0.55606D+00,0.56396D+00,

9160      & 0.57234D+00,0.58120D+00,0.59054D+00,0.60037D+00,0.61070D+00,

9161      & 0.62151D+00,0.63284D+00,0.64467D+00,0.65703D+00,0.66992D+00,

9162      & 0.68335D+00,0.69734D+00,0.71189D+00,0.72703D+00,0.74277D+00,

9163      & 0.75912D+00,0.77611D+00,0.79375D+00,0.81206D+00,0.83106D+00,

9164      & 0.85077D+00,0.87123D+00,0.89244D+00,0.91445D+00,0.93727D+00,

9165      & 0.96093D+00,0.98547D+00,0.10109D+01,0.10373D+01,0.10647D+01,

9166      & 0.10930D+01,0.11224D+01,0.11529D+01,0.11845D+01,0.12173D+01,

9167      & 0.12513D+01,0.12865D+01,0.13230D+01,0.13609D+01,0.14002D+01,

9168      & 0.14409D+01,0.14831D+01,0.15269D+01,0.15724D+01,0.16194D+01,

9169      & 0.16683D+01,0.17189D+01,0.17714D+01,0.18259D+01,0.18824D+01,

9170      & 0.19409D+01,0.20016D+01,0.20646D+01,0.21298D+01,0.21975D+01,

9171      & 0.22677D+01,0.23406D+01,0.24534D+01,0.25269D+01,0.25189D+01,

9172      & 0.23867D+01,0.18913D+01,0.00000D+00,0.00000D+00,0.00000D+00,

9173      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

9174      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

9175      & 0.53939D+00,0.52920D+00,0.52053D+00,0.51325D+00,0.50722D+00,

9176      & 0.50232D+00,0.49847D+00,0.49556D+00,0.49353D+00,0.49230D+00,

9177      & 0.49182D+00,0.49205D+00,0.49293D+00,0.49444D+00,0.49655D+00,

9178      & 0.49923D+00,0.50246D+00,0.50623D+00,0.51051D+00,0.51530D+00,

9179      & 0.52058D+00,0.52636D+00,0.53261D+00,0.53934D+00,0.54655D+00,

9180      & 0.55423D+00,0.56238D+00,0.57100D+00,0.58010D+00,0.58968D+00,

9181      & 0.59975D+00,0.61030D+00,0.62135D+00,0.63290D+00,0.64496D+00,

9182      & 0.65755D+00,0.67067D+00,0.68434D+00,0.69857D+00,0.71336D+00,

9183      & 0.72874D+00,0.74473D+00,0.76134D+00,0.77859D+00,0.79649D+00,

9184      & 0.81507D+00,0.83436D+00,0.85436D+00,0.87512D+00,0.89664D+00,

9185      & 0.91897D+00,0.94212D+00,0.96613D+00,0.99103D+00,0.10168D+01,

9186      & 0.10436D+01,0.10714D+01,0.11001D+01,0.11300D+01,0.11609D+01,

9187      & 0.11930D+01,0.12263D+01,0.12608D+01,0.12966D+01,0.13336D+01,

9188      & 0.13721D+01,0.14120D+01,0.14534D+01,0.14963D+01,0.15408D+01,

9189      & 0.15869D+01,0.16348D+01,0.16844D+01,0.17359D+01,0.17893D+01,

9190      & 0.18446D+01,0.19021D+01,0.19616D+01,0.20233D+01,0.20873D+01,

9191      & 0.21537D+01,0.22225D+01,0.22940D+01,0.24042D+01,0.24764D+01,

9192      & 0.24699D+01,0.23436D+01,0.18606D+01,0.00000D+00,0.00000D+00,

9193      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

9194      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

9195      & 0.00000D+00,0.00000D+00,0.52672D+00,0.51753D+00,0.50979D+00,

9196      & 0.50333D+00,0.49806D+00,0.49385D+00,0.49063D+00,0.48831D+00,

9197      & 0.48681D+00,0.48608D+00,0.48607D+00,0.48673D+00,0.48803D+00,

9198      & 0.48992D+00,0.49240D+00,0.49543D+00,0.49900D+00,0.50308D+00,

9199      & 0.50767D+00,0.51276D+00,0.51833D+00,0.52438D+00,0.53091D+00,

9200      & 0.53791D+00,0.54537D+00,0.55330D+00,0.56170D+00,0.57058D+00,

9201      & 0.57992D+00,0.58974D+00,0.60005D+00,0.61084D+00,0.62213D+00,

9202      & 0.63392D+00,0.64622D+00,0.65905D+00,0.67242D+00,0.68634D+00,

9203      & 0.70081D+00,0.71587D+00,0.73151D+00,0.74777D+00,0.76465D+00,

9204      & 0.78217D+00,0.80037D+00,0.81924D+00,0.83884D+00,0.85916D+00,

9205      & 0.88024D+00,0.90210D+00,0.92478D+00,0.94829D+00,0.97268D+00,

9206      & 0.99797D+00,0.10242D+01,0.10514D+01,0.10796D+01,0.11088D+01,

9207      & 0.11391D+01,0.11706D+01,0.12032D+01,0.12370D+01,0.12721D+01,

9208      & 0.13084D+01,0.13461D+01,0.13852D+01,0.14258D+01,0.14679D+01,

9209      & 0.15115D+01,0.15568D+01,0.16037D+01,0.16524D+01,0.17029D+01,

9210      & 0.17553D+01,0.18096D+01,0.18659D+01,0.19244D+01,0.19849D+01,

9211      & 0.20478D+01,0.21130D+01,0.21806D+01,0.22508D+01,0.23584D+01,

9212      & 0.24294D+01,0.24244D+01,0.23036D+01,0.18323D+01,0.00000D+00,

9213      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

9214      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

9215      & 0.00000D+00,0.00000D+00,0.00000D+00,0.52527D+00,0.51552D+00,

9216      & 0.50727D+00,0.50036D+00,0.49468D+00,0.49011D+00,0.48654D+00,

9217      & 0.48391D+00,0.48214D+00,0.48115D+00,0.48089D+00,0.48132D+00,

9218      & 0.48239D+00,0.48408D+00,0.48634D+00,0.48917D+00,0.49254D+00,

9219      & 0.49643D+00,0.50083D+00,0.50572D+00,0.51110D+00,0.51696D+00,

9220      & 0.52329D+00,0.53008D+00,0.53734D+00,0.54507D+00,0.55326D+00,

9221      & 0.56191D+00,0.57104D+00,0.58063D+00,0.59070D+00,0.60125D+00,

9222      & 0.61229D+00,0.62383D+00,0.63587D+00,0.64843D+00,0.66152D+00,

9223      & 0.67514D+00,0.68932D+00,0.70406D+00,0.71939D+00,0.73532D+00,

9224      & 0.75186D+00,0.76903D+00,0.78686D+00,0.80536D+00,0.82456D+00,

9225      & 0.84448D+00,0.86514D+00,0.88658D+00,0.90881D+00,0.93186D+00,

9226      & 0.95577D+00,0.98057D+00,0.10063D+01,0.10329D+01,0.10606D+01,

9227      & 0.10893D+01,0.11190D+01,0.11499D+01,0.11818D+01,0.12150D+01,

9228      & 0.12494D+01,0.12851D+01,0.13221D+01,0.13605D+01,0.14003D+01,

9229      & 0.14416D+01,0.14844D+01,0.15288D+01,0.15749D+01,0.16227D+01,

9230      & 0.16723D+01,0.17237D+01,0.17771D+01,0.18324D+01,0.18898D+01,

9231      & 0.19493D+01,0.20110D+01,0.20751D+01,0.21415D+01,0.22105D+01,

9232      & 0.23157D+01,0.23856D+01,0.23820D+01,0.22666D+01,0.18061D+01,

9233      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

9234      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

9235      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

9236      & 0.51450D+00,0.50570D+00,0.49831D+00,0.49218D+00,0.48721D+00,

9237      & 0.48329D+00,0.48033D+00,0.47825D+00,0.47699D+00,0.47647D+00,

9238      & 0.47666D+00,0.47751D+00,0.47897D+00,0.48104D+00,0.48366D+00,

9239      & 0.48683D+00,0.49053D+00,0.49474D+00,0.49944D+00,0.50463D+00,

9240      & 0.51030D+00,0.51644D+00,0.52304D+00,0.53011D+00,0.53764D+00,

9241      & 0.54562D+00,0.55407D+00,0.56299D+00,0.57236D+00,0.58221D+00,

9242      & 0.59254D+00,0.60334D+00,0.61464D+00,0.62644D+00,0.63874D+00,

9243      & 0.65157D+00,0.66492D+00,0.67882D+00,0.69328D+00,0.70831D+00,

9244      & 0.72392D+00,0.74015D+00,0.75699D+00,0.77448D+00,0.79263D+00,

9245      & 0.81147D+00,0.83101D+00,0.85128D+00,0.87231D+00,0.89413D+00,

9246      & 0.91675D+00,0.94022D+00,0.96455D+00,0.98979D+00,0.10160D+01,

9247      & 0.10431D+01,0.10712D+01,0.11004D+01,0.11307D+01,0.11621D+01,

9248      & 0.11947D+01,0.12285D+01,0.12635D+01,0.12998D+01,0.13375D+01,

9249      & 0.13766D+01,0.14172D+01,0.14593D+01,0.15029D+01,0.15482D+01,

9250      & 0.15951D+01,0.16439D+01,0.16944D+01,0.17468D+01,0.18012D+01,

9251      & 0.18576D+01,0.19162D+01,0.19769D+01,0.20398D+01,0.21051D+01,

9252      & 0.21730D+01,0.22759D+01,0.23448D+01,0.23425D+01,0.22322D+01,

9253      & 0.17820D+01,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

9254      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

9255      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

9256      & 0.00000D+00,0.51450D+00,0.50510D+00,0.49718D+00,0.49058D+00,

9257      & 0.48518D+00,0.48087D+00,0.47755D+00,0.47515D+00,0.47360D+00,

9258      & 0.47281D+00,0.47275D+00,0.47336D+00,0.47460D+00,0.47645D+00,

9259      & 0.47888D+00,0.48185D+00,0.48535D+00,0.48937D+00,0.49389D+00,

9260      & 0.49889D+00,0.50437D+00,0.51033D+00,0.51675D+00,0.52363D+00,

9261      & 0.53096D+00,0.53876D+00,0.54702D+00,0.55573D+00,0.56490D+00,

9262      & 0.57454D+00,0.58466D+00,0.59524D+00,0.60632D+00,0.61788D+00,

9263      & 0.62995D+00,0.64253D+00,0.65563D+00,0.66927D+00,0.68345D+00,

9264      & 0.69820D+00,0.71353D+00,0.72946D+00,0.74600D+00,0.76317D+00,

9265      & 0.78099D+00,0.79949D+00,0.81868D+00,0.83859D+00,0.85925D+00,

9266      & 0.88067D+00,0.90289D+00,0.92594D+00,0.94985D+00,0.97464D+00,

9267      & 0.10003D+01,0.10270D+01,0.10547D+01,0.10833D+01,0.11131D+01,

9268      & 0.11440D+01,0.11760D+01,0.12091D+01,0.12436D+01,0.12793D+01,

9269      & 0.13163D+01,0.13548D+01,0.13947D+01,0.14360D+01,0.14789D+01,

9270      & 0.15235D+01,0.15696D+01,0.16176D+01,0.16673D+01,0.17188D+01,

9271      & 0.17723D+01,0.18278D+01,0.18854D+01,0.19451D+01,0.20071D+01,

9272      & 0.20713D+01,0.21381D+01,0.22389D+01,0.23068D+01,0.23059D+01,

9273      & 0.22005D+01,0.17598D+01,0.00000D+00,0.00000D+00,0.00000D+00,

9274      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

9275      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

9276      & 0.00000D+00,0.00000D+00,0.00000D+00,0.50548D+00,0.49698D+00,

9277      & 0.48986D+00,0.48400D+00,0.47927D+00,0.47558D+00,0.47284D+00,

9278      & 0.47097D+00,0.46990D+00,0.46957D+00,0.46994D+00,0.47095D+00,

9279      & 0.47258D+00,0.47480D+00,0.47757D+00,0.48088D+00,0.48471D+00,

9280      & 0.48904D+00,0.49386D+00,0.49916D+00,0.50493D+00,0.51117D+00,

9281      & 0.51787D+00,0.52503D+00,0.53264D+00,0.54071D+00,0.54923D+00,

9282      & 0.55821D+00,0.56766D+00,0.57757D+00,0.58795D+00,0.59881D+00,

9283      & 0.61016D+00,0.62200D+00,0.63435D+00,0.64722D+00,0.66061D+00,

9284      & 0.67454D+00,0.68903D+00,0.70409D+00,0.71974D+00,0.73599D+00,

9285      & 0.75287D+00,0.77038D+00,0.78856D+00,0.80743D+00,0.82700D+00,

9286      & 0.84730D+00,0.86837D+00,0.89021D+00,0.91287D+00,0.93638D+00,

9287      & 0.96075D+00,0.98603D+00,0.10122D+01,0.10395D+01,0.10676D+01,

9288      & 0.10969D+01,0.11272D+01,0.11587D+01,0.11914D+01,0.12252D+01,

9289      & 0.12604D+01,0.12968D+01,0.13346D+01,0.13739D+01,0.14146D+01,

9290      & 0.14568D+01,0.15006D+01,0.15460D+01,0.15932D+01,0.16421D+01,

9291      & 0.16929D+01,0.17455D+01,0.18002D+01,0.18569D+01,0.19157D+01,

9292      & 0.19767D+01,0.20399D+01,0.21057D+01,0.22045D+01,0.22714D+01,

9293      & 0.22718D+01,0.21712D+01,0.17393D+01,0.00000D+00,0.00000D+00,

9294      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

9295      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

9296      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.50687D+00,

9297      & 0.49774D+00,0.49007D+00,0.48370D+00,0.47852D+00,0.47442D+00,

9298      & 0.47131D+00,0.46910D+00,0.46773D+00,0.46712D+00,0.46723D+00,

9299      & 0.46800D+00,0.46941D+00,0.47140D+00,0.47397D+00,0.47709D+00,

9300      & 0.48072D+00,0.48487D+00,0.48951D+00,0.49463D+00,0.50023D+00,

9301      & 0.50629D+00,0.51282D+00,0.51980D+00,0.52723D+00,0.53512D+00,

9302      & 0.54347D+00,0.55226D+00,0.56152D+00,0.57124D+00,0.58143D+00,

9303      & 0.59209D+00,0.60323D+00,0.61487D+00,0.62700D+00,0.63964D+00,

9304      & 0.65281D+00,0.66650D+00,0.68075D+00,0.69556D+00,0.71095D+00,

9305      & 0.72693D+00,0.74353D+00,0.76076D+00,0.77865D+00,0.79720D+00,

9306      & 0.81646D+00,0.83644D+00,0.85716D+00,0.87866D+00,0.90095D+00,

9307      & 0.92408D+00,0.94807D+00,0.97294D+00,0.99875D+00,0.10255D+01,

9308      & 0.10533D+01,0.10821D+01,0.11119D+01,0.11429D+01,0.11750D+01,

9309      & 0.12084D+01,0.12430D+01,0.12788D+01,0.13161D+01,0.13547D+01,

9310      & 0.13948D+01,0.14363D+01,0.14795D+01,0.15242D+01,0.15707D+01,

9311      & 0.16189D+01,0.16689D+01,0.17207D+01,0.17746D+01,0.18304D+01,

9312      & 0.18884D+01,0.19485D+01,0.20108D+01,0.20757D+01,0.21725D+01,

9313      & 0.22385D+01,0.22402D+01,0.21441D+01,0.17205D+01,0.00000D+00,

9314      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

9315      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

9316      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

9317      & 0.00000D+00,0.49949D+00,0.49120D+00,0.48429D+00,0.47862D+00,

9318      & 0.47408D+00,0.47057D+00,0.46801D+00,0.46630D+00,0.46540D+00,

9319      & 0.46523D+00,0.46576D+00,0.46692D+00,0.46870D+00,0.47106D+00,

9320      & 0.47397D+00,0.47741D+00,0.48137D+00,0.48583D+00,0.49078D+00,

9321      & 0.49620D+00,0.50209D+00,0.50844D+00,0.51525D+00,0.52252D+00,

9322      & 0.53023D+00,0.53841D+00,0.54703D+00,0.55611D+00,0.56565D+00,

9323      & 0.57565D+00,0.58612D+00,0.59707D+00,0.60851D+00,0.62044D+00,

9324      & 0.63287D+00,0.64583D+00,0.65930D+00,0.67332D+00,0.68790D+00,

9325      & 0.70304D+00,0.71878D+00,0.73512D+00,0.75208D+00,0.76969D+00,

9326      & 0.78796D+00,0.80692D+00,0.82659D+00,0.84700D+00,0.86817D+00,

9327      & 0.89013D+00,0.91290D+00,0.93653D+00,0.96103D+00,0.98644D+00,

9328      & 0.10128D+01,0.10401D+01,0.10685D+01,0.10979D+01,0.11284D+01,

9329      & 0.11601D+01,0.11929D+01,0.12270D+01,0.12624D+01,0.12990D+01,

9330      & 0.13371D+01,0.13766D+01,0.14175D+01,0.14600D+01,0.15042D+01,

9331      & 0.15499D+01,0.15974D+01,0.16467D+01,0.16979D+01,0.17509D+01,

9332      & 0.18060D+01,0.18631D+01,0.19224D+01,0.19839D+01,0.20479D+01,

9333      & 0.21428D+01,0.22080D+01,0.22109D+01,0.21192D+01,0.17033D+01,

9334      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

9335      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

9336      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

9337      & 0.00000D+00,0.00000D+00,0.50227D+00,0.49331D+00,0.48580D+00,

9338      & 0.47960D+00,0.47458D+00,0.47064D+00,0.46769D+00,0.46564D+00,

9339      & 0.46441D+00,0.46396D+00,0.46421D+00,0.46513D+00,0.46667D+00,

9340      & 0.46881D+00,0.47152D+00,0.47477D+00,0.47854D+00,0.48281D+00,

9341      & 0.48758D+00,0.49283D+00,0.49855D+00,0.50473D+00,0.51138D+00,

9342      & 0.51848D+00,0.52603D+00,0.53403D+00,0.54248D+00,0.55139D+00,

9343      & 0.56076D+00,0.57059D+00,0.58089D+00,0.59166D+00,0.60290D+00,

9344      & 0.61465D+00,0.62688D+00,0.63963D+00,0.65291D+00,0.66671D+00,

9345      & 0.68107D+00,0.69599D+00,0.71149D+00,0.72759D+00,0.74430D+00,

9346      & 0.76165D+00,0.77966D+00,0.79835D+00,0.81773D+00,0.83784D+00,

9347      & 0.85871D+00,0.88035D+00,0.90279D+00,0.92608D+00,0.95023D+00,

9348      & 0.97528D+00,0.10013D+01,0.10282D+01,0.10562D+01,0.10852D+01,

9349      & 0.11152D+01,0.11465D+01,0.11788D+01,0.12124D+01,0.12473D+01,

9350      & 0.12834D+01,0.13210D+01,0.13599D+01,0.14003D+01,0.14422D+01,

9351      & 0.14857D+01,0.15309D+01,0.15777D+01,0.16263D+01,0.16768D+01,

9352      & 0.17291D+01,0.17834D+01,0.18398D+01,0.18983D+01,0.19590D+01,

9353      & 0.20222D+01,0.21153D+01,0.21797D+01,0.21839D+01,0.20964D+01,

9354      & 0.16876D+01,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

9355      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

9356      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

9357      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.49644D+00,

9358      & 0.48828D+00,0.48149D+00,0.47595D+00,0.47155D+00,0.46817D+00,

9359      & 0.46574D+00,0.46417D+00,0.46340D+00,0.46337D+00,0.46403D+00,

9360      & 0.46533D+00,0.46724D+00,0.46973D+00,0.47278D+00,0.47635D+00,

9361      & 0.48044D+00,0.48503D+00,0.49011D+00,0.49566D+00,0.50168D+00,

9362      & 0.50816D+00,0.51509D+00,0.52248D+00,0.53032D+00,0.53862D+00,

9363      & 0.54737D+00,0.55657D+00,0.56623D+00,0.57636D+00,0.58696D+00,

9364      & 0.59803D+00,0.60959D+00,0.62165D+00,0.63421D+00,0.64729D+00,

9365      & 0.66089D+00,0.67505D+00,0.68975D+00,0.70504D+00,0.72091D+00,

9366      & 0.73739D+00,0.75450D+00,0.77226D+00,0.79069D+00,0.80981D+00,

9367      & 0.82965D+00,0.85022D+00,0.87157D+00,0.89371D+00,0.91668D+00,

9368      & 0.94050D+00,0.96521D+00,0.99084D+00,0.10174D+01,0.10450D+01,

9369      & 0.10736D+01,0.11033D+01,0.11341D+01,0.11660D+01,0.11992D+01,

9370      & 0.12335D+01,0.12692D+01,0.13062D+01,0.13447D+01,0.13845D+01,

9371      & 0.14259D+01,0.14688D+01,0.15134D+01,0.15596D+01,0.16076D+01,

9372      & 0.16574D+01,0.17091D+01,0.17627D+01,0.18183D+01,0.18761D+01,

9373      & 0.19361D+01,0.19984D+01,0.20899D+01,0.21535D+01,0.21589D+01,

9374      & 0.20756D+01,0.16734D+01,0.00000D+00,0.00000D+00,0.00000D+00,

9375      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

9376      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

9377      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

9378      & 0.00000D+00,0.49175D+00,0.48433D+00,0.47822D+00,0.47331D+00,

9379      & 0.46948D+00,0.46663D+00,0.46469D+00,0.46359D+00,0.46325D+00,

9380      & 0.46363D+00,0.46467D+00,0.46635D+00,0.46861D+00,0.47145D+00,

9381      & 0.47482D+00,0.47872D+00,0.48313D+00,0.48803D+00,0.49341D+00,

9382      & 0.49927D+00,0.50558D+00,0.51236D+00,0.51959D+00,0.52728D+00,

9383      & 0.53541D+00,0.54400D+00,0.55305D+00,0.56255D+00,0.57252D+00,

9384      & 0.58296D+00,0.59386D+00,0.60526D+00,0.61714D+00,0.62952D+00,

9385      & 0.64242D+00,0.65584D+00,0.66980D+00,0.68432D+00,0.69940D+00,

9386      & 0.71506D+00,0.73132D+00,0.74821D+00,0.76574D+00,0.78393D+00,

9387      & 0.80280D+00,0.82238D+00,0.84269D+00,0.86376D+00,0.88562D+00,

9388      & 0.90829D+00,0.93181D+00,0.95620D+00,0.98150D+00,0.10077D+01,

9389      & 0.10350D+01,0.10632D+01,0.10925D+01,0.11229D+01,0.11544D+01,

9390      & 0.11872D+01,0.12211D+01,0.12563D+01,0.12929D+01,0.13308D+01,

9391      & 0.13702D+01,0.14110D+01,0.14534D+01,0.14974D+01,0.15431D+01,

9392      & 0.15905D+01,0.16396D+01,0.16907D+01,0.17436D+01,0.17986D+01,

9393      & 0.18557D+01,0.19149D+01,0.19765D+01,0.20664D+01,0.21293D+01,

9394      & 0.21359D+01,0.20566D+01,0.16605D+01,0.00000D+00,0.00000D+00,

9395      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

9396      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

9397      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

9398      & 0.00000D+00,0.00000D+00,0.49629D+00,0.48817D+00,0.48144D+00,

9399      & 0.47597D+00,0.47164D+00,0.46834D+00,0.46600D+00,0.46453D+00,

9400      & 0.46387D+00,0.46395D+00,0.46472D+00,0.46613D+00,0.46817D+00,

9401      & 0.47078D+00,0.47395D+00,0.47766D+00,0.48188D+00,0.48660D+00,

9402      & 0.49181D+00,0.49750D+00,0.50365D+00,0.51027D+00,0.51735D+00,

9403      & 0.52488D+00,0.53286D+00,0.54130D+00,0.55020D+00,0.55955D+00,

9404      & 0.56936D+00,0.57964D+00,0.59039D+00,0.60163D+00,0.61335D+00,

9405      & 0.62557D+00,0.63829D+00,0.65154D+00,0.66532D+00,0.67965D+00,

9406      & 0.69454D+00,0.71001D+00,0.72607D+00,0.74275D+00,0.76006D+00,

9407      & 0.77803D+00,0.79667D+00,0.81601D+00,0.83608D+00,0.85689D+00,

9408      & 0.87849D+00,0.90088D+00,0.92411D+00,0.94821D+00,0.97320D+00,

9409      & 0.99913D+00,0.10260D+01,0.10539D+01,0.10829D+01,0.11129D+01,

9410      & 0.11440D+01,0.11764D+01,0.12099D+01,0.12447D+01,0.12808D+01,

9411      & 0.13183D+01,0.13572D+01,0.13976D+01,0.14395D+01,0.14829D+01,

9412      & 0.15280D+01,0.15749D+01,0.16235D+01,0.16739D+01,0.17263D+01,

9413      & 0.17806D+01,0.18370D+01,0.18956D+01,0.19565D+01,0.20448D+01,

9414      & 0.21071D+01,0.21148D+01,0.20394D+01,0.16489D+01,0.00000D+00,

9415      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

9416      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

9417      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,

9418      & 0.00000D+00,0.00000D+00,0.00000D+00,0.00000D+00,0.49307D+00,

9419      & 0.48565D+00,0.47957D+00,0.47469D+00,0.47091D+00,0.46813D+00,

9420      & 0.46626D+00,0.46524D+00,0.46500D+00,0.46547D+00,0.46662D+00,

9421      & 0.46840D+00,0.47079D+00,0.47374D+00,0.47724D+00,0.48127D+00,

9422      & 0.48581D+00,0.49085D+00,0.49637D+00,0.50236D+00,0.50882D+00,

9423      & 0.51574D+00,0.52312D+00,0.53096D+00,0.53925D+00,0.54800D+00,

9424      & 0.55721D+00,0.56687D+00,0.57701D+00,0.58761D+00,0.59869D+00,

9425      & 0.61026D+00,0.62232D+00,0.63489D+00,0.64797D+00,0.66159D+00,

9426      & 0.67574D+00,0.69046D+00,0.70574D+00,0.72162D+00,0.73810D+00,

9427      & 0.75522D+00,0.77298D+00,0.79140D+00,0.81052D+00,0.83036D+00,

9428      & 0.85094D+00,0.87228D+00,0.89442D+00,0.91739D+00,0.94121D+00,

9429      & 0.96592D+00,0.99155D+00,0.10181D+01,0.10457D+01,0.10743D+01,

9430      & 0.11040D+01,0.11348D+01,0.11668D+01,0.11999D+01,0.12343D+01,

9431      & 0.12700D+01,0.13071D+01,0.13455D+01,0.13854D+01,0.14269D+01,

9432      & 0.14698D+01,0.15145D+01,0.15608D+01,0.16088D+01,0.16587D+01,

9433      & 0.17105D+01,0.17642D+01,0.18200D+01,0.18779D+01,0.19382D+01,

9434      & 0.20250D+01,0.20867D+01,0.20956D+01,0.20240D+01,0.16386D+01,

9435      & 0.