CDECK ID>, HWSFBR. *CMZ :- -15/07/92 14.08.45 by Mike Seymour *-- Author : Bryan Webber C----------------------------------------------------------------------- SUBROUTINE HWSFBR(X,QQ,FORCED,ID,IW,ID1,ID2,IW1,IW2,Z) C----------------------------------------------------------------------- C FINDS BRANCHING (ID1->ID+ID2) AND Z=X/X1 IN BACKWARD C EVOLUTION AT ENERGY FRACTION X AND SCALE QQ C C FORCED=.TRUE. FORCES SPLITTING OF NON-VALENCE PARTON C C IW,IW1,IW2 ARE COLOUR CONNECTION WORDS C C ID1.LT.0 ON RETURN MEANS NO PHASE SPACE C ID1.EQ.0 ON RETURN FLAGS REJECTED BRANCHINGS C----------------------------------------------------------------------- INCLUDE 'HERWIG61.INC' DOUBLE PRECISION HWBVMC,HWR,HWUALF,HWUAEM,QP,X,QQ,Z,WQG,WQV, & WQP,XQV,ZMIN,ZMAX,YMIN,YMAX,DELY,YY,PSUM,EZ,WQN,WR,ZR,WZ,ZZ,AZ, & PVAL,EY,DIST(13),PROB(13,100),PPHO INTEGER ID,IW,ID1,ID2,IW1,IW2,NZ,IDHAD,IP,IZ LOGICAL HWRLOG,HWSVAL,FORCED,NONF,NONV,PHOTPR EXTERNAL HWBVMC,HWR,HWUALF,HWUAEM,HWRLOG,HWSVAL ID1=-1 QP=HWBVMC(ID) WQG=1.-QG/QQ WQV=1.-QV/QQ WQP=1.-QP/QQ XQV=X/WQV NONV=.NOT.HWSVAL(ID) NONF=.NOT.FORCED 5 IF (ID.EQ.13) THEN ZMIN=X IF (NONF) THEN ZMAX=WQG ELSE ZMAX=WQV ENDIF ELSE IF (NONV) THEN ZMIN=XQV IF (NONF) THEN ZMAX=WQG ELSE ZMAX=WQP ENDIF ELSE ZMIN=X ZMAX=MAX(WQG,WQP) ENDIF ENDIF IF (ZMIN.GE.ZMAX) RETURN ID1=0 C---INTERPOLATION VARIABLE IS Y=LN(Z/(1-Z)) YMIN=LOG(ZMIN/(1.-ZMIN)) YMAX=LOG(ZMAX/(1.-ZMAX)) DELY=YMAX-YMIN NZ=MIN(INT(ZBINM*DELY)+1,NZBIN) DELY=(YMAX-YMIN)/FLOAT(NZ) YY=YMIN+0.5*DELY PSUM=0. IDHAD=IDHW(INHAD) C---SET UP TABLES FOR CHOOSING BRANCHING DO 40 IZ=1,NZ EZ=EXP(YY) WR=1.+EZ ZR=WR/EZ WZ=1./WR ZZ=WZ*EZ AZ=WZ*ZZ*HWUALF(5-2*SUDORD,MAX(WZ*QQ,QG)) CALL HWSFUN(X*ZR,QQ,IDHAD,NSTRU,DIST,JNHAD) IF (ID.NE.13) THEN C---SPLITTING INTO QUARK DO 10 IP=1,ID-1 10 PROB(IP,IZ)=PSUM IF (NONF) PSUM=PSUM+DIST(ID)*AZ*CFFAC*(1.+ZZ*ZZ)*WR DO 20 IP=ID,12 20 PROB(IP,IZ)=PSUM PSUM=PSUM+DIST(13)*AZ*0.5*(ZZ*ZZ+WZ*WZ) PROB(13,IZ)=PSUM ELSE C---SPLITTING INTO GLUON DO 30 IP=1,12 PSUM=PSUM+DIST(IP)*AZ*CFFAC*(1.+WZ*WZ)*ZR 30 PROB(IP,IZ)=PSUM IF (NONF) PSUM=PSUM+DIST(13)*AZ*2.*CAFAC*(WZ*ZR+ZZ*WR+WZ*ZZ) PROB(13,IZ)=PSUM ENDIF 40 YY=YY+DELY 50 PHOTPR=IDHAD.EQ.59.AND.ID.NE.13 IF (PHOTPR) THEN C---ALLOW ANOMALOUS PHOTON SPLITTING PPHO=HWUAEM(-QQ*QQ)*CAFAC*(ZMIN**2+(1.-ZMIN)**2) & *ICHRG(ID)**2/(18.*PIFAC) IF (PPHO.GT.(PPHO+PSUM*DELY)*HWR()) THEN C---ANOMALOUS PHOTON SPLITTING OCCURRED ID1=59 RETURN ENDIF ENDIF IF (PSUM.LE.ZERO) RETURN C---CHOOSE Z PVAL=PSUM*HWR() DO 60 IZ=1,NZ IF (PROB(13,IZ).GT.PVAL) GOTO 70 60 CONTINUE IZ=NZ 70 EY=EXP(YMIN+DELY*(FLOAT(IZ)-HWR())) ZZ=EY/(1.+EY) C---CHOOSE BRANCHING DO 80 IP=1,13 IF (PROB(IP,IZ).GT.PVAL) GOTO 90 80 CONTINUE IP=13 C---CHECK THAT Z IS INSIDE PHASE SPACE (RETURN IF NOT) 90 CONTINUE IF (ID.NE.13) THEN IF (IP.EQ.ID) THEN IF ((NONV.AND.ZZ*WQP.LT.XQV).OR.ZZ.GT.WQG) THEN IF (PHOTPR) GOTO 50 RETURN ENDIF ELSE IF (ZZ.LT.XQV.OR.ZZ.GT.WQP) THEN IF (PHOTPR) GOTO 50 RETURN ENDIF ENDIF ELSE IF (IP.EQ.ID) THEN IF (ZZ.LT.XQV.OR.ZZ.GT.WQG) RETURN ELSEIF (.NOT.HWSVAL(IP)) THEN WQN=1.-HWBVMC(IP)/QQ IF (ZZ*WQN.LT.XQV.OR.ZZ.GT.WQN) RETURN ENDIF ENDIF C---EVERYTHING OK: LABEL NEW BRANCHES Z=ZZ ID1=IP IW1=IW*2 IW2=IW1+1 IF (ID.LE.6) THEN IF (ID1.EQ.13) THEN ID2=ID+6 ELSE ID2=13 IW2=IW1 ENDIF ELSE IF (ID.NE.13) THEN IF (ID1.EQ.13) THEN ID2=ID-6 IW2=IW1 ELSE ID2=13 ENDIF ELSE ID2=ID1 IF (ID1.EQ.13) THEN IF (HWRLOG(HALF)) IW2=IW1 ELSE IF (ID1.GT.6) THEN IW2=IW1 END IF END IF IF (IW2.EQ.IW1) IW1=IW1+1 999 END CDECK ID>, HWSFUN. *CMZ :- -02/05/91 11.30.51 by Federico Carminati *-- Author : Miscellaneous, combined by Bryan Webber C----------------------------------------------------------------------- SUBROUTINE HWSFUN(X,SCALE,IDHAD,NSET,DIST,IBEAM) C----------------------------------------------------------------------- C NUCLEON AND PION STRUCTURE FUNCTIONS DIST=X*QRK(X,Q=SCALE) C C IDHAD = TYPE OF HADRON: C 73=P 91=PBAR 75=N 93=NBAR 38=PI+ 30=PI- 59=PHOTON C C NEW SPECIAL CODES: C 71=`REMNANT PHOTON' 72=`REMNANT NUCLEON' C C NSET = STRUCTURE FUNCTION SET C = 1,2 FOR DUKE+OWENS SETS 1,2 (SOFT/HARD GLUE) C = 3,4 FOR EICHTEN ET AL SETS 1,2 (NUCLEON ONLY) C = 5 FOR OWENS SET 1.1 (PREPRINT FSU-HEP-910606) C C FOR PHOTON DREES+GRASSIE IS USED C C N.B. IF IBEAM.GT.0.AND.MODPDF(IBEAM).GE.0 THEN NSET IS C IGNORED AND CERN PDFLIB WITH AUTHOR GROUP=AUTPDF(IBEAM) AND C SET=MODPDF(IBEAM) IS USED. FOR COMPATABILITY WITH VERSIONS 3 C AND EARLIER, AUTPDF SHOULD BE SET TO 'MODE' C NOTE THAT NO CONSISTENCY CHECK IS MADE, FOR EXAMPLE THAT THE C REQUESTED SET FOR A PHOTON IS ACTUALLY A PHOTON SET C C IF (ISPAC.GT.0) SCALE IS REPLACED BY MAX(SCALE,QSPAC) C C FOR PHOTON, IF (PHOMAS.GT.0) THEN QUARK DISTRIBUTIONS ARE C SUPPRESSED BY LOG((Q**2+PHOMAS**2)/(P**2+PHOMAS**2)) C L = -------------------------------------- , C LOG((Q**2+PHOMAS**2)/( PHOMAS**2)) C WHILE GLUON DISTRIBUTIONS ARE SUPPRESSED BY L**2, C WHERE Q=SCALE AND P=VIRTUALITY OF THE PHOTON C C DUKE+OWENS = D.W.DUKE AND J.F.OWENS, PHYS. REV. D30 (1984) 49 (P/N) C + J.F.OWENS, PHYS. REV. D30 (1984) 943 (PI+/-) C WITH EXTRA SIGNIFICANT FIGURES VIA ED BERGER C WARNING....MOMENTUM SUM RULE BADLY VIOLATED ABOVE 1 TEV C DUKE+OWENS SETS 1,2 OBSOLETE. SET 1 UPDATED TO OWENS 1.1 (1991) C PION NOT RELIABLE ABOVE SCALE = 50 GEV C C EICHTEN ET AL = E.EICHTEN,I.HINCHLIFFE,K.LANE AND C.QUIGG, C REV. MOD. PHYS. 56 (1984) 579 C REVISED AS IN REV. MOD. PHYS. 58 (1986) 1065 C RELIABLE RANGE : SQRT(5)GEV < SCALE < 10TEV, 1E-4 < X < 1 C C DREES+GRASSIE = M.DREES & K.GRASSIE, ZEIT. PHYS. C28 (1985) 451 C MODIFIED IN M.DREES & C.S.KIM, DESY 91-039 C AND C.S.KIM, DTP/91/16 FOR HEAVY QUARKS C C FOR CERN PDFLIB DETAILS SEE PDFLIB DOC Q ON CERNVM OR C CERN_ROOT:[DOC]PDFLIB.TXT ON VXCERN C----------------------------------------------------------------------- INCLUDE 'HERWIG61.INC' DOUBLE PRECISION HWSGAM,X,SCALE,XOLD,QOLD,XMWN,QSCA,SS,SMIN,S,T, & TMIN,TMAX,VX,AA,VT,WT,UPV,DNV,SEA,STR,CHM,BTM,TOP,GLU,WX,XQSUM, & DMIN,TPMIN,TPMAX,DIST(13),G(2),Q0(5),QL(5),F(5),A(6,5), & B(3,6,5,4),XQ(6),TX(6),TT(6),TB(6),NEHLQ(8,2),CEHLQ(6,6,2,8,2), & BB(4,6,5),VAL(20),USEA,DSEA,TOTAL,SCALEF,FAC,TBMIN(2),TTMIN(2) REAL HWSDGG,HWSDGQ,XSP,Q2,P2,W2,EMB2,EMC2,ALAM2,XPGA(-6:6),F2GM, & XPVMD,XPANL,XPANH,XPBEH,XPDIR COMMON/SASCOM/XPVMD(-6:6),XPANL(-6:6),XPANH(-6:6),XPBEH(-6:6), & XPDIR(-6:6) LOGICAL PDFWRX(2,2),PDFWRQ(2,2) DOUBLE PRECISION PDFXMN,PDFXMX,PDFQMN,PDFQMX COMMON /W50513/PDFXMN,PDFXMX,PDFQMN,PDFQMX INTEGER IDHAD,NSET,IBEAM,IOLD,NOLD,IP,I,J,K,NX,IT,IX,IFL,NFL, & MPDF,IHAD,ISET,IOP1,IOP2,IP2 CHARACTER*20 PARM(20) EXTERNAL HWSGAM,HWSDGG,HWSDGQ SAVE QOLD,IOLD,NOLD,XOLD,SS,S,T,TMIN,TMAX,G,A,TX,TT,TB,IP,NX DATA PDFWRX,PDFWRQ/8*.TRUE./ DATA (((B(I,J,K,1),I=1,3),J=1,6),K=1,5)/ &3.,0.,0.,.419,.004383,-.007412, &3.46,.72432,-.065998,4.4,-4.8644,1.3274, &6*0.,1., &0.,0.,.763,-.23696,.025836,4.,.62664,-.019163, &0.,-.42068,.032809,6*0.,1.265,-1.1323,.29268, &0.,-.37162,-.028977,8.05,1.5877,-.15291, &0.,6.3059,-.27342,0.,-10.543,-3.1674, &0.,14.698,9.798,0.,.13479,-.074693, &-.0355,-.22237,-.057685,6.3494,3.2649,-.90945, &0.,-3.0331,1.5042,0.,17.431,-11.255, &0.,-17.861,15.571,1.564,-1.7112,.63751, &0.,-.94892,.32505,6.,1.4345,-1.0485, &9.,-7.1858,.25494,0.,-16.457,10.947, &0.,15.261,-10.085/ DATA (((B(I,J,K,2),I=1,3),J=1,6),K=1,5)/ &3.,0.,0.,.3743,.013946,-.00031695, &3.329,.75343,-.076125,6.032,-6.2153,1.5561, &6*0.,1.,0., &0.,.7608,-.2317,.023232,3.83,.62746,-.019155, &0.,-.41843,.035972,6*0.,1.6714,-1.9168,.58175, &0.,-.27307,-.16392,9.145,.53045,-.76271, &0.,15.665,-2.8341,0.,-100.63,44.658, &0.,223.24,-116.76,0.,.067368,-.030574, &-.11989,-.23293,-.023273,3.5087,3.6554,-.45313, &0.,-.47369,.35793,0.,9.5041,-5.4303, &0.,-16.563,15.524,.8789,-.97093,.43388, &0.,-1.1612,.4759,4.,1.2271,-.25369, &9.,-5.6354,-.81747,0.,-7.5438,5.5034, &0.,-.59649,.12611/ DATA (((B(I,J,K,3),I=1,3),J=1,6),K=1,5)/ &1.,0.,0.,0.4,-0.06212,-0.007109,0.7,0.6478,0.01335,27*0., &0.9,-0.2428,0.1386,0.,-0.2120,0.003671,5.0,0.8673,0.04747, &0.,1.266,-2.215,0.,2.382,0.3482,3*0., &0.,0.07928,-0.06134,-0.02212,-0.3785,-0.1088,2.894,9.433, &-10.852,0.,5.248,-7.187,0.,8.388,-11.61,3*0., &0.888,-1.802,1.812,0.,-1.576,1.20,3.11,-0.1317,0.5068, &6.0,2.801,-12.16,0.,-17.28,20.49,3*0./ DATA (((B(I,J,K,4),I=1,3),J=1,6),K=1,5)/ &1.,0.,0.,0.4,-0.05909,-0.006524,0.628,0.6436,0.01451,27*0., &0.90,-0.1417,-0.1740,0.,-0.1697,-0.09623,5.0,-2.474,1.575, &0.,-2.534,1.378,0.,0.5621,-0.2701,3*0., &0.,0.06229,-0.04099,-0.0882,-0.2892,-0.1082,1.924,0.2424, &2.036,0.,-4.463,5.209,0.,-0.8367,-0.04840,3*0., &0.794,-0.9144,0.5966,0.,-1.237,0.6582,2.89,0.5966,-0.2550, &6.0,-3.671,-2.304,0.,-8.191,7.758,3*0./ C---COEFFTS FOR NEW OWENS 1.1 SET DATA BB/3.,3*0.,.665,-.1097,-.002442,0., &3.614,.8395,-.02186,0.,.8673,-1.6637,.342,0., &0.,1.1049,-.2369,5*0.,1.,3*0., &.8388,-.2092,.02657,0.,4.667,.7951,.1081,0., &0.,-1.0232,.05799,0.,0.,.8616,.153,5*0., &.909,-.4023,.006305,0., &0.,-.3823,.02766,0.,7.278,-.7904,.8108,0., &0.,-1.6629,.5719,0.,0.,-.01333,.5299,0., &0.,.1211,-.1739,0.,0.,.09469,-.07066,.01236, &-.1447,-.402,.1533,-.06479,6.7599,1.6596,.6798,-.8525, &0.,-4.4559,3.3756,-.9468, &0.,7.862,-3.6591,.03672,0.,-.2472,-.751,.0487, &3.017,-4.7347,3.3594,-.9443,0.,-.9342,.5454,-.1668, &5.304,1.4654,-1.4292,.7569,0.,-3.9141,2.8445,-.8411, &0.,9.0176,-10.426,4.0983,0.,-5.9602,7.515,-2.7329/ C...THE FOLLOWING DATA LINES ARE COEFFICIENTS NEEDED IN THE C...EICHTEN, HINCHLIFFE, LANE, QUIGG PROTON STRUCTURE FUNCTION C...POWERS OF 1-X IN DIFFERENT CASES DATA NEHLQ/3,4,7,5,7,7,7,7,3,4,7,6,7,7,7,7/ C...EXPANSION COEFFICIENTS FOR UP VALENCE QUARK DISTRIBUTION DATA (((CEHLQ(IX,IT,NX,1,1),IX=1,6),IT=1,6),NX=1,2)/ 1 7.677E-01,-2.087E-01,-3.303E-01,-2.517E-02,-1.570E-02,-1.000E-04, 2-5.326E-01,-2.661E-01, 3.201E-01, 1.192E-01, 2.434E-02, 7.620E-03, 3 2.162E-01, 1.881E-01,-8.375E-02,-6.515E-02,-1.743E-02,-5.040E-03, 4-9.211E-02,-9.952E-02, 1.373E-02, 2.506E-02, 8.770E-03, 2.550E-03, 5 3.670E-02, 4.409E-02, 9.600E-04,-7.960E-03,-3.420E-03,-1.050E-03, 6-1.549E-02,-2.026E-02,-3.060E-03, 2.220E-03, 1.240E-03, 4.100E-04, 1 2.395E-01, 2.905E-01, 9.778E-02, 2.149E-02, 3.440E-03, 5.000E-04, 2 1.751E-02,-6.090E-03,-2.687E-02,-1.916E-02,-7.970E-03,-2.750E-03, 3-5.760E-03,-5.040E-03, 1.080E-03, 2.490E-03, 1.530E-03, 7.500E-04, 4 1.740E-03, 1.960E-03, 3.000E-04,-3.400E-04,-2.900E-04,-1.800E-04, 5-5.300E-04,-6.400E-04,-1.700E-04, 4.000E-05, 6.000E-05, 4.000E-05, 6 1.700E-04, 2.200E-04, 8.000E-05, 1.000E-05,-1.000E-05,-1.000E-05/ DATA (((CEHLQ(IX,IT,NX,1,2),IX=1,6),IT=1,6),NX=1,2)/ 1 7.237E-01,-2.189E-01,-2.995E-01,-1.909E-02,-1.477E-02, 2.500E-04, 2-5.314E-01,-2.425E-01, 3.283E-01, 1.119E-01, 2.223E-02, 7.070E-03, 3 2.289E-01, 1.890E-01,-9.859E-02,-6.900E-02,-1.747E-02,-5.080E-03, 4-1.041E-01,-1.084E-01, 2.108E-02, 2.975E-02, 9.830E-03, 2.830E-03, 5 4.394E-02, 5.116E-02,-1.410E-03,-1.055E-02,-4.230E-03,-1.270E-03, 6-1.991E-02,-2.539E-02,-2.780E-03, 3.430E-03, 1.720E-03, 5.500E-04, 1 2.410E-01, 2.884E-01, 9.369E-02, 1.900E-02, 2.530E-03, 2.400E-04, 2 1.765E-02,-9.220E-03,-3.037E-02,-2.085E-02,-8.440E-03,-2.810E-03, 3-6.450E-03,-5.260E-03, 1.720E-03, 3.110E-03, 1.830E-03, 8.700E-04, 4 2.120E-03, 2.320E-03, 2.600E-04,-4.900E-04,-3.900E-04,-2.300E-04, 5-6.900E-04,-8.200E-04,-2.000E-04, 7.000E-05, 9.000E-05, 6.000E-05, 6 2.400E-04, 3.100E-04, 1.100E-04, 0.000E+00,-2.000E-05,-2.000E-05/ C...EXPANSION COEFFICIENTS FOR DOWN VALENCE QUARK DISTRIBUTION DATA (((CEHLQ(IX,IT,NX,2,1),IX=1,6),IT=1,6),NX=1,2)/ 1 3.813E-01,-8.090E-02,-1.634E-01,-2.185E-02,-8.430E-03,-6.200E-04, 2-2.948E-01,-1.435E-01, 1.665E-01, 6.638E-02, 1.473E-02, 4.080E-03, 3 1.252E-01, 1.042E-01,-4.722E-02,-3.683E-02,-1.038E-02,-2.860E-03, 4-5.478E-02,-5.678E-02, 8.900E-03, 1.484E-02, 5.340E-03, 1.520E-03, 5 2.220E-02, 2.567E-02,-3.000E-05,-4.970E-03,-2.160E-03,-6.500E-04, 6-9.530E-03,-1.204E-02,-1.510E-03, 1.510E-03, 8.300E-04, 2.700E-04, 1 1.261E-01, 1.354E-01, 3.958E-02, 8.240E-03, 1.660E-03, 4.500E-04, 2 3.890E-03,-1.159E-02,-1.625E-02,-9.610E-03,-3.710E-03,-1.260E-03, 3-1.910E-03,-5.600E-04, 1.590E-03, 1.590E-03, 8.400E-04, 3.900E-04, 4 6.400E-04, 4.900E-04,-1.500E-04,-2.900E-04,-1.800E-04,-1.000E-04, 5-2.000E-04,-1.900E-04, 0.000E+00, 6.000E-05, 4.000E-05, 3.000E-05, 6 7.000E-05, 8.000E-05, 2.000E-05,-1.000E-05,-1.000E-05,-1.000E-05/ DATA (((CEHLQ(IX,IT,NX,2,2),IX=1,6),IT=1,6),NX=1,2)/ 1 3.578E-01,-8.622E-02,-1.480E-01,-1.840E-02,-7.820E-03,-4.500E-04, 2-2.925E-01,-1.304E-01, 1.696E-01, 6.243E-02, 1.353E-02, 3.750E-03, 3 1.318E-01, 1.041E-01,-5.486E-02,-3.872E-02,-1.038E-02,-2.850E-03, 4-6.162E-02,-6.143E-02, 1.303E-02, 1.740E-02, 5.940E-03, 1.670E-03, 5 2.643E-02, 2.957E-02,-1.490E-03,-6.450E-03,-2.630E-03,-7.700E-04, 6-1.218E-02,-1.497E-02,-1.260E-03, 2.240E-03, 1.120E-03, 3.500E-04, 1 1.263E-01, 1.334E-01, 3.732E-02, 7.070E-03, 1.260E-03, 3.400E-04, 2 3.660E-03,-1.357E-02,-1.795E-02,-1.031E-02,-3.880E-03,-1.280E-03, 3-2.100E-03,-3.600E-04, 2.050E-03, 1.920E-03, 9.800E-04, 4.400E-04, 4 7.700E-04, 5.400E-04,-2.400E-04,-3.900E-04,-2.400E-04,-1.300E-04, 5-2.600E-04,-2.300E-04, 2.000E-05, 9.000E-05, 6.000E-05, 4.000E-05, 6 9.000E-05, 1.000E-04, 2.000E-05,-2.000E-05,-2.000E-05,-1.000E-05/ C...EXPANSION COEFFICIENTS FOR UP AND DOWN SEA QUARK DISTRIBUTIONS DATA (((CEHLQ(IX,IT,NX,3,1),IX=1,6),IT=1,6),NX=1,2)/ 1 6.870E-02,-6.861E-02, 2.973E-02,-5.400E-03, 3.780E-03,-9.700E-04, 2-1.802E-02, 1.400E-04, 6.490E-03,-8.540E-03, 1.220E-03,-1.750E-03, 3-4.650E-03, 1.480E-03,-5.930E-03, 6.000E-04,-1.030E-03,-8.000E-05, 4 6.440E-03, 2.570E-03, 2.830E-03, 1.150E-03, 7.100E-04, 3.300E-04, 5-3.930E-03,-2.540E-03,-1.160E-03,-7.700E-04,-3.600E-04,-1.900E-04, 6 2.340E-03, 1.930E-03, 5.300E-04, 3.700E-04, 1.600E-04, 9.000E-05, 1 1.014E+00,-1.106E+00, 3.374E-01,-7.444E-02, 8.850E-03,-8.700E-04, 2 9.233E-01,-1.285E+00, 4.475E-01,-9.786E-02, 1.419E-02,-1.120E-03, 3 4.888E-02,-1.271E-01, 8.606E-02,-2.608E-02, 4.780E-03,-6.000E-04, 4-2.691E-02, 4.887E-02,-1.771E-02, 1.620E-03, 2.500E-04,-6.000E-05, 5 7.040E-03,-1.113E-02, 1.590E-03, 7.000E-04,-2.000E-04, 0.000E+00, 6-1.710E-03, 2.290E-03, 3.800E-04,-3.500E-04, 4.000E-05, 1.000E-05/ DATA (((CEHLQ(IX,IT,NX,3,2),IX=1,6),IT=1,6),NX=1,2)/ 1 1.008E-01,-7.100E-02, 1.973E-02,-5.710E-03, 2.930E-03,-9.900E-04, 2-5.271E-02,-1.823E-02, 1.792E-02,-6.580E-03, 1.750E-03,-1.550E-03, 3 1.220E-02, 1.763E-02,-8.690E-03,-8.800E-04,-1.160E-03,-2.100E-04, 4-1.190E-03,-7.180E-03, 2.360E-03, 1.890E-03, 7.700E-04, 4.100E-04, 5-9.100E-04, 2.040E-03,-3.100E-04,-1.050E-03,-4.000E-04,-2.400E-04, 6 1.190E-03,-1.700E-04,-2.000E-04, 4.200E-04, 1.700E-04, 1.000E-04, 1 1.081E+00,-1.189E+00, 3.868E-01,-8.617E-02, 1.115E-02,-1.180E-03, 2 9.917E-01,-1.396E+00, 4.998E-01,-1.159E-01, 1.674E-02,-1.720E-03, 3 5.099E-02,-1.338E-01, 9.173E-02,-2.885E-02, 5.890E-03,-6.500E-04, 4-3.178E-02, 5.703E-02,-2.070E-02, 2.440E-03, 1.100E-04,-9.000E-05, 5 8.970E-03,-1.392E-02, 2.050E-03, 6.500E-04,-2.300E-04, 2.000E-05, 6-2.340E-03, 3.010E-03, 5.000E-04,-3.900E-04, 6.000E-05, 1.000E-05/ C...EXPANSION COEFFICIENTS FOR GLUON DISTRIBUTION DATA (((CEHLQ(IX,IT,NX,4,1),IX=1,6),IT=1,6),NX=1,2)/ 1 9.482E-01,-9.578E-01, 1.009E-01,-1.051E-01, 3.456E-02,-3.054E-02, 2-9.627E-01, 5.379E-01, 3.368E-01,-9.525E-02, 1.488E-02,-2.051E-02, 3 4.300E-01,-8.306E-02,-3.372E-01, 4.902E-02,-9.160E-03, 1.041E-02, 4-1.925E-01,-1.790E-02, 2.183E-01, 7.490E-03, 4.140E-03,-1.860E-03, 5 8.183E-02, 1.926E-02,-1.072E-01,-1.944E-02,-2.770E-03,-5.200E-04, 6-3.884E-02,-1.234E-02, 5.410E-02, 1.879E-02, 3.350E-03, 1.040E-03, 1 2.948E+01,-3.902E+01, 1.464E+01,-3.335E+00, 5.054E-01,-5.915E-02, 2 2.559E+01,-3.955E+01, 1.661E+01,-4.299E+00, 6.904E-01,-8.243E-02, 3-1.663E+00, 1.176E+00, 1.118E+00,-7.099E-01, 1.948E-01,-2.404E-02, 4-2.168E-01, 8.170E-01,-7.169E-01, 1.851E-01,-1.924E-02,-3.250E-03, 5 2.088E-01,-4.355E-01, 2.239E-01,-2.446E-02,-3.620E-03, 1.910E-03, 6-9.097E-02, 1.601E-01,-5.681E-02,-2.500E-03, 2.580E-03,-4.700E-04/ DATA (((CEHLQ(IX,IT,NX,4,2),IX=1,6),IT=1,6),NX=1,2)/ 1 2.367E+00, 4.453E-01, 3.660E-01, 9.467E-02, 1.341E-01, 1.661E-02, 2-3.170E+00,-1.795E+00, 3.313E-02,-2.874E-01,-9.827E-02,-7.119E-02, 3 1.823E+00, 1.457E+00,-2.465E-01, 3.739E-02, 6.090E-03, 1.814E-02, 4-1.033E+00,-9.827E-01, 2.136E-01, 1.169E-01, 5.001E-02, 1.684E-02, 5 5.133E-01, 5.259E-01,-1.173E-01,-1.139E-01,-4.988E-02,-2.021E-02, 6-2.881E-01,-3.145E-01, 5.667E-02, 9.161E-02, 4.568E-02, 1.951E-02, 1 3.036E+01,-4.062E+01, 1.578E+01,-3.699E+00, 6.020E-01,-7.031E-02, 2 2.700E+01,-4.167E+01, 1.770E+01,-4.804E+00, 7.862E-01,-1.060E-01, 3-1.909E+00, 1.357E+00, 1.127E+00,-7.181E-01, 2.232E-01,-2.481E-02, 4-2.488E-01, 9.781E-01,-8.127E-01, 2.094E-01,-2.997E-02,-4.710E-03, 5 2.506E-01,-5.427E-01, 2.672E-01,-3.103E-02,-1.800E-03, 2.870E-03, 6-1.128E-01, 2.087E-01,-6.972E-02,-2.480E-03, 2.630E-03,-8.400E-04/ C...EXPANSION COEFFICIENTS FOR STRANGE SEA QUARK DISTRIBUTION DATA (((CEHLQ(IX,IT,NX,5,1),IX=1,6),IT=1,6),NX=1,2)/ 1 4.968E-02,-4.173E-02, 2.102E-02,-3.270E-03, 3.240E-03,-6.700E-04, 2-6.150E-03,-1.294E-02, 6.740E-03,-6.890E-03, 9.000E-04,-1.510E-03, 3-8.580E-03, 5.050E-03,-4.900E-03,-1.600E-04,-9.400E-04,-1.500E-04, 4 7.840E-03, 1.510E-03, 2.220E-03, 1.400E-03, 7.000E-04, 3.500E-04, 5-4.410E-03,-2.220E-03,-8.900E-04,-8.500E-04,-3.600E-04,-2.000E-04, 6 2.520E-03, 1.840E-03, 4.100E-04, 3.900E-04, 1.600E-04, 9.000E-05, 1 9.235E-01,-1.085E+00, 3.464E-01,-7.210E-02, 9.140E-03,-9.100E-04, 2 9.315E-01,-1.274E+00, 4.512E-01,-9.775E-02, 1.380E-02,-1.310E-03, 3 4.739E-02,-1.296E-01, 8.482E-02,-2.642E-02, 4.760E-03,-5.700E-04, 4-2.653E-02, 4.953E-02,-1.735E-02, 1.750E-03, 2.800E-04,-6.000E-05, 5 6.940E-03,-1.132E-02, 1.480E-03, 6.500E-04,-2.100E-04, 0.000E+00, 6-1.680E-03, 2.340E-03, 4.200E-04,-3.400E-04, 5.000E-05, 1.000E-05/ DATA (((CEHLQ(IX,IT,NX,5,2),IX=1,6),IT=1,6),NX=1,2)/ 1 6.478E-02,-4.537E-02, 1.643E-02,-3.490E-03, 2.710E-03,-6.700E-04, 2-2.223E-02,-2.126E-02, 1.247E-02,-6.290E-03, 1.120E-03,-1.440E-03, 3-1.340E-03, 1.362E-02,-6.130E-03,-7.900E-04,-9.000E-04,-2.000E-04, 4 5.080E-03,-3.610E-03, 1.700E-03, 1.830E-03, 6.800E-04, 4.000E-04, 5-3.580E-03, 6.000E-05,-2.600E-04,-1.050E-03,-3.800E-04,-2.300E-04, 6 2.420E-03, 9.300E-04,-1.000E-04, 4.500E-04, 1.700E-04, 1.100E-04, 1 9.868E-01,-1.171E+00, 3.940E-01,-8.459E-02, 1.124E-02,-1.250E-03, 2 1.001E+00,-1.383E+00, 5.044E-01,-1.152E-01, 1.658E-02,-1.830E-03, 3 4.928E-02,-1.368E-01, 9.021E-02,-2.935E-02, 5.800E-03,-6.600E-04, 4-3.133E-02, 5.785E-02,-2.023E-02, 2.630E-03, 1.600E-04,-8.000E-05, 5 8.840E-03,-1.416E-02, 1.900E-03, 5.800E-04,-2.500E-04, 1.000E-05, 6-2.300E-03, 3.080E-03, 5.500E-04,-3.700E-04, 7.000E-05, 1.000E-05/ C...EXPANSION COEFFICIENTS FOR CHARM SEA QUARK DISTRIBUTION DATA (((CEHLQ(IX,IT,NX,6,1),IX=1,6),IT=1,6),NX=1,2)/ 1 9.270E-03,-1.817E-02, 9.590E-03,-6.390E-03, 1.690E-03,-1.540E-03, 2 5.710E-03,-1.188E-02, 6.090E-03,-4.650E-03, 1.240E-03,-1.310E-03, 3-3.960E-03, 7.100E-03,-3.590E-03, 1.840E-03,-3.900E-04, 3.400E-04, 4 1.120E-03,-1.960E-03, 1.120E-03,-4.800E-04, 1.000E-04,-4.000E-05, 5 4.000E-05,-3.000E-05,-1.800E-04, 9.000E-05,-5.000E-05,-2.000E-05, 6-4.200E-04, 7.300E-04,-1.600E-04, 5.000E-05, 5.000E-05, 5.000E-05, 1 8.098E-01,-1.042E+00, 3.398E-01,-6.824E-02, 8.760E-03,-9.000E-04, 2 8.961E-01,-1.217E+00, 4.339E-01,-9.287E-02, 1.304E-02,-1.290E-03, 3 3.058E-02,-1.040E-01, 7.604E-02,-2.415E-02, 4.600E-03,-5.000E-04, 4-2.451E-02, 4.432E-02,-1.651E-02, 1.430E-03, 1.200E-04,-1.000E-04, 5 1.122E-02,-1.457E-02, 2.680E-03, 5.800E-04,-1.200E-04, 3.000E-05, 6-7.730E-03, 7.330E-03,-7.600E-04,-2.400E-04, 1.000E-05, 0.000E+00/ DATA (((CEHLQ(IX,IT,NX,6,2),IX=1,6),IT=1,6),NX=1,2)/ 1 9.980E-03,-1.945E-02, 1.055E-02,-6.870E-03, 1.860E-03,-1.560E-03, 2 5.700E-03,-1.203E-02, 6.250E-03,-4.860E-03, 1.310E-03,-1.370E-03, 3-4.490E-03, 7.990E-03,-4.170E-03, 2.050E-03,-4.400E-04, 3.300E-04, 4 1.470E-03,-2.480E-03, 1.460E-03,-5.700E-04, 1.200E-04,-1.000E-05, 5-9.000E-05, 1.500E-04,-3.200E-04, 1.200E-04,-6.000E-05,-4.000E-05, 6-4.200E-04, 7.600E-04,-1.400E-04, 4.000E-05, 7.000E-05, 5.000E-05, 1 8.698E-01,-1.131E+00, 3.836E-01,-8.111E-02, 1.048E-02,-1.300E-03, 2 9.626E-01,-1.321E+00, 4.854E-01,-1.091E-01, 1.583E-02,-1.700E-03, 3 3.057E-02,-1.088E-01, 8.022E-02,-2.676E-02, 5.590E-03,-5.600E-04, 4-2.845E-02, 5.164E-02,-1.918E-02, 2.210E-03,-4.000E-05,-1.500E-04, 5 1.311E-02,-1.751E-02, 3.310E-03, 5.100E-04,-1.200E-04, 5.000E-05, 6-8.590E-03, 8.380E-03,-9.200E-04,-2.600E-04, 1.000E-05,-1.000E-05/ C...EXPANSION COEFFICIENTS FOR BOTTOM SEA QUARK DISTRIBUTION DATA (((CEHLQ(IX,IT,NX,7,1),IX=1,6),IT=1,6),NX=1,2)/ 1 9.010E-03,-1.401E-02, 7.150E-03,-4.130E-03, 1.260E-03,-1.040E-03, 2 6.280E-03,-9.320E-03, 4.780E-03,-2.890E-03, 9.100E-04,-8.200E-04, 3-2.930E-03, 4.090E-03,-1.890E-03, 7.600E-04,-2.300E-04, 1.400E-04, 4 3.900E-04,-1.200E-03, 4.400E-04,-2.500E-04, 2.000E-05,-2.000E-05, 5 2.600E-04, 1.400E-04,-8.000E-05, 1.000E-04, 1.000E-05, 1.000E-05, 6-2.600E-04, 3.200E-04, 1.000E-05,-1.000E-05, 1.000E-05,-1.000E-05, 1 8.029E-01,-1.075E+00, 3.792E-01,-7.843E-02, 1.007E-02,-1.090E-03, 2 7.903E-01,-1.099E+00, 4.153E-01,-9.301E-02, 1.317E-02,-1.410E-03, 3-1.704E-02,-1.130E-02, 2.882E-02,-1.341E-02, 3.040E-03,-3.600E-04, 4-7.200E-04, 7.230E-03,-5.160E-03, 1.080E-03,-5.000E-05,-4.000E-05, 5 3.050E-03,-4.610E-03, 1.660E-03,-1.300E-04,-1.000E-05, 1.000E-05, 6-4.360E-03, 5.230E-03,-1.610E-03, 2.000E-04,-2.000E-05, 0.000E+00/ DATA (((CEHLQ(IX,IT,NX,7,2),IX=1,6),IT=1,6),NX=1,2)/ 1 8.980E-03,-1.459E-02, 7.510E-03,-4.410E-03, 1.310E-03,-1.070E-03, 2 5.970E-03,-9.440E-03, 4.800E-03,-3.020E-03, 9.100E-04,-8.500E-04, 3-3.050E-03, 4.440E-03,-2.100E-03, 8.500E-04,-2.400E-04, 1.400E-04, 4 5.300E-04,-1.300E-03, 5.600E-04,-2.700E-04, 3.000E-05,-2.000E-05, 5 2.000E-04, 1.400E-04,-1.100E-04, 1.000E-04, 0.000E+00, 0.000E+00, 6-2.600E-04, 3.200E-04, 0.000E+00,-3.000E-05, 1.000E-05,-1.000E-05, 1 8.672E-01,-1.174E+00, 4.265E-01,-9.252E-02, 1.244E-02,-1.460E-03, 2 8.500E-01,-1.194E+00, 4.630E-01,-1.083E-01, 1.614E-02,-1.830E-03, 3-2.241E-02,-5.630E-03, 2.815E-02,-1.425E-02, 3.520E-03,-4.300E-04, 4-7.300E-04, 8.030E-03,-5.780E-03, 1.380E-03,-1.300E-04,-4.000E-05, 5 3.460E-03,-5.380E-03, 1.960E-03,-2.100E-04, 1.000E-05, 1.000E-05, 6-4.850E-03, 5.950E-03,-1.890E-03, 2.600E-04,-3.000E-05, 0.000E+00/ C...EXPANSION COEFFICIENTS FOR TOP SEA QUARK DISTRIBUTION DATA (((CEHLQ(IX,IT,NX,8,1),IX=1,6),IT=1,6),NX=1,2)/ 1 4.410E-03,-7.480E-03, 3.770E-03,-2.580E-03, 7.300E-04,-7.100E-04, 2 3.840E-03,-6.050E-03, 3.030E-03,-2.030E-03, 5.800E-04,-5.900E-04, 3-8.800E-04, 1.660E-03,-7.500E-04, 4.700E-04,-1.000E-04, 1.000E-04, 4-8.000E-05,-1.500E-04, 1.200E-04,-9.000E-05, 3.000E-05, 0.000E+00, 5 1.300E-04,-2.200E-04,-2.000E-05,-2.000E-05,-2.000E-05,-2.000E-05, 6-7.000E-05, 1.900E-04,-4.000E-05, 2.000E-05, 0.000E+00, 0.000E+00, 1 6.623E-01,-9.248E-01, 3.519E-01,-7.930E-02, 1.110E-02,-1.180E-03, 2 6.380E-01,-9.062E-01, 3.582E-01,-8.479E-02, 1.265E-02,-1.390E-03, 3-2.581E-02, 2.125E-02, 4.190E-03,-4.980E-03, 1.490E-03,-2.100E-04, 4 7.100E-04, 5.300E-04,-1.270E-03, 3.900E-04,-5.000E-05,-1.000E-05, 5 3.850E-03,-5.060E-03, 1.860E-03,-3.500E-04, 4.000E-05, 0.000E+00, 6-3.530E-03, 4.460E-03,-1.500E-03, 2.700E-04,-3.000E-05, 0.000E+00/ DATA (((CEHLQ(IX,IT,NX,8,2),IX=1,6),IT=1,6),NX=1,2)/ 1 4.260E-03,-7.530E-03, 3.830E-03,-2.680E-03, 7.600E-04,-7.300E-04, 2 3.640E-03,-6.050E-03, 3.030E-03,-2.090E-03, 5.900E-04,-6.000E-04, 3-9.200E-04, 1.710E-03,-8.200E-04, 5.000E-04,-1.200E-04, 1.000E-04, 4-5.000E-05,-1.600E-04, 1.300E-04,-9.000E-05, 3.000E-05, 0.000E+00, 5 1.300E-04,-2.100E-04,-1.000E-05,-2.000E-05,-2.000E-05,-1.000E-05, 6-8.000E-05, 1.800E-04,-5.000E-05, 2.000E-05, 0.000E+00, 0.000E+00, 1 7.146E-01,-1.007E+00, 3.932E-01,-9.246E-02, 1.366E-02,-1.540E-03, 2 6.856E-01,-9.828E-01, 3.977E-01,-9.795E-02, 1.540E-02,-1.790E-03, 3-3.053E-02, 2.758E-02, 2.150E-03,-4.880E-03, 1.640E-03,-2.500E-04, 4 9.200E-04, 4.200E-04,-1.340E-03, 4.600E-04,-8.000E-05,-1.000E-05, 5 4.230E-03,-5.660E-03, 2.140E-03,-4.300E-04, 6.000E-05, 0.000E+00, 6-3.890E-03, 5.000E-03,-1.740E-03, 3.300E-04,-4.000E-05, 0.000E+00/ DATA TBMIN,TTMIN/8.1905,7.4474,11.5528,10.8097/ DATA XOLD,QOLD,IOLD,NOLD/-1.,0.,0,0/ DATA DMIN,Q0,QL/0.,2*2.,2*2.236,2.,.2,.4,.2,.29,.177/ IF (X.LE.ZERO) CALL HWWARN('HWSFUN',100,*999) XMWN=ONE-X IF (XMWN.LE.ZERO) THEN DO 1 I=1,13 DIST(I)=0 1 CONTINUE RETURN ENDIF C---FREEZE THE SCALE IF REQUIRED SCALEF=SCALE IF (ISPAC.GT.0) SCALEF=MAX(SCALEF,QSPAC) C---CHECK IF PDFLIB REQUESTED IF (IBEAM.EQ.1.OR.IBEAM.EQ.2) THEN MPDF=MODPDF(IBEAM) ELSE MPDF=-1 ENDIF QSCA=ABS(SCALEF) IF (IDHAD.EQ.59.OR.IDHAD.EQ.71) THEN IF (MPDF.GE.0) THEN C---USE PDFLIB PHOTON STRUCTURE FUNCTIONS PARM(1)=AUTPDF(IBEAM) VAL(1)=FLOAT(MPDF) C---FIX TO CALL SCHULER-SJOSTRAND CODE IF (AUTPDF(IBEAM).EQ.'SaSph') THEN XSP=X IF ( XSP.LE.ZERO) CALL HWWARN('HWSFUN',102,*999) IF (ONE-XSP.LE.ZERO) CALL HWWARN('HWSFUN',103,*999) Q2=QSCA**2 ISET=MOD(MODPDF(IBEAM),10) IOP1=MOD(MODPDF(IBEAM)/10,2) IOP2=MOD(MODPDF(IBEAM)/20,2) IP2=MODPDF(IBEAM)/100 IF (IOP2.EQ.0) THEN P2=0. ELSE IHAD=IBEAM IF (JDAHEP(1,IHAD).NE.0) IHAD=JDAHEP(1,IHAD) P2=PHEP(5,IHAD)**2 ENDIF CALL SASGAM(ISET,XSP,Q2,P2,IP2,F2GM,XPGA) IF (IOP1.EQ.1 .AND. ISTAT.LT.10) THEN DO 5 I=-6,6 5 XPGA(I)=XPVMD(I)+XPANL(I)+XPBEH(I)+XPDIR(I) ENDIF UPV=XPGA(2) DNV=XPGA(1) USEA=XPGA(2) DSEA=XPGA(1) STR=XPGA(3) CHM=XPGA(4) BTM=XPGA(5) TOP=XPGA(6) GLU=XPGA(0) ELSE CALL PDFSET(PARM,VAL) IF (X.LT.PDFXMN.AND.PDFWRX(IBEAM,1) .OR. & X.GT.PDFXMX.AND.PDFWRX(IBEAM,2)) THEN CALL HWWARN('HWSFUN',2,*999) WRITE (6,'(2A)') ' WARNING: PDFLIB CALLED WITH X', & ' OUTSIDE ALLOWED RANGE!' WRITE (6,'(1P,3(A,E9.3))') ' X VALUE=',X, & ', MINIMUM=',PDFXMN,', MAXIMUM=',PDFXMX WRITE (6,'(A)') ' NO FURTHER WARNINGS WILL BE ISSUED' IF (X.LT.PDFXMN) PDFWRX(IBEAM,1)=.FALSE. IF (X.GT.PDFXMX) PDFWRX(IBEAM,2)=.FALSE. ENDIF IF (QSCA**2.LT.PDFQMN.AND.PDFWRQ(IBEAM,1) .OR. & QSCA**2.GT.PDFQMX.AND.PDFWRQ(IBEAM,2)) THEN CALL HWWARN('HWSFUN',3,*999) WRITE (6,'(2A)') ' WARNING: PDFLIB CALLED WITH Q', & ' OUTSIDE ALLOWED RANGE!' WRITE (6,'(1P,3(A,E9.3))') ' Q VALUE=',QSCA, & ', MINIMUM=',SQRT(PDFQMN),', MAXIMUM=',SQRT(PDFQMX) WRITE (6,'(A)') ' NO FURTHER WARNINGS WILL BE ISSUED' IF (QSCA**2.LT.PDFQMN) PDFWRQ(IBEAM,1)=.FALSE. IF (QSCA**2.GT.PDFQMN) PDFWRQ(IBEAM,2)=.FALSE. ENDIF CALL STRUCTM(X,QSCA,UPV,DNV,USEA,DSEA,STR,CHM,BTM,TOP,GLU) ENDIF DIST(1)=DSEA DIST(2)=USEA DIST(7)=DSEA DIST(8)=USEA ELSE XSP=X IF ( XSP.LE.ZERO) CALL HWWARN('HWSFUN',102,*999) IF (ONE-XSP.LE.ZERO) CALL HWWARN('HWSFUN',103,*999) Q2=SCALEF**2 W2=Q2*(1-X)/X EMC2=4*RMASS(4)**2 EMB2=4*RMASS(5)**2 ALAM2=0.160 NFL=3 IF (Q2.GT.50.) NFL=4 IF (Q2.GT.500.) NFL=5 STR=HWSDGQ(XSP,Q2,NFL,1) CHM=HWSDGQ(XSP,Q2,NFL,2) GLU=HWSDGG(XSP,Q2,NFL) DIST(1)=STR DIST(2)=CHM DIST(7)=STR DIST(8)=CHM IF (W2.GT.EMB2) THEN BTM=STR IF (W2*ALAM2.LT.Q2*EMB2) & BTM=BTM*LOG(W2/EMB2)/LOG(Q2/ALAM2) ELSE BTM=0. ENDIF IF (W2.GT.EMC2) THEN IF (W2*ALAM2.LT.Q2*EMC2) & CHM=CHM*LOG(W2/EMC2)/LOG(Q2/ALAM2) ELSE CHM=0. ENDIF TOP=0. ENDIF C---INCLUDE SUPPRESSION FROM PHOTON VIRTUALITY IF NECESSARY IF (PHOMAS.GT.ZERO.AND.(IBEAM.EQ.1.OR.IBEAM.EQ.2)) THEN IHAD=IBEAM IF (JDAHEP(1,IHAD).NE.0) IHAD=JDAHEP(1,IHAD) IF (IDHW(IHAD).EQ.59) THEN FAC=LOG((QSCA**2+PHOMAS**2)/(PHEP(5,IHAD)**2+PHOMAS**2))/ $ LOG((QSCA**2+PHOMAS**2)/( PHOMAS**2)) IF (FAC.LT.ZERO) FAC=ZERO DIST(1)=DIST(1)*FAC DIST(2)=DIST(2)*FAC DIST(7)=DIST(7)*FAC DIST(8)=DIST(8)*FAC STR=STR*FAC CHM=CHM*FAC BTM=BTM*FAC TOP=TOP*FAC GLU=GLU*FAC**2 ELSE CALL HWWARN('HWSFUN',1,*999) ENDIF ENDIF GOTO 900 ENDIF IF (MPDF.GE.0) THEN C---USE PDFLIB NUCLEON STRUCTURE FUNCTIONS PARM(1)=AUTPDF(IBEAM) VAL(1)=FLOAT(MPDF) CALL PDFSET(PARM,VAL) IF (X.LT.PDFXMN.AND.PDFWRX(IBEAM,1) .OR. & X.GT.PDFXMX.AND.PDFWRX(IBEAM,2)) THEN CALL HWWARN('HWSFUN',4,*999) WRITE (6,'(2A)') ' WARNING: PDFLIB CALLED WITH X', & ' OUTSIDE ALLOWED RANGE!' WRITE (6,'(1P,3(A,E9.3))') ' X VALUE=',X, & ', MINIMUM=',PDFXMN,', MAXIMUM=',PDFXMX WRITE (6,'(A)') ' NO FURTHER WARNINGS WILL BE ISSUED' IF (X.LT.PDFXMN) PDFWRX(IBEAM,1)=.FALSE. IF (X.GT.PDFXMX) PDFWRX(IBEAM,2)=.FALSE. ENDIF IF (QSCA**2.LT.PDFQMN.AND.PDFWRQ(IBEAM,1) .OR. & QSCA**2.GT.PDFQMX.AND.PDFWRQ(IBEAM,2)) THEN CALL HWWARN('HWSFUN',5,*999) WRITE (6,'(2A)') ' WARNING: PDFLIB CALLED WITH Q', & ' OUTSIDE ALLOWED RANGE!' WRITE (6,'(1P,3(A,E9.3))') ' Q VALUE=',QSCA, & ', MINIMUM=',SQRT(PDFQMN),', MAXIMUM=',SQRT(PDFQMX) WRITE (6,'(A)') ' NO FURTHER WARNINGS WILL BE ISSUED' IF (QSCA**2.LT.PDFQMN) PDFWRQ(IBEAM,1)=.FALSE. IF (QSCA**2.GT.PDFQMN) PDFWRQ(IBEAM,2)=.FALSE. ENDIF CALL STRUCTM(X,QSCA,UPV,DNV,USEA,DSEA,STR,CHM,BTM,TOP,GLU) ELSE IF (QSCA.LT.Q0(NSET)) QSCA=Q0(NSET) IF (QSCA.NE.QOLD.OR.IDHAD.NE.IOLD.OR.NSET.NE.NOLD) THEN C---INITIALIZE IF (NSET.LT.1.OR.NSET.GT.5) CALL HWWARN('HWSFUN',400,*999) QOLD=QSCA IOLD=IDHAD NOLD=NSET SS=LOG(QSCA/QL(NSET)) SMIN=LOG(Q0(NSET)/QL(NSET)) IF (NSET.LT.3.OR.NSET.EQ.5) THEN S=LOG(SS/SMIN) ELSE T=2.*SS TMIN=2.*SMIN TMAX=2.*LOG(1.E4/QL(NSET)) ENDIF IF (IDHAD.GE.72) THEN IF (NSET.LT.3) THEN IP=NSET DO 10 I=1,5 DO 10 J=1,6 10 A(J,I)=B(1,J,I,IP)+S*(B(2,J,I,IP)+S*B(3,J,I,IP)) DO 20 K=1,2 AA=ONE+A(2,K)+A(3,K) 20 G(K)=HWSGAM(AA)/((ONE+A(2,K)*A(4,K)/AA)*HWSGAM(A(2,K)) & *HWSGAM(ONE+A(3,K))) ELSEIF (NSET.EQ.5) THEN DO 21 I=1,5 DO 21 J=1,6 21 A(J,I)=BB(1,J,I)+S*(BB(2,J,I)+S*(BB(3,J,I)+S*BB(4,J,I))) DO 22 K=1,2 AA=ONE+A(2,K)+A(3,K) 22 G(K)=HWSGAM(AA)/((ONE+A(2,K)/AA*(A(4,K)+ & (ONE+A(2,K))/(ONE+AA)*A(5,K)))*HWSGAM(A(2,K)) & *HWSGAM(ONE+A(3,K))) ELSE IP=NSET-2 VT=MAX(-ONE,MIN(ONE,(2.*T-TMAX-TMIN)/(TMAX-TMIN))) WT=VT*VT C...CHEBYSHEV POLYNOMIALS FOR T EXPANSION TT(1)=1. TT(2)=VT TT(3)= 2.*WT- 1. TT(4)= (4.*WT- 3.)*VT TT(5)= (8.*WT- 8.)*WT+1. TT(6)=((16.*WT-20.)*WT+5.)*VT ENDIF ELSEIF (NSET.LT.3) THEN IP=NSET+2 DO 30 I=1,5 DO 30 J=1,6 30 A(J,I)=B(1,J,I,IP)+S*(B(2,J,I,IP)+S*B(3,J,I,IP)) AA=ONE+A(2,1)+A(3,1) G(1)=HWSGAM(AA)/(HWSGAM(A(2,1))*HWSGAM(ONE+A(3,1))) G(2)=0. ENDIF ENDIF C IF (NSET.LT.3.OR.NSET.EQ.5) THEN DO 50 I=1,5 50 F(I)=A(1,I)*X**A(2,I)*XMWN**A(3,I)*(ONE+X* & (A(4,I)+X*(A(5,I) + X*A(6,I)))) F(1)=F(1)*G(1) F(2)=F(2)*G(2) UPV=F(1)-F(2) DNV=F(2) SEA=F(3)/6. STR=SEA CHM=F(4) BTM=0. TOP=0. GLU=F(5) ELSE IF (X.NE.XOLD) THEN XOLD=X IF (X.GT.0.1) THEN NX=1 VX=(2.*X-1.1)/0.9 ELSE NX=2 VX=MAX(-ONE,(2.*LOG(X)+11.51293)/6.90776) ENDIF WX=VX*VX TX(1)=1. TX(2)=VX TX(3)= 2.*WX- 1. TX(4)= (4.*WX- 3.)*VX TX(5)= (8.*WX- 8.)*WX+1. TX(6)=((16.*WX-20.)*WX+5.)*VX ENDIF C...CALCULATE STRUCTURE FUNCTIONS DO 120 IFL=1,6 XQSUM=0. DO 110 IT=1,6 DO 110 IX=1,6 110 XQSUM=XQSUM+CEHLQ(IX,IT,NX,IFL,IP)*TX(IX)*TT(IT) 120 XQ(IFL)=XQSUM*XMWN**NEHLQ(IFL,IP) UPV=XQ(1) DNV=XQ(2) STR=XQ(5) CHM=XQ(6) SEA=XQ(3) GLU=XQ(4) C...SPECIAL EXPANSION FOR BOTTOM (THRESHOLD EFFECTS) IF (NFLAV.LT.5.OR.T.LE.TBMIN(IP)) THEN BTM=0. ELSE VT=MAX(-ONE,MIN(ONE,(2.*T-TMAX-TBMIN(IP))/(TMAX-TBMIN(IP)))) WT=VT*VT TB(1)=1. TB(2)=VT TB(3)= 2.*WT- 1. TB(4)= (4.*WT- 3.)*VT TB(5)= (8.*WT- 8.)*WT+1. TB(6)=((16.*WT-20.)*WT+5.)*VT XQSUM=0. DO 130 IT=1,6 DO 130 IX=1,6 130 XQSUM=XQSUM+CEHLQ(IX,IT,NX,7,IP)*TX(IX)*TB(IT) BTM=XQSUM*XMWN**NEHLQ(7,IP) ENDIF C...SPECIAL EXPANSION FOR TOP (THRESHOLD EFFECTS) TPMIN=TTMIN(IP)+TMTOP C---TMTOP=2.*LOG(TOPMAS/30.) TPMAX=TMAX+TMTOP IF (NFLAV.LT.6.OR.T.LE.TPMIN) THEN TOP=0. ELSE VT=MAX(-ONE,MIN(ONE,(2.*T-TPMAX-TPMIN)/(TPMAX-TPMIN))) WT=VT*VT TB(1)=1. TB(2)=VT TB(3)= 2.*WT- 1. TB(4)= (4.*WT- 3.)*VT TB(5)= (8.*WT- 8.)*WT+1. TB(6)=((16.*WT-20.)*WT+5.)*VT XQSUM=0. DO 150 IT=1,6 DO 150 IX=1,6 150 XQSUM=XQSUM+CEHLQ(IX,IT,NX,8,IP)*TX(IX)*TB(IT) TOP=XQSUM*XMWN**NEHLQ(8,IP) ENDIF ENDIF ENDIF IF (MPDF.LT.0) THEN USEA=SEA DSEA=USEA ENDIF IF (IDHAD.EQ.73.OR.IDHAD.EQ.72) THEN DIST(1)=DSEA+DNV DIST(2)=USEA+UPV DIST(7)=DSEA DIST(8)=USEA ELSEIF (IDHAD.EQ.91) THEN DIST(1)=DSEA DIST(2)=USEA DIST(7)=DSEA+DNV DIST(8)=USEA+UPV ELSEIF (IDHAD.EQ.75) THEN DIST(1)=USEA+UPV DIST(2)=DSEA+DNV DIST(7)=USEA DIST(8)=DSEA ELSEIF (IDHAD.EQ.93) THEN DIST(1)=USEA DIST(2)=DSEA DIST(7)=USEA+UPV DIST(8)=DSEA+DNV ELSEIF (IDHAD.EQ.38) THEN DIST(1)=USEA DIST(2)=USEA+UPV DIST(7)=USEA+UPV DIST(8)=USEA ELSEIF (IDHAD.EQ.30) THEN DIST(1)=USEA+UPV DIST(2)=USEA DIST(7)=USEA DIST(8)=USEA+UPV ELSE PRINT *,' CALLED HWSFUN FOR IDHAD =',IDHAD CALL HWWARN('HWSFUN',400,*999) ENDIF 900 DIST(3)=STR DIST(4)=CHM DIST(5)=BTM DIST(6)=TOP DIST(9)=STR DIST(10)=CHM DIST(11)=BTM DIST(12)=TOP DIST(13)=GLU DO 901 I=1,13 IF (DIST(I).LT.DMIN) DIST(I)=DMIN 901 CONTINUE C---FOR REMNANT NUCLEONS SWITCH OFF VALENCE QUARKS, C WHILE MAINTAINING MOMENTUM SUM RULE IF (IDHAD.EQ.72) THEN TOTAL=0 DO 910 I=1,13 TOTAL=TOTAL+DIST(I) 910 CONTINUE DIST(1)=DIST(1)-DNV DIST(2)=DIST(2)-UPV IF (TOTAL.GT.DNV+UPV) THEN DO 920 I=1,13 DIST(I)=DIST(I)*TOTAL/(TOTAL-DNV-UPV) 920 CONTINUE ENDIF ENDIF 999 END CDECK ID>, HWSGAM. *CMZ :- -26/04/91 11.11.56 by Bryan Webber *-- Author : Adapted by Bryan Webber C----------------------------------------------------------------------- FUNCTION HWSGAM(ZINPUT) C----------------------------------------------------------------------- C Gamma function computed by eq. 6.1.40, Abramowitz. C B(M) = B2m/(2m *(2m-1)) where B2m is the 2m'th Bernoulli number. C HLNTPI = .5*LOG(2.*PI) C----------------------------------------------------------------------- DOUBLE PRECISION HWSGAM,ZINPUT,B(10),HLNTPI,Z,SHIFT,G,T,RECZSQ INTEGER I DATA B/ 1 0.83333333333333333333D-01, -0.27777777777777777778D-02, 1 0.79365079365079365079D-03, -0.59523809523809523810D-03, 1 0.84175084175084175084D-03, -0.19175269175269175269D-02, 1 0.64102564102564102564D-02, -0.29550653594771241830D-01, 1 0.17964437236883057316D0 , -1.3924322169059011164D0 / DATA HLNTPI/0.91893853320467274178D0/ C C Shift argument to large value ( > 20 ) C Z=ZINPUT SHIFT=1. 10 IF (Z.LT.20.D0) THEN SHIFT = SHIFT*Z Z = Z + 1.D0 GOTO 10 ENDIF C C Compute asymptotic formula C G = (Z-.5D0)*LOG(Z) - Z + HLNTPI T = 1.D0/Z RECZSQ = T**2 DO 20 I = 1,10 G = G + B(I)*T T = T*RECZSQ 20 CONTINUE HWSGAM = EXP(G)/SHIFT END