PDF/npdf/structa.F

   1 #include "pdf/pilot.h"
   2 C
   3 C-----------------------------------------------------------------------
   4 C
   5       SUBROUTINE STRUCTA(X,SCALE,ANO,
   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  *             SCALE = QCD scale in GeV                              *
  15 C  *             ANO   = atomic mass number of a nucleus               *
  16 C  *                                                                   *
  17 C  *   Output:   UPV   = up valence quark * Ruv-Npdf                   *
  18 C  *             DNV   = down valence quark * Rdv-Npdf                 *
  19 C  *             USEA  = sea (up_bar) * Rub-Npdf                       *
  20 C  *             DSEA  = sea (down_bar) * Rdb-Npdf                     *
  21 C  *             STR   = strange quark * Rs-Npdf                       *
  22 C  *             CHM   = charm quark * Rc-Npdf                         *
  23 C  *             BOT   = bottom quark * Rb-Npdf                        *
  24 C  *             TOP   = top quark * Rt-Npdf                           *
  25 C  *             GL    = gluon * Rg-Npdf                               *
  26 C  *                                                                   *
  27 C  *                                                                   *
  28 C  *   The variables  NPTYPE, NGROUP and NSET  and                     *
  29 C  *   the variables  NATYPE, NAGROUP and NASET  should be,            *
  30 C  *   could be provided by the user via a call to the                 *
  31 C  *   subroutine PDFSET at the initialization phase, where            *
  32 C  *                                                                   *
  33 C  *             NPTYPE = Particle type for proton PDF's               *
  34 C  *                      (number or character string,                 *
  35 C  *                       1,2,3 or 'NU','PI','PH')                    *
  36 C  *                      of desired structure functions set           *
  37 C  *                      (Default: NPTYPE = 1  or  'NU'               *
  38 C  *             NGROUP = author group for proton PDF's                *
  39 C  *                      (number or character string,                 *
  40 C  *                       1 to 7 or i.e. 'DFLM','MRS','MT','GRV',etc) *
  41 C  *                      of desired structure functions set           *
  42 C  *                      (Default: NGROUP = 5  or  'GRV')             *
  43 C  *             NSET   = number of desired structure functions set    *
  44 C  *                      for proton PDF's                             *
  45 C  *                      (Default: NSET = 3)                          *
  46 C  *             NATYPE = 4  for Nuclear Corrections                   *
  47 C  *                      (Default: NATYPE = 4)                        *
  48 C  *             NAGROUP= author group of Nuclear Corrections          *
  49 C  *                      (number or character string, 1 or i.e. 'EKS')*
  50 C  *                      of desired uclear Corrections set            *
  51 C  *                      (Default: NAGROUP = 1)                       *
  52 C  *             NASET  = number of desired Nuclear Corrections set    *
  53 C  *                      (Default: NASET = 1)                         *
  54 C  *                                                                   *
  55 C  *   for each set of structure function.                             *
  56 C  *                                                                   *
  57 C  *   The internal COMMON blocks                                      *
  58 C  *                                                                   *
  59 C  *   COMMON/W50511/  NPTYPE,NGROUP,NSET                              *
  60 C  *   COMMON/W50511a/ NATYPE,NAGROUP,NASET                            *
  61 C  *                                                                   *
  62 C  *   are filled then by the subroutine PDFSET.                       *
  63 C  *                                                                   *
  64 C  *                                                                   *
  65 C  *     Note: STRUCTA returns                                         *
  66 C  *           X * parton distribution function * Nuclear Correction ! *
  67 C  *                                                                   *
  68 C  *                                                                   *
  69 C  *     Author:   H. Plothow-Besch                                    *
  70 C  *               CERN-ETT/TT, CH - 1211 Geneva 23, Switzerland       *
  71 C  *                                                                   *
  72 C  *     Please return any problems, questions, suggestions            *
  73 C  *     to the author                                                 *
  74 C  *                                                                   *
  75 C  *********************************************************************
  76 C
  77 C
  78 #include "pdf/impdp.inc"
  79 C
  80 #include "pdf/w5051p1.inc"
  81 #include "pdf/w5051p2.inc"
  82 #include "pdf/w5051p7.inc"
  83 #include "pdf/w50510.inc"
  84 #include "pdf/w50511.inc"
  85 #include "pdf/w50511a.inc"
  86 #include "pdf/w50512.inc"
  87 #include "pdf/w50513.inc"
  88 #include "pdf/w50514.inc"
  89 #include "pdf/w50514w.inc"
  90 #include "pdf/w50515.inc"
  91 #include "pdf/w50516.inc"
  92 #include "pdf/w50517.inc"
  93 #include "pdf/w50519.inc"
  94 #include "pdf/w505120.inc"
  95 #include "pdf/w505121.inc"
  96       CHARACTER*20 PARM(NCHDIM)
  97 #include "pdf/expdp.inc"
  98      +       VAL(NCHDIM)
  99       DATA ZEROD/0.D0/,ONED/1.D0/,TWOD/2.D0/
 100       SAVE /W50514/, /W50514W/, /W50516/
 101 C.
 102 #include "pdf/w50511c.inc"
 103 C.
 104 C User wants new version (4.0 or bigger) of PDFLIB format
 105       IF (IFLSET.NE.1) THEN
 106          IF(FIRST) THEN
 107          WRITE(N6,*) ' Warning : NO initialisation via PDFSET made !!'
 108          WRITE(N6,*)
 109      +   '           ALL Parameters set to default (Nucleon PDFs) !!'
 110          ENDIF
 111          NPTYPE = LPTYPE
 112          NGROUP = LGROUP
 113          NSET   = LNSET
 114 C
 115          PARM(1) = 'Nptype'
 116          VAL(1)  = NPTYPE
 117          PARM(2) = 'Ngroup'
 118          VAL(2)  = NGROUP
 119          PARM(3) = 'Nset'
 120          VAL(3)  = NSET
 121 C
 122          NATYPE  = LATYPE
 123          NAGROUP = LAGROUP
 124          NASET   = LNASET
 125 C
 126          PARM(4) = 'NAtype'
 127          VAL(4)  = NATYPE
 128          PARM(5) = 'NAgroup'
 129          VAL(5)  = NAGROUP
 130          PARM(6) = 'NAset'
 131          VAL(6)  = NASET
 132 C
 133          CALL PDFSET(PARM,VAL)
 134       ENDIF
 135 C.
 136 C... Define printer
 137            IF(N6.LE.0) N6 = L6
 138 C
 139         DUPV = ZEROD
 140         DDNV = ZEROD
 141         DUSEA = ZEROD
 142         DDSEA = ZEROD
 143         DSTR = ZEROD
 144         DCHM = ZEROD
 145         DBOT = ZEROD
 146         DTOP = ZEROD
 147         DGL  = ZEROD
 148 C
 149         DX  = X
 150         DQ  = SCALE
 151         DQ2 = SCALE*SCALE
 152         DANO = ANO
 153 C.
 154         IF (DX.LE.ZEROD .OR. DX.GE.ONED) THEN
 155            WRITE(N6,*) ' PDFLIB  : Nptype = ',NPTYPE,',   Ngroup = ',
 156      +                 NGROUP,',   Nset = ',NSET
 157            WRITE(N6,*)
 158      +     ' Error   : X value outside physical range , X = ',DX
 159            GOTO 100
 160         ENDIF
 161         WTXMIN = WTXMIN + PDFWGT
 162         IF (DX.LT.XMIN) THEN
 163            WXMIN = WXMIN + PDFWGT
 164            IF(IFLPRT.GE.3) THEN
 165               WRITE(N6,*) ' PDFLIB  : Nptype = ',NPTYPE,',   Ngroup = ',
 166      +                 NGROUP,',   Nset = ',NSET
 167               WRITE(N6,*)
 168      +        ' Error   : X value smaller allowed range , X = ',DX
 169            ENDIF
 170         ENDIF
 171         WTXMAX = WTXMAX + PDFWGT
 172         IF (DX.GT.XMAX) THEN
 173            WXMAX = WXMAX + PDFWGT
 174            IF(IFLPRT.GE.3) THEN
 175               WRITE(N6,*) ' PDFLIB  : Nptype = ',NPTYPE,',   Ngroup = ',
 176      +                 NGROUP,',   Nset = ',NSET
 177               WRITE(N6,*)
 178      +        ' Error   : X value bigger  allowed range , X = ',DX
 179            ENDIF
 180            GOTO 100
 181         ENDIF
 182         WTQ2MIN = WTQ2MIN + PDFWGT
 183         IF (DQ2.LT.Q2MIN) THEN
 184            WQ2MIN = WQ2MIN + PDFWGT
 185            IF(IFLPRT.GE.3) THEN
 186               WRITE(N6,*) ' PDFLIB  : Nptype = ',NPTYPE,',   Ngroup = ',
 187      +                 NGROUP,',   Nset = ',NSET
 188               WRITE(N6,*)
 189      +      ' Error   : SCALE value smaller allowed range , Q**2 = ',DQ2
 190            ENDIF
 191         ENDIF
 192         WTQ2MAX = WTQ2MAX + PDFWGT
 193         IF (DQ2.GT.Q2MAX) THEN
 194            WQ2MAX = WQ2MAX + PDFWGT
 195            IF(IFLPRT.GE.3) THEN
 196               WRITE(N6,*) ' PDFLIB  : Nptype = ',NPTYPE,',   Ngroup = ',
 197      +                 NGROUP,',   Nset = ',NSET
 198               WRITE(N6,*)
 199      +       ' Error   : SCALE value bigger allowed range , Q**2 = ',DQ2
 200            ENDIF
 201         ENDIF
 202 C
 203       IF (FIRST) WRITE(N6,*) ' '
 204       IF (FIRST) WRITE(N6,*) ' '
 205 C Call default structure functions set
 206 C      IF    (NPTYPE.EQ.0 .OR. NGROUP.EQ.0 .OR. NSET.EQ.0) THEN
 207 C          IF (FIRST) WRITE(N6,*)
 208 C     + ' Nucleon PDFs :  MRS central-g (L300-MSb) Structure Functions'
 209 C          IF (FIRST) WRITE(N6,*)
 210 C     + '                 Ngroup = ',NGROUP,',   Nset = ',NSET
 211 C       CALL SFMRS_99A1
 212 C     +               (DX,DQ2,DUPV,DDNV,DUSEA,DDSEA,DSTR,DCHM,DBOT,DGL)
 213 C          DTOP=ZEROD
 214 C          GOTO 100
 215 C      ENDIF
 216 C Start with NUCLEAR structure functions
 217       IF(NATYPE.EQ.4) THEN
 218       IF(NAGROUP.EQ.1) THEN
 219         IF(NASET.EQ.1) THEN
 220           IF (FIRST) WRITE(N6,*)
 221      + ' Nuclear PDFs :  EKS98 Structure Functions with Nuclear Correcti
 222      +ons'
 223           IF (FIRST) WRITE(N6,*)
 224      + '                 NAgroup = ',NAGROUP,',   NAset = ',NASET
 225        CALL SFEKS98(DX,DQ,DANO,
 226      +              DUPV,DDNV,DUSEA,DDSEA,DSTR,DCHM,DBOT,DTOP,DGL)
 227           GOTO 100
 228         ELSEIF(NASET.GE.2) THEN
 229           WRITE(N6,*) ' Nuclear PDFs :  NAgroup = ',NAGROUP,
 230      +             ',   NAset = ',NASET,
 231      +             ',   Structure Functions not yet exsistent'
 232           STOP
 233         ENDIF
 234       ENDIF
 235       ENDIF
 236   100 IF(FIRST) WRITE(N6,*)
 237      +' ----------------------------------------------------------------
 238      +----------------------'
 239       IF (FIRST) FIRST = .FALSE.
 240 C
 241       UPV = MAX( ZEROD,DUPV)
 242       DNV = MAX( ZEROD,DDNV)
 243       USEA = MAX( ZEROD,DUSEA)
 244       DSEA = MAX( ZEROD,DDSEA)
 245       STR = MAX( ZEROD,DSTR)
 246       CHM = MAX( ZEROD,DCHM)
 247       BOT = MAX( ZEROD,DBOT)
 248       TOP = MAX( ZEROD,DTOP)
 249       GL  = MAX( ZEROD,DGL)
 250 C
 251       RETURN
 252 C
 253       END