PDF/spdf/structp.F

   1 #include "pdf/pilot.h"
   2 C
   3 C-----------------------------------------------------------------------
   4 C
   5       SUBROUTINE STRUCTP(X,Q2,P2,IP,
   6      +                             UPV,DNV,USEA,DSEA,STR,CHM,BOT,TOP,GL)
   7 C
   8 C  *********************************************************************
   9 C  *                                                                   *
  10 C  *   Main steering routine for all sets of structure functions       *
  11 C  *                                                                   *
  12 C  *                                                                   *
  13 C  *   Input:    X     = x value of parton                             *
  14 C  *             Q2    = QCD scale in GeV**2                           *
  15 C  *             P2    = Virtuality of the Photon in GeV**2            *
  16 C  *             IP    = Flag to evaluate off-shell anomalous photon   *
  17 C  *                     component                                     *
  18 C  *                                                                   *
  19 C  *   Output:   UPV   = up valence quark                              *
  20 C  *             DNV   = down valence quark                            *
  21 C  *             USEA  = sea (up_bar)                                  *
  22 C  *             DSEA  = sea (down_bar)                                *
  23 C  *             STR   = strange quark                                 *
  24 C  *             CHM   = charm quark                                   *
  25 C  *             BOT   = bottom quark                                  *
  26 C  *             TOP   = top quark                                     *
  27 C  *             GL    = gluon                                         *
  28 C  *                                                                   *
  29 C  *                                                                   *
  30 C  *   The variables  NPTYPE, NGROUP and NSET  should be,              *
  31 C  *   the variables  NFL, LO, TMAS  and                               *
  32 C  *   QCDL4, QCDL5, XMIN, XMAX, Q2MIN, Q2MAX                          *
  33 C  *   could be provided by the user via a call to the                 *
  34 C  *   subroutine PDFSET at the initialization phase, where            *
  35 C  *                                                                   *
  36 C  *             NPTYPE = Particle type                                *
  37 C  *                      (number or character string,                 *
  38 C  *                       1,2,3 or 'NU','PI','PH')                    *
  39 C  *                      of desired structure functions set           *
  40 C  *                      (Default: NPTYPE = 1  or  'NU'               *
  41 C  *             NGROUP = author group                                 *
  42 C  *                      (number or character string,                 *
  43 C  *                       1 to 7 or i.e. 'DFLM','MRS','MT','GRV',etc) *
  44 C  *                      of desired structure functions set           *
  45 C  *                      (Default: NGROUP = 5  or  'GRV')             *
  46 C  *             NSET   = number of desired structure functions set    *
  47 C  *                      (Default: NSET = 3)                          *
  48 C  *             NFL    = desired number of flavours for alpha(s)      *
  49 C  *                      (Default: NFL = 5)                           *
  50 C  *             LO     = order of alpha(s) calculation                *
  51 C  *                      (Default: LO = 2)                            *
  52 C  *             TMAS   = top quark mass in GeV/c**2  (optional)       *
  53 C  *                      (Default: TMAS = 100.0D0)                    *
  54 C  *             QCDL4  = QCD scale in GeV for four flavours           *
  55 C  *             QCDL5  = QCD scale in GeV for five flavours           *
  56 C  *                      corresponding to QCDL4                       *
  57 C  *             XMIN   = minimal allowed x value                      *
  58 C  *             XMAX   = maximal allowed x value                      *
  59 C  *             Q2MIN  = minimal allowed Q**2 value                   *
  60 C  *             Q2MAX  = maximal allowed Q**2 value                   *
  61 C  *                                                                   *
  62 C  *   for each set of structure fuction.                              *
  63 C  *                                                                   *
  64 C  *   The internal COMMON blocks                                      *
  65 C  *                                                                   *
  66 C  *   COMMON/W50511/ NPTYPE,NGROUP,NSET,MODE,NFL,LO,TMAS              *
  67 C  *   COMMON/W50512/ QCDL4,QCDL5                                      *
  68 C  *   COMMON/W50513/ XMIN,XMAX,Q2MIN,Q2MAX                            *
  69 C  *                                                                   *
  70 C  *   are filled then by the subroutine PDFSET.                       *
  71 C  *                                                                   *
  72 C  *                                                                   *
  73 C  *     Note: STRUCTM returns X * parton distribution function !      *
  74 C  *                                                                   *
  75 C  *                                                                   *
  76 C  *     Author:   H. Plothow-Besch                                    *
  77 C  *               CERN-PPE, CH - 1211 Geneva 23, Switzerland          *
  78 C  *                                                                   *
  79 C  *     Please return any problems, questions, suggestions            *
  80 C  *     to the author                                                 *
  81 C  *                                                                   *
  82 C  *********************************************************************
  83 C
  84 C
  85 #include "pdf/impdp.inc"
  86 C
  87 #include "pdf/w5051p1.inc"
  88 #include "pdf/w5051p2.inc"
  89 #include "pdf/w5051p7.inc"
  90 #include "pdf/w50510.inc"
  91 #include "pdf/w50511.inc"
  92 #include "pdf/w50512.inc"
  93 #include "pdf/w50513.inc"
  94 #include "pdf/w50514.inc"
  95 #include "pdf/w50514w.inc"
  96 #include "pdf/w50515.inc"
  97 #include "pdf/w50516.inc"
  98 #include "pdf/w50517.inc"
  99 #include "pdf/w50519.inc"
 100 #include "pdf/w505120.inc"
 101 #include "pdf/w505121.inc"
 102       CHARACTER*20 PARM(NCHDIM)
 103 #include "pdf/expdp.inc"
 104      +       VAL(NCHDIM)
 105       DATA ZEROD/0.D0/,ONED/1.D0/,TWOD/2.D0/
 106       SAVE /W50514/, /W50514W/, /W50516/
 107 C.
 108 #include "pdf/w50511c.inc"
 109 C.
 110 C User wants new version (4.0 or bigger) of PDFLIB format
 111       IF (IFLSET.NE.1) THEN
 112          IF(FIRST) THEN
 113          WRITE(N6,*) ' Warning : NO initialisation via PDFSET made !!'
 114          WRITE(N6,*)
 115      +   '           ALL Parameters set to default (Nucleon PDFs) !!'
 116          ENDIF
 117          NPTYPE = LPTYPE
 118          NGROUP = LGROUP
 119          NSET   = LNSET
 120 C
 121          PARM(1) = 'Nptype'
 122          VAL(1)  = NPTYPE
 123          PARM(2) = 'Ngroup'
 124          VAL(2)  = NGROUP
 125          PARM(3) = 'Nset'
 126          VAL(3)  = NSET
 127 C
 128          CALL PDFSET(PARM,VAL)
 129       ENDIF
 130 C.
 131 C User wants old version (3.0 or less) of PDFLIB format
 132       IF(.NOT.NEWVER) THEN
 133         IF (MODE .GE.0 .AND. MODE .LE.MODEMX) THEN
 134            IF(MODE.EQ.0) THEN
 135              NPTYPE = LPTYPO
 136              NGROUP = LGROPO
 137              NSET   = LNSETO
 138            ELSE
 139              NPTYPE = NPTYCR(MODE)
 140              NGROUP = NGROCR(MODE)
 141              NSET   = NSETCR(MODE)
 142 C   Check on validity of parameter values
 143              IF (NPTYPE.LT.0 .OR. NGROUP.LT.0 .OR. NSET.LT.0) THEN
 144                 IF(FIRST) THEN
 145                 WRITE(N6,*) ' PDFLIB  : MODE value INCORRECT, MODE = ',
 146      +          MODE
 147                WRITE(N6,*) ' Warning : MODE value set to OLD default !!'
 148                 ENDIF
 149                 NPTYPE = LPTYPO
 150                 NGROUP = LGROPO
 151                 NSET   = LNSETO
 152              ENDIF
 153            ENDIF
 154         ENDIF
 155       ENDIF
 156 C.
 157 C... Define printer
 158            IF(N6.LE.0) N6 = L6
 159 C
 160         DUPV = ZEROD
 161         DDNV = ZEROD
 162         DUSEA = ZEROD
 163         DDSEA = ZEROD
 164         DSTR = ZEROD
 165         DCHM = ZEROD
 166         DBOT = ZEROD
 167         DTOP = ZEROD
 168         DGL  = ZEROD
 169 C
 170         ZUPV = ZEROD
 171         ZDNV = ZEROD
 172         ZUSEA = ZEROD
 173         ZDSEA = ZEROD
 174         ZSTR = ZEROD
 175         ZCHM = ZEROD
 176         ZBOT = ZEROD
 177         ZTOP = ZEROD
 178         ZGL  = ZEROD
 179 C
 180         DX  = X
 181         DQ  = SQRT(Q2)
 182         DQ2 = Q2
 183         IF (NPTYPE.EQ.3) THEN
 184             DP2 = P2
 185             IP2 = IP
 186         ELSE
 187             DP2 = ZEROD
 188             IP2 = 0
 189         ENDIF
 190 C.
 191         IF (DX.LE.ZEROD .OR. DX.GE.ONED) THEN
 192            WRITE(N6,*) ' PDFLIB  : Nptype = ',NPTYPE,',   Ngroup = ',
 193      +                 NGROUP,',   Nset = ',NSET
 194            WRITE(N6,*)
 195      +     ' Error   : X value outside physical range , X = ',DX
 196            GOTO 100
 197         ENDIF
 198         WTXMIN = WTXMIN + PDFWGT
 199         IF (DX.LT.XMIN) THEN
 200            WXMIN = WXMIN + PDFWGT
 201            IF(IFLPRT.GE.3) THEN
 202               WRITE(N6,*) ' PDFLIB  : Nptype = ',NPTYPE,',   Ngroup = ',
 203      +                 NGROUP,',   Nset = ',NSET
 204               WRITE(N6,*)
 205      +        ' Error   : X value smaller allowed range , X = ',DX
 206            ENDIF
 207         ENDIF
 208         WTXMAX = WTXMAX + PDFWGT
 209         IF (DX.GT.XMAX) THEN
 210            WXMAX = WXMAX + PDFWGT
 211            IF(IFLPRT.GE.3) THEN
 212               WRITE(N6,*) ' PDFLIB  : Nptype = ',NPTYPE,',   Ngroup = ',
 213      +                 NGROUP,',   Nset = ',NSET
 214               WRITE(N6,*)
 215      +        ' Error   : X value bigger  allowed range , X = ',DX
 216            ENDIF
 217            GOTO 100
 218         ENDIF
 219         WTQ2MIN = WTQ2MIN + PDFWGT
 220         IF (DQ2.LT.Q2MIN) THEN
 221            WQ2MIN = WQ2MIN + PDFWGT
 222            IF(IFLPRT.GE.3) THEN
 223               WRITE(N6,*) ' PDFLIB  : Nptype = ',NPTYPE,',   Ngroup = ',
 224      +                 NGROUP,',   Nset = ',NSET
 225               WRITE(N6,*)
 226      +      ' Error   : SCALE value smaller allowed range , Q**2 = ',DQ2
 227            ENDIF
 228         ENDIF
 229         WTQ2MAX = WTQ2MAX + PDFWGT
 230         IF (DQ2.GT.Q2MAX) THEN
 231            WQ2MAX = WQ2MAX + PDFWGT
 232            IF(IFLPRT.GE.3) THEN
 233               WRITE(N6,*) ' PDFLIB  : Nptype = ',NPTYPE,',   Ngroup = ',
 234      +                 NGROUP,',   Nset = ',NSET
 235               WRITE(N6,*)
 236      +       ' Error   : SCALE value bigger allowed range , Q**2 = ',DQ2
 237            ENDIF
 238         ENDIF
 239 C
 240       IF (FIRST) WRITE(N6,*) ' '
 241       IF (FIRST) WRITE(N6,*) ' '
 242 C Call default structure functions set
 243       IF    (NPTYPE.EQ.0 .OR. NGROUP.EQ.0 .OR. NSET.EQ.0) THEN
 244 C       IF (FIRST) WRITE(N6,*)
 245 C     + ' Nucleon PDFs :  GRV Set HO Structure Functions'
 246 C          IF (FIRST) WRITE(N6,*)
 247 C     + '                 Ngroup = ',NGROUP,',   Nset = ',NSET
 248 C       CALL GRVHO(DX,DQ,DUPV,DDNV,DUSEA,DSTR,DCHM,DBOT,DTOP,DGL)
 249 C       DDSEA = DUSEA
 250 C       GOTO 100
 251           IF (FIRST) WRITE(N6,*)
 252      + ' Nucleon PDFs :  MRS Set (G) (L255-MSb) Structure Functions'
 253           IF (FIRST) WRITE(N6,*)
 254      + '                 Ngroup = ',NGROUP,',   Nset = ',NSET
 255           CALL SFMRSG(DX,DQ,DUPV,DDNV,DUSEA,DDSEA,DSTR,DCHM,DBOT,DGL)
 256           DTOP=ZEROD
 257           GOTO 100
 258       ENDIF
 259 C Start with NUCLEON structure functions
 260       IF(NPTYPE.EQ.1 .OR. NPTYPE.EQ.2) THEN
 261          CALL STRUCTM(DX,DQ,
 262      +                DUPV,DDNV,DUSEA,DDSEA,DSTR,DCHM,DBOT,DTOP,DGL)
 263       ENDIF
 264 C Now start PHOTON structure functions
 265       IF(NPTYPE.EQ.3) THEN
 266       IF(NGROUP.LE.4) THEN
 267          CALL STRUCTM(DX,DQ,
 268      +                DUPV,DDNV,DUSEA,DDSEA,DSTR,DCHM,DBOT,DTOP,DGL)
 269       ELSEIF(NGROUP.EQ.5) THEN
 270         IF(NSET.LE.3) THEN
 271          CALL STRUCTM(DX,DQ,
 272      +                DUPV,DDNV,DUSEA,DDSEA,DSTR,DCHM,DBOT,DTOP,DGL)
 273         ELSEIF(NSET.EQ.4) THEN
 274           IF (FIRST) WRITE(N6,*)
 275      + ' Photon PDFs :  GRS-G Set LO Structure Functions'
 276           IF (FIRST) WRITE(N6,*)
 277      + '                Ngroup = ',NGROUP,',   Nset = ',NSET
 278           CALL GRVGALO(DX,DQ,ZUPV,ZDNV,ZUSEA,ZDSEA,ZSTR,DCHM,DBOT,ZGL)
 279           CALL GRSGALO(DX,DQ2,DP2,
 280      +                     DUPV,DDNV,DUSEA,DDSEA,DSTR,ZCHM,ZBOT,DGL)
 281           DTOP=ZEROD
 282           GOTO 100
 283         ELSEIF(NSET.GE.5) THEN
 284           WRITE(N6,*) ' Photon PDFs :  Ngroup = ',NGROUP,
 285      +             ',   Nset = ',NSET,
 286      +             ',  Structure Functions not yet exsistent'
 287           STOP
 288         ENDIF
 289       ELSEIF(NGROUP.GE.6 .AND. NGROUP.LE.8) THEN
 290          CALL STRUCTM(DX,DQ,
 291      +                DUPV,DDNV,DUSEA,DDSEA,DSTR,DCHM,DBOT,DTOP,DGL)
 292       ELSEIF(NGROUP.EQ.9) THEN
 293         IF(NSET.EQ.1) THEN
 294           IF (FIRST) WRITE(N6,*)
 295      + ' Photon PDFs :  SaS-G 95 Set 1D Structure Functions'
 296           IF (FIRST) WRITE(N6,*)
 297      + '                Ngroup = ',NGROUP,',   Nset = ',NSET
 298           CALL SFSAS11(DX,DQ2,DP2,
 299      +                DUPV,DDNV,DUSEA,DDSEA,DSTR,DCHM,DBOT,DTOP,DGL)
 300           GOTO 100
 301         ELSEIF(NSET.EQ.2) THEN
 302           IF (FIRST) WRITE(N6,*)
 303      + ' Photon PDFs :  SaS-G 95 Set 1M Structure Functions'
 304           IF (FIRST) WRITE(N6,*)
 305      + '                Ngroup = ',NGROUP,',   Nset = ',NSET
 306           CALL SFSAS12(DX,DQ2,DP2,
 307      +                DUPV,DDNV,DUSEA,DDSEA,DSTR,DCHM,DBOT,DTOP,DGL)
 308           GOTO 100
 309         ELSEIF(NSET.EQ.3) THEN
 310           IF (FIRST) WRITE(N6,*)
 311      + ' Photon PDFs :  SaS-G 95 Set 2D Structure Functions'
 312           IF (FIRST) WRITE(N6,*)
 313      + '                Ngroup = ',NGROUP,',   Nset = ',NSET
 314           CALL SFSAS13(DX,DQ2,DP2,
 315      +                DUPV,DDNV,DUSEA,DDSEA,DSTR,DCHM,DBOT,DTOP,DGL)
 316           GOTO 100
 317         ELSEIF(NSET.EQ.4) THEN
 318           IF (FIRST) WRITE(N6,*)
 319      + ' Photon PDFs :  SaS-G 95 Set 2M Structure Functions'
 320           IF (FIRST) WRITE(N6,*)
 321      + '                Ngroup = ',NGROUP,',   Nset = ',NSET
 322           CALL SFSAS14(DX,DQ2,DP2,
 323      +                DUPV,DDNV,DUSEA,DDSEA,DSTR,DCHM,DBOT,DTOP,DGL)
 324           GOTO 100
 325         ELSEIF(NSET.EQ.5) THEN
 326           IF (FIRST) WRITE(N6,*)
 327      + ' Photon PDFs :  SaS-G 96 Set 1D Structure Functions'
 328           IF (FIRST) WRITE(N6,*)
 329      + '                Ngroup = ',NGROUP,',   Nset = ',NSET
 330           CALL SFSAS21(DX,DQ2,DP2,IP2,
 331      +                DUPV,DDNV,DUSEA,DDSEA,DSTR,DCHM,DBOT,DTOP,DGL)
 332           GOTO 100
 333         ELSEIF(NSET.EQ.6) THEN
 334           IF (FIRST) WRITE(N6,*)
 335      + ' Photon PDFs :  SaS-G 96 Set 1M Structure Functions'
 336           IF (FIRST) WRITE(N6,*)
 337      + '                Ngroup = ',NGROUP,',   Nset = ',NSET
 338           CALL SFSAS22(DX,DQ2,DP2,IP2,
 339      +                DUPV,DDNV,DUSEA,DDSEA,DSTR,DCHM,DBOT,DTOP,DGL)
 340           GOTO 100
 341         ELSEIF(NSET.EQ.7) THEN
 342           IF (FIRST) WRITE(N6,*)
 343      + ' Photon PDFs :  SaS-G 96 Set 2D Structure Functions'
 344           IF (FIRST) WRITE(N6,*)
 345      + '                Ngroup = ',NGROUP,',   Nset = ',NSET
 346           CALL SFSAS23(DX,DQ2,DP2,IP2,
 347      +                DUPV,DDNV,DUSEA,DDSEA,DSTR,DCHM,DBOT,DTOP,DGL)
 348           GOTO 100
 349         ELSEIF(NSET.EQ.8) THEN
 350           IF (FIRST) WRITE(N6,*)
 351      + ' Photon PDFs :  SaS-G 96 Set 2M Structure Functions'
 352           IF (FIRST) WRITE(N6,*)
 353      + '                Ngroup = ',NGROUP,',   Nset = ',NSET
 354           CALL SFSAS24(DX,DQ2,DP2,IP2,
 355      +                DUPV,DDNV,DUSEA,DDSEA,DSTR,DCHM,DBOT,DTOP,DGL)
 356           GOTO 100
 357         ELSEIF(NSET.GE.9) THEN
 358           WRITE(N6,*) ' Photon PDFs :  Ngroup = ',NGROUP,
 359      +             ',   Nset = ',NSET,
 360      +             ',  Structure Functions not yet exsistent'
 361           STOP
 362         ENDIF
 363       ELSE
 364         WRITE(N6,*)' PHOTON Structure function call for unknown GROUP ',
 365      +  NGROUP,',   and unknown NSET ',NSET
 366         STOP
 367       ENDIF
 368       ENDIF
 369   100 IF(FIRST) WRITE(N6,*)
 370      +' ----------------------------------------------------------------
 371      +----------------------'
 372       IF (FIRST) FIRST = .FALSE.
 373 C
 374       UPV = MAX( ZEROD,DUPV)
 375       DNV = MAX( ZEROD,DDNV)
 376       USEA = MAX( ZEROD,DUSEA)
 377       DSEA = MAX( ZEROD,DDSEA)
 378       STR = MAX( ZEROD,DSTR)
 379       CHM = MAX( ZEROD,DCHM)
 380       BOT = MAX( ZEROD,DBOT)
 381       TOP = MAX( ZEROD,DTOP)
 382       GL  = MAX( ZEROD,DGL)
 383 C
 384       RETURN
 385       END