-
Notifications
You must be signed in to change notification settings - Fork 6
/
Copy pathhvqpdfpho.f
13438 lines (12541 loc) · 446 KB
/
hvqpdfpho.f
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
C**** DECEMBER 1990 :
C RENAME TO MLMGEN **** WHOLE NEW SET OF PDF: DO,EHLQ,DFLM,HMRS,MT
C**** JULY 1990 -- ADD MULTIHISTOGRAMMING
C**** JAN 29 , 1990 -- USE WEBBER ROUTINE FOR STRUCTURE FUNCTIONS
C**** JUNE 12 , 1989 -- ADD SCATTER PLOT ROUTINES, AND INCLUDE SOME
C UTILITIES (VSUM, DOT)
C**** DECEMBER 2, 1988 -- ADD EHLQ1,GHR
C**** NOVEMBER 9, 1988
C
C
C**** MLMGEN.FOR ********
C--- GENERAL UTILITY SUBROUTINES:
C--- STRUCTURE FUNCTIONS, VEGAS, HISTOGRAMMING&PLOTTING
C-----------------------------------------------------------------------
C------- START STRUCTURE FUNCTION SECTION -------------------------------
C--------------------------------------------------------------------------
C-------------------------------------------------------------------------
SUBROUTINE PRNTSF
C prints details of the structure function sets
C-------------------------------------------------------------------------
WRITE(*,100)
# ' Set Authors Lambda_4 Lambda_5_2loop Scheme'
# ,' 1 DO I * .200 * .340 MS '
# ,' 1 OW I PION * .200 * .340 MS '
# ,' 2 DO II * .400 * .680 MS '
# ,' 2 OW II PION * .400 * .680 MS '
# ,' 3 EHLQ I * .200 * .340 MS '
# ,' 4 EHLQ II * .290 * .490 MS '
# ,' 5 DFLM .160 .101 DI '
# ,' 6 DFLM .260 .173 DI '
# ,' 7 DFLM .360 .250 DI '
WRITE(*,100)
# ' 10 MRSA mod. .230 .151 MS '
# ,' 11 HMRS B .190 .122 MS '
# ,' 12 KMRS B .190 .122 MS '
# ,' 13 MRS B .135 .083 MS '
# ,' 14 MRS B .160 .101 MS '
# ,' 15 MRS B .200 .130 MS '
# ,' 16 MRS B .235 .155 MS '
# ,' 17 MRSS0 .215 .140 MS '
# ,' 18 MRSD0 .215 .140 MS '
# ,' 19 MRSD- .215 .140 MS '
# ,' 20 MRSA .230 .151 MS '
WRITE(*,100)
# ' 21 MT S1 .212 .138 DI '
# ,' 22 MT B1 .194 .125 DI '
# ,' 23 MT B2 .191 .123 DI '
# ,' 24 MT E1 .155 .097 DI '
# ,' 25 MT S1M .212 .138 MS '
# ,' 26 MT S2 .237 .156 DI '
# ,' 27 MT S2M .237 .156 MS '
# ,' 28 MT SL * .144 * .245 MS '
# ,' 31 SMRS PION1 .190 .122 MS '
# ,' 32 SMRS PION2 .190 .122 MS '
# ,' 33 SMRS PION3 .190 .122 MS '
# ,' 40 DGK PHOTON* .400* .680 MS '
# ,' 41 ACFGP-MC PH .200 .130 MS '
# ,' 42 AFG-MC PH .200 .130 MS '
# ,' 43 GRV-HO PH .200 .130 DI_G'
# ,' 44 LAC1 PH* .200 .130 MS '
# ,' 50 DGK EL* .400* .680 MS '
# ,' 51 LAC1 EL* .200 .130 MS '
# ,' 52 LAC2 EL* .200 .130 MS '
# ,' 53 LAC3 EL* .200 .130 MS '
# ,' 54 GS-G HO EL .200 .130 MS '
# ,' 55 GRV-G HO EL .200 .130 DI_G'
# ,' 56 ACFGP-MC EL .200 .130 MS '
# ,' 57 AFG-MC EL .200 .130 MS '
WRITE(*,100)
# ' 61 CTEQ1M .231 .152 MS '
# ,' 62 CTEQ1MS .231 .152 MS '
# ,' 63 CTEQ1ML .322 .220 MS '
# ,' 64 CTEQ1D .247 .164 DI '
# ,' 65 CTEQ1L * .168 * .125 * MS '
# ,' 66 CTEQ3M .239 .158 MS '
# ,' 67 CTEQ3L * .177 * .132 * MS '
# ,' 68 CTEQ3D .247 .164 DI '
WRITE(*,100)
# ' 71 MRSA prime .231 .152 MS '
# ,' 72 MRSG .255 .170 MS '
# ,' 73 MRS105 .158 .0994 MS '
# ,' 74 MRS110 .214 .140 MS '
# ,' 75 MRS115 .282 .190 MS '
# ,' 76 MRS120 .364 .253 MS '
# ,' 77 MRS125 .458 .328 MS '
# ,' 78 MRS130 .566 .416 MS '
WRITE(*,100)
# ' 81 CTEQ4M .298 .202 MS '
# ,' 82 CTEQ4D .298 .202 DI '
# ,' 83 CTEQ4L * .298 .202 MS '
# ,' 84 CTEQ4A1 .214 .140 MS '
# ,' 85 CTEQ4A2 .254 .169 MS '
# ,' 86 CTEQ4A4 .346 .239 MS '
# ,' 87 CTEQ4A5 .400 .281 MS '
# ,' 88 CTEQ4HJ .298 .202 MS '
# ,' 89 CTEQ4LQ .268 .179 MS '
WRITE(*,100)
# ' 91 MRSR1(1996) .241 .159 MS '
# ,' 92 MRSR2 .. .344 .237 MS '
# ,' 93 MRSR3 .. .241 .159 MS '
# ,' 94 MRSR4 .. .344 .237 MS '
# ,' 95 MRST1(1998) .321 .220 MS '
# ,' 96 MRSTH .. .321 .220 MS '
# ,' 97 MRSTL .. .321 .220 MS '
# ,' 98 MRSTM .. .247 .164 MS '
# ,' 99 MRSTP .. .409 .288 MS '
WRITE(*,100)
# ' 101 CTEQ5M .329 .226 (as=0.118) MS '
# ,' 102 CTEQ5D .329 .226 (as=0.118) DI '
# ,' 103 CTEQ5L .192 .146 (as=0.127) MS '
# ,' 104 CTEQ5HJ .329 .226 (as=0.118) MS '
# ,' 105 CTEQ5HQ .329 .226 (as=0.118) MS '
# ,' 106 CTEQ5F3 Nf=3, L_3=.395 (as=0.106) MS '
# ,' 107 CTEQ5F4 Nf=4, L_4=.309 (as=0.112) MS '
# ,' 108 CTEQ5M1 .329 .226 (as=0.118) MS '
# ,' 109 CTEQ5HQ1 .329 .226 (as=0.118) MS '
# ,' 110 CTEQ5M1(parametrized version) '
WRITE(*,100)
# ' 111 MRST99 COR01 .321 .220 MS '
# ,' 112 MRSTH COR02 .321 .220 MS '
# ,' 113 MRSTL COR03 .321 .220 MS '
# ,' 114 MRSTM COR04 .247 .164 MS '
# ,' 115 MRSTP COR05 .409 .288 MS '
# ,' 116 MRST99 COR06 .327 .224 MS '
# ,' 117 MRST99 COR07 .315 .215 MS '
# ,' 118 MRST99 COR08 .321 .220 MS '
# ,' 119 MRST99 COR09 .321 .220 MS '
# ,' 120 MRST99 COR10 .321 .220 MS '
# ,' 121 MRST99 COR11 .321 .220 MS '
# ,' 122 MRST99 COR12 .321 .220 MS '
WRITE(*,100)
# ' 131 CTEQ6M .326 .226 (as=0.118) MS '
# ,' 132 CTEQ6D .326 .226 (as=0.118) DI '
# ,' 133 CTEQ6L .326 .226 (as=0.118) MS '
# ,' 134-173 CTEQ6M1xx .326 .226 (as=0.118) MS '
write(*,100)
# ' 181 MRST200?NNLO av. .29 0.1805 (as=0.1155) MS '
# ,' 182 MRST200?NNLO fast .29 0.1805 (as=0.1155) MS '
# ,' 183 MRST200?NNLO slow .29 0.1805 (as=0.1155) MS '
# ,' 184 MRST200?NNLO jet .33 0.209 (as=0.118) MS '
# ,' 185 MRST2001 best fit .347 .239 (as=0.119) MS '
# ,' 186 MRST2001 low as .313 .214 (as=0.117) MS '
# ,' 187 MRST2001 high as .382 .267 (as=0.121) MS '
# ,' 188 MRST2001 jet fit .382 .267 (as=0.121) MS '
# ,' 189 MRST2001lo .566 .416 (as=0.130) LO '
write(*,100)
# ' 191 MRST2002 .359 .249 (as=0.1197) MS '
# ,' 192 MRST2002NNLO .289 .1795 (as=0.1154) MS '
# ,' 200-230 MRS2001E .347 .239 (as=0.119) MS '
write(*,100) ' Alekhin pdf sets;'
#, ' 231 LO nominal ffn; .4163 (as=0.1301)'
#, ' 232 LO nominal vfn'
#, ' 233 LO mc=1.85 ffn'
#, ' 234 LO mc=1.85 vfn'
#, ' 235 LO ss ffn'
#, ' 236 LO ss vfn'
#, ' 237 NL nominal ffn; .215 (as=0.1171)'
#, ' 238 NL nominal vfn'
#, ' 239 NL mc=1.85 ffn'
#, ' 240 NL mc=1.85 vfn'
#, ' 241 NL ss ffn'
#, ' 242 NL ss vfn'
#, ' 243 NNL nominal ffn; .1826 (as=0.1143)'
#, ' 244 NNL nominal vfn'
#, ' 245 NNL mc=1.85 ffn'
#, ' 246 NNL mc=1.85 vfn'
#, ' 247 NNL ss ffn'
#, ' 248 NNL ss vfn'
#, ' 249 NNL slow ev vfn'
#, ' 250 NNL slow ev vfn'
#, ' To get the sets with errorrs, replace the set number ndns'
#, ' with ndns + (2*i-k)*10^6; this will return the pdf'
#, ' minus (for k=1) or plus (for k=0) the variation'
#, ' of the |ith| parameter'
write(*,100) ' Cteq61'
#, ' 261 CTEQ6M (should be the same as 131)'
#, ' 262 CTEQ6D (should be the same as 132)'
#, ' 263 CTEQ6L (should be the same as 133)'
#, ' 264 CTEQ6L1'
#, ' 265 CTEQ6M (same as 261)'
#, ' 265 + (2*i-k)*10^6 returns the + (k=1) or - (k=0)'
#, ' variation of the ith eigenvector (i=1,20)'
#, ' (same as 234-273)'
#, ' 266 CTEQ6.1M, 265 + (2*i-k)*10^6 corresponding errors'
C ---------------------------------------------------------------------------
WRITE(*,100)
# ' PDF sets followed by * are obtained from a 1-loop analysis,'
# ,' and the relative values of Lambda_4 refer to 1-loop. '
# ,' Lambda is automatically converted to 2-loop for use with '
# ,' a 2-loop alpha in the program. The conversion is performed'
# ,' in such a way that at a scale of 10 GeV the value of alpha'
# ,' is the same. The MSbar subtr. scheme'
# ,' is used by default with 1-loop structure functions.'
# ,' MT set 26 has SU(3)-violating strange sea distributions'
# ,' Morfin and Tung sets labeled 25 and 27 are simply MSbar '
# ,' versions of sets 21 and 26, respectively.'
# ,' PDF sets 31-33 are the new NLO pion distributions by '
# ,' Sutton-MRS. Sets 13-16 are MRS fits of BCDMS data using'
# ,' different values of Lambda PHYS REV D43 (91) 3648.'
# ,' Sets 17-19 are the new NMC/CCFR fits by MRS (RAL-92-021)'
WRITE(*,100)
# ' Set 20: MRSA (Durham preprint, DTP/94/34)'
# ,' Set 71: MRSA prime (Durham preprint, DTP/95/14)'
# ,' Set 72: MRSG (Durham preprint, DTP/95/14)'
# ,' Sets 73-78 are the MRS structure functions '
# ,' with variable Lambda. The values of Lambda5 quoted '
# ,' here correspond to values of alpha(Mz) of 0.105,0.110,0.115'
# ,' 0.120,0.125,0.130, which is slightly different from the'
# ,' values one would obtain with the usual matching procedure'
# ,' from the corresponding value of Lambda4 quoted by MRS'
WRITE(*,100)
# ' Sets 61-65 are the CTEQ1 fits (61=default, 62=sing.gluon,'
# ,' 63= LEP lambda, 64=DIS scheme, 65=LO fit).'
# ,' Sets 81-89 are the CTEQ4 fits, H.L. Lai et al.,'
# ,' CTEQ-604, hep-ph/9606399, (81=default, 82=DIS scheme,'
# ,' 83=leading order, 84-87=variable Lambda, 88=High-et jet fit,'
# ,' 89=low momentum evolution)'
WRITE(*,100)
# ' Set 40 corresponds to photon PDF''s by Drees, Grassie, Kim'
# ,' Z.Phys. C28 (1985) 51 and DTP/91/16'
# ,' Set 41 corresponds to photon PDF''s Aurenche et al.'
# ,' Set 42 corresponds to photon PDF''s Aurenche et al. (1994)'
# ,' Set 43 corresponds to photon PDF''s Glueck et al.'
# ,' Set 44 corresponds to photon PDF''s Abramowicz et al.'
# ,' Set 50 corresponds to electron with photon DG'
# ,' Set 51 corresponds to electron with photon LAC1'
# ,' Set 52 corresponds to electron with photon LAC2'
# ,' Set 53 corresponds to electron with photon LAC3'
# ,' Set 54 corresponds to electron with photon GS-G HO'
# ,' Set 55 corresponds to electron with photon GRV-G HO'
# ,' Set 56 corresponds to electron with photon ACFGP-MC'
# ,' Set 57 corresponds to electron with photon AFG-MC'
# ,' GRV-G HO photon uses the DIS_gamma scheme, defined'
# ,' in Gluck, Reya and Vogt, Phys. Rev. D45(1992)3986.'
100 FORMAT(1X,A,100(/,1X,A))
END
SUBROUTINE PDFPAR(J0,IH,XLAM,SCHE,IRET)
PARAMETER (NPDF=266)
C LAMBDA VALUES (lAMBDA_5FLAVOUR_2LOOP) FOR DIFFERENT PARTON DENSITIES
IMPLICIT REAL * 8 (A-H,O-Z)
CHARACTER * 2 SCHE,SCH(NPDF)
DIMENSION XLA(NPDF)
DATA SCH/4*'MS',3*'DI',2*' ',
# 11*'MS',
# 4*'DI','MS','DI',2*'MS',2*' ',
# 3*'MS',6*' ',
# 3*'MS','DG','MS',5*' ',
# 5*'MS','DG',2*'MS',3*' ',
# 3*'MS','DI','MS',
c CTEQ3M
# 2*'MS','DI', 2*' ',
c MRSAp, MRSG, MRSalpha
# 8*'MS',2*' ',
c CTEQ4
# 'MS','DI',7*'MS',' ',
c MRSR and MRST
# 9*'MS',' ',
c CTEQ5
# 'MS','DI',6*'MS',2*'MS',
c MRST99
# 12*'MS',8*' ',
C CTEQ6
# 'MS', 'DI', 'MS', 40*'MS',7*' ',
c MRS200?NNLO
# 4*'MS',
c MRS2001
# 4*'MS','LO',' ',
c MRST2002
# 2*'MS',7*' ',
c MRST2002E
# 31*'MS',
c Alekhin
# 6*'LO',14*'MS',
# 10*' ',
c cteq6.1
# 'MS','DI',2*'LO',2*'MS'/
c
DATA XLA/
c 1 DO
# .34D0,.68D0,.34D0,.49D0,
# .101D0,.173D0,.250D0,2*0.D0,
c 10 MRSA mod
# .151d0,.122D0,.122D0,.083D0,.101D0,.130D0,.155D0,3*.140d0,.151d0,
c 21 MT S1
# .138D0,.125D0,.123D0,.097D0,.138d0,2*.156d0,.245d0,2*0.D0,
# 3*.122D0,6*0.D0,
# 0.68D0,4*.130D0,5*0.D0,
# 0.68D0,7*.130D0,3*0.D0,
c 61 CTEQ1M
# 2*0.152D0,0.220D0,0.164D0,0.125D0,
c 66 CTEQ3M
# .158d0,.132d0,.164d0,2*0.D0,
# 0.152D0,0.170D0,
c MRSA-alpha dependent
# 0.09936d0,0.1396d0,0.1903d0,0.2526d0,0.3276d0,0.4162d0,2*0.D0,
c The values given above for the MRSXXX sets are consistent with the
c alfas(Mz) given by MRS. The values
c # .094d0,0.130d0,0.178d0,0.237d0,0.309d0,0.396d0/
c are on the other hand consistent with the Lambda_4 given by MRS
c CTEQ4
# 3*0.2018d0,0.1396d0,0.1687d0,
# 0.2392d0,0.2811d0,0.2018d0,0.1793d0,0d0,
c 91-94 MRSR
# .159d0,.237d0,.159d0,.237d0,
c 95-99 MRST
# 3*.220d0,.164d0,.288d0,0d0,
c 101-108 cteq5
# 2*.226d0,1.d-8,2*.226d0,2*1.d-8,.226d0,2*.226d0,
c 111-122 MRST99
# 3*.220d0,.164d0,.288d0,.224d0,.215d0,5*.220d0,8*0d0,
C 131-173 CTEQ6
# 43*.226D0,7*0d0,
C 181-184, MRS200?NNLO
# 3*.1805d0,.2085d0,
c 185-189, MRS2002
#0.239d0,0.214d0,2*0.267d0,0.416,0d0,
c 191-192, MRST2002
#0.249d0,0.1795d0,7*0d0,
c 200-230
# 31*0.239d0,
c 231-250, Alekhin 20 sets
# 6*0.4163d0, 6*0.215d0, 8*0.1826d0,
c 251-260
# 10*0d0,
c CTEQ6.1
# 3*0.226d0,0d0,2*0.226d0/
c /
IRET=0
c if j0 >10^6 it is a pdf with error
if(j0.gt.1000000) then
jerr=(j0/1000000)
j=j0-jerr*1000000
else
j=j0
jerr=0
endif
IF(J.LT.1.OR.J.GT.NPDF) THEN
WRITE(*,*) ' PDF SET ',J,' NOT EXISTING'
IRET=1
RETURN
ENDIF
XLAM = XLA(J)
C SCHEME
SCHE = SCH(J)
IF(XLAM.EQ.0.OR.SCHE.EQ.' ') THEN
WRITE(*,*) ' PDF SET ',J,' NOT EXISTING'
IRET=1
RETURN
ENDIF
IF(
# ABS(IH).EQ.3
C It is a pion
# .AND.J.NE.1.AND.J.NE.2
C It is not Owens 1 or 2
# .AND.J.NE.31.AND.J.NE.32.AND.J.NE.33 )
C It is not SMRS 1-2-3
# THEN
WRITE(*,*) ' PDF SET ',J,' NOT AVAILABLE FOR PIONS'
IRET=1
RETURN
ENDIF
IF(
# ABS(IH).EQ.4
C It is a photon
# .AND. J.NE.40
C It is not Drees e Grassie
# .AND. J.NE.41
C It is not ACFGP
# .AND. J.NE.42
C It is not AFG
# .AND. J.NE.43
C It is not GRV-HO
# .AND. J.NE.44)
C It is not LAC1
C It is not a photon PDF
# THEN
WRITE(*,*) ' PDF SET ',J,' NOT AVAILABLE FOR PHOTONS'
IRET=1
RETURN
ENDIF
IF(
# ABS(IH).EQ.5
C It is an electron
# .AND. J.NE.40
C It is not Drees e Grassie
# .AND. J.NE.41
C It is not ACFGP
# .AND. J.NE.42
C It is not AFG
# .AND. J.NE.43
C It is not GRV-HO
# .AND. J.NE.44
C It is not LAC1
# .AND. J.NE.50
C It is not Drees e Grassie
# .AND. J.NE.51 .AND. J.NE.52 .AND. J.NE.53
C It is not LAC1, LAC2, LAC3
# .AND. J.NE.54
C It is not GS-G HO
# .AND. J.NE.55
C It is not GRV-G HO
# .AND. J.NE.56
C It is not ACFGP-MC
# .AND. J.NE.57 )
C It is not AFG-MC
# THEN
WRITE(*,*) ' PDF SET ',J,' NOT AVAILABLE FOR ELECTRON'
IRET=1
RETURN
ENDIF
END
C--------------------------------------------------
C- STRUCTURE FUNCTION MAIN PROGRAM
C--------------------------------------------------
SUBROUTINE MLMPDF(j0,IH,Q2,X,FX,NF)
REAL FX(-NF:NF),DISF(13)
INTEGER IPAR(-6:6)
DATA IPAR/12,11,10,9,7,8,13,2,1,3,4,5,6/
if(j0.gt.1000000) then
jerr=(j0/1000000)
ndns=j0-jerr*1000000
else
ndns=j0
jerr=0
endif
C Fix to prevent undefined math operations for x=1.
C Assumes that all structure functions vanish for x=1.
IF(1-X.EQ.0) THEN
DO J=-NF,NF
FX(J) = 0
ENDDO
RETURN
ENDIF
C
IH0=IH
IF(IH.EQ.0) IH0=1
IF(NDNS.LE.4) THEN
C--DO1,DO2,EHLQ1,EHLQ2
Q=SQRT(Q2)
CALL DOEHLQ(X,Q,IH0,NDNS,DISF,NF)
DO I =-NF,NF
FX(I) = DISF(IPAR(I)) / X
ENDDO
ELSEIF(NDNS.LE.9) THEN
C--DFLM
ISET=NDNS-4
CALL DFLM(ISET,IH0,Q2,X,FX,NF)
ELSEIF(NDNS.LE.10) THEN
C--MRSA modified
CALL XMRSA(Q2,X,FX,NF)
ELSEIF(NDNS.LE.20) THEN
C--MRS,HMRS,KMRS SETS
ISET=NDNS-10
CALL HMRS(ISET,IH0,Q2,X,FX,NF)
ELSEIF(NDNS.LE.30) THEN
C--MORFIN AND TUNG
ISET=NDNS-20
CALL TUNG(ISET,IH0,Q2,X,FX,NF)
ELSEIF(NDNS.LE.33) THEN
C--SUTTON MRS PIONS
ISET=NDNS-30
CALL PION(ISET,IH0,Q2,X,FX,NF)
ELSEIF(NDNS.LE.44) THEN
C--PHOTON PDFS
IF(IH.EQ.4) THEN
ISET=NDNS-40
IF(ISET.EQ.0) THEN
C--DREES,GRASSIE, KIM
CALL PHOPDF(Q2,X,FX,NF)
ELSEIF(ISET.EQ.1) THEN
C-- AURENCHE ET AL
CALL FONPDF(Q2,X,FX,NF)
ELSEIF(ISET.EQ.2) THEN
C-- AURENCHE 1994
CALL AFGPDF(Q2,X,FX,NF)
ELSEIF(ISET.EQ.3) THEN
C-- GLUECK NLO
CALL GRV_PH(Q2,X,FX,NF)
ELSEIF(ISET.EQ.4) THEN
C-- LAC
CALL XLAC(1,Q2,X,FX,NF)
ENDIF
ELSEIF(IH.EQ.5) THEN
C-- USER-DEFINED ELECTRON PDF
CALL ELPDF_USER(NDNS,Q2,X,FX,NF)
ENDIF
C--ELECTRON PDFS
ELSEIF(NDNS.LE.57) THEN
ISET=NDNS-50
IF(ISET.EQ.0) THEN
CALL ELPDF_DG(Q2,X,FX,NF)
ELSEIF(ISET.EQ.1) THEN
CALL ELPDF_LAC1(Q2,X,FX,NF)
ELSEIF(ISET.EQ.2) THEN
CALL ELPDF_LAC2(Q2,X,FX,NF)
ELSEIF(ISET.EQ.3) THEN
CALL ELPDF_LAC3(Q2,X,FX,NF)
ELSEIF(ISET.EQ.4) THEN
CALL ELPDF_GS(Q2,X,FX,NF)
ELSEIF(ISET.EQ.5) THEN
CALL ELPDF_GRV(Q2,X,FX,NF)
ELSEIF(ISET.EQ.6) THEN
CALL ELPDF_ACF(Q2,X,FX,NF)
ELSEIF(ISET.EQ.7) THEN
CALL ELPDF_AFG(Q2,X,FX,NF)
ENDIF
ELSEIF(NDNS.LE.65) THEN
C-- CTEQ1 FITS
ISET=NDNS-60
CALL CTEQ(ISET,IH0,Q2,X,FX,NF)
ELSEIF(NDNS.LE.70) THEN
C-- CTEQ3 FITS
ISET=NDNS-65
CALL CTEQ3(ISET,IH0,Q2,X,FX,NF)
ELSEIF(NDNS.LE.80) THEN
C-- MRSAP, MRSG AND MRS WITH VARIABLE LAMBDA
ISET=NDNS-60
CALL HMRS(ISET,IH0,Q2,X,FX,NF)
ELSEIF(NDNS.LE.89) THEN
C-- CTEQ4 FITS
ISET=NDNS-80
CALL CTEQ4(ISET,IH0,Q2,X,FX,NF)
ELSEIF(NDNS.LE.99) THEN
C-- MRSR/T sets
ISET=NDNS-60
CALL HMRS(ISET,IH0,Q2,X,FX,NF)
ELSEIF(NDNS.LE.110) THEN
C-- CTEQ5
ISET=NDNS-100
CALL CTEQ5(ISET,IH0,Q2,X,FX,NF)
ELSEIF(NDNS.LE.122) THEN
C-- MRST99 sets
ISET=NDNS-70
CALL HMRS(ISET,IH0,Q2,X,FX,NF)
ELSEIF(NDNS.LE.173) THEN
C-- CTEQ6 FITS
ISET=NDNS-130
IF(ISET.GE.4) ISET=ISET-3+100
CALL CTEQ6(ISET,IH0,Q2,X,FX,NF)
C-- MRSTNNLO (200?)
ELSEIF(NDNS.LE.184) THEN
ISET=NDNS-(184-56)
CALL HMRS(ISET,IH0,Q2,X,FX,NF)
C-- MRST2001
ELSEIF(NDNS.LE.188) THEN
ISET=NDNS-(188-60)
CALL HMRS(ISET,IH0,Q2,X,FX,NF)
C-- MRST2001 lo
ELSEIF(NDNS.EQ.189) THEN
ISET=NDNS-(189-61)
CALL HMRS(ISET,IH0,Q2,X,FX,NF)
C-- MRST2002, MRST2002NNLO
ELSEIF(NDNS.LE.192) THEN
ISET=NDNS-(192-63)
CALL HMRS(ISET,IH0,Q2,X,FX,NF)
C-- MRST2001E
ELSEIF(NDNS.LE.230) THEN
ISET=NDNS-(230-94)
CALL HMRS(ISET,IH0,Q2,X,FX,NF)
ELSEIF(NDNS.LE.250) THEN
ISET=NDNS-230
c turns jerr=1,...,30 to 1,-1,2,-2,...,15,-15
jerr=((1+jerr)/2)*(2*jerr-(jerr/2)*4-1)
call errsk(jerr)
CALL alekhin(iset,x,q2,fx,nf)
call hadconv(fx,ih0,nf)
ELSEif(ndns.le.260) then
WRITE(*,*) ' STRUCTURE FUNCTION SET NOT DEFINED , STOP'
STOP
elseif(ndns.le.266) then
C-- CTEQ6.1 FITS
ISET=NDNS-260
IF(ISET.GE.5) ISET=(ISET-4)*100+jerr
CALL CTEQ61(ISET,IH0,Q2,X,FX,NF)
else
WRITE(*,*) ' STRUCTURE FUNCTION SET NOT DEFINED , STOP'
STOP
ENDIF
IF(IH.EQ.0) THEN
FX(1) = 0.5 * ( FX(1)+FX(2) )
FX(-1) = 0.5 * ( FX(-1)+FX(-2) )
FX(2) = FX(1)
FX(-2) = FX(-1)
ENDIF
END
subroutine hadconv(fx,ih0,nf)
implicit none
integer nf,ih0,j
real * 4 fx(-nf:nf),tmp
if(ih0.eq.-1) then
c antiproton
do j=1,nf
tmp=fx(j)
fx(j)=fx(-j)
fx(-j)=tmp
enddo
elseif(ih0.eq.2) then
c neutron
tmp=fx(1)
fx(1)=fx(2)
fx(2)=tmp
tmp=fx(-1)
fx(-1)=fx(-2)
fx(-2)=tmp
elseif(ih0.eq.0) then
c nucleon
fx(1)=(fx(1)+fx(2))/2
fx(2)=fx(1)
fx(-1)=(fx(-1)+fx(-2))/2
fx(-2)=fx(-1)
elseif(ih0.ne.1) then
write(*,*) ' hadron ',ih0, 'not implemented'
stop
endif
end
C------------------------------------------------------------------------
SUBROUTINE DOEHLQ(X,SCALE,IDHAD,NSET,DIST,NF)
C NUCLEON AND PION STRUCTURE FUNCTIONS DIST=X*QRK(X,Q=SCALE)
C
C IDHAD = TYPE OF HADRON:
C 1 = P -1 = PBAR 2 = N -2 = NBAR 38 = PI+ 30 = PI-
C
C NSET = STRUCTURE FUNCTION SET
C = 1,2 FOR DUKE+OWENS SETS 1,2 (SOFT/HARD GLUE)
C = 3,4 FOR EICHTEN ET AL SETS 1,2 (NUCLEON ONLY)
C
C DUKE+OWENS = D.W.DUKE AND J.F.OWENS, PHYS. REV. D30 (1984) 49 (P/N)
C + J.F.OWENS, PHYS. REV. D30 (1984) 943 (PI+/-)
C WITH EXTRA SIGNIFICANT FIGURES VIA ED BERGER
C WARNING....MOMENTUM SUM RULE BADLY VIOLATED ABOVE 1 TEV
C PION NOT RELIABLE ABOVE SCALE = 50 GEV
C
C EICHTEN ET AL = E.EICHTEN,I.HINCHLIFFE,K.LANE AND C.QUIGG,
C REV. MOD. PHYS. 56 (1984) 579
C REVISED AS IN REV. MOD. PHYS. 58 (1986) 1065
C RELIABLE RANGE : SQRT(5)GEV < SCALE < 10TEV, 1E-4 < X < 1
C
C------------------------------------------------------------------------
REAL DIST(13),G(2),Q0(4),QL(4),F(5),A(6,5),B(3,6,5,4)
REAL XQ(6),TX(6),TT(6),TB(6),NEHLQ(8,2),CEHLQ(6,6,2,8,2)
REAL TBMIN(2),TTMIN(2)
DATA (((B(I,J,K,1),I=1,3),J=1,6),K=1,5)/
&3.,0.,0.,.419,.004383,-.007412,
&3.46,.72432,-.065998,4.4,-4.8644,1.3274,
&6*0.,1.,
&0.,0.,.763,-.23696,.025836,4.,.62664,-.019163,
&0.,-.42068,.032809,6*0.,1.265,-1.1323,.29268,
&0.,-.37162,-.028977,8.05,1.5877,-.15291,
&0.,6.3059,-.27342,0.,-10.543,-3.1674,
&0.,14.698,9.798,0.,.13479,-.074693,
&-.0355,-.22237,-.057685,6.3494,3.2649,-.90945,
&0.,-3.0331,1.5042,0.,17.431,-11.255,
&0.,-17.861,15.571,1.564,-1.7112,.63751,
&0.,-.94892,.32505,6.,1.4345,-1.0485,
&9.,-7.1858,.25494,0.,-16.457,10.947,
&0.,15.261,-10.085/
DATA (((B(I,J,K,2),I=1,3),J=1,6),K=1,5)/
&3.,0.,0.,.3743,.013946,-.00031695,
&3.329,.75343,-.076125,6.032,-6.2153,1.5561,
&6*0.,1.,0.,
&0.,.7608,-.2317,.023232,3.83,.62746,-.019155,
&0.,-.41843,.035972,6*0.,1.6714,-1.9168,.58175,
&0.,-.27307,-.16392,9.145,.53045,-.76271,
&0.,15.665,-2.8341,0.,-100.63,44.658,
&0.,223.24,-116.76,0.,.067368,-.030574,
&-.11989,-.23293,-.023273,3.5087,3.6554,-.45313,
&0.,-.47369,.35793,0.,9.5041,-5.4303,
&0.,-16.563,15.524,.8789,-.97093,.43388,
&0.,-1.1612,.4759,4.,1.2271,-.25369,
&9.,-5.6354,-.81747,0.,-7.5438,5.5034,
&0.,-.59649,.12611/
DATA (((B(I,J,K,3),I=1,3),J=1,6),K=1,5)/
&1.,0.,0.,0.4,-0.06212,-0.007109,0.7,0.6478,0.01335,27*0.,
&0.9,-0.2428,0.1386,0.,-0.2120,0.003671,5.0,0.8673,0.04747,
&0.,1.266,-2.215,0.,2.382,0.3482,3*0.,
&0.,0.07928,-0.06134,-0.02212,-0.3785,-0.1088,2.894,9.433,
&-10.852,0.,5.248,-7.187,0.,8.388,-11.61,3*0.,
&0.888,-1.802,1.812,0.,-1.576,1.20,3.11,-0.1317,0.5068,
&6.0,2.801,-12.16,0.,-17.28,20.49,3*0./
DATA (((B(I,J,K,4),I=1,3),J=1,6),K=1,5)/
&1.,0.,0.,0.4,-0.05909,-0.006524,0.628,0.6436,0.01451,27*0.,
&0.90,-0.1417,-0.1740,0.,-0.1697,-0.09623,5.0,-2.474,1.575,
&0.,-2.534,1.378,0.,0.5621,-0.2701,3*0.,
&0.,0.06229,-0.04099,-0.0882,-0.2892,-0.1082,1.924,0.2424,
&2.036,0.,-4.463,5.209,0.,-0.8367,-0.04840,3*0.,
&0.794,-0.9144,0.5966,0.,-1.237,0.6582,2.89,0.5966,-0.2550,
&6.0,-3.671,-2.304,0.,-8.191,7.758,3*0./
C...THE FOLLOWING DATA LINES ARE COEFFICIENTS NEEDED IN THE
C...EICHTEN, HINCHLIFFE, LANE, QUIGG PROTON STRUCTURE FUNCTION
C...POWERS OF 1-X IN DIFFERENT CASES
DATA NEHLQ/3,4,7,5,7,7,7,7,3,4,7,6,7,7,7,7/
C...EXPANSION COEFFICIENTS FOR UP VALENCE QUARK DISTRIBUTION
DATA (((CEHLQ(IX,IT,NX,1,1),IX=1,6),IT=1,6),NX=1,2)/
1 7.677E-01,-2.087E-01,-3.303E-01,-2.517E-02,-1.570E-02,-1.000E-04,
2-5.326E-01,-2.661E-01, 3.201E-01, 1.192E-01, 2.434E-02, 7.620E-03,
3 2.162E-01, 1.881E-01,-8.375E-02,-6.515E-02,-1.743E-02,-5.040E-03,
4-9.211E-02,-9.952E-02, 1.373E-02, 2.506E-02, 8.770E-03, 2.550E-03,
5 3.670E-02, 4.409E-02, 9.600E-04,-7.960E-03,-3.420E-03,-1.050E-03,
6-1.549E-02,-2.026E-02,-3.060E-03, 2.220E-03, 1.240E-03, 4.100E-04,
1 2.395E-01, 2.905E-01, 9.778E-02, 2.149E-02, 3.440E-03, 5.000E-04,
2 1.751E-02,-6.090E-03,-2.687E-02,-1.916E-02,-7.970E-03,-2.750E-03,
3-5.760E-03,-5.040E-03, 1.080E-03, 2.490E-03, 1.530E-03, 7.500E-04,
4 1.740E-03, 1.960E-03, 3.000E-04,-3.400E-04,-2.900E-04,-1.800E-04,
5-5.300E-04,-6.400E-04,-1.700E-04, 4.000E-05, 6.000E-05, 4.000E-05,
6 1.700E-04, 2.200E-04, 8.000E-05, 1.000E-05,-1.000E-05,-1.000E-05/
DATA (((CEHLQ(IX,IT,NX,1,2),IX=1,6),IT=1,6),NX=1,2)/
1 7.237E-01,-2.189E-01,-2.995E-01,-1.909E-02,-1.477E-02, 2.500E-04,
2-5.314E-01,-2.425E-01, 3.283E-01, 1.119E-01, 2.223E-02, 7.070E-03,
3 2.289E-01, 1.890E-01,-9.859E-02,-6.900E-02,-1.747E-02,-5.080E-03,
4-1.041E-01,-1.084E-01, 2.108E-02, 2.975E-02, 9.830E-03, 2.830E-03,
5 4.394E-02, 5.116E-02,-1.410E-03,-1.055E-02,-4.230E-03,-1.270E-03,
6-1.991E-02,-2.539E-02,-2.780E-03, 3.430E-03, 1.720E-03, 5.500E-04,
1 2.410E-01, 2.884E-01, 9.369E-02, 1.900E-02, 2.530E-03, 2.400E-04,
2 1.765E-02,-9.220E-03,-3.037E-02,-2.085E-02,-8.440E-03,-2.810E-03,
3-6.450E-03,-5.260E-03, 1.720E-03, 3.110E-03, 1.830E-03, 8.700E-04,
4 2.120E-03, 2.320E-03, 2.600E-04,-4.900E-04,-3.900E-04,-2.300E-04,
5-6.900E-04,-8.200E-04,-2.000E-04, 7.000E-05, 9.000E-05, 6.000E-05,
6 2.400E-04, 3.100E-04, 1.100E-04, 0.000E+00,-2.000E-05,-2.000E-05/
C...EXPANSION COEFFICIENTS FOR DOWN VALENCE QUARK DISTRIBUTION
DATA (((CEHLQ(IX,IT,NX,2,1),IX=1,6),IT=1,6),NX=1,2)/
1 3.813E-01,-8.090E-02,-1.634E-01,-2.185E-02,-8.430E-03,-6.200E-04,
2-2.948E-01,-1.435E-01, 1.665E-01, 6.638E-02, 1.473E-02, 4.080E-03,
3 1.252E-01, 1.042E-01,-4.722E-02,-3.683E-02,-1.038E-02,-2.860E-03,
4-5.478E-02,-5.678E-02, 8.900E-03, 1.484E-02, 5.340E-03, 1.520E-03,
5 2.220E-02, 2.567E-02,-3.000E-05,-4.970E-03,-2.160E-03,-6.500E-04,
6-9.530E-03,-1.204E-02,-1.510E-03, 1.510E-03, 8.300E-04, 2.700E-04,
1 1.261E-01, 1.354E-01, 3.958E-02, 8.240E-03, 1.660E-03, 4.500E-04,
2 3.890E-03,-1.159E-02,-1.625E-02,-9.610E-03,-3.710E-03,-1.260E-03,
3-1.910E-03,-5.600E-04, 1.590E-03, 1.590E-03, 8.400E-04, 3.900E-04,
4 6.400E-04, 4.900E-04,-1.500E-04,-2.900E-04,-1.800E-04,-1.000E-04,
5-2.000E-04,-1.900E-04, 0.000E+00, 6.000E-05, 4.000E-05, 3.000E-05,
6 7.000E-05, 8.000E-05, 2.000E-05,-1.000E-05,-1.000E-05,-1.000E-05/
DATA (((CEHLQ(IX,IT,NX,2,2),IX=1,6),IT=1,6),NX=1,2)/
1 3.578E-01,-8.622E-02,-1.480E-01,-1.840E-02,-7.820E-03,-4.500E-04,
2-2.925E-01,-1.304E-01, 1.696E-01, 6.243E-02, 1.353E-02, 3.750E-03,
3 1.318E-01, 1.041E-01,-5.486E-02,-3.872E-02,-1.038E-02,-2.850E-03,
4-6.162E-02,-6.143E-02, 1.303E-02, 1.740E-02, 5.940E-03, 1.670E-03,
5 2.643E-02, 2.957E-02,-1.490E-03,-6.450E-03,-2.630E-03,-7.700E-04,
6-1.218E-02,-1.497E-02,-1.260E-03, 2.240E-03, 1.120E-03, 3.500E-04,
1 1.263E-01, 1.334E-01, 3.732E-02, 7.070E-03, 1.260E-03, 3.400E-04,
2 3.660E-03,-1.357E-02,-1.795E-02,-1.031E-02,-3.880E-03,-1.280E-03,
3-2.100E-03,-3.600E-04, 2.050E-03, 1.920E-03, 9.800E-04, 4.400E-04,
4 7.700E-04, 5.400E-04,-2.400E-04,-3.900E-04,-2.400E-04,-1.300E-04,
5-2.600E-04,-2.300E-04, 2.000E-05, 9.000E-05, 6.000E-05, 4.000E-05,
6 9.000E-05, 1.000E-04, 2.000E-05,-2.000E-05,-2.000E-05,-1.000E-05/
C...EXPANSION COEFFICIENTS FOR UP AND DOWN SEA QUARK DISTRIBUTIONS
DATA (((CEHLQ(IX,IT,NX,3,1),IX=1,6),IT=1,6),NX=1,2)/
1 6.870E-02,-6.861E-02, 2.973E-02,-5.400E-03, 3.780E-03,-9.700E-04,
2-1.802E-02, 1.400E-04, 6.490E-03,-8.540E-03, 1.220E-03,-1.750E-03,
3-4.650E-03, 1.480E-03,-5.930E-03, 6.000E-04,-1.030E-03,-8.000E-05,
4 6.440E-03, 2.570E-03, 2.830E-03, 1.150E-03, 7.100E-04, 3.300E-04,
5-3.930E-03,-2.540E-03,-1.160E-03,-7.700E-04,-3.600E-04,-1.900E-04,
6 2.340E-03, 1.930E-03, 5.300E-04, 3.700E-04, 1.600E-04, 9.000E-05,
1 1.014E+00,-1.106E+00, 3.374E-01,-7.444E-02, 8.850E-03,-8.700E-04,
2 9.233E-01,-1.285E+00, 4.475E-01,-9.786E-02, 1.419E-02,-1.120E-03,
3 4.888E-02,-1.271E-01, 8.606E-02,-2.608E-02, 4.780E-03,-6.000E-04,
4-2.691E-02, 4.887E-02,-1.771E-02, 1.620E-03, 2.500E-04,-6.000E-05,
5 7.040E-03,-1.113E-02, 1.590E-03, 7.000E-04,-2.000E-04, 0.000E+00,
6-1.710E-03, 2.290E-03, 3.800E-04,-3.500E-04, 4.000E-05, 1.000E-05/
DATA (((CEHLQ(IX,IT,NX,3,2),IX=1,6),IT=1,6),NX=1,2)/
1 1.008E-01,-7.100E-02, 1.973E-02,-5.710E-03, 2.930E-03,-9.900E-04,
2-5.271E-02,-1.823E-02, 1.792E-02,-6.580E-03, 1.750E-03,-1.550E-03,
3 1.220E-02, 1.763E-02,-8.690E-03,-8.800E-04,-1.160E-03,-2.100E-04,
4-1.190E-03,-7.180E-03, 2.360E-03, 1.890E-03, 7.700E-04, 4.100E-04,
5-9.100E-04, 2.040E-03,-3.100E-04,-1.050E-03,-4.000E-04,-2.400E-04,
6 1.190E-03,-1.700E-04,-2.000E-04, 4.200E-04, 1.700E-04, 1.000E-04,
1 1.081E+00,-1.189E+00, 3.868E-01,-8.617E-02, 1.115E-02,-1.180E-03,
2 9.917E-01,-1.396E+00, 4.998E-01,-1.159E-01, 1.674E-02,-1.720E-03,
3 5.099E-02,-1.338E-01, 9.173E-02,-2.885E-02, 5.890E-03,-6.500E-04,
4-3.178E-02, 5.703E-02,-2.070E-02, 2.440E-03, 1.100E-04,-9.000E-05,
5 8.970E-03,-1.392E-02, 2.050E-03, 6.500E-04,-2.300E-04, 2.000E-05,
6-2.340E-03, 3.010E-03, 5.000E-04,-3.900E-04, 6.000E-05, 1.000E-05/
C...EXPANSION COEFFICIENTS FOR GLUON DISTRIBUTION
DATA (((CEHLQ(IX,IT,NX,4,1),IX=1,6),IT=1,6),NX=1,2)/
1 9.482E-01,-9.578E-01, 1.009E-01,-1.051E-01, 3.456E-02,-3.054E-02,
2-9.627E-01, 5.379E-01, 3.368E-01,-9.525E-02, 1.488E-02,-2.051E-02,
3 4.300E-01,-8.306E-02,-3.372E-01, 4.902E-02,-9.160E-03, 1.041E-02,
4-1.925E-01,-1.790E-02, 2.183E-01, 7.490E-03, 4.140E-03,-1.860E-03,
5 8.183E-02, 1.926E-02,-1.072E-01,-1.944E-02,-2.770E-03,-5.200E-04,
6-3.884E-02,-1.234E-02, 5.410E-02, 1.879E-02, 3.350E-03, 1.040E-03,
1 2.948E+01,-3.902E+01, 1.464E+01,-3.335E+00, 5.054E-01,-5.915E-02,
2 2.559E+01,-3.955E+01, 1.661E+01,-4.299E+00, 6.904E-01,-8.243E-02,
3-1.663E+00, 1.176E+00, 1.118E+00,-7.099E-01, 1.948E-01,-2.404E-02,
4-2.168E-01, 8.170E-01,-7.169E-01, 1.851E-01,-1.924E-02,-3.250E-03,
5 2.088E-01,-4.355E-01, 2.239E-01,-2.446E-02,-3.620E-03, 1.910E-03,
6-9.097E-02, 1.601E-01,-5.681E-02,-2.500E-03, 2.580E-03,-4.700E-04/
DATA (((CEHLQ(IX,IT,NX,4,2),IX=1,6),IT=1,6),NX=1,2)/
1 2.367E+00, 4.453E-01, 3.660E-01, 9.467E-02, 1.341E-01, 1.661E-02,
2-3.170E+00,-1.795E+00, 3.313E-02,-2.874E-01,-9.827E-02,-7.119E-02,
3 1.823E+00, 1.457E+00,-2.465E-01, 3.739E-02, 6.090E-03, 1.814E-02,
4-1.033E+00,-9.827E-01, 2.136E-01, 1.169E-01, 5.001E-02, 1.684E-02,
5 5.133E-01, 5.259E-01,-1.173E-01,-1.139E-01,-4.988E-02,-2.021E-02,
6-2.881E-01,-3.145E-01, 5.667E-02, 9.161E-02, 4.568E-02, 1.951E-02,
1 3.036E+01,-4.062E+01, 1.578E+01,-3.699E+00, 6.020E-01,-7.031E-02,
2 2.700E+01,-4.167E+01, 1.770E+01,-4.804E+00, 7.862E-01,-1.060E-01,
3-1.909E+00, 1.357E+00, 1.127E+00,-7.181E-01, 2.232E-01,-2.481E-02,
4-2.488E-01, 9.781E-01,-8.127E-01, 2.094E-01,-2.997E-02,-4.710E-03,
5 2.506E-01,-5.427E-01, 2.672E-01,-3.103E-02,-1.800E-03, 2.870E-03,
6-1.128E-01, 2.087E-01,-6.972E-02,-2.480E-03, 2.630E-03,-8.400E-04/
C...EXPANSION COEFFICIENTS FOR STRANGE SEA QUARK DISTRIBUTION
DATA (((CEHLQ(IX,IT,NX,5,1),IX=1,6),IT=1,6),NX=1,2)/
1 4.968E-02,-4.173E-02, 2.102E-02,-3.270E-03, 3.240E-03,-6.700E-04,
2-6.150E-03,-1.294E-02, 6.740E-03,-6.890E-03, 9.000E-04,-1.510E-03,
3-8.580E-03, 5.050E-03,-4.900E-03,-1.600E-04,-9.400E-04,-1.500E-04,
4 7.840E-03, 1.510E-03, 2.220E-03, 1.400E-03, 7.000E-04, 3.500E-04,
5-4.410E-03,-2.220E-03,-8.900E-04,-8.500E-04,-3.600E-04,-2.000E-04,
6 2.520E-03, 1.840E-03, 4.100E-04, 3.900E-04, 1.600E-04, 9.000E-05,
1 9.235E-01,-1.085E+00, 3.464E-01,-7.210E-02, 9.140E-03,-9.100E-04,
2 9.315E-01,-1.274E+00, 4.512E-01,-9.775E-02, 1.380E-02,-1.310E-03,
3 4.739E-02,-1.296E-01, 8.482E-02,-2.642E-02, 4.760E-03,-5.700E-04,
4-2.653E-02, 4.953E-02,-1.735E-02, 1.750E-03, 2.800E-04,-6.000E-05,
5 6.940E-03,-1.132E-02, 1.480E-03, 6.500E-04,-2.100E-04, 0.000E+00,
6-1.680E-03, 2.340E-03, 4.200E-04,-3.400E-04, 5.000E-05, 1.000E-05/
DATA (((CEHLQ(IX,IT,NX,5,2),IX=1,6),IT=1,6),NX=1,2)/
1 6.478E-02,-4.537E-02, 1.643E-02,-3.490E-03, 2.710E-03,-6.700E-04,
2-2.223E-02,-2.126E-02, 1.247E-02,-6.290E-03, 1.120E-03,-1.440E-03,
3-1.340E-03, 1.362E-02,-6.130E-03,-7.900E-04,-9.000E-04,-2.000E-04,
4 5.080E-03,-3.610E-03, 1.700E-03, 1.830E-03, 6.800E-04, 4.000E-04,
5-3.580E-03, 6.000E-05,-2.600E-04,-1.050E-03,-3.800E-04,-2.300E-04,
6 2.420E-03, 9.300E-04,-1.000E-04, 4.500E-04, 1.700E-04, 1.100E-04,
1 9.868E-01,-1.171E+00, 3.940E-01,-8.459E-02, 1.124E-02,-1.250E-03,
2 1.001E+00,-1.383E+00, 5.044E-01,-1.152E-01, 1.658E-02,-1.830E-03,
3 4.928E-02,-1.368E-01, 9.021E-02,-2.935E-02, 5.800E-03,-6.600E-04,
4-3.133E-02, 5.785E-02,-2.023E-02, 2.630E-03, 1.600E-04,-8.000E-05,
5 8.840E-03,-1.416E-02, 1.900E-03, 5.800E-04,-2.500E-04, 1.000E-05,
6-2.300E-03, 3.080E-03, 5.500E-04,-3.700E-04, 7.000E-05, 1.000E-05/
C...EXPANSION COEFFICIENTS FOR CHARM SEA QUARK DISTRIBUTION
DATA (((CEHLQ(IX,IT,NX,6,1),IX=1,6),IT=1,6),NX=1,2)/
1 9.270E-03,-1.817E-02, 9.590E-03,-6.390E-03, 1.690E-03,-1.540E-03,
2 5.710E-03,-1.188E-02, 6.090E-03,-4.650E-03, 1.240E-03,-1.310E-03,
3-3.960E-03, 7.100E-03,-3.590E-03, 1.840E-03,-3.900E-04, 3.400E-04,
4 1.120E-03,-1.960E-03, 1.120E-03,-4.800E-04, 1.000E-04,-4.000E-05,
5 4.000E-05,-3.000E-05,-1.800E-04, 9.000E-05,-5.000E-05,-2.000E-05,
6-4.200E-04, 7.300E-04,-1.600E-04, 5.000E-05, 5.000E-05, 5.000E-05,
1 8.098E-01,-1.042E+00, 3.398E-01,-6.824E-02, 8.760E-03,-9.000E-04,
2 8.961E-01,-1.217E+00, 4.339E-01,-9.287E-02, 1.304E-02,-1.290E-03,
3 3.058E-02,-1.040E-01, 7.604E-02,-2.415E-02, 4.600E-03,-5.000E-04,
4-2.451E-02, 4.432E-02,-1.651E-02, 1.430E-03, 1.200E-04,-1.000E-04,
5 1.122E-02,-1.457E-02, 2.680E-03, 5.800E-04,-1.200E-04, 3.000E-05,
6-7.730E-03, 7.330E-03,-7.600E-04,-2.400E-04, 1.000E-05, 0.000E+00/
DATA (((CEHLQ(IX,IT,NX,6,2),IX=1,6),IT=1,6),NX=1,2)/
1 9.980E-03,-1.945E-02, 1.055E-02,-6.870E-03, 1.860E-03,-1.560E-03,
2 5.700E-03,-1.203E-02, 6.250E-03,-4.860E-03, 1.310E-03,-1.370E-03,
3-4.490E-03, 7.990E-03,-4.170E-03, 2.050E-03,-4.400E-04, 3.300E-04,
4 1.470E-03,-2.480E-03, 1.460E-03,-5.700E-04, 1.200E-04,-1.000E-05,
5-9.000E-05, 1.500E-04,-3.200E-04, 1.200E-04,-6.000E-05,-4.000E-05,
6-4.200E-04, 7.600E-04,-1.400E-04, 4.000E-05, 7.000E-05, 5.000E-05,
1 8.698E-01,-1.131E+00, 3.836E-01,-8.111E-02, 1.048E-02,-1.300E-03,
2 9.626E-01,-1.321E+00, 4.854E-01,-1.091E-01, 1.583E-02,-1.700E-03,
3 3.057E-02,-1.088E-01, 8.022E-02,-2.676E-02, 5.590E-03,-5.600E-04,
4-2.845E-02, 5.164E-02,-1.918E-02, 2.210E-03,-4.000E-05,-1.500E-04,
5 1.311E-02,-1.751E-02, 3.310E-03, 5.100E-04,-1.200E-04, 5.000E-05,
6-8.590E-03, 8.380E-03,-9.200E-04,-2.600E-04, 1.000E-05,-1.000E-05/
C...EXPANSION COEFFICIENTS FOR BOTTOM SEA QUARK DISTRIBUTION
DATA (((CEHLQ(IX,IT,NX,7,1),IX=1,6),IT=1,6),NX=1,2)/
1 9.010E-03,-1.401E-02, 7.150E-03,-4.130E-03, 1.260E-03,-1.040E-03,
2 6.280E-03,-9.320E-03, 4.780E-03,-2.890E-03, 9.100E-04,-8.200E-04,
3-2.930E-03, 4.090E-03,-1.890E-03, 7.600E-04,-2.300E-04, 1.400E-04,
4 3.900E-04,-1.200E-03, 4.400E-04,-2.500E-04, 2.000E-05,-2.000E-05,
5 2.600E-04, 1.400E-04,-8.000E-05, 1.000E-04, 1.000E-05, 1.000E-05,
6-2.600E-04, 3.200E-04, 1.000E-05,-1.000E-05, 1.000E-05,-1.000E-05,
1 8.029E-01,-1.075E+00, 3.792E-01,-7.843E-02, 1.007E-02,-1.090E-03,
2 7.903E-01,-1.099E+00, 4.153E-01,-9.301E-02, 1.317E-02,-1.410E-03,
3-1.704E-02,-1.130E-02, 2.882E-02,-1.341E-02, 3.040E-03,-3.600E-04,
4-7.200E-04, 7.230E-03,-5.160E-03, 1.080E-03,-5.000E-05,-4.000E-05,
5 3.050E-03,-4.610E-03, 1.660E-03,-1.300E-04,-1.000E-05, 1.000E-05,
6-4.360E-03, 5.230E-03,-1.610E-03, 2.000E-04,-2.000E-05, 0.000E+00/
DATA (((CEHLQ(IX,IT,NX,7,2),IX=1,6),IT=1,6),NX=1,2)/
1 8.980E-03,-1.459E-02, 7.510E-03,-4.410E-03, 1.310E-03,-1.070E-03,
2 5.970E-03,-9.440E-03, 4.800E-03,-3.020E-03, 9.100E-04,-8.500E-04,
3-3.050E-03, 4.440E-03,-2.100E-03, 8.500E-04,-2.400E-04, 1.400E-04,
4 5.300E-04,-1.300E-03, 5.600E-04,-2.700E-04, 3.000E-05,-2.000E-05,
5 2.000E-04, 1.400E-04,-1.100E-04, 1.000E-04, 0.000E+00, 0.000E+00,
6-2.600E-04, 3.200E-04, 0.000E+00,-3.000E-05, 1.000E-05,-1.000E-05,
1 8.672E-01,-1.174E+00, 4.265E-01,-9.252E-02, 1.244E-02,-1.460E-03,
2 8.500E-01,-1.194E+00, 4.630E-01,-1.083E-01, 1.614E-02,-1.830E-03,
3-2.241E-02,-5.630E-03, 2.815E-02,-1.425E-02, 3.520E-03,-4.300E-04,
4-7.300E-04, 8.030E-03,-5.780E-03, 1.380E-03,-1.300E-04,-4.000E-05,
5 3.460E-03,-5.380E-03, 1.960E-03,-2.100E-04, 1.000E-05, 1.000E-05,
6-4.850E-03, 5.950E-03,-1.890E-03, 2.600E-04,-3.000E-05, 0.000E+00/
C...EXPANSION COEFFICIENTS FOR TOP SEA QUARK DISTRIBUTION
DATA (((CEHLQ(IX,IT,NX,8,1),IX=1,6),IT=1,6),NX=1,2)/
1 4.410E-03,-7.480E-03, 3.770E-03,-2.580E-03, 7.300E-04,-7.100E-04,
2 3.840E-03,-6.050E-03, 3.030E-03,-2.030E-03, 5.800E-04,-5.900E-04,
3-8.800E-04, 1.660E-03,-7.500E-04, 4.700E-04,-1.000E-04, 1.000E-04,
4-8.000E-05,-1.500E-04, 1.200E-04,-9.000E-05, 3.000E-05, 0.000E+00,
5 1.300E-04,-2.200E-04,-2.000E-05,-2.000E-05,-2.000E-05,-2.000E-05,
6-7.000E-05, 1.900E-04,-4.000E-05, 2.000E-05, 0.000E+00, 0.000E+00,
1 6.623E-01,-9.248E-01, 3.519E-01,-7.930E-02, 1.110E-02,-1.180E-03,
2 6.380E-01,-9.062E-01, 3.582E-01,-8.479E-02, 1.265E-02,-1.390E-03,
3-2.581E-02, 2.125E-02, 4.190E-03,-4.980E-03, 1.490E-03,-2.100E-04,
4 7.100E-04, 5.300E-04,-1.270E-03, 3.900E-04,-5.000E-05,-1.000E-05,
5 3.850E-03,-5.060E-03, 1.860E-03,-3.500E-04, 4.000E-05, 0.000E+00,
6-3.530E-03, 4.460E-03,-1.500E-03, 2.700E-04,-3.000E-05, 0.000E+00/
DATA (((CEHLQ(IX,IT,NX,8,2),IX=1,6),IT=1,6),NX=1,2)/
1 4.260E-03,-7.530E-03, 3.830E-03,-2.680E-03, 7.600E-04,-7.300E-04,
2 3.640E-03,-6.050E-03, 3.030E-03,-2.090E-03, 5.900E-04,-6.000E-04,
3-9.200E-04, 1.710E-03,-8.200E-04, 5.000E-04,-1.200E-04, 1.000E-04,
4-5.000E-05,-1.600E-04, 1.300E-04,-9.000E-05, 3.000E-05, 0.000E+00,
5 1.300E-04,-2.100E-04,-1.000E-05,-2.000E-05,-2.000E-05,-1.000E-05,
6-8.000E-05, 1.800E-04,-5.000E-05, 2.000E-05, 0.000E+00, 0.000E+00,
1 7.146E-01,-1.007E+00, 3.932E-01,-9.246E-02, 1.366E-02,-1.540E-03,
2 6.856E-01,-9.828E-01, 3.977E-01,-9.795E-02, 1.540E-02,-1.790E-03,
3-3.053E-02, 2.758E-02, 2.150E-03,-4.880E-03, 1.640E-03,-2.500E-04,
4 9.200E-04, 4.200E-04,-1.340E-03, 4.600E-04,-8.000E-05,-1.000E-05,
5 4.230E-03,-5.660E-03, 2.140E-03,-4.300E-04, 6.000E-05, 0.000E+00,
6-3.890E-03, 5.000E-03,-1.740E-03, 3.300E-04,-4.000E-05, 0.000E+00/
DATA TBMIN,TTMIN/8.1905,7.4474,11.5528,10.8097/
DATA XOLD,QOLD,IOLD,NOLD/-1.,0.,0,0/
DATA DMIN,Q0,QL/1.E-15,2*2.,2*2.236,.2,.4,.2,.29/
DATA IXLOW,IQLOW,IQHIG/0,0,0/
XMWN=1.-X
QSCA=ABS(SCALE)
ISET=MOD(NSET,100)
IF (QSCA.LT.Q0(ISET)) THEN
QSCA=Q0(ISET)
IF(IQLOW.LE.100) THEN
IQLOW=IQLOW+1
CALL MWARN('DOEHLQ')
IF(IQLOW.EQ.100) WRITE(*,*) ' LAST WARNING'
WRITE(*,*) ' Q SCALE SMALLER THAN ALLOWED, SET TO MINIMUM'
WRITE(*,*) '*********************************************'
ENDIF
ELSEIF (QSCA.GT.1.E4) THEN
QSCA=Q0(ISET)
IF(IQHIG.LE.100) THEN
IQHIG=IQHIG+1
CALL MWARN('DOEHLQ')
IF(IQHIG.EQ.100) WRITE(*,*) ' LAST WARNING'
WRITE(*,*) ' Q SCALE LARGER THAN ALLOWED, SET TO MAXIMUM'
WRITE(*,*) '*********************************************'
ENDIF
ENDIF
IF(X.LT.1.E-4) THEN
IF(IXLOW.LE.100) THEN
IXLOW=IXLOW+1
CALL MWARN('DOEHLQ')
IF(IXLOW.EQ.100) WRITE(*,*) ' LAST WARNING'
WRITE(*,*) ' X VALUE SMALLER THAN ALLOWED (1.E-4)'
WRITE(*,*) '*********************************************'
ENDIF
ENDIF
IF (QSCA.NE.QOLD.OR.IDHAD.NE.IOLD.OR.NSET.NE.NOLD) THEN
QOLD=QSCA
IOLD=IDHAD
NOLD=NSET
SS=LOG(QSCA/QL(ISET))
SMIN=LOG(Q0(ISET)/QL(ISET))
IF (ISET.LT.3) THEN
S=LOG(SS/SMIN)
ELSEIF (ISET.LT.5) THEN
T=2.*SS
TMIN=2.*SMIN
TMAX=2.*LOG(1.E4/QL(ISET))
ENDIF
GG=1.
C
IF (ABS(IDHAD).LT.3) THEN
IF (ISET.LT.3) THEN
C...........DUKE AND OWENS NUCLEONS
IP=ISET
DO 10 I=1,5
DO 10 J=1,6
10 A(J,I)=B(1,J,I,IP)+S*(B(2,J,I,IP)+S*B(3,J,I,IP))
DO 20 K=1,2
AA=1.+A(2,K)+A(3,K)
20 G(K)=SPLGAM(AA)/((1.+A(2,K)*A(4,K)/AA)*SPLGAM(A(2,K))
& *SPLGAM(1.+A(3,K)))
ELSE
C...........EHLQ NUCLEONS
IP=ISET-2
VT=MAX(-1.,MIN(1.,(2.*T-TMAX-TMIN)/(TMAX-TMIN)))
WT=VT*VT
C...CHEBYSHEV POLYNOMIALS FOR T EXPANSION
TT(1)=1.
TT(2)=VT
TT(3)= 2.*WT- 1.
TT(4)= (4.*WT- 3.)*VT
TT(5)= (8.*WT- 8.)*WT+1.
TT(6)=((16.*WT-20.)*WT+5.)*VT
ENDIF
ELSEIF (ISET.LT.3) THEN
C...........DUKE AND OWENS PION
IP=ISET+2
DO 30 I=1,5
DO 30 J=1,6
30 A(J,I)=B(1,J,I,IP)+S*(B(2,J,I,IP)+S*B(3,J,I,IP))
AA=1.+A(2,1)+A(3,1)
G(1)=SPLGAM(AA)/(SPLGAM(A(2,1))*SPLGAM(1.+A(3,1)))
G(2)=0.
ENDIF
ENDIF