PDF/tpdf/testgam.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.4  2000/04/19 13:30:01  mclareni
   6 * Import version 8.04
   7 *
   8 * Revision 1.4  2000/04/09 10:06:56  plothow
   9 * new version 8.00 - MRS 98 and 99, CTEQ5 and GRV98 added
  10 *
  11 * Revision 1.3  1997/07/02 15:03:11  pdflib
  12 * potential bug removed in GRSGALO
  13 *
  14 * Revision 1.2  1996/10/28 16:10:10  pdflib
  15 * PDFLIB new version 7.04
  16 *
  17 * Revision 1.1.1.1  1996/04/12 15:30:17  plothow
  18 * Version 7.01
  19 *
  20 *
  21 #include "pdf/pilot.h"
  22       PROGRAM TESTGAM
  23 C
  24 #include "pdf/impdp.inc"
  25       PARAMETER (LFLPRT = 2)
  26 #include "pdf/w5051p2.inc"
  27 #include "pdf/w5051p7.inc"
  28 #include "pdf/w50510.inc"
  29 #include "pdf/w50511.inc"
  30 #include "pdf/w50512.inc"
  31 #include "pdf/w50513.inc"
  32 #include "pdf/w50516.inc"
  33 #include "pdf/w50517.inc"
  34 #include "pdf/w505110.inc"
  35 #include "pdf/w505120.inc"
  36 #include "pdf/w505122.inc"
  37 C
  38 #include "pdf/expdp.inc"
  39      +       DX,DQ,DUV,DDV,DUB,DDB,DSB,DCB,DBB,DTB,DGL,
  40      +       DQ2,DP2
  41 #include "pdf/expdp.inc"
  42      +               XI(32),WI(32),XX(33)
  43       COMMON/W5051I9/XI,WI,XX,NTERMS
  44 #include "pdf/expdp.inc"
  45      +       XV(3),ZQ(5)
  46       CHARACTER*20 PARM(NCHDIM)
  47 #include "pdf/expdp.inc"
  48      +       VAL(NCHDIM)
  49 C
  50       DATA XV/0.05D0,0.50D0,0.95D0/
  51       DATA ZQ/10.D0,100.D0,1000.D0,1.D+4,5.5D+5/
  52       DATA P2/5./
  53       DATA IP2/0/
  54       DATA FLAV/4.D0/
  55       DATA ALQED/137.D0/
  56       DATA ICALL/0/
  57 C
  58       N6 = L6
  59       IFLPRT = LFLPRT
  60 C
  61 C*****adjustment of the VDM contribution*******************************
  62       KA=1.
  63 C*****mass of the charm quark******************************************
  64       CM=1.41
  65 C*****CHARME=0. -> no charm contribution ******************************
  66       CHARME=1.
  67 C
  68       PI=4.D0*ATAN(1.D0)
  69       PI2=PI**2
  70       CF=4.D0/3.D0
  71       NF=INT(FLAV+0.1D0)
  72       IF(NF.EQ.0) NF=3
  73       FLAVOR=FLAV
  74       B0=11.D0-2.D0*NF/3.D0
  75       B1=102.D0-38.D0*NF/3.D0
  76       CCOEG=2.D0/9.D0
  77 C      IF(NF.EQ.4) CCOEG=5.D0/18.D0
  78 C      COEG=2.D0*FLAVOR*CCOEG
  79       COEG=2.D0*FLAVOR*CCOEG
  80       CALL WATE32
  81 C
  82 C First call to PDFSET to initialize COMMON/W505120/
  83       PARM(1) = 'Init0'
  84       VAL(1)  = 0.D0
  85       CALL PDFSET(PARM,VAL)
  86 C.
  87 C Test new PDFLIB versions (4.0 or bigger) for Photons only
  88       NPTYPE = 3
  89          DO KGRO = 1,NGRMAX
  90             IF(NPGSMX(NPTYPE,KGRO) .EQ. 0) GOTO 500
  91             DO ISET=1,NPGSMX(NPTYPE,KGRO)
  92                WRITE (N6,*) ' ==========================================
  93      +============================================'
  94                FIRST=.TRUE.
  95                PARM(1) = 'Nptype'
  96                VAL(1)  = NPTYPE
  97                PARM(2) = 'Ngroup'
  98                VAL(2)  = KGRO
  99                PARM(3) = 'Nset'
 100                VAL(3)  = ISET
 101                CALL PDFSET(PARM,VAL)
 102 C
 103          ICALL = 0
 104          Q02 = Q2MIN
 105          OWLAM = QCDL4
 106          OWLAM2=OWLAM**2
 107          IORD = LO - 1
 108 *
 109       DO 100 J=3,3
 110       Q2=Q02
 111       IF(J.GE.2) Q2=ZQ(J-1)
 112       XTH=1.D0/(1.D0+4.D0*CM**2/Q2)
 113       ALQ2= LOG(Q2/OWLAM2)
 114       ALFPI= 2.D0 /(B0*ALQ2+B1* LOG(ALQ2)/B0)
 115       DO 70 K=1,3
 116       X=XV(K)
 117       DX = X
 118       Q = SQRT(Q2)
 119       DQ = Q
 120       DQ2 = Q2
 121       DP2 = P2
 122       IP = IP2
 123       CUT=1.
 124       IF(CHARME.LT.0.5) CUT=0.
 125       CUTG=1.
 126       IF(X.GT.XTH) CUT=0.
 127       CALL STRUCTP(DX,DQ2,DP2,IP,
 128      +             DUV,DDV,DUB,DDB,DSB,DCB,DBB,DTB,DGL)
 129       UB =DUB
 130       DB =DDB
 131       SB =DSB
 132       CB =DCB
 133       GL =DGL
 134       F2=(4.D0*  DUB   +  DDB   +  DSB)/9.D0
 135       F2C=4.D0/9.D0*(FLAVOR-3.D0)*DCB*CUT
 136       F2=F2+F2C
 137       IF(ICALL.EQ.0) THEN
 138         ICALL = 1
 139         WRITE (N6,1000) Q02,P2,CHARME,CUT,IORD,OWLAM,FLAV
 140  1000   FORMAT(1X,' Q02= ',F7.3,'   P2= ',F7.3,
 141      +               '   CHARM= ',F3.1,'   CUT= ',F3.1,
 142      +               '   IORD= ',I2,'   LAMBDA=',F7.4,'   NF = ',F5.2)
 143         ENDIF
 144       IF (K.EQ.1) THEN
 145         WRITE (N6,1001) Q2
 146  1001   FORMAT(/,'  Q2=  ',E10.3,' GEV**2')
 147         WRITE(N6,1002)
 148  1002   FORMAT(/,4X,' X',6X,'X*UB  ',6X,'X*DB  ',6X,'X*SB  ',6X,'X*CB  '
 149      +                  ,6X,'X*GL',8X,' F2 ',6X,' F2/ALPHA'
 150      +                            ,5X,' F2C ',5X,' F2C/ALPHA')
 151       ENDIF
 152       IF(IORD)13,13,14
 153 14    CONTINUE
 154       AL=0.5D0*ALFPI
 155       AL1= LOG(1.D0-X)
 156       XQ=F2+F2*AL*CF*(-9.D0-2.D0*PI2/3.D0+AL1*(-3.D0+2.D0*AL1))
 157 C     WRITE(N6,1111) X,Q,F2,AL1,XQ
 158 C1111 FORMAT(1X,' X,F2 = ',5E13.5)
 159       XM=1.-X
 160       XP=1.+X
 161       DIS2=(XM**2-4.*X*XM*CM**2/Q2)*CUT
 162       DIS=SQRT(DIS2)
 163       YP=(XP+DIS)/2.
 164       YM=(XP-DIS)/2.
 165       CUTY=1.
 166       DO 81 I=1,NTERMS
 167       Y=0.5D0*(1.D0-X)*XI(I)+0.5D0*(1.D0+X)
 168       XY=X/Y
 169       AL1= LOG(1.D0-Y)
 170       DX = XY
 171       CALL STRUCTP(DX,DQ2,DP2,IP,
 172      +             DUV,DDV,DUB,DDB,DSB,DCB,DBB,DTB,DGL)
 173       XQQ=(4.D0*  DUB   +  DDB   +  DSB)/9.D0
 174       XQQ=XQQ+4.D0/9.D0*(FLAVOR-3.D0)*DCB*CUT*CUTY
 175       F2A=F2+F2C*(CUTY-1.)
 176  6    C22=CF*(6.D0+4.D0*Y-2.D0*(1.D0+Y*Y)/
 177      +          (1.D0-Y)* LOG(Y)-2.D0*(1.D0+Y)*AL1)
 178       C23=CF*(-3.D0+4.D0*AL1)/(1.D0-Y)
 179       COEGM=COEG+(8./9.)*(FLAVOR-3.)*CUTG*CUT
 180       CG2=(-1.D0+8.D0*Y*(1.D0-Y)+(1.D0-2.D0*Y+2.D0*Y*Y)*
 181      +                   LOG(1.D0/Y-1.D0))*COEGM
 182       XQ=XQ +0.5D0*(1.D0-X)*WI(I)*AL*(C22*XQQ+C23*(XQQ- F2A))
 183       XQ=XQ +0.5D0*(1.D0-X)*WI(I)*AL*CG2*(DGL+KA*GL)
 184 C     WRITE(N6,1112) Y,AL1,C22,C23,CG2,XQQ,XQ
 185 C1112 FORMAT(1X,' Y,C22 = ',7E13.5)
 186       CUTG=1.
 187    81 CUTY=1.
 188       COE3=3.D0*3.D0*(2.D0/27.D0)*(1.D0/(2.D0*PI*ALQED))*2.D0
 189       COE4=3.D0*(34.D0/81.D0)*(1.D0/(2.D0*PI*ALQED))*2.D0
 190       IF(NF.EQ.3) COE4=COE3
 191          F2=XQ+COE4*(8.D0*X*(1.D0-X)-1.D0+(1.D0-2.D0*X+2.D0*X*X)*
 192      +            LOG(1.D0/X-1.D0))*X
 193          F2M=XQ+COE3*(8.D0*X*(1.D0-X)-1.D0+(1.D0-2.D0*X+2.D0*X*X)*
 194      +            LOG(1.D0/X-1.D0))*X
 195       CMS=CM**2
 196       SC=Q2*(1.D0-X)/X
 197       BE=4.*CMS/SC
 198       IF(BE.GE.1.) WCM=0.
 199       IF(BE.GE.1.) GO TO 91
 200       SQ=SQRT(1.-BE)
 201       A1=((1.D0+SQ)/2.D0)**2
 202       A2=(1.D0-X)/X
 203       WCM=(8.D0*(1.D0-X)*X-1.D0)*SQ+(X**2+(1.D0-X)**2)*LOG(A1*A2)
 204       WCM=3.D0*(4.D0/9.D0)/(PI*ALQED)*X*WCM
 205 91    CONTINUE
 206       F2M=F2M+(4.D0/9.D0)*(FLAVOR-3.D0)*WCM*CUT
 207          F2C=F2M
 208    13    F2N=F2*ALQED
 209          F2CN=F2C*ALQED
 210          WRITE(N6,1003)X,UB,DB,SB,CB,GL,F2,F2N,F2C,F2CN
 211  1003    FORMAT(1X,' ',F6.3,9E12.4)
 212    70    CONTINUE
 213   100    CONTINUE
 214        ENDDO
 215        WRITE(N6,*) '  '
 216   500  CONTINUE
 217       ENDDO
 218       STOP
 219       END