| 0caf84a5 |
1 | ! -*- F90 -*- |
| 2 | |
| 3 | |
| 4 | subroutine ABFKWPevolve(xin,qin,pdf) |
| 5 | include 'parmsetup.inc' |
| 6 | PARAMETER(NX=50) |
| 7 | PARAMETER(NQ=19) |
| 8 | real*8 xin,qin,pdf(-6:6),xval(45),qcdl4,qcdl5 |
| 9 | real*8 upv,dnv,usea,dsea,str,chm,bot,top,glu |
| 10 | real*8 calcpi(8,20,25,3),calcpio(8,20,25),parpi(40,3) |
| 11 | common /ABFKWP/ CALCPI,CALCPIO,PARPI,lastmem |
| 12 | character*16 name(nmxset) |
| 13 | integer nmem(nmxset),ndef(nmxset),mmem |
| 14 | common/NAME/name,nmem,ndef,mmem |
| 15 | integer nset |
| 16 | save |
| 17 | |
| 18 | iimem = imem |
| 19 | if(iimem.eq.0) iimem = 1 |
| 20 | if(iimem.le.3) then |
| 21 | call ABFKWxx(iimem,xin,qin,upv,dnv,usea,dsea, str,chm,glu) |
| 22 | endif |
| 23 | |
| 24 | |
| 25 | pdf(-6)= 0.0d0 |
| 26 | pdf(6)= 0.0d0 |
| 27 | pdf(-5)= 0.0d0 |
| 28 | pdf(5 )= 0.0d0 |
| 29 | pdf(-4)= chm |
| 30 | pdf(4 )= chm |
| 31 | pdf(-3)= str |
| 32 | pdf(3 )= str |
| 33 | pdf(-2)= usea |
| 34 | pdf(2 )= upv+usea |
| 35 | pdf(-1)= dsea |
| 36 | pdf(1 )= dnv+dsea |
| 37 | pdf(0 )= glu |
| 38 | |
| 39 | return |
| 40 | !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc |
| 41 | entry ABFKWPread(nset) |
| 42 | read(1,*)nmem(nset),ndef(nset) |
| 43 | ! print *,nmem,ndef |
| 44 | lastmem = -999 |
| 45 | do j=1,3 |
| 46 | read(1,*)(parpi(k,j),k=1,4) |
| 47 | read(1,*)(parpi(k,j),k=5,8) |
| 48 | read(1,*)(parpi(k,j),k=9,12) |
| 49 | read(1,*)(parpi(k,j),k=13,16) |
| 50 | read(1,*)(parpi(k,j),k=17,20) |
| 51 | read(1,*)(parpi(k,j),k=21,24) |
| 52 | read(1,*)(parpi(k,j),k=25,28) |
| 53 | read(1,*)(parpi(k,j),k=29,32) |
| 54 | read(1,*)(parpi(k,j),k=33,36) |
| 55 | read(1,*)(parpi(k,j),k=37,40) |
| 56 | do l=1,25 |
| 57 | do k=1,20 |
| 58 | read(1,*)(CALCPI(m,k,l,j),m=1,4) |
| 59 | read(1,*)(CALCPI(m,k,l,j),m=5,8) |
| 60 | enddo |
| 61 | enddo |
| 62 | enddo |
| 63 | return |
| 64 | ! |
| 65 | !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc |
| 66 | entry ABFKWPalfa(alfas,qalfa) |
| 67 | call getnset(iset) |
| 68 | call GetOrderAsM(iset,iord) |
| 69 | call Getlam4M(iset,imem,qcdl4) |
| 70 | call Getlam5M(iset,imem,qcdl5) |
| 71 | call aspdflib(alfas,Qalfa,iord,qcdl5) |
| 72 | return |
| 73 | ! |
| 74 | !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc |
| 75 | entry ABFKWPinit(Eorder,Q2fit) |
| 76 | return |
| 77 | ! |
| 78 | !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc |
| 79 | entry ABFKWPpdf(mem) |
| 80 | imem = mem |
| 81 | return |
| 82 | ! |
| 83 | 1000 format(5e13.5) |
| 84 | END |
| 85 | !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc |
| 86 | ! |
| 87 | ! $Id: wrapabfkwpi.f 356 2008-08-28 15:58:02Z buckley $ |
| 88 | ! |
| 89 | ! $Log$ |
| 90 | ! Revision 1.2 2005/10/07 15:15:05 whalley |
| 91 | ! Changes to most files for V5 - multiset initializations |
| 92 | ! |
| 93 | ! Revision 1.1.1.1 2005/05/06 14:54:43 whalley |
| 94 | ! Initial CVS import of the LHAPDF code and data sets |
| 95 | ! |
| 96 | ! Revision 1.1.1.2 1996/10/30 08:27:26 cernlib |
| 97 | ! Version 7.04 |
| 98 | ! |
| 99 | ! Revision 1.1.1.1 1996/04/12 15:28:53 plothow |
| 100 | ! Version 7.01 |
| 101 | ! |
| 102 | ! |
| 103 | SUBROUTINE ABFKWxx(imem,DX,DQ,DUPV,DDNV,DUSEA,DDSEA,DSTR,DCHM,DGL) |
| 104 | double precision & |
| 105 | & PARPI(40,3),CALCPI(8,20,25,3),CALCPIO(8,20,25),ZEROD, & |
| 106 | & DX,DQ,DUPV,DDNV,DUSEA,DDSEA,DSTR,DCHM,DGL |
| 107 | REAL X, Q, UPV, DNV, USEA, DSEA, STR, CHM, GL |
| 108 | |
| 109 | common /ABFKWP/CALCPI,CALCPIO,PARPI,lastmem |
| 110 | |
| 111 | ! COMMON/W5051Ixx/CALCPIO |
| 112 | REAL XPDF(7) |
| 113 | DATA ZEROD/0.D0/ |
| 114 | !---------------------------------------------------------------------- |
| 115 | DATA ISTART/0/ |
| 116 | SAVE ISTART,OWLAM2,Q02PI |
| 117 | ! |
| 118 | if(imem.ne.lastmem) then |
| 119 | istart = 0 |
| 120 | lastmem = imem |
| 121 | endif |
| 122 | IF (ISTART.EQ.0) THEN |
| 123 | ISTART=1 |
| 124 | DO 11 K=1,25 |
| 125 | DO 11 I=1,20 |
| 126 | DO 11 M=1,8 |
| 127 | 11 CALCPIO(M,I,K) = CALCPI(M,I,K,imem) |
| 128 | OWLAM=PARPI(1,imem) |
| 129 | OWLAM2=OWLAM**2 |
| 130 | Q02PI=PARPI(39,imem) |
| 131 | Q2MAX=PARPI(40,imem) |
| 132 | ENDIF |
| 133 | ! |
| 134 | ! the conventions are : q(1)=x*u, q(2)=x*d, q(3)=x*str, q(4)=x*usea, |
| 135 | ! q(5)=x*dsea, q(6)=x*charm, q(7)=x*gluon |
| 136 | ! |
| 137 | X = DX |
| 138 | Q = DQ |
| 139 | Q2 = Q*Q |
| 140 | IDQ2=2 |
| 141 | SB=0. |
| 142 | IF((Q2-Q02PI).LE.0) THEN |
| 143 | GO TO 1 |
| 144 | ELSE |
| 145 | GO TO 2 |
| 146 | ENDIF |
| 147 | 2 IF((IDQ2-1).LE.0) THEN |
| 148 | GO TO 1 |
| 149 | ELSE |
| 150 | GO TO 3 |
| 151 | ENDIF |
| 152 | 3 SB= LOG( LOG( MAX(Q02PI,Q2)/OWLAM2)/ LOG(Q02PI/OWLAM2)) |
| 153 | 1 CALL AURPIx(1,0,X,SB,XPDF(1)) |
| 154 | CALL AURPIx(2,0,X,SB,XPDF(2)) |
| 155 | CALL AURPIx(3,0,X,SB,XPDF(3)) |
| 156 | CALL AURPIx(4,0,X,SB,XPDF(4)) |
| 157 | CALL AURPIx(5,0,X,SB,XPDF(5)) |
| 158 | CALL AURPIx(8,0,X,SB,XPDF(6)) |
| 159 | CALL AURPIx(7,0,X,SB,XPDF(7)) |
| 160 | ! |
| 161 | DUPV=XPDF(1) - XPDF(4) |
| 162 | DDNV=XPDF(2) - XPDF(5) |
| 163 | DUSEA=XPDF(4) |
| 164 | DDSEA=XPDF(5) |
| 165 | DSTR=XPDF(3) |
| 166 | DCHM=XPDF(6) |
| 167 | DGL =XPDF(7) |
| 168 | ! |
| 169 | RETURN |
| 170 | END |
| 171 | !============================================================== |
| 172 | ! |
| 173 | ! $Id: wrapabfkwpi.f 356 2008-08-28 15:58:02Z buckley $ |
| 174 | ! |
| 175 | ! $Log$ |
| 176 | ! Revision 1.2 2005/10/07 15:15:05 whalley |
| 177 | ! Changes to most files for V5 - multiset initializations |
| 178 | ! |
| 179 | ! Revision 1.1.1.1 2005/05/06 14:54:43 whalley |
| 180 | ! Initial CVS import of the LHAPDF code and data sets |
| 181 | ! |
| 182 | ! Revision 1.1.1.2 1996/10/30 08:27:36 cernlib |
| 183 | ! Version 7.04 |
| 184 | ! |
| 185 | ! Revision 1.1.1.1 1996/04/12 15:29:03 plothow |
| 186 | ! Version 7.01 |
| 187 | ! |
| 188 | ! |
| 189 | ! |
| 190 | SUBROUTINE AURPIx(I,NDRV,X,S,ANS) |
| 191 | double precision & |
| 192 | & CALCPI(8,20,25,3),CALCPIO(8,20,25),parpi(40,3) |
| 193 | common /ABFKWP/CALCPI,CALCPIO,parpi,lastmem |
| 194 | ! COMMON/W5051I4/CALCPIO |
| 195 | REAL F1(25),F2(25) |
| 196 | DATA DELTA/.10/ |
| 197 | ANS=0. |
| 198 | IF(X.GT.0.9985) RETURN |
| 199 | IF(I.EQ.3.AND.X.GT.0.95) RETURN |
| 200 | IF(I.EQ.8.AND.X.GT.0.95) RETURN |
| 201 | IS=S/DELTA+1 |
| 202 | IS1=IS+1 |
| 203 | DO 1 L=1,25 |
| 204 | KL=L+NDRV*25 |
| 205 | F1(L)=CALCPIO(I,IS,KL) |
| 206 | F2(L)=CALCPIO(I,IS1,KL) |
| 207 | 1 END DO |
| 208 | A1=AUGETFV(X,F1) |
| 209 | A2=AUGETFV(X,F2) |
| 210 | S1=(IS-1)*DELTA |
| 211 | S2=S1+DELTA |
| 212 | ANS=A1*(S-S2)/(S1-S2)+A2*(S-S1)/(S2-S1) |
| 213 | RETURN |
| 214 | END |
| 215 | !=============================================================== |
| 216 | ! |
| 217 | ! $Id: wrapabfkwpi.f 356 2008-08-28 15:58:02Z buckley $ |
| 218 | ! |
| 219 | ! $Log$ |
| 220 | ! Revision 1.2 2005/10/07 15:15:05 whalley |
| 221 | ! Changes to most files for V5 - multiset initializations |
| 222 | ! |
| 223 | ! Revision 1.1.1.1 2005/05/06 14:54:43 whalley |
| 224 | ! Initial CVS import of the LHAPDF code and data sets |
| 225 | ! |
| 226 | ! Revision 1.1.1.2 1996/10/30 08:27:34 cernlib |
| 227 | ! Version 7.04 |
| 228 | ! |
| 229 | ! Revision 1.1.1.1 1996/04/12 15:29:02 plothow |
| 230 | ! Version 7.01 |
| 231 | ! |
| 232 | ! |
| 233 | ! |
| 234 | FUNCTION AUGETFV(X,FVL) |
| 235 | ! LOGARITHMIC INTERPOLATOR - WATCH OUT FOR NEGATIVE |
| 236 | ! FUNCTIONS AND/OR X VALUES OUTSIDE THE RANGE 0 TO 1. |
| 237 | ! NOTE: DIMENSION OF FVL IS OVERWRITTEN BY VALUE USED |
| 238 | ! IN MAIN ROUTINE. |
| 239 | DIMENSION FVL(25),XGRID(25) |
| 240 | DATA NX,XGRID/25,.001,.002,.004,.008,.016,.032,.064,.1,.15, & |
| 241 | &.2,.25,.3,.35,.4,.45,.5,.55,.6,.65,.7,.75,.8,.85,.9,.95/ |
| 242 | AUGETFV=0. |
| 243 | DO 1 I=1,NX |
| 244 | IF(X.LT.XGRID(I)) GO TO 2 |
| 245 | 1 END DO |
| 246 | 2 I=I-1 |
| 247 | IF(I.EQ.0) THEN |
| 248 | I=I+1 |
| 249 | ELSE IF(I.GT.23) THEN |
| 250 | I=23 |
| 251 | ENDIF |
| 252 | J=I+1 |
| 253 | K=J+1 |
| 254 | AXI= LOG(XGRID(I)) |
| 255 | BXI= LOG(1.-XGRID(I)) |
| 256 | AXJ= LOG(XGRID(J)) |
| 257 | BXJ= LOG(1.-XGRID(J)) |
| 258 | AXK= LOG(XGRID(K)) |
| 259 | BXK= LOG(1.-XGRID(K)) |
| 260 | FI= LOG(ABS(FVL(I)) +1.E-15) |
| 261 | FJ= LOG(ABS(FVL(J)) +1.E-16) |
| 262 | FK= LOG(ABS(FVL(K)) +1.E-17) |
| 263 | DET=AXI*(BXJ-BXK)+AXJ*(BXK-BXI)+AXK*(BXI-BXJ) |
| 264 | ALOGA=(FI*(AXJ*BXK-AXK*BXJ)+FJ*(AXK*BXI-AXI*BXK)+FK*(AXI*BXJ-AXJ* & |
| 265 | & BXI))/DET |
| 266 | ALPHA=(FI*(BXJ-BXK)+FJ*(BXK-BXI)+FK*(BXI-BXJ))/DET |
| 267 | BETA=(FI*(AXK-AXJ)+FJ*(AXI-AXK)+FK*(AXJ-AXI))/DET |
| 268 | IF(ABS(ALPHA).GT.99..OR.ABS(BETA).GT.99..OR.ABS(ALOGA).GT.99.) & |
| 269 | &RETURN |
| 270 | ! IF(ALPHA.GT.50..OR.BETA.GT.50.) THEN |
| 271 | ! WRITE(6,2001) X,FVL |
| 272 | ! 2001 FORMAT(8E12.4) |
| 273 | ! WRITE(6,2001) ALPHA,BETA,ALOGA,DET |
| 274 | ! ENDIF |
| 275 | AUGETFV=EXP(ALOGA)*X**ALPHA*(1.-X)**BETA |
| 276 | RETURN |
| 277 | END |
git://git.uio.no / u / mrichter / AliRoot.git / blame