| 1 | SUBROUTINE UTQSEA(X1,X2,X3)
|
|---|
| 2 |
|
|---|
| 3 | C-----------------------------------------------------------------------
|
|---|
| 4 | C UT(ILITY ROUTINE) SEA (QUARK STRUCTURE FUNCTION)
|
|---|
| 5 | C
|
|---|
| 6 | C SEA QUARK STRUCTURE FUNCTION INTEGRAL
|
|---|
| 7 | C RETURNS INTEGRAL (XSE(1)->XSE(I)) OF FU(Z) DZ
|
|---|
| 8 | C
|
|---|
| 9 | C THIS SUBROUTINE IS CALLED FROM VENLNK
|
|---|
| 10 | C
|
|---|
| 11 | C DESIGN : D. HECK IK3 FZK KARLSRUHE
|
|---|
| 12 | C-----------------------------------------------------------------------
|
|---|
| 13 |
|
|---|
| 14 | *KEEP,RUNPAR.
|
|---|
| 15 | COMMON /RUNPAR/ FIXHEI,THICK0,HILOECM,HILOELB,
|
|---|
| 16 | * STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
|
|---|
| 17 | * MONIOU,MDEBUG,NUCNUC,
|
|---|
| 18 | * CETAPE,
|
|---|
| 19 | * SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
|
|---|
| 20 | * N1STTR,MDBASE,
|
|---|
| 21 | * DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
|
|---|
| 22 | * FIX1I,FMUADD,FNKG,FPRINT,FDBASE
|
|---|
| 23 | * ,GHEISH,GHESIG
|
|---|
| 24 | COMMON /RUNPAC/ DSN,HOST,USER
|
|---|
| 25 | DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
|
|---|
| 26 | REAL STEPFC
|
|---|
| 27 | INTEGER NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
|
|---|
| 28 | * SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
|
|---|
| 29 | * N1STTR,MDBASE
|
|---|
| 30 | INTEGER CETAPE
|
|---|
| 31 | CHARACTER*79 DSN
|
|---|
| 32 | CHARACTER*20 HOST,USER
|
|---|
| 33 |
|
|---|
| 34 | LOGICAL DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
|
|---|
| 35 | * FIX1I,FMUADD,FNKG,FPRINT,FDBASE
|
|---|
| 36 | * ,GHEISH,GHESIG
|
|---|
| 37 | *KEND.
|
|---|
| 38 |
|
|---|
| 39 | PARAMETER (NSTRU=2049)
|
|---|
| 40 | COMMON /FILES/ IFCH,IFDT,IFHI,IFMT,IFOP
|
|---|
| 41 | COMMON /PARO1/ AMPRIF,AMSIAC,BMAXIM,BMINIM,CORE,CUTMSQ,CUTMSS
|
|---|
| 42 | * ,DELMSS,DELREM,FCTRMX,GAUMX,OVERLP,PAREA,PDIQUA
|
|---|
| 43 | * ,PHARD,PSPINL,PSPINH,PISPN,PTF,PTH,PTMX,PTQ,PUD
|
|---|
| 44 | * ,PVALEN,QSEPC,QSETC,QMUST,QVAPC,QVATC,RADIAC
|
|---|
| 45 | * ,RADIAS,RSTRAS,SIGJ,SIGPPI,TAUMAX,TAUMIN
|
|---|
| 46 | * ,TAUMX,TAUNLL,TENSN,THEMAS,WPROJ,WTARG,WTMINI
|
|---|
| 47 | * ,WTSTEP,XCUT
|
|---|
| 48 | * ,IAQU,IFRADE,IOJINT,IOPBRK,IOPENT,IOPENU
|
|---|
| 49 | * ,IOPTF,IOPTQ,IRESCL,IWCENT,KENTRO,KO1KO2
|
|---|
| 50 | * ,LABSYS,MAXRES,NCLEAN,NCOLMX,NDECAW,NEQMN,NEQMX
|
|---|
| 51 | * ,NSTTAU,NTRYMX,NUMTAU
|
|---|
| 52 | COMMON /PARO2/ AMPROJ,AMTARG,ANGMUE,ELEPTI,ELEPTO,ENGY
|
|---|
| 53 | * ,PNLL,PNLLX,PROB(99),PROSEA,RHOPHI,TAUREA
|
|---|
| 54 | * ,YHAHA,YMXIMI,YPJTL
|
|---|
| 55 | * ,ICBAC(99,2),ICFOR(99,2),ICHOIC,ICLHIS,IDPM
|
|---|
| 56 | * ,IDPROJ,IDTARG,IENTRO,IJPHIS,IMIHIS,IPAGI,ISH
|
|---|
| 57 | * ,ISHEVT,ISHSUB,ISPALL,ISPHIS,ISTMAX,ISUP,IVI
|
|---|
| 58 | * ,JPSI,JPSIFI,KUTDIQ,LAPROJ,LATARG,MAPROJ,MATARG
|
|---|
| 59 | * ,MODSHO,NDECAX,NDECAY,NEVENT
|
|---|
| 60 | COMMON /STRU2/ DELTA0,DELTA1,QSEH(NSTRU),QSEPI(NSTRU)
|
|---|
| 61 | * ,QVAH(NSTRU),QVAPI(NSTRU),XSE(NSTRU),XVA(NSTRU)
|
|---|
| 62 | C-----------------------------------------------------------------------
|
|---|
| 63 |
|
|---|
| 64 | IF ( DEBUG ) WRITE(MDEBUG,*) 'UTQSEA:'
|
|---|
| 65 |
|
|---|
| 66 | X0 = 0.
|
|---|
| 67 | N = NSTRU
|
|---|
| 68 | IF ( ISH .GE. 90 ) THEN
|
|---|
| 69 | IF ( X1.LT.X0 .OR. X2.LT.X1 .OR. X3.LT.X2 ) THEN
|
|---|
| 70 | CALL UTMSG('UTQSEA')
|
|---|
| 71 | WRITE(IFCH,*)' XI=',X0,X1,X2,X3
|
|---|
| 72 | CALL UTMSGF
|
|---|
| 73 | ENDIF
|
|---|
| 74 | ENDIF
|
|---|
| 75 | I1 = N/3
|
|---|
| 76 | I2 = 2*N/3
|
|---|
| 77 | FAC1 = (X1-X0)/FLOAT(I1-1)
|
|---|
| 78 | DO 11 I=1,I1-1
|
|---|
| 79 | XSE(I)=(I-1.)*FAC1+X0
|
|---|
| 80 | 11 CONTINUE
|
|---|
| 81 | FAC2 = (X2-X1)/FLOAT(I2-I1)
|
|---|
| 82 | DO 12 I=I1,I2-1
|
|---|
| 83 | XSE(I)=FLOAT(I-I1)*FAC2 +X1
|
|---|
| 84 | 12 CONTINUE
|
|---|
| 85 | FAC3 = (X3-X2)/FLOAT(N-I2)
|
|---|
| 86 | DO 13 I=I2,N
|
|---|
| 87 | XSE(I)=MIN( FLOAT(I-I2)*FAC3 +X2, 0.99999999 )
|
|---|
| 88 | 13 CONTINUE
|
|---|
| 89 |
|
|---|
| 90 | XCUT2 = XCUT**2
|
|---|
| 91 | XCUT4 = XCUT2**2
|
|---|
| 92 | XCUT6 = XCUT2*XCUT4
|
|---|
| 93 | CUTLOG = LOG(XCUT)
|
|---|
| 94 | C COEFFICIENTS FOR HADRONIC SEA QUARK STRUCTURE FUNCTION
|
|---|
| 95 | AH0 = -8. + 37.333333*XCUT2 - 29.866667*XCUT4 + 3.65714286*XCUT6
|
|---|
| 96 | AH1 = 14. - 26.25*XCUT2 + 8.75*XCUT4 - 0.2734375*XCUT6
|
|---|
| 97 | AH2 = -18.666667 + 14.933333*XCUT2 - 1.82857143*XCUT4
|
|---|
| 98 | AH3 = 17.5 - 5.8333333*XCUT2 + 0.182291667*XCUT4
|
|---|
| 99 | AH4 = -11.2 + 1.37142857*XCUT2
|
|---|
| 100 | AH5 = 4.6666667 - 0.14583333*XCUT2
|
|---|
| 101 | AH6 = -1.14285714
|
|---|
| 102 | AH7 = 0.125
|
|---|
| 103 | QAH = 1. - AH1 * XCUT2
|
|---|
| 104 | AHCUT = AH0 * XCUT
|
|---|
| 105 | C COEFFICIENTS FOR PIONIC SEA QUARK STRUCTURE FUNCTION
|
|---|
| 106 | API0 = -5. + 6.6666667*XCUT2 - 0.53333333*XCUT4
|
|---|
| 107 | API1 = 5. - 1.875*XCUT2
|
|---|
| 108 | API2 = -3.3333333 + 0.26666667*XCUT2
|
|---|
| 109 | API3 = 1.25
|
|---|
| 110 | API4 = -0.2
|
|---|
| 111 | QAPI = 1. - API1 * XCUT2
|
|---|
| 112 | APICUT = API0 * XCUT
|
|---|
| 113 |
|
|---|
| 114 | QSEH(1) = 0.
|
|---|
| 115 | QSEPI(1) = 0.
|
|---|
| 116 | DO 2 I=2,N
|
|---|
| 117 | Z = XSE(I)
|
|---|
| 118 | ROOT = SQRT(Z**2 + XCUT2)
|
|---|
| 119 | ROOTLG = LOG( Z + ROOT ) - CUTLOG
|
|---|
| 120 | QSEH(I) = 1.265 * ( QAH * ROOTLG - AHCUT
|
|---|
| 121 | * + ROOT * (AH0 + Z*(AH1 + Z*(AH2 + Z*(AH3
|
|---|
| 122 | * + Z*(AH4 + Z*(AH5 + Z*(AH6 + Z*AH7))))))) )
|
|---|
| 123 | QSEPI(I) = 0.9 * ( QAPI * ROOTLG - APICUT
|
|---|
| 124 | * + ROOT * (API0+Z*(API1+Z*(API2+Z*(API3+Z*API4)))) )
|
|---|
| 125 | 2 CONTINUE
|
|---|
| 126 |
|
|---|
| 127 | RETURN
|
|---|
| 128 | END
|
|---|
