[u/mrichter/AliRoot.git] / PDF / spdf / alphas2.F

*
* $Id$
*
* $Log$
* Revision 1.4  2000/09/18 10:02:35  hristov
* Makefile added to PDF8
*
* Revision 1.3  1996/10/30 11:05:22  cernlib
* Conflicts resolved
*
* Revision 1.1.1.2  1996/10/30 08:32:07  cernlib
* Version 7.04
*
* Revision 1.2  1996/05/31 13:57:48  pdflib
* replace # by +
*
* Revision 1.1.1.1  1996/04/12 15:29:01  plothow
* Version 7.01
*
*
#include "pdf/pilot.h"
C-----------------------------------------------------------------------
#if defined(CERNLIB_SINGLE)
      FUNCTION ALPHAS2(SCALE)
#endif
#if defined(CERNLIB_DOUBLE)
      DOUBLE PRECISION FUNCTION ALPHAS2(SCALE)

#endif
C
C **********************************************************************
C *                                                                    *
C *   Program to calculate alfa strong to second order                 *
C *   as a function of lambda of 5 flavours                            *
C *   and the desired number of flavours (NFL)                         *
C *   for the selected set of structure functions which fixes lambda.  *
C *   NFL is limited to max. of 6 flavours.                            *
C *   The value of alfa is matched at the thresholds q = mq.           *
C *   When invoked with NFL < 0, it chooses NFL                        *
C *   as the number of flavours with mass less then q.                 *
C *   (mc = 1.5 GeV, mb = 4.75 GeV, mt = 100 GeV)                      *
C *                                                                    *
C *   Input:   SCALE   = QCD scale in GeV                              *
C *                                                                    *
C *   Output:  ALPHAS2 = alpha strong to second order,                 *
C *                      if not LO = 1                                 *
C *                                                                    *
C *   The variables NPTYPE,NGROUP,NSET,NFL,LO,TMAS,QCDL4,QCDL5         *
C *   should be provided by the user via a call to the                 *
C *   subroutine PDFSET at the initialization phase.                   *
C *                                                                    *
C *   Author:   H. Plothow-Besch (CERN-PPE)                            *
C *                                                                    *
C **********************************************************************
C
#include "pdf/impdp.inc"
C
#include "pdf/w5051p1.inc"
#include "pdf/w5051p2.inc"
#include "pdf/w5051p7.inc"
#include "pdf/w50510.inc"
#include "pdf/w50511.inc"
#include "pdf/w50512.inc"
#include "pdf/w50513.inc"
#include "pdf/w50515.inc"
#include "pdf/w50516.inc"
#include "pdf/w50517.inc"
#include "pdf/w50519.inc"
#include "pdf/w505120.inc"
#include "pdf/w505121.inc"
C
#if defined(CERNLIB_DOUBLE)
      DOUBLE PRECISION
#endif
#if defined(CERNLIB_SINGLE)
      REAL
#endif
     +    NF,KNF
      CHARACTER*20 PARM(NCHDIM)
#if defined(CERNLIB_DOUBLE)
      DOUBLE PRECISION
#endif
#if defined(CERNLIB_SINGLE)
      REAL
#endif
     +       VAL(NCHDIM)
      DATA XMC/1.5D0/,XMB/4.75D0/,XMT/100.D0/
      DATA ZEROD/0.D0/,PONED/0.001D0/,ONED/1.D0/,TWOD/2.D0/
C.
C.    initialization of the parameters for the coupling constant
C.
C.    QCDL4  : QCD scale, which is matched to the scale used in the
C.             parton distribution function chosen above for 4 flavours.
C.
C.    QCDL5  : QCD scale, which is matched to the scale used in the
C.              parton distribution function chosen above.
C.
C. be aware, this lambda is given for 5 flavours (mb = 4.75 GeV/c**2) !!
C.
C
C   set the default values
C
      ALPHAS2 = ZEROD
C
      IF(N6.LE.0) N6 = L6
C.
#include "pdf/w50511c.inc"
C.
C User wants new version (4.0 or bigger) of PDFLIB format
      IF (IFLSET.NE.1) THEN
         IF(FIRST) THEN
         WRITE(N6,*) ' Warning : NO initialisation via PDFSET made !!'
         WRITE(N6,*)
     +   '           ALL Parameters set to default (Nucleon PDFs) !!'
         ENDIF
         NPTYPE = LPTYPE
         NGROUP = LGROUP
         NSET   = LNSET
C
         PARM(1) = 'NPTYPE'
         VAL(1)  = NPTYPE
         PARM(2) = 'NGROUP'
         VAL(2)  = NGROUP
         PARM(3) = 'NSET'
         VAL(3)  = NSET
C
         CALL PDFSET(PARM,VAL)
      ENDIF
C.
C User wants old version (3.0 or less) of PDFLIB format
      IF(.NOT.NEWVER) THEN
        IF (MODE .GE.0 .AND. MODE .LE.MODEMX) THEN
           IF(MODE.EQ.0) THEN
             NPTYPE = LPTYPO
             NGROUP = LGROPO
             NSET   = LNSETO
           ELSE
             NPTYPE = NPTYCR(MODE)
             NGROUP = NGROCR(MODE)
             NSET   = NSETCR(MODE)
C   Check on validity of parameter values
             IF (NPTYPE.LT.0 .OR. NGROUP.LT.0 .OR. NSET.LT.0) THEN
                IF(FIRST) THEN
                WRITE(N6,*) ' PDFLIB  : MODE value INCORRECT, MODE = ',
     +          MODE
               WRITE(N6,*) ' Warning : MODE value set to OLD default !!'
                ENDIF
                NPTYPE = LPTYPO
                NGROUP = LGROPO
                NSET   = LNSETO
             ENDIF
           ENDIF
        ENDIF
      ENDIF
C.
         IF (QCDL5 .LE. PONED) THEN
            IF(FIRST) THEN
            WRITE (N6,*) ' PDFLIB: QCD-Lambda5 is not defined !! '
            ENDIF
            ALPHAS2 = ZEROD
            RETURN
         ENDIF
C.
        PI=4.0D0*ATAN(ONED)
        B6  = (33.D0-2.D0*6.D0)/PI/12.D0
        BP6 = (153.D0 - 19.D0*6.D0) / PI / TWOD / (33.D0 - 2.D0*6.D0)
        B5  = (33.D0-2.D0*5.D0)/PI/12.D0
        BP5 = (153.D0 - 19.D0*5.D0) / PI / TWOD / (33.D0 - 2.D0*5.D0)
        B4  = (33.D0-2.D0*4.D0)/PI/12.D0
        BP4 = (153.D0 - 19.D0*4.D0) / PI / TWOD / (33.D0 - 2.D0*4.D0)
        B3  = (33.D0-2.D0*3.D0)/PI/12.D0
        BP3 = (153.D0 - 19.D0*3.D0) / PI / TWOD / (33.D0 - 2.D0*3.D0)
        XLC = TWOD * LOG( XMC/QCDL5)
        XLB = TWOD * LOG( XMB/QCDL5)
        XLT = TWOD * LOG( XMT/QCDL5 * TMAS/XMT)
        XLLC = LOG( XLC)
        XLLB = LOG( XLB)
        XLLT = LOG( XLT)
        C65  =  ONED/( ONED/(B5 * XLT) - XLLT*BP5/(B5 * XLT)**2 )
     +        - ONED/( ONED/(B6 * XLT) - XLLT*BP6/(B6 * XLT)**2 )
        C45  =  ONED/( ONED/(B5 * XLB) - XLLB*BP5/(B5 * XLB)**2 )
     +        - ONED/( ONED/(B4 * XLB) - XLLB*BP4/(B4 * XLB)**2 )
        C35  =  ONED/( ONED/(B4 * XLC) - XLLC*BP4/(B4 * XLC)**2 )
     +        - ONED/( ONED/(B3 * XLC) - XLLC*BP3/(B3 * XLC)**2 ) + C45
C
      Q   = SCALE
      XLQ = TWOD *  LOG( Q/QCDL5 )
      XLLQ =  LOG( XLQ )
      KNF = NFL
      NF = KNF
      IF  ( NF .LT. ZEROD) THEN
        IF      ( Q .GT. XMT * TMAS/XMT) THEN
          NF = 6.D0
        ELSEIF  ( Q .GT. XMB ) THEN
          NF = 5.D0
        ELSEIF  ( Q .GT. XMC ) THEN
          NF = 4.D0
        ELSE
          NF = 3.D0
        ENDIF
      ENDIF
      IF(NF .GT. 6.D0) NF = 6.D0
      IF      ( NF .EQ. 6.D0 ) THEN
       ALF = ONED/(ONED/(ONED/(B6*XLQ)- BP6/(B6*XLQ)**2*XLLQ) + C65)
       IF (LO.EQ.1) ALF = ONED/B6/XLQ
      ELSEIF  ( NF .EQ. 5.D0 ) THEN
       ALF = ONED/(B5 * XLQ) -  BP5/(B5 * XLQ)**2 * XLLQ
       IF (LO.EQ.1) ALF = ONED/B5/XLQ
      ELSEIF  ( NF .EQ. 4.D0 ) THEN
       ALF = ONED/(ONED/(ONED/(B4*XLQ)- BP4/(B4*XLQ)**2*XLLQ) + C45)
       IF (LO.EQ.1) ALF = ONED/B4/XLQ
      ELSEIF  ( NF .EQ. 3.D0 ) THEN
       ALF = ONED/(ONED/(ONED/(B3*XLQ)- BP3/(B3*XLQ)**2*XLLQ) + C35)
       IF (LO.EQ.1) ALF = ONED/B3/XLQ
      ELSE
       WRITE(N6,*)'Error in Alphas2: unimplemented # of light flavours',
     +             NFL
       STOP
      ENDIF
      ALPHAS2 = ALF
      RETURN
      END
Commit	Line	Data
21886bb6	1	*
	2	* $Id$
	3	*
	4	* $Log$
7ef50f50	5	* Revision 1.4 2000/09/18 10:02:35 hristov
	6	* Makefile added to PDF8
	7	*
21886bb6	8	* Revision 1.3 1996/10/30 11:05:22 cernlib
	9	* Conflicts resolved
	10	*
	11	* Revision 1.1.1.2 1996/10/30 08:32:07 cernlib
	12	* Version 7.04
	13	*
	14	* Revision 1.2 1996/05/31 13:57:48 pdflib
	15	* replace # by +
	16	*
	17	* Revision 1.1.1.1 1996/04/12 15:29:01 plothow
	18	* Version 7.01
	19	*
	20	*
	21	#include "pdf/pilot.h"
	22	C-----------------------------------------------------------------------
	23	#if defined(CERNLIB_SINGLE)
	24	FUNCTION ALPHAS2(SCALE)
	25	#endif
	26	#if defined(CERNLIB_DOUBLE)
	27	DOUBLE PRECISION FUNCTION ALPHAS2(SCALE)
	28
	29	#endif
	30	C
	31	C **********************************************************************
	32	C * *
	33	C * Program to calculate alfa strong to second order *
	34	C * as a function of lambda of 5 flavours *
	35	C * and the desired number of flavours (NFL) *
	36	C * for the selected set of structure functions which fixes lambda. *
	37	C * NFL is limited to max. of 6 flavours. *
	38	C * The value of alfa is matched at the thresholds q = mq. *
	39	C * When invoked with NFL < 0, it chooses NFL *
	40	C * as the number of flavours with mass less then q. *
	41	C * (mc = 1.5 GeV, mb = 4.75 GeV, mt = 100 GeV) *
	42	C * *
	43	C * Input: SCALE = QCD scale in GeV *
	44	C * *
	45	C * Output: ALPHAS2 = alpha strong to second order, *
	46	C * if not LO = 1 *
	47	C * *
	48	C * The variables NPTYPE,NGROUP,NSET,NFL,LO,TMAS,QCDL4,QCDL5 *
	49	C * should be provided by the user via a call to the *
	50	C * subroutine PDFSET at the initialization phase. *
	51	C * *
	52	C * Author: H. Plothow-Besch (CERN-PPE) *
	53	C * *
	54	C **********************************************************************
	55	C
	56	#include "pdf/impdp.inc"
	57	C
	58	#include "pdf/w5051p1.inc"
	59	#include "pdf/w5051p2.inc"
	60	#include "pdf/w5051p7.inc"
	61	#include "pdf/w50510.inc"
	62	#include "pdf/w50511.inc"
	63	#include "pdf/w50512.inc"
	64	#include "pdf/w50513.inc"
	65	#include "pdf/w50515.inc"
	66	#include "pdf/w50516.inc"
	67	#include "pdf/w50517.inc"
	68	#include "pdf/w50519.inc"
	69	#include "pdf/w505120.inc"
	70	#include "pdf/w505121.inc"
	71	C
7ef50f50	72	#if defined(CERNLIB_DOUBLE)
	73	DOUBLE PRECISION
	74	#endif
	75	#if defined(CERNLIB_SINGLE)
	76	REAL
	77	#endif
21886bb6	78	+ NF,KNF
21886bb6	79	CHARACTER*20 PARM(NCHDIM)
7ef50f50	80	#if defined(CERNLIB_DOUBLE)
	81	DOUBLE PRECISION
	82	#endif
	83	#if defined(CERNLIB_SINGLE)
	84	REAL
	85	#endif
21886bb6	86	+ VAL(NCHDIM)
	87	DATA XMC/1.5D0/,XMB/4.75D0/,XMT/100.D0/
	88	DATA ZEROD/0.D0/,PONED/0.001D0/,ONED/1.D0/,TWOD/2.D0/
	89	C.
	90	C. initialization of the parameters for the coupling constant
	91	C.
	92	C. QCDL4 : QCD scale, which is matched to the scale used in the
	93	C. parton distribution function chosen above for 4 flavours.
	94	C.
	95	C. QCDL5 : QCD scale, which is matched to the scale used in the
	96	C. parton distribution function chosen above.
	97	C.
	98	C. be aware, this lambda is given for 5 flavours (mb = 4.75 GeV/c**2) !!
	99	C.
	100	C
	101	C set the default values
	102	C
	103	ALPHAS2 = ZEROD
	104	C
	105	IF(N6.LE.0) N6 = L6
	106	C.
	107	#include "pdf/w50511c.inc"
	108	C.
	109	C User wants new version (4.0 or bigger) of PDFLIB format
	110	IF (IFLSET.NE.1) THEN
	111	IF(FIRST) THEN
	112	WRITE(N6,*) ' Warning : NO initialisation via PDFSET made !!'
	113	WRITE(N6,*)
	114	+ ' ALL Parameters set to default (Nucleon PDFs) !!'
	115	ENDIF
	116	NPTYPE = LPTYPE
	117	NGROUP = LGROUP
	118	NSET = LNSET
	119	C
	120	PARM(1) = 'NPTYPE'
	121	VAL(1) = NPTYPE
	122	PARM(2) = 'NGROUP'
	123	VAL(2) = NGROUP
	124	PARM(3) = 'NSET'
	125	VAL(3) = NSET
	126	C
	127	CALL PDFSET(PARM,VAL)
	128	ENDIF
	129	C.
	130	C User wants old version (3.0 or less) of PDFLIB format
	131	IF(.NOT.NEWVER) THEN
	132	IF (MODE .GE.0 .AND. MODE .LE.MODEMX) THEN
	133	IF(MODE.EQ.0) THEN
	134	NPTYPE = LPTYPO
	135	NGROUP = LGROPO
	136	NSET = LNSETO
	137	ELSE
	138	NPTYPE = NPTYCR(MODE)
	139	NGROUP = NGROCR(MODE)
	140	NSET = NSETCR(MODE)
	141	C Check on validity of parameter values
	142	IF (NPTYPE.LT.0 .OR. NGROUP.LT.0 .OR. NSET.LT.0) THEN
	143	IF(FIRST) THEN
	144	WRITE(N6,*) ' PDFLIB : MODE value INCORRECT, MODE = ',
	145	+ MODE
	146	WRITE(N6,*) ' Warning : MODE value set to OLD default !!'
	147	ENDIF
	148	NPTYPE = LPTYPO
	149	NGROUP = LGROPO
150	NSET = LNSETO
151	ENDIF
152	ENDIF
153	ENDIF
154	ENDIF
155	C.
156	IF (QCDL5 .LE. PONED) THEN
157	IF(FIRST) THEN
158	WRITE (N6,*) ' PDFLIB: QCD-Lambda5 is not defined !! '
159	ENDIF
160	ALPHAS2 = ZEROD
161	RETURN
162	ENDIF
163	C.
164	PI=4.0D0*ATAN(ONED)
165	B6 = (33.D0-2.D0*6.D0)/PI/12.D0
166	BP6 = (153.D0 - 19.D06.D0) / PI / TWOD / (33.D0 - 2.D06.D0)
167	B5 = (33.D0-2.D0*5.D0)/PI/12.D0
168	BP5 = (153.D0 - 19.D05.D0) / PI / TWOD / (33.D0 - 2.D05.D0)
169	B4 = (33.D0-2.D0*4.D0)/PI/12.D0
170	BP4 = (153.D0 - 19.D04.D0) / PI / TWOD / (33.D0 - 2.D04.D0)
171	B3 = (33.D0-2.D0*3.D0)/PI/12.D0
172	BP3 = (153.D0 - 19.D03.D0) / PI / TWOD / (33.D0 - 2.D03.D0)
173	XLC = TWOD * LOG( XMC/QCDL5)
174	XLB = TWOD * LOG( XMB/QCDL5)
175	XLT = TWOD * LOG( XMT/QCDL5 * TMAS/XMT)
176	XLLC = LOG( XLC)
177	XLLB = LOG( XLB)
178	XLLT = LOG( XLT)
179	C65 = ONED/( ONED/(B5 * XLT) - XLLTBP5/(B5 XLT)**2 )
180	+ - ONED/( ONED/(B6 * XLT) - XLLTBP6/(B6 XLT)**2 )
181	C45 = ONED/( ONED/(B5 * XLB) - XLLBBP5/(B5 XLB)**2 )
182	+ - ONED/( ONED/(B4 * XLB) - XLLBBP4/(B4 XLB)**2 )
183	C35 = ONED/( ONED/(B4 * XLC) - XLLCBP4/(B4 XLC)**2 )
184	+ - ONED/( ONED/(B3 * XLC) - XLLCBP3/(B3 XLC)**2 ) + C45
185	C
186	Q = SCALE
187	XLQ = TWOD * LOG( Q/QCDL5 )
188	XLLQ = LOG( XLQ )
189	KNF = NFL
190	NF = KNF
191	IF ( NF .LT. ZEROD) THEN
192	IF ( Q .GT. XMT * TMAS/XMT) THEN
193	NF = 6.D0
194	ELSEIF ( Q .GT. XMB ) THEN
195	NF = 5.D0
196	ELSEIF ( Q .GT. XMC ) THEN
197	NF = 4.D0
198	ELSE
199	NF = 3.D0
200	ENDIF
201	ENDIF
202	IF(NF .GT. 6.D0) NF = 6.D0
203	IF ( NF .EQ. 6.D0 ) THEN
204	ALF = ONED/(ONED/(ONED/(B6XLQ)- BP6/(B6XLQ)*2XLLQ) + C65)
205	IF (LO.EQ.1) ALF = ONED/B6/XLQ
206	ELSEIF ( NF .EQ. 5.D0 ) THEN
207	ALF = ONED/(B5 * XLQ) - BP5/(B5 * XLQ)*2 XLLQ
208	IF (LO.EQ.1) ALF = ONED/B5/XLQ
209	ELSEIF ( NF .EQ. 4.D0 ) THEN
210	ALF = ONED/(ONED/(ONED/(B4XLQ)- BP4/(B4XLQ)*2XLLQ) + C45)
211	IF (LO.EQ.1) ALF = ONED/B4/XLQ
212	ELSEIF ( NF .EQ. 3.D0 ) THEN
213	ALF = ONED/(ONED/(ONED/(B3XLQ)- BP3/(B3XLQ)*2XLLQ) + C35)
214	IF (LO.EQ.1) ALF = ONED/B3/XLQ
215	ELSE
216	WRITE(N6,*)'Error in Alphas2: unimplemented # of light flavours',
217	+ NFL
218	STOP
219	ENDIF
220	ALPHAS2 = ALF
221	RETURN
222	END