From d0f2ed0c0e20fd5f485d4af5e9c2b487ef97f431 Mon Sep 17 00:00:00 2001 From: morsch Date: Thu, 9 Oct 2014 14:40:11 +0200 Subject: [PATCH] ALIROOT-5713 CT10 data added LHAPDF veraion 5.9.1 https://alice.its.cern.ch/jira/browse/ALIROOT-5648 extension .F -> .f .F deleted correction roll back of previous commit extension .F matters for preprocessor directives external declaration added removed since there are problems on certain platforms. extension changed Cmake for new lhapdf version Fix for include path for Fortran file LHAPDF5.9.1 always requires -DCTEQ flag Remove Pydat1 common block from lhaglue Set ill-formed small numbers to 0 The LHgrid files contains some very small values, which should be 0. If the value exponent is a negative number with three digits the exponential notation is dropped. This seems to be harmless, except when running pre-compiled code on grid. --- LHAPDF/AliStructFuncType.cxx | 12 +- LHAPDF/AliStructFuncType.h | 4 +- LHAPDF/CMakeliblhapdf.pkg | 1 + LHAPDF/CMakeliblhapdf5_9_1.pkg | 131 + .../include/LHAPDF/FortranWrappers.h | 39 + .../include/LHAPDF/FortranWrappers.h.in | 18 + LHAPDF/lhapdf-5.9.1/include/LHAPDF/LHAPDF.h | 581 + .../include/LHAPDF/LHAPDFConfig.h | 13 + .../include/LHAPDF/LHAPDFConfig.h.in | 13 + .../lhapdf-5.9.1/include/LHAPDF/LHAPDFWrap.h | 204 + LHAPDF/lhapdf-5.9.1/include/LHAPDF/LHAPDFfw.h | 140 + .../lhapdf-5.9.1/include/LHAPDF/Makefile.am | 17 + .../lhapdf-5.9.1/include/LHAPDF/Makefile.in | 490 + LHAPDF/lhapdf-5.9.1/include/Makefile.am | 1 + LHAPDF/lhapdf-5.9.1/include/Makefile.in | 514 + LHAPDF/lhapdf-5.9.1/src/EVLCTEQ.f | 2910 ++ LHAPDF/lhapdf-5.9.1/src/EVLNNPDF.f | 3065 ++ LHAPDF/lhapdf-5.9.1/src/LHpdflib.F | 450 + LHAPDF/lhapdf-5.9.1/src/LHpdflib.f | 450 + LHAPDF/lhapdf-5.9.1/src/Makefile.am | 211 + LHAPDF/lhapdf-5.9.1/src/Makefile.in | 819 + LHAPDF/lhapdf-5.9.1/src/QCDNUM.F | 27359 ++++++++++++++++ LHAPDF/lhapdf-5.9.1/src/QCDNUM.f | 27359 ++++++++++++++++ LHAPDF/lhapdf-5.9.1/src/QCDparams.f | 137 + LHAPDF/lhapdf-5.9.1/src/Smrst-lite.f | 239 + LHAPDF/lhapdf-5.9.1/src/Smrst.f | 239 + LHAPDF/lhapdf-5.9.1/src/Sqcdnum.f | 585 + LHAPDF/lhapdf-5.9.1/src/Szeus.f | 14 + LHAPDF/lhapdf-5.9.1/src/alphas.f | 975 + LHAPDF/lhapdf-5.9.1/src/binreloc.c | 793 + LHAPDF/lhapdf-5.9.1/src/binreloc.cxx | 793 + LHAPDF/lhapdf-5.9.1/src/binreloc.h | 81 + LHAPDF/lhapdf-5.9.1/src/common.inc | 7 + LHAPDF/lhapdf-5.9.1/src/commoninit.f | 48 + LHAPDF/lhapdf-5.9.1/src/commonlhacontrol.inc | 7 + LHAPDF/lhapdf-5.9.1/src/commonlhaglsta.inc | 10 + LHAPDF/lhapdf-5.9.1/src/commonlhapdf.inc | 6 + LHAPDF/lhapdf-5.9.1/src/commonlhapdfc.inc | 5 + LHAPDF/lhapdf-5.9.1/src/commonlhasets.inc | 8 + LHAPDF/lhapdf-5.9.1/src/description.f | 58 + LHAPDF/lhapdf-5.9.1/src/eks98.f | 1976 ++ LHAPDF/lhapdf-5.9.1/src/eksarp.f | 23 + LHAPDF/lhapdf-5.9.1/src/eps08.f | 401 + LHAPDF/lhapdf-5.9.1/src/eps09.f | 364 + LHAPDF/lhapdf-5.9.1/src/evolution.f | 83 + LHAPDF/lhapdf-5.9.1/src/getdatapath.cxx | 94 + LHAPDF/lhapdf-5.9.1/src/inputPDF.F | 683 + LHAPDF/lhapdf-5.9.1/src/inputPDF.f | 683 + LHAPDF/lhapdf-5.9.1/src/lhaglue.f | 2558 ++ LHAPDF/lhapdf-5.9.1/src/parameter.F | 124 + LHAPDF/lhapdf-5.9.1/src/parameter.f | 124 + LHAPDF/lhapdf-5.9.1/src/parmsetup.inc | 16 + LHAPDF/lhapdf-5.9.1/src/parmsetup.inc.in | 16 + LHAPDF/lhapdf-5.9.1/src/uncertainties.f | 205 + LHAPDF/lhapdf-5.9.1/src/version.cxx | 25 + LHAPDF/lhapdf-5.9.1/src/wrapEVLCTEQ.f | 164 + LHAPDF/lhapdf-5.9.1/src/wrapNNPDF.f | 130 + .../lhapdf-5.9.1/src/wrapNNPDF20grid-lite.f | 392 + LHAPDF/lhapdf-5.9.1/src/wrapNNPDF20grid.f | 344 + .../src/wrapNNPDF20qedgrid-lite.f | 388 + LHAPDF/lhapdf-5.9.1/src/wrapNNPDF20qedgrid.f | 334 + LHAPDF/lhapdf-5.9.1/src/wrapNNPDFgrid-lite.f | 615 + LHAPDF/lhapdf-5.9.1/src/wrapNNPDFgrid.f | 562 + LHAPDF/lhapdf-5.9.1/src/wrapQCDNUM.F | 362 + LHAPDF/lhapdf-5.9.1/src/wrapQCDNUM.f | 362 + LHAPDF/lhapdf-5.9.1/src/wrapQCDNUM3.f | 176 + LHAPDF/lhapdf-5.9.1/src/wrapQCDNUM4.f | 240 + LHAPDF/lhapdf-5.9.1/src/wrapUSER.f | 25 + LHAPDF/lhapdf-5.9.1/src/wrapXNN.f | 184 + LHAPDF/lhapdf-5.9.1/src/wrapa02m-lite.f | 297 + LHAPDF/lhapdf-5.9.1/src/wrapa02m.f | 265 + LHAPDF/lhapdf-5.9.1/src/wrapabfkwpi.f | 277 + LHAPDF/lhapdf-5.9.1/src/wrapabkm09-lite.f | 371 + LHAPDF/lhapdf-5.9.1/src/wrapabkm09.f | 335 + LHAPDF/lhapdf-5.9.1/src/wrapabm11-lite.f | 406 + LHAPDF/lhapdf-5.9.1/src/wrapabm11.f | 366 + LHAPDF/lhapdf-5.9.1/src/wrapacfgpg.f | 744 + LHAPDF/lhapdf-5.9.1/src/wrapct12.f | 576 + LHAPDF/lhapdf-5.9.1/src/wrapcteq5.f | 263 + LHAPDF/lhapdf-5.9.1/src/wrapcteq6-lite.f | 511 + LHAPDF/lhapdf-5.9.1/src/wrapcteq6.f | 488 + LHAPDF/lhapdf-5.9.1/src/wrapcteq65-lite.f | 685 + LHAPDF/lhapdf-5.9.1/src/wrapcteq65.f | 662 + LHAPDF/lhapdf-5.9.1/src/wrapcteq6lg.f | 544 + LHAPDF/lhapdf-5.9.1/src/wrapdgg.f | 580 + LHAPDF/lhapdf-5.9.1/src/wrapdog.f | 174 + LHAPDF/lhapdf-5.9.1/src/wrapevolve.F | 884 + LHAPDF/lhapdf-5.9.1/src/wrapevolve.f | 884 + LHAPDF/lhapdf-5.9.1/src/wrapgjr-lite.f | 276 + LHAPDF/lhapdf-5.9.1/src/wrapgjr.f | 244 + LHAPDF/lhapdf-5.9.1/src/wrapgrv.f | 277 + LHAPDF/lhapdf-5.9.1/src/wrapgrvg.f | 773 + LHAPDF/lhapdf-5.9.1/src/wrapgrvpi.f | 401 + LHAPDF/lhapdf-5.9.1/src/wrapgsg.f | 225 + LHAPDF/lhapdf-5.9.1/src/wrapgsg96.f | 211 + LHAPDF/lhapdf-5.9.1/src/wraph1-lite.f | 341 + LHAPDF/lhapdf-5.9.1/src/wraph1.f | 306 + LHAPDF/lhapdf-5.9.1/src/wraphera.f | 581 + LHAPDF/lhapdf-5.9.1/src/wrapheragrid-lite.f | 327 + LHAPDF/lhapdf-5.9.1/src/wrapheragrid.f | 276 + LHAPDF/lhapdf-5.9.1/src/wraphkn-lite.f | 362 + LHAPDF/lhapdf-5.9.1/src/wraphkn.f | 330 + LHAPDF/lhapdf-5.9.1/src/wraplacg.f | 2887 ++ LHAPDF/lhapdf-5.9.1/src/wrapmrst-lite.f | 291 + LHAPDF/lhapdf-5.9.1/src/wrapmrst.f | 258 + LHAPDF/lhapdf-5.9.1/src/wrapmrst2006-lite.f | 449 + LHAPDF/lhapdf-5.9.1/src/wrapmrst2006.f | 445 + LHAPDF/lhapdf-5.9.1/src/wrapmrst98.f | 150 + LHAPDF/lhapdf-5.9.1/src/wrapmrstqed-lite.f | 218 + LHAPDF/lhapdf-5.9.1/src/wrapmrstqed.f | 184 + LHAPDF/lhapdf-5.9.1/src/wrapmstw-lite.f | 1501 + LHAPDF/lhapdf-5.9.1/src/wrapmstw.f | 1446 + LHAPDF/lhapdf-5.9.1/src/wrapowpi.f | 219 + LHAPDF/lhapdf-5.9.1/src/wrapsasg.f | 1373 + LHAPDF/lhapdf-5.9.1/src/wrapsmrspi.f | 172 + LHAPDF/lhapdf-5.9.1/src/wrapusergrid.f | 495 + LHAPDF/lhapdf-5.9.1/src/wrapwhitg.f | 2126 ++ LHAPDF/lhapdf-5.9.1/src/wrapzeus.f | 579 + 118 files changed, 107489 insertions(+), 5 deletions(-) create mode 100644 LHAPDF/CMakeliblhapdf5_9_1.pkg create mode 100644 LHAPDF/lhapdf-5.9.1/include/LHAPDF/FortranWrappers.h create mode 100644 LHAPDF/lhapdf-5.9.1/include/LHAPDF/FortranWrappers.h.in create mode 100644 LHAPDF/lhapdf-5.9.1/include/LHAPDF/LHAPDF.h create mode 100644 LHAPDF/lhapdf-5.9.1/include/LHAPDF/LHAPDFConfig.h create mode 100644 LHAPDF/lhapdf-5.9.1/include/LHAPDF/LHAPDFConfig.h.in create mode 100644 LHAPDF/lhapdf-5.9.1/include/LHAPDF/LHAPDFWrap.h create mode 100644 LHAPDF/lhapdf-5.9.1/include/LHAPDF/LHAPDFfw.h create mode 100644 LHAPDF/lhapdf-5.9.1/include/LHAPDF/Makefile.am create mode 100644 LHAPDF/lhapdf-5.9.1/include/LHAPDF/Makefile.in create mode 100644 LHAPDF/lhapdf-5.9.1/include/Makefile.am create mode 100644 LHAPDF/lhapdf-5.9.1/include/Makefile.in create mode 100644 LHAPDF/lhapdf-5.9.1/src/EVLCTEQ.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/EVLNNPDF.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/LHpdflib.F create mode 100644 LHAPDF/lhapdf-5.9.1/src/LHpdflib.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/Makefile.am create mode 100644 LHAPDF/lhapdf-5.9.1/src/Makefile.in create mode 100644 LHAPDF/lhapdf-5.9.1/src/QCDNUM.F create mode 100644 LHAPDF/lhapdf-5.9.1/src/QCDNUM.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/QCDparams.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/Smrst-lite.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/Smrst.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/Sqcdnum.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/Szeus.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/alphas.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/binreloc.c create mode 100644 LHAPDF/lhapdf-5.9.1/src/binreloc.cxx create mode 100644 LHAPDF/lhapdf-5.9.1/src/binreloc.h create mode 100644 LHAPDF/lhapdf-5.9.1/src/common.inc create mode 100644 LHAPDF/lhapdf-5.9.1/src/commoninit.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/commonlhacontrol.inc create mode 100644 LHAPDF/lhapdf-5.9.1/src/commonlhaglsta.inc create mode 100644 LHAPDF/lhapdf-5.9.1/src/commonlhapdf.inc create mode 100644 LHAPDF/lhapdf-5.9.1/src/commonlhapdfc.inc create mode 100644 LHAPDF/lhapdf-5.9.1/src/commonlhasets.inc create mode 100644 LHAPDF/lhapdf-5.9.1/src/description.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/eks98.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/eksarp.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/eps08.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/eps09.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/evolution.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/getdatapath.cxx create mode 100644 LHAPDF/lhapdf-5.9.1/src/inputPDF.F create mode 100644 LHAPDF/lhapdf-5.9.1/src/inputPDF.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/lhaglue.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/parameter.F create mode 100644 LHAPDF/lhapdf-5.9.1/src/parameter.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/parmsetup.inc create mode 100644 LHAPDF/lhapdf-5.9.1/src/parmsetup.inc.in create mode 100644 LHAPDF/lhapdf-5.9.1/src/uncertainties.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/version.cxx create mode 100644 LHAPDF/lhapdf-5.9.1/src/wrapEVLCTEQ.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/wrapNNPDF.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/wrapNNPDF20grid-lite.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/wrapNNPDF20grid.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/wrapNNPDF20qedgrid-lite.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/wrapNNPDF20qedgrid.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/wrapNNPDFgrid-lite.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/wrapNNPDFgrid.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/wrapQCDNUM.F create mode 100644 LHAPDF/lhapdf-5.9.1/src/wrapQCDNUM.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/wrapQCDNUM3.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/wrapQCDNUM4.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/wrapUSER.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/wrapXNN.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/wrapa02m-lite.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/wrapa02m.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/wrapabfkwpi.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/wrapabkm09-lite.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/wrapabkm09.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/wrapabm11-lite.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/wrapabm11.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/wrapacfgpg.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/wrapct12.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/wrapcteq5.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/wrapcteq6-lite.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/wrapcteq6.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/wrapcteq65-lite.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/wrapcteq65.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/wrapcteq6lg.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/wrapdgg.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/wrapdog.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/wrapevolve.F create mode 100644 LHAPDF/lhapdf-5.9.1/src/wrapevolve.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/wrapgjr-lite.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/wrapgjr.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/wrapgrv.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/wrapgrvg.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/wrapgrvpi.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/wrapgsg.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/wrapgsg96.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/wraph1-lite.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/wraph1.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/wraphera.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/wrapheragrid-lite.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/wrapheragrid.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/wraphkn-lite.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/wraphkn.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/wraplacg.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/wrapmrst-lite.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/wrapmrst.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/wrapmrst2006-lite.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/wrapmrst2006.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/wrapmrst98.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/wrapmrstqed-lite.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/wrapmrstqed.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/wrapmstw-lite.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/wrapmstw.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/wrapowpi.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/wrapsasg.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/wrapsmrspi.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/wrapusergrid.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/wrapwhitg.f create mode 100644 LHAPDF/lhapdf-5.9.1/src/wrapzeus.f diff --git a/LHAPDF/AliStructFuncType.cxx b/LHAPDF/AliStructFuncType.cxx index 105aa7cc212..eee50136ff5 100644 --- a/LHAPDF/AliStructFuncType.cxx +++ b/LHAPDF/AliStructFuncType.cxx @@ -63,7 +63,7 @@ void AliStructFuncType::StructA(Double_t xx, Double_t qq, Double_t a, Int_t AliStructFuncType::PDFsetIndex(StrucFunc_t pdf) { // PDF set index - Int_t pdfSetNumber[10] = { + Int_t pdfSetNumber[12] = { 19170, 19150, 19070, @@ -73,7 +73,9 @@ Int_t AliStructFuncType::PDFsetIndex(StrucFunc_t pdf) 10100, 10050, 10041, - 10042 + 10042, + 10800, + 11000 }; return pdfSetNumber[pdf]; } @@ -81,7 +83,7 @@ Int_t AliStructFuncType::PDFsetIndex(StrucFunc_t pdf) TString AliStructFuncType::PDFsetName(StrucFunc_t pdf) { // PDF Set Name - TString pdfsetName[10] = { + TString pdfsetName[12] = { "cteq4l.LHgrid", "cteq4m.LHgrid", "cteq5l.LHgrid", @@ -91,7 +93,9 @@ TString AliStructFuncType::PDFsetName(StrucFunc_t pdf) "cteq61.LHpdf", "cteq6m.LHpdf", "cteq6l.LHpdf", - "cteq6ll.LHpdf" + "cteq6ll.LHpdf", + "CT10.LHgrid", + "CT10nlo.LHgrid" }; return pdfsetName[pdf]; } diff --git a/LHAPDF/AliStructFuncType.h b/LHAPDF/AliStructFuncType.h index 983ef484aad..4b61db5c348 100644 --- a/LHAPDF/AliStructFuncType.h +++ b/LHAPDF/AliStructFuncType.h @@ -22,7 +22,9 @@ typedef enum kCTEQ61, // cteq61.LHpdf kCTEQ6m, // cteq6m.LHpdf kCTEQ6l, // cteq6l.LHpdf - kCTEQ6ll // cteq6ll.LHpdf + kCTEQ6ll, // cteq6ll.LHpdf + kCT10, // CT10.LHgrid + kCT10nlo // CT10nlo.LHgrid } StrucFunc_t; diff --git a/LHAPDF/CMakeliblhapdf.pkg b/LHAPDF/CMakeliblhapdf.pkg index ca710f2216b..b9516247be0 100644 --- a/LHAPDF/CMakeliblhapdf.pkg +++ b/LHAPDF/CMakeliblhapdf.pkg @@ -33,6 +33,7 @@ set ( HDRS AliStructFuncType.h) set ( DHDR lhapdfLinkDef.h) +set_property(DIRECTORY PROPERTY INCLUDE_DIRECTORIES "") set ( EINCLUDE LHAPDF/lhapdf5.5.1 LHAPDF/lhapdf5.5.1/include LHAPDF/lhapdf5.5.1/src) set ( CSRCS lhapdf5.5.1/src/binreloc.c ) diff --git a/LHAPDF/CMakeliblhapdf5_9_1.pkg b/LHAPDF/CMakeliblhapdf5_9_1.pkg new file mode 100644 index 00000000000..8ee0a91cdad --- /dev/null +++ b/LHAPDF/CMakeliblhapdf5_9_1.pkg @@ -0,0 +1,131 @@ +# -*- mode: cmake -*- + +#--------------------------------------------------------------------------------# +# Package File for lhapdf # +# Author : Johny Jose (johny.jose@cern.ch) # +# Variables Defined : # +# # +# SRCS - C++ source files # +# HDRS - C++ header files # +# DHDR - ROOT Dictionary Linkdef header file # +# CSRCS - C source files # +# CHDRS - C header files # +# EINCLUDE - Include directories # +# EDEFINE - Compiler definitions # +# ELIBS - Extra libraries to link # +# ELIBSDIR - Extra library directories # +# PACKFFLAGS - Fortran compiler flags for package # +# PACKCXXFLAGS - C++ compiler flags for package # +# PACKCFLAGS - C compiler flags for package # +# PACKSOFLAGS - Shared library linking flags # +# PACKLDFLAGS - Module linker flags # +# PACKBLIBS - Libraries to link (Executables only) # +# EXPORT - Header files to be exported # +# CINTHDRS - Dictionary header files # +# CINTAUTOLINK - Set automatic dictionary generation # +# ARLIBS - Archive Libraries and objects for linking (Executables only) # +# SHLIBS - Shared Libraries and objects for linking (Executables only) # +#--------------------------------------------------------------------------------# + +set ( SRCS AliStructFuncType.cxx lhapdf-5.9.1/src/version.cxx lhapdf-5.9.1/src/getdatapath.cxx) + +set ( HDRS AliStructFuncType.h) + +set ( DHDR lhapdfLinkDef.h) + +set_property(DIRECTORY PROPERTY INCLUDE_DIRECTORIES "") +set ( EINCLUDE LHAPDF/lhapdf-5.9.1 LHAPDF/lhapdf-5.9.1/include LHAPDF/lhapdf-5.9.1/src) + +set ( CSRCS lhapdf-5.9.1/src/binreloc.c ) + +set ( FSRCS + lhapdf-5.9.1/src/alphas.f + lhapdf-5.9.1/src/commoninit.f + lhapdf-5.9.1/src/description.f + lhapdf-5.9.1/src/eks98.f + lhapdf-5.9.1/src/eksarp.f + lhapdf-5.9.1/src/eps08.f + lhapdf-5.9.1/src/eps09.f + lhapdf-5.9.1/src/EVLCTEQ.f + lhapdf-5.9.1/src/EVLNNPDF.f + lhapdf-5.9.1/src/evolution.f + lhapdf-5.9.1/src/inputPDF.F + lhapdf-5.9.1/src/LHpdflib.F + lhapdf-5.9.1/src/parameter.F + lhapdf-5.9.1/src/QCDNUM.F + lhapdf-5.9.1/src/QCDparams.f + lhapdf-5.9.1/src/Smrst.f + lhapdf-5.9.1/src/Sqcdnum.f + lhapdf-5.9.1/src/Szeus.f + lhapdf-5.9.1/src/uncertainties.f + lhapdf-5.9.1/src/wrapNNPDF.f + lhapdf-5.9.1/src/wrapNNPDF20grid.f + lhapdf-5.9.1/src/wrapNNPDF20qedgrid.f + lhapdf-5.9.1/src/wrapNNPDFgrid.f + lhapdf-5.9.1/src/wrapa02m.f + lhapdf-5.9.1/src/wrapabfkwpi.f + lhapdf-5.9.1/src/wrapabkm09.f + lhapdf-5.9.1/src/wrapabm11.f + lhapdf-5.9.1/src/wrapacfgpg.f + lhapdf-5.9.1/src/wrapct12.f + lhapdf-5.9.1/src/wrapcteq5.f + lhapdf-5.9.1/src/wrapcteq6.f + lhapdf-5.9.1/src/wrapcteq65.f + lhapdf-5.9.1/src/wrapcteq6lg.f + lhapdf-5.9.1/src/wrapdgg.f + lhapdf-5.9.1/src/wrapdog.f + lhapdf-5.9.1/src/wrapEVLCTEQ.f + lhapdf-5.9.1/src/wrapevolve.F + lhapdf-5.9.1/src/wrapgjr.f + lhapdf-5.9.1/src/wrapgrv.f + lhapdf-5.9.1/src/wrapgrvg.f + lhapdf-5.9.1/src/wrapgrvpi.f + lhapdf-5.9.1/src/wrapgsg96.f + lhapdf-5.9.1/src/wrapgsg.f + lhapdf-5.9.1/src/wraph1.f + lhapdf-5.9.1/src/wraphera.f + lhapdf-5.9.1/src/wrapheragrid.f + lhapdf-5.9.1/src/wraphkn.f + lhapdf-5.9.1/src/wraplacg.f + lhapdf-5.9.1/src/wrapowpi.f + lhapdf-5.9.1/src/wrapmrst.f + lhapdf-5.9.1/src/wrapmrst2006.f + lhapdf-5.9.1/src/wrapmrst98.f + lhapdf-5.9.1/src/wrapmrstqed.f + lhapdf-5.9.1/src/wrapQCDNUM3.f + lhapdf-5.9.1/src/wrapQCDNUM4.f + lhapdf-5.9.1/src/wrapQCDNUM.F + lhapdf-5.9.1/src/wrapsasg.f + lhapdf-5.9.1/src/wrapmstw.f + lhapdf-5.9.1/src/wrapsmrspi.f + lhapdf-5.9.1/src/wrapwhitg.f + lhapdf-5.9.1/src/wrapzeus.f + lhapdf-5.9.1/src/lhaglue.f + lhapdf-5.9.1/src/wrapUSER.f + lhapdf-5.9.1/src/wrapusergrid.f + lhapdf-5.9.1/src/wrapXNN.f +) + +if( ALICE_TARGET STREQUAL "solarisCC5") + set ( PACKFFLAGS "${FFLAGS} -free") +elseif( ALICE_TARGET STREQUAL "linuxx8664icc") + set ( PACKFFLAGS "${FFLAGS} -nofixed" ) +else() + set ( PACKFFLAGS "${FFLAGS} -ffree-form") +endif( ALICE_TARGET STREQUAL "solarisCC5") + +set ( PACKFFLAGS "${PACKFFLAGS} -DCTEQ") + +set( PACKCXXFLAGS "${CXXFLAGS} -DDEFAULTPREFIXPATH=\\\"NONE\\\" -DDEFAULTLHAPATH=\\\"${ALICE_ROOT}/LHAPDF/PDFsets\\\"" ) + + +set ( EXPORT AliStructFuncType.h) + +#--------------------------------------------------------------------------------# +# install PDF data +install ( DIRECTORY PDFsets + DESTINATION LHAPDF + PATTERN ".svn" EXCLUDE + PATTERN ".d" EXCLUDE + PATTERN ".so" EXCLUDE) + diff --git a/LHAPDF/lhapdf-5.9.1/include/LHAPDF/FortranWrappers.h b/LHAPDF/lhapdf-5.9.1/include/LHAPDF/FortranWrappers.h new file mode 100644 index 00000000000..b704933dc85 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/include/LHAPDF/FortranWrappers.h @@ -0,0 +1,39 @@ +//#ifndef LHAPDF_FORTRANWRAPPERS_H +//#define LHAPDF_FORTRANWRAPPERS_H + +/* Define to dummy `main' function (if any) required to link to the Fortran + libraries. */ +//#undef FC_DUMMY_MAIN + +/* Define if F77 and FC dummy `main' functions are identical. */ +//#undef FC_DUMMY_MAIN_EQ_F77 + +/* Define to a macro mangling the given C identifier (in lower and upper + case), which must not contain underscores, for linking with Fortran. */ +//#undef FC_FUNC + +/* As FC_FUNC, but for C identifiers containing underscores. */ +//#undef FC_FUNC_ + +//#endif + +/* include/LHAPDF/FortranWrappers.h. Generated from FortranWrappers.h.in by configure. */ +/* Define to dummy `main' function (if any) required to link to the Fortran + libraries. */ +/* #undef FC_DUMMY_MAIN */ + +/* Define if F77 and FC dummy `main' functions are identical. */ +/* #undef FC_DUMMY_MAIN_EQ_F77 */ + +/* Define to a macro mangling the given C identifier (in lower and upper + case), which must not contain underscores, for linking with Fortran. */ +#define FC_FUNC(name,NAME) name ## _ + +/* As FC_FUNC, but for C identifiers containing underscores. */ +#define FC_FUNC_(name,NAME) name ## _ + +/* As FC_FUNC, but for C identifiers containing underscores. */ +#define FC_FUNC_(name,NAME) name ## _ + +/* LHAPDF version string */ +#define PACKAGE_VERSION "5.9.1" diff --git a/LHAPDF/lhapdf-5.9.1/include/LHAPDF/FortranWrappers.h.in b/LHAPDF/lhapdf-5.9.1/include/LHAPDF/FortranWrappers.h.in new file mode 100644 index 00000000000..ff8525a2137 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/include/LHAPDF/FortranWrappers.h.in @@ -0,0 +1,18 @@ +#ifndef LHAPDF_FORTRANWRAPPERS_H +#define LHAPDF_FORTRANWRAPPERS_H + +/* Define to dummy `main' function (if any) required to link to the Fortran + libraries. */ +#undef FC_DUMMY_MAIN + +/* Define if F77 and FC dummy `main' functions are identical. */ +#undef FC_DUMMY_MAIN_EQ_F77 + +/* Define to a macro mangling the given C identifier (in lower and upper + case), which must not contain underscores, for linking with Fortran. */ +#undef FC_FUNC + +/* As FC_FUNC, but for C identifiers containing underscores. */ +#undef FC_FUNC_ + +#endif diff --git a/LHAPDF/lhapdf-5.9.1/include/LHAPDF/LHAPDF.h b/LHAPDF/lhapdf-5.9.1/include/LHAPDF/LHAPDF.h new file mode 100644 index 00000000000..4fd79e43d91 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/include/LHAPDF/LHAPDF.h @@ -0,0 +1,581 @@ +#ifndef LHAPDF_H +#define LHAPDF_H + +#include "LHAPDF/LHAPDFConfig.h" + +#include +#include +#include +#include + +/** + * @mainpage A C++ wrapper for the LHAPDF library + * + * @section intro Introduction + * The LHAPDF library provides a set of C++ wrapper functions + * for its Fortran subroutines. New users should browse this + * documentation and take a look at the @c CCTest1.cc and + * @c CCTest2.cc example program source files, which are good + * examples of how the wrapper is used. + * + * @section changes Recent changes + * The LHAPDF wrapper has been improved in several ways for + * the LHAPDF v5.4 release: + * + * @li String passing to the Fortran functions from C++ now + * correctly passes the hidden length argument, fixing problems + * on 64 bit systems; + * @li The @c LHAPDFWrap class has been deprecated in favour of + * a set of wrapper functions in the @c LHAPDF namespace. The + * class interface was misleading, since no persistent state + * was involved and two class instances would not have been + * independent; + * @li Proper C++ @c std::string arguments can now be used for + * set names: @c char* string arguments can still be passed, due + * to implicit conversion via the string(char*) constructor. + * + * @section credits Credits + * + * @li Originally by Stefan Gieseke. + * @li Adapted for LHAPDFv4 by Mike Whalley. + * @li Adapted for LHAPDFv5 by Craig Group/Mike Whalley. + * @li v5.4: Fortran portability, tidying, extensions + * and conversion to namespaced functions by Andy Buckley. + * @li v5.4.1: Rationalised init functions and deprecated "M" + * functions by Andy Buckley. + * @li v5.5.1: Added PDFSetInfo set metadata struct, and + * associated querying based on reading the PDFsets.index file. + * + * @example ../examples/CCTest1.cc + * This is an example of a program using the recommended C++ + * interface to LHAPDF. + * + * @example ../examples/CCTest2.cc + * An example of a program using the C++ interface to LHAPDF to + * calculate PDF errors. + */ + + +// Compatibility preprocessing of deprecated "M" function names +#define initPDFSetM initPDFSet +#define initPDFSetByNameM initPDFSetByName +#define initPDFM initPDF +#define initPDFByNameM initPDFByName +#define getDescriptionM getDescription +#define xfxM xfx +#define xfxpM xfxp +#define xfxaM xfxa +#define xfxphotonM xfxphoton +#define numberPDFM numberPDF +#define alphasPDFM alphasPDF +#define getOrderPDFM getOrderPDF +#define getOrderAlphaSM getOrderAlphaS +#define getQMassM getQMass +#define getThresholdM getThreshold +#define getNfM getNf +#define getLam4M getLam4 +#define getLam5M getLam5 +#define getXminM getXmin +#define getXmaxM getXmax +#define getQ2minM getQ2min +#define getQ2maxM getQ2max + + +/// Namespace containing all the LHAPDF wrapper functions. +namespace LHAPDF { + + /// @brief Enum of flavours which map to LHAPDF integer codes. + /// Useful for improving readability of client code. Note that these codes + /// can't be used to access elements of returned @c vector, which + /// don't use the LHAPDF scheme (they use "LHAPDF code + 6"). + enum Flavour { + TBAR= -6, BBAR = -5, CBAR = -4, SBAR = -3, UBAR = -2, DBAR = -1, + GLUON = 0, + DOWN = 1, UP = 2, STRANGE = 3, CHARM = 4, BOTTOM = 5, TOP= 6, + PHOTON = 7 + }; + + /// @brief Distinction between evolution or interpolation PDF sets. + /// Enum to choose whether evolution (i.e. @c LHpdf data file) or + /// interpolation (i.e. @c LHgrid data file) is used. + enum SetType { + EVOLVE = 0, LHPDF = 0, + INTERPOLATE = 1, LHGRID = 1 + }; + + /// Level of noisiness. + enum Verbosity { SILENT=0, LOWKEY=1, DEFAULT=2 }; + + + /// @name Global functions + //@{ + + /// Get LHAPDF version string. + std::string getVersion(); + + /// Get max allowed number of concurrent sets. + int getMaxNumSets(); + + /// Global initialisation. + void initLHAPDF(); + + /// Choose level of noisiness. + void setVerbosity(Verbosity noiselevel); + + /// Extrapolate beyond grid edges. + void extrapolate(bool extrapolate=true); + + /// Set the LHAPATH variable (the location of the PDF sets directory). + void setPDFPath(const std::string& path); + + /// Set a steering parameter (direct map to Fortran @c setlhaparm(parm) function). + void setParameter(const std::string& parm); + + //@} + + + /// @name Set metadata + //@{ + + /// Structure containing metadata about a PDF set. + class PDFSetInfo { + public: + std::string file; + std::string description; + int id; + int pdflibNType, pdflibNGroup, pdflibNSet; + int memberId; + double lowx, highx; + double lowQ2, highQ2; + + /// Render a standard representation of a PDF set's metadata. + std::string toString() const { + std::ostringstream os; + os << "PDF set #" << id + << " {" + << " file='" << file << "'," + << " description='" << description << "'," + << " x = [" << lowx << ", " << highx << "]," + << " Q2 = [" << lowQ2 << ", " << highQ2 << "]" + << " }"; + return os.str(); + } + }; + + + inline std::ostream& operator<<(std::ostream& os, const PDFSetInfo& info) { + os << info.toString(); + return os; + } + + /// Get a PDF set info object by filename and member number. + PDFSetInfo getPDFSetInfo(const std::string& filename, int memid); + + /// Get a PDF set info object by the LHAPDF ID number. + PDFSetInfo getPDFSetInfo(int id); + + /// Get a vector of PDF set info objects for all known sets. + std::vector getAllPDFSetInfo(); + //@} + + + /// @name Path info functions + //@{ + + /// Get path to LHAPDF installation (the "prefix" path). + std::string prefixPath(); + + /// Get path to LHAPDF PDF sets directory. + std::string pdfsetsPath(); + + /// Get path to LHAPDF PDF sets index file. + std::string pdfsetsIndexPath(); + + //@} + + + /// @name Initialisation functions + /// LHAPDF functions for initialising PDF sets. If you need to use + /// more than one set simultaneously, use the multi-set functions, which + /// have a integer @c nset first argument. + //@{ + + /// Initialise @a member in PDF set @a setid. + void initPDFSet(int setid, int member); + /// Initialise @a member in PDF set @a setid (multi-set version). + void initPDFSet(int nset, int setid, int member); // can't have a default 3rd arg + + /// Initialise @a member in PDF set @a name, of type @a type. + void initPDFSet(const std::string& name, SetType type, int member=0); + /// Initialise @a member in PDF set @a name, of type @a type (multi-set version). + void initPDFSet(int nset, const std::string& name, SetType type, int member=0); + + /// @brief Initialise @a member in PDF set file @a filename. + /// If @a filename contains a "/" character, it will be used as a path, + /// otherwise it will be assumed to be a PDF file in the LHAPDF @c PDFsets directory. + void initPDFSet(const std::string& filename, int member=0); + /// @brief Initialise @a member in PDF set file @a filename (multi-set version). + /// If @a filename contains a "/" character, it will be used as a path, + /// otherwise it will be assumed to be a PDF file in the LHAPDF @c PDFsets directory. + void initPDFSet(int nset, const std::string& filename, int member=0); + + /// @brief Use @a member in current PDF set. + /// This operation is computationally cheap. + void usePDFMember(int member); + /// @brief Use @a member in PDF set @a nset (multi-set version). + /// This operation is computationally cheap. + void usePDFMember(int nset, int member); + //@} + + + /// @name PDF set information + //@{ + + /// Prints a brief description of the current PDF set to stdout. + void getDescription(); + /// Prints a brief description of the current PDF set to stdout. + void getDescription(int nset); + + /// Does the current set have a photon member? + bool hasPhoton(); + + /// Number of members available in the current set. + int numberPDF(); + /// Number of members available in the current set. + int numberPDF(int nset); + + /// \f$ \alpha_\mathrm{s} \f$ used by the current PDF. + double alphasPDF(double Q); + /// \f$ \alpha_\mathrm{s} \f$ used by the current PDF. + double alphasPDF(int nset, double Q); + + /// Get order at which the PDF was fitted. + int getOrderPDF(); + /// Get order at which the PDF was fitted. + int getOrderPDF(int nset); + + /// Perturbative order of parton evolution and \f$ \alpha_\mathrm{s} \f$ respectively. + int getOrderAlphaS(); + /// Perturbative order of parton evolution and \f$ \alpha_\mathrm{s} \f$ respectively. + int getOrderAlphaS(int nset); + + /// Quark mass used for flavour @a f. + double getQMass(int f); + /// Quark mass used for flavour @a f. + double getQMass(int nset, int f); + + /// Threshold for flavour @a f. + double getThreshold(int f); + /// Threshold for flavour @a f. + double getThreshold(int nset, int f); + + /// Number of flavours used in the current PDF set. + int getNf(); + /// Number of flavours used in the current PDF set. + int getNf(int nset); + + /// Value of QCD \f$ \lambda_4 \f$ for member @a m. + double getLam4(int m); + /// Value of QCD \f$ \lambda_4 \f$ for member @a m. + double getLam4(int nset, int m); + + /// Value of QCD \f$ \lambda_5 \f$ for member @a m. + double getLam5(int m); + /// Value of QCD \f$ \lambda_5 \f$ for member @a m. + double getLam5(int nset, int m); + + /// Minimum \f$ x \f$ value considered valid for this set, as specified by the set authors. + double getXmin(int m); + /// Minimum \f$ x \f$ value considered valid for this set, as specified by the set authors. + double getXmin(int nset, int m); + + /// Maximum \f$ x \f$ value considered valid for this set, as specified by the set authors. + double getXmax(int m); + /// Maximum \f$ x \f$ value considered valid for this set, as specified by the set authors. + double getXmax(int nset, int m); + + /// Minimum \f$ Q^2 \f$ value considered valid for this set, as specified by the set authors. + double getQ2min(int m); + /// Minimum \f$ Q^2 \f$ value considered valid for this set, as specified by the set authors. + double getQ2min(int nset, int m); + + /// Maximum \f$ Q^2 \f$ value considered valid for this set, as specified by the set authors. + double getQ2max(int m); + /// Maximum \f$ Q^2 \f$ value considered valid for this set, as specified by the set authors. + double getQ2max(int nset, int m); + //@} + + + /// @name Nucleon PDFs + /// These PDFs are defined for protons --- neutron PDFs are usually obtained by + /// isospin conjugation. + //@{ + + /// Nucleon PDF: returns a vector \f$ x f_i(x, Q) \f$ with index \f$ 0 < i < 12 \f$. + /// @arg 0..5 = \f$ \bar{t} \f$, ..., \f$ \bar{u} \f$, \f$ \bar{d} \f$; + /// @arg 6 = \f$ g \f$; + /// @arg 7..12 = \f$ d \f$, \f$ u \f$, ..., \f$ t \f$. + std::vector xfx(double x, double Q); + /// Nucleon PDF: returns a vector @c x f_i(x, Q) with index \f$ 0 < i < 12 \f$. + /// @arg 0..5 = \f$ \bar{t} \f$, ..., \f$ \bar{u} \f$, \f$ \bar{d} \f$; + /// @arg 6 = \f$ g \f$; + /// @arg 7..12 = \f$ d \f$, \f$ u \f$, ..., \f$ t \f$. + std::vector xfx(int nset, double x, double Q); + + /// Nucleon PDF: fills primitive 13 element array pointed at by @a results with + /// \f$ x f(x, Q) \f$ with index \f$ 0 < i < 12 \f$. + /// @arg 0..5 = \f$ \bar{t} \f$, ..., \f$ \bar{u} \f$, \f$ \bar{d} \f$; + /// @arg 6 = \f$ g \f$; + /// @arg 7..12 = \f$ d \f$, \f$ u \f$, ..., \f$ t \f$. + void xfx(double x, double Q, double* results); + /// Nucleon PDF: fills primitive 13 element array pointed at by @a results with + /// \f$ x f(x, Q) \f$ with index \f$ 0 < i < 12 \f$. + /// @arg 0..5 = \f$ \bar{t} \f$, ..., \f$ \bar{u} \f$, \f$ \bar{d} \f$; + /// @arg 6 = \f$ g \f$; + /// @arg 7..12 = \f$ d \f$, \f$ u \f$, ..., \f$ t \f$. + void xfx(int nset, double x, double Q, double* results); + + + /// Nucleon PDF: returns \f$ x f(x, Q) \f$ for flavour @a fl - this time the flavour encoding + /// is as in the LHAPDF manual. + /// @arg -6..-1 = \f$ \bar{t} \f$, ..., \f$ \bar{u} \f$, \f$ \bar{d} \f$; + /// @arg 0 = \f$ g \f$ + /// @arg 1..6 = \f$ d \f$, \f$ u \f$, ..., \f$ t \f$. + double xfx(double x, double Q, int fl); + /// Nucleon PDF: returns @c x f(x, Q) for flavour @a fl - this time the flavour encoding + /// is as in the LHAPDF manual. + /// @arg -6..-1 = \f$ \bar{t} \f$, ..., \f$ \bar{u} \f$, \f$ \bar{d} \f$; + /// @arg 0 = \f$ g \f$ + /// @arg 1..6 = \f$ d \f$, \f$ u \f$, ..., \f$ t \f$. + double xfx(int nset, double x, double Q, int fl); + //@} + + + /// @name Photon PDFs + //@{ + + /// Photon PDF: returns a vector \f$ x f_i(x, Q) \f$ with index \f$ 0 < i < 12 \f$. + /// @arg 0..5 = \f$ \bar{t} \f$, ..., \f$ \bar{u} \f$, \f$ \bar{d} \f$; + /// @arg 6 = \f$ g \f$; + /// @arg 7..12 = \f$ d \f$, \f$ u \f$, ..., \f$ t \f$. + /// + /// NB. Extra @a P2 and @a ip params. + std::vector xfxp(double x, double Q, double P2, int ip); + /// Photon PDF: returns a vector \f$ x f_i(x, Q) \f$ with index \f$ 0 < i < 12 \f$. + /// @arg 0..5 = \f$ \bar{t} \f$, ..., \f$ \bar{u} \f$, \f$ \bar{d} \f$; + /// @arg 6 = \f$ g \f$; + /// @arg 7..12 = \f$ d \f$, \f$ u \f$, ..., \f$ t \f$. + /// + /// NB. Extra @a P2 and @a ip params. + std::vector xfxp(int nset, double x, double Q, double P2, int ip); + + /// Photon PDF: fills primitive 13 element array pointed at by @a results with + /// \f$ x f(x, Q) \f$ with index \f$ 0 < i < 12 \f$. + /// @arg 0..5 = \f$ \bar{t} \f$, ..., \f$ \bar{u} \f$, \f$ \bar{d} \f$; + /// @arg 6 = \f$ g \f$; + /// @arg 7..12 = \f$ d \f$, \f$ u \f$, ..., \f$ t \f$. + /// + /// NB. Extra @a P2 and @a ip params. + void xfxp(double x, double Q, double P2, int ip, double* results); + /// Photon PDF: fills primitive 13 element array pointed at by @a results with + /// \f$ x f(x, Q) \f$ with index \f$ 0 < i < 12 \f$. + /// @arg 0..5 = \f$ \bar{t} \f$, ..., \f$ \bar{u} \f$, \f$ \bar{d} \f$; + /// @arg 6 = \f$ g \f$; + /// @arg 7..12 = \f$ d \f$, \f$ u \f$, ..., \f$ t \f$. + /// + /// NB. Extra @a P2 and @a ip params. + void xfxp(int nset, double x, double Q, double P2, int ip, double* results); + + + /// Photon PDF: returns \f$ x f(x, Q) \f$ for flavour @a fl - this time the flavour encoding + /// is as in the LHAPDF manual. + /// @arg -6..-1 = \f$ \bar{t} \f$, ..., \f$ \bar{u} \f$, \f$ \bar{d} \f$; + /// @arg 0 = \f$ g \f$ + /// @arg 1..6 = \f$ d \f$, \f$ u \f$, ..., \f$ t \f$. + /// + /// NB. Extra @a P2 and @a ip params. + double xfxp(double x, double Q, double P2, int ip, int fl); + /// Photon PDF: returns \f$ x f(x, Q) \f$ for flavour @a fl - this time the flavour encoding + /// is as in the LHAPDF manual. + /// @arg -6..-1 = \f$ \bar{t} \f$, ..., \f$ \bar{u} \f$, \f$ \bar{d} \f$; + /// @arg 0 = \f$ g \f$ + /// @arg 1..6 = \f$ d \f$, \f$ u \f$, ..., \f$ t \f$. + /// + /// NB. Extra @a P2 and @a ip params. + double xfxp(int nset, double x, double Q, double P2, int ip, int fl); + //@} + + + /// @name Nuclear PDFs + //@{ + + /// Nuclear PDF: returns a vector \f$ x f_i(x, Q) \f$ with index \f$ 0 < i < 12 \f$. + /// @arg 0..5 = \f$ \bar{t} \f$, ..., \f$ \bar{u} \f$, \f$ \bar{d} \f$; + /// @arg 6 = \f$ g \f$; + /// @arg 7..12 = \f$ d \f$, \f$ u \f$, ..., \f$ t \f$. + /// + /// NB. Extra @a a param for atomic mass number. + std::vector xfxa(double x, double Q, double a); + /// Nuclear PDF: returns a vector \f$ x f_i(x, Q) \f$ with index \f$ 0 < i < 12 \f$. + /// @arg 0..5 = \f$ \bar{t} \f$, ..., \f$ \bar{u} \f$, \f$ \bar{d} \f$; + /// @arg 6 = \f$ g \f$; + /// @arg 7..12 = \f$ d \f$, \f$ u \f$, ..., \f$ t \f$. + /// + /// NB. Extra @a a param for atomic mass number. + std::vector xfxa(int nset, double x, double Q, double a); + + /// Nuclear PDF: fills primitive 13 element array pointed at by @a results with + /// \f$ x f(x, Q) \f$ with index \f$ 0 < i < 12 \f$. + /// @arg 0..5 = \f$ \bar{t} \f$, ..., \f$ \bar{u} \f$, \f$ \bar{d} \f$; + /// @arg 6 = \f$ g \f$; + /// @arg 7..12 = \f$ d \f$, \f$ u \f$, ..., \f$ t \f$. + /// + /// NB. Extra @a a param for atomic mass number. + void xfxa(double x, double Q, double a, double* results); + /// Nuclear PDF: fills primitive 13 element array pointed at by @a results with + /// \f$ x f(x, Q) \f$ with index \f$ 0 < i < 12 \f$. + /// @arg 0..5 = \f$ \bar{t} \f$, ..., \f$ \bar{u} \f$, \f$ \bar{d} \f$; + /// @arg 6 = \f$ g \f$; + /// @arg 7..12 = \f$ d \f$, \f$ u \f$, ..., \f$ t \f$. + /// + /// NB. Extra @a a param for atomic mass number. + void xfxa(int nset, double x, double Q, double a, double* results); + + /// Nuclear PDF: returns \f$ x f(x, Q) \f$ for flavour @a fl - this time the flavour encoding + /// is as in the LHAPDF manual. + /// @arg -6..-1 = \f$ \bar{t} \f$, ..., \f$ \bar{u} \f$, \f$ \bar{d} \f$; + /// @arg 0 = \f$ g \f$ + /// @arg 1..6 = \f$ d \f$, \f$ u \f$, ..., \f$ t \f$. + /// + /// NB. Extra @a a param for atomic mass number. + double xfxa(double x, double Q, double a, int fl); + /// Nuclear PDF: returns \f$ x f(x, Q) \f$ for flavour @a fl - this time the flavour encoding + /// is as in the LHAPDF manual. + /// @arg -6..-1 = \f$ \bar{t} \f$, ..., \f$ \bar{u} \f$, \f$ \bar{d} \f$; + /// @arg 0 = \f$ g \f$ + /// @arg 1..6 = \f$ d \f$, \f$ u \f$, ..., \f$ t \f$. + /// + /// NB. Extra @a a param for atomic mass number. + double xfxa(int nset, double x, double Q, double a, int fl); + //@} + + + /// @name Nucleon MRST QED PDF + /// These functions only apply to the MRST QED PDF set, since they return an extra element + /// for the additional photon. + //@{ + + /// MRST QED PDF: returns a vector \f$ x f_i(x, Q) \f$ with index \f$ 0 < i < 12 \f$. + /// @arg 0..5 = \f$ \bar{t} \f$, ..., \f$ \bar{u} \f$, \f$ \bar{d} \f$; + /// @arg 6 = \f$ g \f$; + /// @arg 7..12 = \f$ d \f$, \f$ u \f$, ..., \f$ t \f$; + /// @arg 13 = \f$ \gamma \f$. + /// + /// NB. Note extra element in this set for MRST photon. + std::vector xfxphoton(double x, double Q); + /// MRST QED PDF: returns a vector \f$ x f_i(x, Q) \f$ with index \f$ 0 < i < 12 \f$. + /// @arg 0..5 = \f$ \bar{t} \f$, ..., \f$ \bar{u} \f$, \f$ \bar{d} \f$; + /// @arg 6 = \f$ g \f$; + /// @arg 7..12 = \f$ d \f$, \f$ u \f$, ..., \f$ t \f$; + /// @arg 13 = \f$ \gamma \f$. + std::vector xfxphoton(int nset, double x, double Q); + + + /// MRST QED PDF: fills primitive 14 element array pointed at by @a results with + /// \f$ x f(x, Q) \f$ with index \f$ 0 < i < 12 \f$. + /// @arg 0..5 = \f$ \bar{t} \f$, ..., \f$ \bar{u} \f$, \f$ \bar{d} \f$; + /// @arg 6 = \f$ g \f$; + /// @arg 7..12 = \f$ d \f$, \f$ u \f$, ..., \f$ t \f$. + /// @arg 13 = \f$ \gamma \f$. + /// + /// NB. Note extra element in this set for MRST photon. + void xfxphoton(double x, double Q, double* results); + /// MRST QED PDF: fills primitive 14 element array pointed at by @a results with + /// \f$ x f(x, Q) \f$ with index \f$ 0 < i < 12 \f$. + /// @arg 0..5 = \f$ \bar{t} \f$, ..., \f$ \bar{u} \f$, \f$ \bar{d} \f$; + /// @arg 6 = \f$ g \f$; + /// @arg 7..12 = \f$ d \f$, \f$ u \f$, ..., \f$ t \f$. + /// @arg 13 = \f$ \gamma \f$. + /// + /// NB. Note extra element in this set for MRST photon. + void xfxphoton(int nset, double x, double Q, double* results); + + + /// MRST QED PDF: returns \f$ x f(x, Q) \f$ for flavour @a fl - this time the flavour encoding + /// is as in the LHAPDF manual. + /// @arg -6..-1 = \f$ \bar{t} \f$, ..., \f$ \bar{u} \f$, \f$ \bar{d} \f$; + /// @arg 0 = \f$ g \f$ + /// @arg 1..6 = \f$ d \f$, \f$ u \f$, ..., \f$ t \f$; + /// @arg 7 = \f$ \gamma \f$. + /// + /// NB. Note extra element in this set for MRST photon. + double xfxphoton(double x, double Q, int fl); + /// MRST QED PDF: returns \f$ x f(x, Q) \f$ for flavour @a fl - this time the flavour encoding + /// is as in the LHAPDF manual. + /// @arg -6..-1 = \f$ \bar{t} \f$, ..., \f$ \bar{u} \f$, \f$ \bar{d} \f$; + /// @arg 0 = \f$ g \f$ + /// @arg 1..6 = \f$ d \f$, \f$ u \f$, ..., \f$ t \f$; + /// @arg 7 = \f$ \gamma \f$. + double xfxphoton(int nset, double x, double Q, int fl); + //@} + + + /// @name Deprecated initialisation functions + /// LHAPDF functions for initialising PDF sets. If you need to use + /// more than one set simultaneously, use the multi-set functions, which + /// have a integer @c nset first argument. + /// @deprecated These init methods are deprecated. + //@{ + + /// The PDF set by file path, see subdir @c PDFsets of LHAPDF for choices. + //void initPDFSet(const std::string& path); + /// The PDF set by file path, see subdir @c PDFsets of LHAPDF for choices. + //void initPDFSet(int nset, const std::string& path); + + /// The PDF set by name and type, see subdir @c PDFsets of LHAPDF for choices. + void initPDFSetByName(const std::string& name, SetType type); + /// The PDF set by name and type, see subdir @c PDFsets of LHAPDF for choices. + void initPDFSetByName(int nset, const std::string& name, SetType type); + + /// The PDF set by filename, see subdir @c PDFsets of LHAPDF for choices. + void initPDFSetByName(const std::string& filename); + /// The PDF set by filename, see subdir @c PDFsets of LHAPDF for choices. + void initPDFSetByName(int nset, const std::string& filename); + + /// The choice of PDF member out of one distribution. + void initPDF(int memset); + /// The choice of PDF member out of one distribution. + void initPDF(int nset, int memset); + + /// @brief Convenient initializer with PDF set @a name, set type @a type and member @a memset. + /// @param name The name of the desired set. + /// @param type The type of PDF set (grid or data) by enum. + /// @param memset PDF number within set @a name. + /// Equivalent to @c initPDFSetByName + @c initPDF. + void initPDFByName(const std::string& name, SetType type, int memset); + + /// @brief Typical initializer for multiple PDF sets with PDF set @a name and member @a memset. + /// @param nset Specifies the reference number for the set to be initialized. + /// @param name Name of the desired set. + /// @param type The type of PDF set (grid or data) by enum. + /// @param memset PDF number within set @a name. + /// Equivalent to @c initPDFSetByNameM + @c initPDFM. + void initPDFByName(int nset, const std::string& name, SetType type, int memset); + + /// @brief Convenient initializer with PDF set @a filename and member @a memset. + /// @param filename The name of the grid or data file of the desired set. + /// @param memset PDF number within set @a name. + /// Equivalent to @c initPDFSetByName + @c initPDF. + void initPDFByName(const std::string& filename, int memset); + /// @brief Typical initializer for multiple PDF sets with PDF set @a name and member @a memset. + /// @param nset Specifies the reference number for the set to be initialized. + /// @param filename Name of the grid or data file of the desired set. + /// @param memset PDF number within set @a name. + /// Equivalent to @c initPDFSetByNameM + @c initPDFM. + void initPDFByName(int nset, const std::string& filename, int memset); + //@} + + +} + +#endif diff --git a/LHAPDF/lhapdf-5.9.1/include/LHAPDF/LHAPDFConfig.h b/LHAPDF/lhapdf-5.9.1/include/LHAPDF/LHAPDFConfig.h new file mode 100644 index 00000000000..05f3513dece --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/include/LHAPDF/LHAPDFConfig.h @@ -0,0 +1,13 @@ +#ifndef LHAPDF_LHAPDFCONFIG_H +#define LHAPDF_LHAPDFCONFIG_H + +/* LHAPDF version string */ +#undef LHAPDF_VERSION + +/* Was LHAPDF built in low-memory mode? */ +#undef LHAPDF_LOWMEM + +/* How many LHAPDF PDF sets can be used concurrently? */ +#undef LHAPDF_NMXSET + +#endif diff --git a/LHAPDF/lhapdf-5.9.1/include/LHAPDF/LHAPDFConfig.h.in b/LHAPDF/lhapdf-5.9.1/include/LHAPDF/LHAPDFConfig.h.in new file mode 100644 index 00000000000..05f3513dece --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/include/LHAPDF/LHAPDFConfig.h.in @@ -0,0 +1,13 @@ +#ifndef LHAPDF_LHAPDFCONFIG_H +#define LHAPDF_LHAPDFCONFIG_H + +/* LHAPDF version string */ +#undef LHAPDF_VERSION + +/* Was LHAPDF built in low-memory mode? */ +#undef LHAPDF_LOWMEM + +/* How many LHAPDF PDF sets can be used concurrently? */ +#undef LHAPDF_NMXSET + +#endif diff --git a/LHAPDF/lhapdf-5.9.1/include/LHAPDF/LHAPDFWrap.h b/LHAPDF/lhapdf-5.9.1/include/LHAPDF/LHAPDFWrap.h new file mode 100644 index 00000000000..f591d9c66e2 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/include/LHAPDF/LHAPDFWrap.h @@ -0,0 +1,204 @@ +#ifndef LHAPDFWRAP_H +#define LHAPDFWRAP_H + +#include +#include + +// WARNING! This C++ interface is deprecated in favour of the +// interface declared in LHAPDF/LHAPDF.h + +// This class is a wrapper around the LHAPDF package for parton +// distribution functions of the proton. +// +// Originally by Stefan Gieseke. +// Adapted for LHAPDFv4 by Mike Whalley. +// Adapted for LHAPDFv5 by Craig Group/Mike Whalley. +// Fortran portability and interface improvements by Andy Buckley. + + +///////////////////////////////////////////////////////////////// + + +/// Wrapper class used to contain all the wrapper functions. +/// @deprecated +/// The class-based C++ wrapper on LHAPDF will be retired in a forthcoming +/// release of LHAPDF in favour of the namespaced wrapper declared in @c +/// LHAPDF.h. Please convert client code which uses the class interface to use +/// the new interface instead. Typically, this will just involve changing the +/// header include from @c "LHAPDF/LHAPDFWrap.h" to @c "LHAPDF/LHAPDFWrap.h", +/// changing any constructors to initialisation functions, and replacing @c +/// LHAPDFWrap objects with an @c LHAPDF namespace. For example, +/// @code +/// #include "LHAPDF/LHAPDFWrap.h" +/// LHAPDFWrap pdf = LHAPDFWrap("MRST2004qed.LHgrid", 0); +/// pdf.getDescription(); +/// @endcode +/// would be replaced by +/// @code +/// #include "LHAPDF/LHAPDF.h" +/// LHAPDF::initPDFByName("MRST2004qed.LHgrid", 0); +/// LHAPDF::getDescription(); +/// @endcode +class LHAPDFWrap { + +public: + /// Do-nothing constructor. + LHAPDFWrap(); + + /// Typical constructor with PDF set 'name' + /// 'name' is the name of the grid or data file of the desired set. + LHAPDFWrap(const std::string& name); + + /// Typical constructor with PDF set 'name' and subset 'memset' + /// 'name' is the name of the grid or data file of the desired set. + LHAPDFWrap(const std::string& name, int memset); + + /// Typical constructor (when multiple PDF sets need to be initialized) + /// with pdfset 'name' and subset 'memset'. + /// 'name' is the name of the grid or data file of the desired set. + /// int nset specifies the reference number for the set to be initialized + LHAPDFWrap(int nset, const std::string& name); + + /// Typical constructor (when multiple PDF sets need to be initialized) + /// with PDF set 'name' and subset 'memset'. + /// 'name' is the name of the grid or data file of the desired set. + /// int nset specifies the reference number for the set to be initialized + LHAPDFWrap(int nset, const std::string& name, int memset); + + /// Returns a vector xf(x, Q) with index 0 < i < 12. + /// 0..5 = tbar, ..., ubar, dbar; + /// 6 = g; + /// 7..12 = d, u, ..., t + std::vector xfx(double x, double Q); + + /// Returns xf(x, Q) for flavour fl - this time the flavour encoding + /// is as in the LHAPDF manual... + /// -6..-1 = tbar,...,ubar, dbar + /// 1..6 = duscbt + /// 0 = g + double xfx(double x, double Q, int fl); + + std::vector xfxp(double x, double Q, double P2, int ip); + double xfxp(double x, double Q, double P2, int ip, int fl); + + std::vector xfxa(double x, double Q, double a); + double xfxa(double x, double Q, double a, int fl); + + std::vector xfxphoton(double x, double Q); + double xfxphoton(double x, double Q, int fl); + + /// The PDF set by name, see subdir 'PDFset' of LHAPDFv2 for choices + void initPDFSet(const std::string& name); + + /// The PDF set by name, see subdir 'PDFset' of LHAPDFv2 for choices + void initPDFSetByName(const std::string& name); + + /// The choice of PDF subset out of one distribution + void initPDF(int memset); + + /// Prints a brief description of the current pdf set to stdout + void getDescription(); + + /// Number of subsets available in the current distribution. + int numberPDF(); + + /// \f$ \alpha_\mathrm{s} \f$ used by the current PDF. + double alphasPDF(double Q); + + int getOrderPDF(); + + /// Perturbative order of parton evolution and \f$ \alpha_\mathrm{s} \f$ respectively. + int getOrderAlphaS(); + + /// Quark mass used for flavour f. + double getQMass(int f); + + /// Threshold for flavour f. + double getThreshold(int f); + + /// Number of flavours used in the current PDF set. + int getNf(); + + /// Value of QCD lambda4 for member m + double getLam4(int m); + + /// Value of QCD lambda5 for member m + double getLam5(int m); + + double getXmin(int m); + double getXmax(int m); + double getQ2min(int m); + double getQ2max(int m); + + void extrapolate(); + + // Additional functions for when more than 1 PDF set is being stored in memory + + // Returns a vector xf(x, Q) with index 0 < i < 12. + // 0..5 = tbar, ..., ubar, dbar; + // 6 = g; + // 7..12 = d, u, ..., t + std::vector xfxM(int nset, double x, double Q); + + // Returns xf(x, Q) for flavour fl - this time the flavour encoding + // is as in the LHAPDF manual... + // -6..-1 = tbar,...,ubar, dbar + // 1..6 = duscbt + // 0 = g + double xfxM(int nset, double x, double Q, int fl); + + std::vector xfxpM(int nset, double x, double Q, double P2, int ip); + double xfxpM(int nset, double x, double Q, double P2, int ip, int fl); + + std::vector xfxaM(int nset, double x, double Q, double a); + double xfxaM(int nset, double x, double Q, double a, int fl); + + std::vector xfxphotonM(int nset, double x, double Q); + double xfxphotonM(int nset, double x, double Q, int fl); + + /// The PDF set by name, see subdir 'PDFset' of LHAPDFv2 for choices + void initPDFSetM(int nset, const std::string& name); + + /// The PDF set by name, see subdir 'PDFset' of LHAPDFv2 for choices + void initPDFSetByNameM(int nset, const std::string& name); + + /// The choice of PDF subset out of one distribution + void initPDFM(int nset, int memset); + + /// Prints a brief description of the current PDF set to stdout + void getDescriptionM(int nset); + + /// Number of subsets available in the current distribution. + int numberPDFM(int nset); + + /// \f$ \alpha_\mathrm{s} \f$ used by the current PDF. + double alphasPDFM(int nset, double Q); + + int getOrderPDFM(int nset); + + /// Perturbative order of parton evolution and \f$ \alpha_\mathrm{s} \f$ respectively. + int getOrderAlphaSM(int nset); + + /// Quark mass used for flavour f. + double getQMassM(int nset, int f); + + /// Threshold for flavour f. + double getThresholdM(int nset, int f); + + /// Number of flavours used in the current PDF set. + int getNfM(int nset); + + /// Value of QCD lambda4 for member m + double getLam4M(int nset, int m); + + /// Value of QCD lambda5 for member m + double getLam5M(int nset, int m); + + double getXminM(int nset, int m); + double getXmaxM(int nset, int m); + double getQ2minM(int nset, int m); + double getQ2maxM(int nset, int m); + +}; + +#endif diff --git a/LHAPDF/lhapdf-5.9.1/include/LHAPDF/LHAPDFfw.h b/LHAPDF/lhapdf-5.9.1/include/LHAPDF/LHAPDFfw.h new file mode 100644 index 00000000000..2bf08c7942c --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/include/LHAPDF/LHAPDFfw.h @@ -0,0 +1,140 @@ +#ifndef LHAPDFfw_H +#define LHAPDFfw_H + +// Forward declarations of signatures of Fortran +// intermediate wrapper functions. + +#include "LHAPDF/FortranWrappers.h" + +extern "C" { + + #define fgetprefixpath FC_FUNC(getprefixpath, GETPREFIXPATH) + void fgetprefixpath(char*, int len); + #define fgetindexpath FC_FUNC(getindexpath, GETINDEXPATH) + void fgetindexpath(char*, int len); + #define fgetdirpath FC_FUNC(getdirpath, GETDIRPATH) + void fgetdirpath(char*, int len); + + #define finitlhapdf FC_FUNC(initlhapdf, INITLHAPDF) + void finitlhapdf(); + + #define fgetlhapdfversion FC_FUNC(getlhapdfversion, GETLHAPDFVERSION) + void fgetlhapdfversion(char*, int len); + + #define fgetmaxnumsets FC_FUNC(getmaxnumsets, GETMAXNUMSETS) + void fgetmaxnumsets(int* len); + + #define finitpdfset FC_FUNC(finitpdfset, FINITPDFSET) + void finitpdfset(char*, int len); + #define finitpdfsetbyname FC_FUNC(finitpdfsetbyname, FINITPDFSETBYNAME) + void finitpdfsetbyname(char*, int len); + #define finitpdf FC_FUNC(finitpdf, FINITPDF) + void finitpdf(int*); + #define fevolvepdf FC_FUNC(fevolvepdf, FEVOLVEPDF) + void fevolvepdf(double*, double *, double*); + #define fevolvepdfp FC_FUNC(fevolvepdfp, FEVOLVEPDFP) + void fevolvepdfp(double*, double *, double*, int*, double*); + #define fevolvepdfa FC_FUNC(fevolvepdfa, FEVOLVEPDFA) + void fevolvepdfa(double*, double *, double *, double*); + #define fevolvepdfphoton FC_FUNC(fevolvepdfphoton, FEVOLVEPDFPHOTON) + void fevolvepdfphoton(double*, double *, double*, double*); + #define fhasphoton FC_FUNC(fhasphoton, FHASPHOTON) + void fhasphoton(int*); + #define fnumberpdf FC_FUNC(fnumberpdf, FNUMBERPDF) + void fnumberpdf(int*); + #define falphaspdf FC_FUNC(falphaspdf, FALPHASPDF) + void falphaspdf(double*, double *); + #define fgetorderpdf FC_FUNC(fgetorderpdf, FGETORDERPDF) + void fgetorderpdf(int*); + #define fgetorderas FC_FUNC(fgetorderas, FGETORDERAS) + void fgetorderas(int*); + #define fgetdesc FC_FUNC(fgetdesc, FGETDESC) + void fgetdesc(); + #define fgetqmass FC_FUNC(fgetqmass, FGETQMASS) + void fgetqmass(int*, double*); + #define fgetthreshold FC_FUNC(fgetthreshold, FGETTHRESHOLD) + void fgetthreshold(int*, double*); + #define fgetnf FC_FUNC(fgetnf, FGETNF) + void fgetnf(int*); + #define fgetlam4 FC_FUNC(fgetlam4, FGETLAM4) + void fgetlam4(int*, double*); + #define fgetlam5 FC_FUNC(fgetlam5, FGETLAM5) + void fgetlam5(int*, double*); + #define fgetxmin FC_FUNC(fgetxmin, FGETXMIN) + void fgetxmin(int*, double*); + #define fgetxmax FC_FUNC(fgetxmax, FGETXMAX) + void fgetxmax(int*, double*); + #define fgetq2min FC_FUNC(fgetq2min, FGETQ2MIN) + void fgetq2min(int*, double*); + #define fgetq2max FC_FUNC(fgetq2max, FGETQ2MAX) + void fgetq2max(int*, double*); + #define fgetminmax FC_FUNC(fgetminmax, FGETMINMAX) + void fgetminmax(int*, double*, double*, double*, double*); + #define fextrapolate FC_FUNC(fextrapolate, FEXTRAPOLATE) + void fextrapolate(); + + // v5 subroutines for multiple set initialization + #define finitpdfsetm FC_FUNC(finitpdfsetm, FINITPDFSETM) + void finitpdfsetm(int*, char*, int len); + #define finitpdfsetbynamem FC_FUNC(finitpdfsetbynamem, FINITPDFSETBYNAMEM) + void finitpdfsetbynamem(int*, char*, int len); + #define finitpdfm FC_FUNC(finitpdfm, FINITPDFM) + void finitpdfm(int*, int*); + #define fevolvepdfm FC_FUNC(fevolvepdfm, FEVOLVEPDFM) + void fevolvepdfm(int*, double*, double *, double*); + #define fevolvepdfpm FC_FUNC(fevolvepdfpm, FEVOLVEPDFPM) + void fevolvepdfpm(int*, double*, double *, double*, int*, double*); + #define fevolvepdfam FC_FUNC(fevolvepdfam, FEVOLVEPDFAM) + void fevolvepdfam(int*, double*, double *, double *, double*); + #define fevolvepdfphotonm FC_FUNC(fevolvepdfphotonm, FEVOLVEPDFPHOTONM) + void fevolvepdfphotonm(int*, double*, double *, double*, double*); + #define fnumberpdfm FC_FUNC(fnumberpdfm, FNUMBERPDFM) + void fnumberpdfm(int*, int*); + #define falphaspdfm FC_FUNC(falphaspdfm, FALPHASPDFM) + void falphaspdfm(int*, double*, double *); + #define fgetorderpdfm FC_FUNC(fgetorderpdfm, FGETORDERPDFM) + void fgetorderpdfm(int*, int*); + #define fgetorderasm FC_FUNC(fgetorderasm, FGETORDERASM) + void fgetorderasm(int*, int*); + #define fgetdescm FC_FUNC(fgetdescm, FGETDESCM) + void fgetdescm(int*); + #define fgetqmassm FC_FUNC(fgetqmassm, FGETQMASSM) + void fgetqmassm(int*, int*, double*); + #define fgetthresholdm FC_FUNC(fgetthresholdm, FGETTHRESHOLDM) + void fgetthresholdm(int*, int*, double*); + #define fgetnfm FC_FUNC(fgetnfm, FGETNFM) + void fgetnfm(int*, int*); + #define fgetlam4m FC_FUNC(fgetlam4m, FGETLAM4M) + void fgetlam4m(int*, int*, double*); + #define fgetlam5m FC_FUNC(fgetlam5m, FGETLAM5M) + void fgetlam5m(int*, int*, double*); + #define fgetxminm FC_FUNC(fgetxminm, FGETXMINM) + void fgetxminm(int*, int*, double*); + #define fgetxmaxm FC_FUNC(fgetxmaxm, FGETXMAXM) + void fgetxmaxm(int*, int*, double*); + #define fgetq2minm FC_FUNC(fgetq2minm, FGETQ2MINM) + void fgetq2minm(int*, int*, double*); + #define fgetq2maxm FC_FUNC(fgetq2maxm, FGETQ2MAXM) + void fgetq2maxm(int*, int*, double*); + #define fgetminmaxm FC_FUNC(fgetminmaxm, FGETMINMAXM) + void fgetminmaxm(int*, int*, double*, double*, double*, double*); + #define fextrapolateon FC_FUNC(fextrapolateon, FEXTRAPOLATEON) + void fextrapolateon(); + #define fextrapolateoff FC_FUNC(fextrapolateoff, FEXTRAPOLATEOFF) + void fextrapolateoff(); + #define fsilent FC_FUNC(fsilent, FSILENT) + void fsilent(); + #define flowkey FC_FUNC(flowkey, FLOWKEY) + void flowkey(); + #define fdefaultverb FC_FUNC(fdefaultverb, FDEFAULTVERB) + void fdefaultverb(); + #define fsetpdfpath FC_FUNC(fsetpdfpath, FSETPDFPATH) + void fsetpdfpath(char*, int len); + + #define fsetlhaparm FC_FUNC(setlhaparm, SETLHAPARM) + void fsetlhaparm(char*, int len); + + +} + +#endif diff --git a/LHAPDF/lhapdf-5.9.1/include/LHAPDF/Makefile.am b/LHAPDF/lhapdf-5.9.1/include/LHAPDF/Makefile.am new file mode 100644 index 00000000000..bb1cdb949a4 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/include/LHAPDF/Makefile.am @@ -0,0 +1,17 @@ +EXTRA_DIST = FortranWrappers.h.in LHAPDFConfig.h.in + +if ENABLE_CCWRAP + +PKGincludedir = $(includedir)/LHAPDF +PKGinclude_HEADERS = LHAPDF.h LHAPDFfw.h +nodist_PKGinclude_HEADERS = FortranWrappers.h LHAPDFConfig.h +if ENABLE_OLDCCWRAP +PKGinclude_HEADERS += LHAPDFWrap.h +endif + +else + +## Make sure that headers are always bundled +EXTRA_DIST += LHAPDF.h LHAPDFfw.h LHAPDFWrap.h + +endif diff --git a/LHAPDF/lhapdf-5.9.1/include/LHAPDF/Makefile.in b/LHAPDF/lhapdf-5.9.1/include/LHAPDF/Makefile.in new file mode 100644 index 00000000000..67238494098 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/include/LHAPDF/Makefile.in @@ -0,0 +1,490 @@ +# Makefile.in generated by automake 1.10.2 from Makefile.am. +# @configure_input@ + +# Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, +# 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. +# This Makefile.in is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY, to the extent permitted by law; without +# even the implied warranty of MERCHANTABILITY or FITNESS FOR A +# PARTICULAR PURPOSE. + +@SET_MAKE@ + +VPATH = @srcdir@ +pkgdatadir = $(datadir)/@PACKAGE@ +pkglibdir = $(libdir)/@PACKAGE@ +pkgincludedir = $(includedir)/@PACKAGE@ +am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd +install_sh_DATA = $(install_sh) -c -m 644 +install_sh_PROGRAM = $(install_sh) -c +install_sh_SCRIPT = $(install_sh) -c +INSTALL_HEADER = $(INSTALL_DATA) +transform = $(program_transform_name) +NORMAL_INSTALL = : +PRE_INSTALL = : +POST_INSTALL = : +NORMAL_UNINSTALL = : +PRE_UNINSTALL = : +POST_UNINSTALL = : +build_triplet = @build@ +host_triplet = @host@ +@ENABLE_CCWRAP_TRUE@@ENABLE_OLDCCWRAP_TRUE@am__append_1 = LHAPDFWrap.h +@ENABLE_CCWRAP_FALSE@am__append_2 = LHAPDF.h LHAPDFfw.h LHAPDFWrap.h +subdir = include/LHAPDF +DIST_COMMON = $(am__PKGinclude_HEADERS_DIST) \ + $(srcdir)/FortranWrappers.h.in $(srcdir)/LHAPDFConfig.h.in \ + $(srcdir)/Makefile.am $(srcdir)/Makefile.in +ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 +am__aclocal_m4_deps = $(top_srcdir)/m4/binreloc.m4 \ + $(top_srcdir)/m4/compilerflags.m4 $(top_srcdir)/m4/libtool.m4 \ + $(top_srcdir)/m4/ltoptions.m4 $(top_srcdir)/m4/ltsugar.m4 \ + $(top_srcdir)/m4/ltversion.m4 $(top_srcdir)/m4/lt~obsolete.m4 \ + $(top_srcdir)/m4/python.m4 $(top_srcdir)/configure.ac +am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \ + $(ACLOCAL_M4) +mkinstalldirs = $(install_sh) -d +CONFIG_HEADER = $(top_builddir)/config/config.h FortranWrappers.h \ + LHAPDFConfig.h +CONFIG_CLEAN_FILES = +SOURCES = +DIST_SOURCES = +am__PKGinclude_HEADERS_DIST = LHAPDF.h LHAPDFfw.h LHAPDFWrap.h +am__vpath_adj_setup = srcdirstrip=`echo "$(srcdir)" | sed 's|.|.|g'`; +am__vpath_adj = case $$p in \ + $(srcdir)/*) f=`echo "$$p" | sed "s|^$$srcdirstrip/||"`;; \ + *) f=$$p;; \ + esac; +am__strip_dir = `echo $$p | sed -e 's|^.*/||'`; +am__installdirs = "$(DESTDIR)$(PKGincludedir)" \ + "$(DESTDIR)$(PKGincludedir)" +PKGincludeHEADERS_INSTALL = $(INSTALL_HEADER) +nodist_PKGincludeHEADERS_INSTALL = $(INSTALL_HEADER) +HEADERS = $(PKGinclude_HEADERS) $(nodist_PKGinclude_HEADERS) +ETAGS = etags +CTAGS = ctags +DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST) +ACLOCAL = @ACLOCAL@ +AMTAR = @AMTAR@ +AM_CPPFLAGS = @AM_CPPFLAGS@ +AM_CXXFLAGS = @AM_CXXFLAGS@ +AM_FCFLAGS = @AM_FCFLAGS@ +AM_FFLAGS = @AM_FFLAGS@ +AR = @AR@ +AUTOCONF = @AUTOCONF@ +AUTOHEADER = @AUTOHEADER@ +AUTOMAKE = @AUTOMAKE@ +AWK = @AWK@ +BINRELOC_CFLAGS = @BINRELOC_CFLAGS@ +BINRELOC_LIBS = @BINRELOC_LIBS@ +CC = @CC@ +CCDEPMODE = @CCDEPMODE@ +CFLAGS = @CFLAGS@ +CPP = @CPP@ +CPPFLAGS = @CPPFLAGS@ +CXX = @CXX@ +CXXCPP = @CXXCPP@ +CXXDEPMODE = @CXXDEPMODE@ +CXXFLAGS = @CXXFLAGS@ +CYGPATH_W = @CYGPATH_W@ +DEFS = @DEFS@ +DEPDIR = @DEPDIR@ +DOXYGEN = @DOXYGEN@ +DSYMUTIL = @DSYMUTIL@ +DUMPBIN = @DUMPBIN@ +ECHO_C = @ECHO_C@ +ECHO_N = @ECHO_N@ +ECHO_T = @ECHO_T@ +EGREP = @EGREP@ +EXEEXT = @EXEEXT@ +F77 = @F77@ +FC = @FC@ +FCFLAGS = @FCFLAGS@ +FCLIBS = @FCLIBS@ +FFLAGS = @FFLAGS@ +FGREP = @FGREP@ +GREP = @GREP@ +INSTALL = @INSTALL@ +INSTALL_DATA = @INSTALL_DATA@ +INSTALL_PROGRAM = @INSTALL_PROGRAM@ +INSTALL_SCRIPT = @INSTALL_SCRIPT@ +INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@ +LD = @LD@ +LDFLAGS = @LDFLAGS@ +LIBOBJS = @LIBOBJS@ +LIBS = @LIBS@ +LIBTOOL = @LIBTOOL@ +LIPO = @LIPO@ +LN_S = @LN_S@ +LTLIBOBJS = @LTLIBOBJS@ +MAKEINFO = @MAKEINFO@ +MKDIR_P = @MKDIR_P@ +MKOCTFILE = @MKOCTFILE@ +NM = @NM@ +NMEDIT = @NMEDIT@ +NMXSET = @NMXSET@ +OBJDUMP = @OBJDUMP@ +OBJEXT = @OBJEXT@ +OCTAVE = @OCTAVE@ +OTOOL = @OTOOL@ +OTOOL64 = @OTOOL64@ +PACKAGE = @PACKAGE@ +PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@ +PACKAGE_NAME = @PACKAGE_NAME@ +PACKAGE_STRING = @PACKAGE_STRING@ +PACKAGE_TARNAME = @PACKAGE_TARNAME@ +PACKAGE_VERSION = @PACKAGE_VERSION@ +PATH_SEPARATOR = @PATH_SEPARATOR@ +PYTHON = @PYTHON@ +RANLIB = @RANLIB@ +SED = @SED@ +SET_MAKE = @SET_MAKE@ +SHELL = @SHELL@ +STRIP = @STRIP@ +SWIG = @SWIG@ +SWVERS = @SWVERS@ +VERSION = @VERSION@ +VERSIONFLAGS = @VERSIONFLAGS@ +abs_builddir = @abs_builddir@ +abs_srcdir = @abs_srcdir@ +abs_top_builddir = @abs_top_builddir@ +abs_top_srcdir = @abs_top_srcdir@ +ac_ct_CC = @ac_ct_CC@ +ac_ct_CXX = @ac_ct_CXX@ +ac_ct_DUMPBIN = @ac_ct_DUMPBIN@ +ac_ct_FC = @ac_ct_FC@ +am__include = @am__include@ +am__leading_dot = @am__leading_dot@ +am__quote = @am__quote@ +am__tar = @am__tar@ +am__untar = @am__untar@ +bindir = @bindir@ +build = @build@ +build_alias = @build_alias@ +build_cpu = @build_cpu@ +build_os = @build_os@ +build_vendor = @build_vendor@ +builddir = @builddir@ +datadir = @datadir@ +datarootdir = @datarootdir@ +docdir = @docdir@ +dvidir = @dvidir@ +exec_prefix = @exec_prefix@ +host = @host@ +host_alias = @host_alias@ +host_cpu = @host_cpu@ +host_os = @host_os@ +host_vendor = @host_vendor@ +htmldir = @htmldir@ +includedir = @includedir@ +infodir = @infodir@ +install_sh = @install_sh@ +libdir = @libdir@ +libexecdir = @libexecdir@ +localedir = @localedir@ +localstatedir = @localstatedir@ +lt_ECHO = @lt_ECHO@ +mandir = @mandir@ +mkdir_p = @mkdir_p@ +oldincludedir = @oldincludedir@ +pdfdir = @pdfdir@ +prefix = @prefix@ +program_transform_name = @program_transform_name@ +psdir = @psdir@ +sbindir = @sbindir@ +sharedstatedir = @sharedstatedir@ +srcdir = @srcdir@ +sysconfdir = @sysconfdir@ +target_alias = @target_alias@ +top_build_prefix = @top_build_prefix@ +top_builddir = @top_builddir@ +top_srcdir = @top_srcdir@ +EXTRA_DIST = FortranWrappers.h.in LHAPDFConfig.h.in $(am__append_2) +@ENABLE_CCWRAP_TRUE@PKGincludedir = $(includedir)/LHAPDF +@ENABLE_CCWRAP_TRUE@PKGinclude_HEADERS = LHAPDF.h LHAPDFfw.h \ +@ENABLE_CCWRAP_TRUE@ $(am__append_1) +@ENABLE_CCWRAP_TRUE@nodist_PKGinclude_HEADERS = FortranWrappers.h LHAPDFConfig.h +all: FortranWrappers.h LHAPDFConfig.h + $(MAKE) $(AM_MAKEFLAGS) all-am + +.SUFFIXES: +$(srcdir)/Makefile.in: $(srcdir)/Makefile.am $(am__configure_deps) + @for dep in $?; do \ + case '$(am__configure_deps)' in \ + *$$dep*) \ + ( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \ + && { if test -f $@; then exit 0; else break; fi; }; \ + exit 1;; \ + esac; \ + done; \ + echo ' cd $(top_srcdir) && $(AUTOMAKE) --gnu include/LHAPDF/Makefile'; \ + cd $(top_srcdir) && \ + $(AUTOMAKE) --gnu include/LHAPDF/Makefile +.PRECIOUS: Makefile +Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status + @case '$?' in \ + *config.status*) \ + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \ + *) \ + echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \ + cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \ + esac; + +$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh + +$(top_srcdir)/configure: $(am__configure_deps) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh +$(ACLOCAL_M4): $(am__aclocal_m4_deps) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh + +FortranWrappers.h: stamp-h2 + @if test ! -f $@; then \ + rm -f stamp-h2; \ + $(MAKE) $(AM_MAKEFLAGS) stamp-h2; \ + else :; fi + +stamp-h2: $(srcdir)/FortranWrappers.h.in $(top_builddir)/config.status + @rm -f stamp-h2 + cd $(top_builddir) && $(SHELL) ./config.status include/LHAPDF/FortranWrappers.h +$(srcdir)/FortranWrappers.h.in: $(am__configure_deps) + cd $(top_srcdir) && $(AUTOHEADER) + rm -f stamp-h2 + touch $@ + +LHAPDFConfig.h: stamp-h3 + @if test ! -f $@; then \ + rm -f stamp-h3; \ + $(MAKE) $(AM_MAKEFLAGS) stamp-h3; \ + else :; fi + +stamp-h3: $(srcdir)/LHAPDFConfig.h.in $(top_builddir)/config.status + @rm -f stamp-h3 + cd $(top_builddir) && $(SHELL) ./config.status include/LHAPDF/LHAPDFConfig.h + +distclean-hdr: + -rm -f FortranWrappers.h stamp-h2 LHAPDFConfig.h stamp-h3 + +mostlyclean-libtool: + -rm -f *.lo + +clean-libtool: + -rm -rf .libs _libs +install-PKGincludeHEADERS: $(PKGinclude_HEADERS) + @$(NORMAL_INSTALL) + test -z "$(PKGincludedir)" || $(MKDIR_P) "$(DESTDIR)$(PKGincludedir)" + @list='$(PKGinclude_HEADERS)'; for p in $$list; do \ + if test -f "$$p"; then d=; else d="$(srcdir)/"; fi; \ + f=$(am__strip_dir) \ + echo " $(PKGincludeHEADERS_INSTALL) '$$d$$p' '$(DESTDIR)$(PKGincludedir)/$$f'"; \ + $(PKGincludeHEADERS_INSTALL) "$$d$$p" "$(DESTDIR)$(PKGincludedir)/$$f"; \ + done + +uninstall-PKGincludeHEADERS: + @$(NORMAL_UNINSTALL) + @list='$(PKGinclude_HEADERS)'; for p in $$list; do \ + f=$(am__strip_dir) \ + echo " rm -f '$(DESTDIR)$(PKGincludedir)/$$f'"; \ + rm -f "$(DESTDIR)$(PKGincludedir)/$$f"; \ + done +install-nodist_PKGincludeHEADERS: $(nodist_PKGinclude_HEADERS) + @$(NORMAL_INSTALL) + test -z "$(PKGincludedir)" || $(MKDIR_P) "$(DESTDIR)$(PKGincludedir)" + @list='$(nodist_PKGinclude_HEADERS)'; for p in $$list; do \ + if test -f "$$p"; then d=; else d="$(srcdir)/"; fi; \ + f=$(am__strip_dir) \ + echo " $(nodist_PKGincludeHEADERS_INSTALL) '$$d$$p' '$(DESTDIR)$(PKGincludedir)/$$f'"; \ + $(nodist_PKGincludeHEADERS_INSTALL) "$$d$$p" "$(DESTDIR)$(PKGincludedir)/$$f"; \ + done + +uninstall-nodist_PKGincludeHEADERS: + @$(NORMAL_UNINSTALL) + @list='$(nodist_PKGinclude_HEADERS)'; for p in $$list; do \ + f=$(am__strip_dir) \ + echo " rm -f '$(DESTDIR)$(PKGincludedir)/$$f'"; \ + rm -f "$(DESTDIR)$(PKGincludedir)/$$f"; \ + done + +ID: $(HEADERS) $(SOURCES) $(LISP) $(TAGS_FILES) + list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \ + unique=`for i in $$list; do \ + if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ + done | \ + $(AWK) '{ files[$$0] = 1; nonempty = 1; } \ + END { if (nonempty) { for (i in files) print i; }; }'`; \ + mkid -fID $$unique +tags: TAGS + +TAGS: $(HEADERS) $(SOURCES) FortranWrappers.h.in LHAPDFConfig.h.in $(TAGS_DEPENDENCIES) \ + $(TAGS_FILES) $(LISP) + tags=; \ + here=`pwd`; \ + list='$(SOURCES) $(HEADERS) FortranWrappers.h.in LHAPDFConfig.h.in $(LISP) $(TAGS_FILES)'; \ + unique=`for i in $$list; do \ + if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ + done | \ + $(AWK) '{ files[$$0] = 1; nonempty = 1; } \ + END { if (nonempty) { for (i in files) print i; }; }'`; \ + if test -z "$(ETAGS_ARGS)$$tags$$unique"; then :; else \ + test -n "$$unique" || unique=$$empty_fix; \ + $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \ + $$tags $$unique; \ + fi +ctags: CTAGS +CTAGS: $(HEADERS) $(SOURCES) FortranWrappers.h.in LHAPDFConfig.h.in $(TAGS_DEPENDENCIES) \ + $(TAGS_FILES) $(LISP) + tags=; \ + list='$(SOURCES) $(HEADERS) FortranWrappers.h.in LHAPDFConfig.h.in $(LISP) $(TAGS_FILES)'; \ + unique=`for i in $$list; do \ + if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ + done | \ + $(AWK) '{ files[$$0] = 1; nonempty = 1; } \ + END { if (nonempty) { for (i in files) print i; }; }'`; \ + test -z "$(CTAGS_ARGS)$$tags$$unique" \ + || $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \ + $$tags $$unique + +GTAGS: + here=`$(am__cd) $(top_builddir) && pwd` \ + && cd $(top_srcdir) \ + && gtags -i $(GTAGS_ARGS) $$here + +distclean-tags: + -rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags + +distdir: $(DISTFILES) + @srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ + topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ + list='$(DISTFILES)'; \ + dist_files=`for file in $$list; do echo $$file; done | \ + sed -e "s|^$$srcdirstrip/||;t" \ + -e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \ + case $$dist_files in \ + */*) $(MKDIR_P) `echo "$$dist_files" | \ + sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \ + sort -u` ;; \ + esac; \ + for file in $$dist_files; do \ + if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \ + if test -d $$d/$$file; then \ + dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \ + if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \ + cp -pR $(srcdir)/$$file $(distdir)$$dir || exit 1; \ + fi; \ + cp -pR $$d/$$file $(distdir)$$dir || exit 1; \ + else \ + test -f $(distdir)/$$file \ + || cp -p $$d/$$file $(distdir)/$$file \ + || exit 1; \ + fi; \ + done +check-am: all-am +check: check-am +all-am: Makefile $(HEADERS) FortranWrappers.h LHAPDFConfig.h +installdirs: + for dir in "$(DESTDIR)$(PKGincludedir)" "$(DESTDIR)$(PKGincludedir)"; do \ + test -z "$$dir" || $(MKDIR_P) "$$dir"; \ + done +install: install-am +install-exec: install-exec-am +install-data: install-data-am +uninstall: uninstall-am + +install-am: all-am + @$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am + +installcheck: installcheck-am +install-strip: + $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ + install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ + `test -z '$(STRIP)' || \ + echo "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'"` install +mostlyclean-generic: + +clean-generic: + +distclean-generic: + -test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES) + +maintainer-clean-generic: + @echo "This command is intended for maintainers to use" + @echo "it deletes files that may require special tools to rebuild." +clean: clean-am + +clean-am: clean-generic clean-libtool mostlyclean-am + +distclean: distclean-am + -rm -f Makefile +distclean-am: clean-am distclean-generic distclean-hdr distclean-tags + +dvi: dvi-am + +dvi-am: + +html: html-am + +info: info-am + +info-am: + +install-data-am: install-PKGincludeHEADERS \ + install-nodist_PKGincludeHEADERS + +install-dvi: install-dvi-am + +install-exec-am: + +install-html: install-html-am + +install-info: install-info-am + +install-man: + +install-pdf: install-pdf-am + +install-ps: install-ps-am + +installcheck-am: + +maintainer-clean: maintainer-clean-am + -rm -f Makefile +maintainer-clean-am: distclean-am maintainer-clean-generic + +mostlyclean: mostlyclean-am + +mostlyclean-am: mostlyclean-generic mostlyclean-libtool + +pdf: pdf-am + +pdf-am: + +ps: ps-am + +ps-am: + +uninstall-am: uninstall-PKGincludeHEADERS \ + uninstall-nodist_PKGincludeHEADERS + +.MAKE: install-am install-strip + +.PHONY: CTAGS GTAGS all all-am check check-am clean clean-generic \ + clean-libtool ctags distclean distclean-generic distclean-hdr \ + distclean-libtool distclean-tags distdir dvi dvi-am html \ + html-am info info-am install install-PKGincludeHEADERS \ + install-am install-data install-data-am install-dvi \ + install-dvi-am install-exec install-exec-am install-html \ + install-html-am install-info install-info-am install-man \ + install-nodist_PKGincludeHEADERS install-pdf install-pdf-am \ + install-ps install-ps-am install-strip installcheck \ + installcheck-am installdirs maintainer-clean \ + maintainer-clean-generic mostlyclean mostlyclean-generic \ + mostlyclean-libtool pdf pdf-am ps ps-am tags uninstall \ + uninstall-PKGincludeHEADERS uninstall-am \ + uninstall-nodist_PKGincludeHEADERS + +# Tell versions [3.59,3.63) of GNU make to not export all variables. +# Otherwise a system limit (for SysV at least) may be exceeded. +.NOEXPORT: diff --git a/LHAPDF/lhapdf-5.9.1/include/Makefile.am b/LHAPDF/lhapdf-5.9.1/include/Makefile.am new file mode 100644 index 00000000000..145042785ea --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/include/Makefile.am @@ -0,0 +1 @@ +SUBDIRS = LHAPDF diff --git a/LHAPDF/lhapdf-5.9.1/include/Makefile.in b/LHAPDF/lhapdf-5.9.1/include/Makefile.in new file mode 100644 index 00000000000..937c3dbc568 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/include/Makefile.in @@ -0,0 +1,514 @@ +# Makefile.in generated by automake 1.10.2 from Makefile.am. +# @configure_input@ + +# Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, +# 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. +# This Makefile.in is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY, to the extent permitted by law; without +# even the implied warranty of MERCHANTABILITY or FITNESS FOR A +# PARTICULAR PURPOSE. + +@SET_MAKE@ +VPATH = @srcdir@ +pkgdatadir = $(datadir)/@PACKAGE@ +pkglibdir = $(libdir)/@PACKAGE@ +pkgincludedir = $(includedir)/@PACKAGE@ +am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd +install_sh_DATA = $(install_sh) -c -m 644 +install_sh_PROGRAM = $(install_sh) -c +install_sh_SCRIPT = $(install_sh) -c +INSTALL_HEADER = $(INSTALL_DATA) +transform = $(program_transform_name) +NORMAL_INSTALL = : +PRE_INSTALL = : +POST_INSTALL = : +NORMAL_UNINSTALL = : +PRE_UNINSTALL = : +POST_UNINSTALL = : +build_triplet = @build@ +host_triplet = @host@ +subdir = include +DIST_COMMON = $(srcdir)/Makefile.am $(srcdir)/Makefile.in +ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 +am__aclocal_m4_deps = $(top_srcdir)/m4/binreloc.m4 \ + $(top_srcdir)/m4/compilerflags.m4 $(top_srcdir)/m4/libtool.m4 \ + $(top_srcdir)/m4/ltoptions.m4 $(top_srcdir)/m4/ltsugar.m4 \ + $(top_srcdir)/m4/ltversion.m4 $(top_srcdir)/m4/lt~obsolete.m4 \ + $(top_srcdir)/m4/python.m4 $(top_srcdir)/configure.ac +am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \ + $(ACLOCAL_M4) +mkinstalldirs = $(install_sh) -d +CONFIG_HEADER = $(top_builddir)/config/config.h \ + $(top_builddir)/include/LHAPDF/FortranWrappers.h \ + $(top_builddir)/include/LHAPDF/LHAPDFConfig.h +CONFIG_CLEAN_FILES = +SOURCES = +DIST_SOURCES = +RECURSIVE_TARGETS = all-recursive check-recursive dvi-recursive \ + html-recursive info-recursive install-data-recursive \ + install-dvi-recursive install-exec-recursive \ + install-html-recursive install-info-recursive \ + install-pdf-recursive install-ps-recursive install-recursive \ + installcheck-recursive installdirs-recursive pdf-recursive \ + ps-recursive uninstall-recursive +RECURSIVE_CLEAN_TARGETS = mostlyclean-recursive clean-recursive \ + distclean-recursive maintainer-clean-recursive +ETAGS = etags +CTAGS = ctags +DIST_SUBDIRS = $(SUBDIRS) +DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST) +ACLOCAL = @ACLOCAL@ +AMTAR = @AMTAR@ +AM_CPPFLAGS = @AM_CPPFLAGS@ +AM_CXXFLAGS = @AM_CXXFLAGS@ +AM_FCFLAGS = @AM_FCFLAGS@ +AM_FFLAGS = @AM_FFLAGS@ +AR = @AR@ +AUTOCONF = @AUTOCONF@ +AUTOHEADER = @AUTOHEADER@ +AUTOMAKE = @AUTOMAKE@ +AWK = @AWK@ +BINRELOC_CFLAGS = @BINRELOC_CFLAGS@ +BINRELOC_LIBS = @BINRELOC_LIBS@ +CC = @CC@ +CCDEPMODE = @CCDEPMODE@ +CFLAGS = @CFLAGS@ +CPP = @CPP@ +CPPFLAGS = @CPPFLAGS@ +CXX = @CXX@ +CXXCPP = @CXXCPP@ +CXXDEPMODE = @CXXDEPMODE@ +CXXFLAGS = @CXXFLAGS@ +CYGPATH_W = @CYGPATH_W@ +DEFS = @DEFS@ +DEPDIR = @DEPDIR@ +DOXYGEN = @DOXYGEN@ +DSYMUTIL = @DSYMUTIL@ +DUMPBIN = @DUMPBIN@ +ECHO_C = @ECHO_C@ +ECHO_N = @ECHO_N@ +ECHO_T = @ECHO_T@ +EGREP = @EGREP@ +EXEEXT = @EXEEXT@ +F77 = @F77@ +FC = @FC@ +FCFLAGS = @FCFLAGS@ +FCLIBS = @FCLIBS@ +FFLAGS = @FFLAGS@ +FGREP = @FGREP@ +GREP = @GREP@ +INSTALL = @INSTALL@ +INSTALL_DATA = @INSTALL_DATA@ +INSTALL_PROGRAM = @INSTALL_PROGRAM@ +INSTALL_SCRIPT = @INSTALL_SCRIPT@ +INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@ +LD = @LD@ +LDFLAGS = @LDFLAGS@ +LIBOBJS = @LIBOBJS@ +LIBS = @LIBS@ +LIBTOOL = @LIBTOOL@ +LIPO = @LIPO@ +LN_S = @LN_S@ +LTLIBOBJS = @LTLIBOBJS@ +MAKEINFO = @MAKEINFO@ +MKDIR_P = @MKDIR_P@ +MKOCTFILE = @MKOCTFILE@ +NM = @NM@ +NMEDIT = @NMEDIT@ +NMXSET = @NMXSET@ +OBJDUMP = @OBJDUMP@ +OBJEXT = @OBJEXT@ +OCTAVE = @OCTAVE@ +OTOOL = @OTOOL@ +OTOOL64 = @OTOOL64@ +PACKAGE = @PACKAGE@ +PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@ +PACKAGE_NAME = @PACKAGE_NAME@ +PACKAGE_STRING = @PACKAGE_STRING@ +PACKAGE_TARNAME = @PACKAGE_TARNAME@ +PACKAGE_VERSION = @PACKAGE_VERSION@ +PATH_SEPARATOR = @PATH_SEPARATOR@ +PYTHON = @PYTHON@ +RANLIB = @RANLIB@ +SED = @SED@ +SET_MAKE = @SET_MAKE@ +SHELL = @SHELL@ +STRIP = @STRIP@ +SWIG = @SWIG@ +SWVERS = @SWVERS@ +VERSION = @VERSION@ +VERSIONFLAGS = @VERSIONFLAGS@ +abs_builddir = @abs_builddir@ +abs_srcdir = @abs_srcdir@ +abs_top_builddir = @abs_top_builddir@ +abs_top_srcdir = @abs_top_srcdir@ +ac_ct_CC = @ac_ct_CC@ +ac_ct_CXX = @ac_ct_CXX@ +ac_ct_DUMPBIN = @ac_ct_DUMPBIN@ +ac_ct_FC = @ac_ct_FC@ +am__include = @am__include@ +am__leading_dot = @am__leading_dot@ +am__quote = @am__quote@ +am__tar = @am__tar@ +am__untar = @am__untar@ +bindir = @bindir@ +build = @build@ +build_alias = @build_alias@ +build_cpu = @build_cpu@ +build_os = @build_os@ +build_vendor = @build_vendor@ +builddir = @builddir@ +datadir = @datadir@ +datarootdir = @datarootdir@ +docdir = @docdir@ +dvidir = @dvidir@ +exec_prefix = @exec_prefix@ +host = @host@ +host_alias = @host_alias@ +host_cpu = @host_cpu@ +host_os = @host_os@ +host_vendor = @host_vendor@ +htmldir = @htmldir@ +includedir = @includedir@ +infodir = @infodir@ +install_sh = @install_sh@ +libdir = @libdir@ +libexecdir = @libexecdir@ +localedir = @localedir@ +localstatedir = @localstatedir@ +lt_ECHO = @lt_ECHO@ +mandir = @mandir@ +mkdir_p = @mkdir_p@ +oldincludedir = @oldincludedir@ +pdfdir = @pdfdir@ +prefix = @prefix@ +program_transform_name = @program_transform_name@ +psdir = @psdir@ +sbindir = @sbindir@ +sharedstatedir = @sharedstatedir@ +srcdir = @srcdir@ +sysconfdir = @sysconfdir@ +target_alias = @target_alias@ +top_build_prefix = @top_build_prefix@ +top_builddir = @top_builddir@ +top_srcdir = @top_srcdir@ +SUBDIRS = LHAPDF +all: all-recursive + +.SUFFIXES: +$(srcdir)/Makefile.in: $(srcdir)/Makefile.am $(am__configure_deps) + @for dep in $?; do \ + case '$(am__configure_deps)' in \ + *$$dep*) \ + ( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \ + && { if test -f $@; then exit 0; else break; fi; }; \ + exit 1;; \ + esac; \ + done; \ + echo ' cd $(top_srcdir) && $(AUTOMAKE) --gnu include/Makefile'; \ + cd $(top_srcdir) && \ + $(AUTOMAKE) --gnu include/Makefile +.PRECIOUS: Makefile +Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status + @case '$?' in \ + *config.status*) \ + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \ + *) \ + echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \ + cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \ + esac; + +$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh + +$(top_srcdir)/configure: $(am__configure_deps) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh +$(ACLOCAL_M4): $(am__aclocal_m4_deps) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh + +mostlyclean-libtool: + -rm -f *.lo + +clean-libtool: + -rm -rf .libs _libs + +# This directory's subdirectories are mostly independent; you can cd +# into them and run `make' without going through this Makefile. +# To change the values of `make' variables: instead of editing Makefiles, +# (1) if the variable is set in `config.status', edit `config.status' +# (which will cause the Makefiles to be regenerated when you run `make'); +# (2) otherwise, pass the desired values on the `make' command line. +$(RECURSIVE_TARGETS): + @failcom='exit 1'; \ + for f in x $$MAKEFLAGS; do \ + case $$f in \ + *=* | --[!k]*);; \ + *k*) failcom='fail=yes';; \ + esac; \ + done; \ + dot_seen=no; \ + target=`echo $@ | sed s/-recursive//`; \ + list='$(SUBDIRS)'; for subdir in $$list; do \ + echo "Making $$target in $$subdir"; \ + if test "$$subdir" = "."; then \ + dot_seen=yes; \ + local_target="$$target-am"; \ + else \ + local_target="$$target"; \ + fi; \ + (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) $$local_target) \ + || eval $$failcom; \ + done; \ + if test "$$dot_seen" = "no"; then \ + $(MAKE) $(AM_MAKEFLAGS) "$$target-am" || exit 1; \ + fi; test -z "$$fail" + +$(RECURSIVE_CLEAN_TARGETS): + @failcom='exit 1'; \ + for f in x $$MAKEFLAGS; do \ + case $$f in \ + *=* | --[!k]*);; \ + *k*) failcom='fail=yes';; \ + esac; \ + done; \ + dot_seen=no; \ + case "$@" in \ + distclean-* | maintainer-clean-*) list='$(DIST_SUBDIRS)' ;; \ + *) list='$(SUBDIRS)' ;; \ + esac; \ + rev=''; for subdir in $$list; do \ + if test "$$subdir" = "."; then :; else \ + rev="$$subdir $$rev"; \ + fi; \ + done; \ + rev="$$rev ."; \ + target=`echo $@ | sed s/-recursive//`; \ + for subdir in $$rev; do \ + echo "Making $$target in $$subdir"; \ + if test "$$subdir" = "."; then \ + local_target="$$target-am"; \ + else \ + local_target="$$target"; \ + fi; \ + (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) $$local_target) \ + || eval $$failcom; \ + done && test -z "$$fail" +tags-recursive: + list='$(SUBDIRS)'; for subdir in $$list; do \ + test "$$subdir" = . || (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) tags); \ + done +ctags-recursive: + list='$(SUBDIRS)'; for subdir in $$list; do \ + test "$$subdir" = . || (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) ctags); \ + done + +ID: $(HEADERS) $(SOURCES) $(LISP) $(TAGS_FILES) + list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \ + unique=`for i in $$list; do \ + if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ + done | \ + $(AWK) '{ files[$$0] = 1; nonempty = 1; } \ + END { if (nonempty) { for (i in files) print i; }; }'`; \ + mkid -fID $$unique +tags: TAGS + +TAGS: tags-recursive $(HEADERS) $(SOURCES) $(TAGS_DEPENDENCIES) \ + $(TAGS_FILES) $(LISP) + tags=; \ + here=`pwd`; \ + if ($(ETAGS) --etags-include --version) >/dev/null 2>&1; then \ + include_option=--etags-include; \ + empty_fix=.; \ + else \ + include_option=--include; \ + empty_fix=; \ + fi; \ + list='$(SUBDIRS)'; for subdir in $$list; do \ + if test "$$subdir" = .; then :; else \ + test ! -f $$subdir/TAGS || \ + tags="$$tags $$include_option=$$here/$$subdir/TAGS"; \ + fi; \ + done; \ + list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \ + unique=`for i in $$list; do \ + if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ + done | \ + $(AWK) '{ files[$$0] = 1; nonempty = 1; } \ + END { if (nonempty) { for (i in files) print i; }; }'`; \ + if test -z "$(ETAGS_ARGS)$$tags$$unique"; then :; else \ + test -n "$$unique" || unique=$$empty_fix; \ + $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \ + $$tags $$unique; \ + fi +ctags: CTAGS +CTAGS: ctags-recursive $(HEADERS) $(SOURCES) $(TAGS_DEPENDENCIES) \ + $(TAGS_FILES) $(LISP) + tags=; \ + list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \ + unique=`for i in $$list; do \ + if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ + done | \ + $(AWK) '{ files[$$0] = 1; nonempty = 1; } \ + END { if (nonempty) { for (i in files) print i; }; }'`; \ + test -z "$(CTAGS_ARGS)$$tags$$unique" \ + || $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \ + $$tags $$unique + +GTAGS: + here=`$(am__cd) $(top_builddir) && pwd` \ + && cd $(top_srcdir) \ + && gtags -i $(GTAGS_ARGS) $$here + +distclean-tags: + -rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags + +distdir: $(DISTFILES) + @srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ + topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ + list='$(DISTFILES)'; \ + dist_files=`for file in $$list; do echo $$file; done | \ + sed -e "s|^$$srcdirstrip/||;t" \ + -e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \ + case $$dist_files in \ + */*) $(MKDIR_P) `echo "$$dist_files" | \ + sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \ + sort -u` ;; \ + esac; \ + for file in $$dist_files; do \ + if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \ + if test -d $$d/$$file; then \ + dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \ + if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \ + cp -pR $(srcdir)/$$file $(distdir)$$dir || exit 1; \ + fi; \ + cp -pR $$d/$$file $(distdir)$$dir || exit 1; \ + else \ + test -f $(distdir)/$$file \ + || cp -p $$d/$$file $(distdir)/$$file \ + || exit 1; \ + fi; \ + done + list='$(DIST_SUBDIRS)'; for subdir in $$list; do \ + if test "$$subdir" = .; then :; else \ + test -d "$(distdir)/$$subdir" \ + || $(MKDIR_P) "$(distdir)/$$subdir" \ + || exit 1; \ + distdir=`$(am__cd) $(distdir) && pwd`; \ + top_distdir=`$(am__cd) $(top_distdir) && pwd`; \ + (cd $$subdir && \ + $(MAKE) $(AM_MAKEFLAGS) \ + top_distdir="$$top_distdir" \ + distdir="$$distdir/$$subdir" \ + am__remove_distdir=: \ + am__skip_length_check=: \ + distdir) \ + || exit 1; \ + fi; \ + done +check-am: all-am +check: check-recursive +all-am: Makefile +installdirs: installdirs-recursive +installdirs-am: +install: install-recursive +install-exec: install-exec-recursive +install-data: install-data-recursive +uninstall: uninstall-recursive + +install-am: all-am + @$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am + +installcheck: installcheck-recursive +install-strip: + $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ + install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ + `test -z '$(STRIP)' || \ + echo "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'"` install +mostlyclean-generic: + +clean-generic: + +distclean-generic: + -test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES) + +maintainer-clean-generic: + @echo "This command is intended for maintainers to use" + @echo "it deletes files that may require special tools to rebuild." +clean: clean-recursive + +clean-am: clean-generic clean-libtool mostlyclean-am + +distclean: distclean-recursive + -rm -f Makefile +distclean-am: clean-am distclean-generic distclean-tags + +dvi: dvi-recursive + +dvi-am: + +html: html-recursive + +info: info-recursive + +info-am: + +install-data-am: + +install-dvi: install-dvi-recursive + +install-exec-am: + +install-html: install-html-recursive + +install-info: install-info-recursive + +install-man: + +install-pdf: install-pdf-recursive + +install-ps: install-ps-recursive + +installcheck-am: + +maintainer-clean: maintainer-clean-recursive + -rm -f Makefile +maintainer-clean-am: distclean-am maintainer-clean-generic + +mostlyclean: mostlyclean-recursive + +mostlyclean-am: mostlyclean-generic mostlyclean-libtool + +pdf: pdf-recursive + +pdf-am: + +ps: ps-recursive + +ps-am: + +uninstall-am: + +.MAKE: $(RECURSIVE_CLEAN_TARGETS) $(RECURSIVE_TARGETS) install-am \ + install-strip + +.PHONY: $(RECURSIVE_CLEAN_TARGETS) $(RECURSIVE_TARGETS) CTAGS GTAGS \ + all all-am check check-am clean clean-generic clean-libtool \ + ctags ctags-recursive distclean distclean-generic \ + distclean-libtool distclean-tags distdir dvi dvi-am html \ + html-am info info-am install install-am install-data \ + install-data-am install-dvi install-dvi-am install-exec \ + install-exec-am install-html install-html-am install-info \ + install-info-am install-man install-pdf install-pdf-am \ + install-ps install-ps-am install-strip installcheck \ + installcheck-am installdirs installdirs-am maintainer-clean \ + maintainer-clean-generic mostlyclean mostlyclean-generic \ + mostlyclean-libtool pdf pdf-am ps ps-am tags tags-recursive \ + uninstall uninstall-am + +# Tell versions [3.59,3.63) of GNU make to not export all variables. +# Otherwise a system limit (for SysV at least) may be exceeded. +.NOEXPORT: diff --git a/LHAPDF/lhapdf-5.9.1/src/EVLCTEQ.f b/LHAPDF/lhapdf-5.9.1/src/EVLCTEQ.f new file mode 100644 index 00000000000..3cd65ffb0f1 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/EVLCTEQ.f @@ -0,0 +1,2910 @@ +! -*- F90 -*- + + +SUBROUTINE CtLhALFSET (QS, ALFS) + IMPLICIT DOUBLE PRECISION (A-H, O-Z) + EXTERNAL CtLhRTALF + COMMON / CtLhRTALFC / ALFST, JORD, NEFF + DATA ALAM, BLAM, ERR / 0.01, 10.0, 0.02 / + ALFST = ALFS + CALL CtLhParQcd (2, 'ORDR', ORDR, IR1) + JORD = Int(ORDR) + NEFF = LhCtNFL(QS) + EFLLN = CtLhQZBRNT (CtLhRTALF, ALAM, BLAM, ERR, IR2) + EFFLAM = QS / EXP (EFLLN) + CALL CtLhSETL1 (NEFF, EFFLAM) +END SUBROUTINE CtLhALFSET + + +FUNCTION CtLhALPI (AMU) + IMPLICIT DOUBLE PRECISION (A-H, O-Z) + COMMON / LhCtCWZPRM / ALAM(0:9), AMHAT(0:9), AMN, NHQ + COMMON / LhCtQCDPAR_LHA / AL, NF, NORDER, SET + LOGICAL SET + PARAMETER (D0 = 0.D0, D1 = 1.D0, BIG = 1.0D15) + DATA IW1, IW2 / 2*0 / + IF(.NOT.SET) CALL CtLhLAMCWZ + NEFF = LhCtNFL(AMU) + ALM = ALAM(NEFF) + CtLhALPI = CtLhALPQCD (NORDER, NEFF, AMU/ALM, IRT) + IF (IRT .EQ. 1) THEN + CALL CtLhWARNR (IW1, 'AMU < ALAM in CtLhALPI', 'AMU', AMU, & + & ALM, BIG, 1) + ELSEIF (IRT .EQ. 2) THEN + CALL CtLhWARNR (IW2, 'CtLhALPI > 3; Be aware!', 'CtLhALPI', & + & CtLhALPI, D0, D1, 0) + ENDIF + RETURN +END FUNCTION CtLhALPI + + +FUNCTION CtLhALPQCD (IRDR, NF, RML, IRT) + IMPLICIT DOUBLE PRECISION (A-H, O-Z) + PARAMETER (D0 = 0.D0, D1 = 1.D0, BIG = 1.0D15) + PARAMETER (CG = 3.0d0, TR = 0.5d0, CF = 4.0d0/3.0d0) + IRT = 0 + IF (IRDR .LT. 1 .OR. IRDR .GT. 2) THEN + print *, & + & 'Order out of range in CtLhALPQCD: IRDR = ', IRDR + STOP + ENDIF + B0 = (11.d0*CG - 2.* NF) / 3.d0 + B1 = (34.d0*CG**2 - 10.d0*CG*NF - 6.d0*CF*NF) / 3.d0 + RM2 = RML**2 + IF (RM2 .LE. 1.) THEN + IRT = 1 + CtLhALPQCD = 99. + RETURN + ENDIF + ALN = LOG (RM2) + AL = 4.d0/ B0 / ALN + IF (IRDR .GE. 2) AL = AL * (1.d0-B1*LOG(ALN) / ALN / B0**2) + IF (AL .GE. 3.) THEN + IRT = 2 + ENDIF + CtLhALPQCD = AL + RETURN +END FUNCTION CtLhALPQCD + + +FUNCTION CtLhAMHATF(I) + IMPLICIT DOUBLE PRECISION (A-H, O-Z) + COMMON / LhCtCWZPRM / ALAM(0:9), AMHAT(0:9), AMN, NHQ + COMMON / LhCtQCDPAR_LHA / AL, NF, NORDER, SET + LOGICAL SET + IF (.NOT.SET) CALL CtLhLAMCWZ + IF ((I.LE.0).OR.(I.GT.9)) THEN + print *,'warning I OUT OF RANGE IN CtLhAMHATF' + CtLhAMHATF = 0 + ELSE + CtLhAMHATF = AMHAT(I) + ENDIF + RETURN +END FUNCTION CtLhAMHATF + + +FUNCTION CtLhDXDZ (Z) + IMPLICIT DOUBLE PRECISION (A-H, O-Z) + PARAMETER (D0=0D0, D1=1D0, D2=2D0, D3=3D0, D4=4D0, D10=1D1) + DATA HUGE, IWRN / 1.E20, 0 / + ZZ = Z + X = CtLhXFRMZ (ZZ) + TEM = CtLhDZDX (X) + IF (TEM .NE. D0) THEN + TMP = D1 / TEM + Else + CALL CtLhWARNR(IWRN, 'CtLhDXDZ singular in CtLhDXDZ; set=HUGE', & + & 'Z', Z, D0, D1, 0) + TMP = HUGE + EndIf + CtLhDXDZ = TMP + RETURN +END FUNCTION CtLhDXDZ + + +SUBROUTINE CtLhEVLPAR (IACT, NAME, VALUE, IRET) + IMPLICIT DOUBLE PRECISION (A-H, O-Z) + CHARACTER*(*) NAME + IRET = 1 + IF (IACT .EQ. 0) THEN + WRITE ( NINT(VALUE) , 101) +101 FORMAT (/ ' Initiation parameters: Qini, Ipd0, Ihdn ' / & + & ' Maximum Q, Order of Alpha: Qmax, IKNL ' / & + & ' X- mesh parameters : Xmin, Xcr, Nx ' / & + & ' LnQ-mesh parameters : Nt, Jt ' / & + & ' # of parton flavors : NfMx ' /) + IRET = 4 + ElseIF (IACT .EQ. 1) THEN + CALL CtLhEVLSET (NAME, VALUE, IRET) + Else + print *,'fatal evlpar' + stop + EndIf + RETURN +END SUBROUTINE CtLhEVLPAR + + +SUBROUTINE CtLhEVLSET (NAME, VALUE, IRET) + IMPLICIT DOUBLE PRECISION (A-H, O-Z) + LOGICAL LSTX + CHARACTER*(*) NAME + PARAMETER (MXX = 105, MXQ = 25, MXF = 6) + PARAMETER (MXPN = MXF * 2 + 2) + PARAMETER (MXQX= MXQ * MXX, MXPQX = MXQX * MXPN) + COMMON / LhCtXXARAY / XCR, XMIN, XV(0:MXX), LSTX, NX + COMMON / LhCtQARAY1 / QINI,QMAX, QV(0:MXQ),TV(0:MXQ), NT,JT,NG + COMMON / LhCtEVLPAC / AL, IKNL, IPD0, IHDN, NfMx & + & / PdfSwh / Iset, IpdMod, Iptn0, NuIni + IRET = 1 + IF (NAME .EQ. 'QINI') THEN + IF (VALUE .LE. 0) GOTO 12 + QINI = VALUE + ElseIF (NAME .EQ. 'IPD0') THEN + ITEM = NINT(VALUE) + IF (Item .Eq. 10 .or. Item .Eq. 11) GOTO 12 + IPD0 = ITEM + ElseIF (NAME .EQ. 'IHDN') THEN + ITEM = NINT(VALUE) + IF (ITEM .LT. -1 .OR. ITEM .GT. 5) GOTO 12 + IHDN = ITEM + ElseIF (NAME .EQ. 'QMAX') THEN + IF (VALUE .LE. QINI) GOTO 12 + QMAX = VALUE + ElseIF (NAME .EQ. 'IKNL') THEN + ITMP = NINT(VALUE) + ITEM = ABS(ITMP) + IF (ITEM.NE.1.AND.ITEM.NE.2) GOTO 12 + IKNL = ITMP + ElseIF (NAME .EQ. 'XCR') THEN + IF (VALUE .LT. XMIN .OR. VALUE .GT. 10.) GOTO 12 + XCR = VALUE + LSTX = .FALSE. + ElseIF (NAME .EQ. 'XMIN') THEN + IF (VALUE .LT. 1D-7 .OR. VALUE .GT. 1D0) GOTO 12 + XMIN = VALUE + LSTX = .FALSE. + ElseIF (NAME .EQ. 'NX') THEN + ITEM = NINT(VALUE) + IF (ITEM .LT. 10 .OR. ITEM .GT. MXX-1) GOTO 12 + NX = ITEM + LSTX = .FALSE. + ElseIF (NAME .EQ. 'NT') THEN + ITEM = NINT(VALUE) + IF (ITEM .LT. 2 .OR. ITEM .GT. MXQ) GOTO 12 + NT = ITEM + ElseIF (NAME .EQ. 'JT') THEN + ITEM = NINT(VALUE) + IF (ITEM .LT. 1 .OR. ITEM .GT. 5) GOTO 12 + JT = ITEM + ElseIF (NAME .EQ. 'NFMX') THEN + ITEM = NINT(VALUE) + IF (ITEM .LT. 1 .OR. ITEM .GT. MXPN) GOTO 12 + NfMx = ITEM + ElseIF (NAME .EQ. 'IPDMOD') THEN + ITEM = NINT(VALUE) + IF (Abs(Item) .Gt. 1) GOTO 12 + IpdMod = ITEM + ElseIF (NAME .EQ. 'IPTN0') THEN + ITEM = NINT(VALUE) + IF (ABS(ITEM) .GT. MXF) GOTO 12 + IPTN0 = ITEM + ElseIF (NAME .EQ. 'NUINI') THEN + ITEM = NINT(VALUE) + IF (ITEM .LE. 0) GOTO 12 + NuIni = ITEM + Else + IRET = 0 + EndIf + RETURN +12 IRET = 2 + RETURN +END SUBROUTINE CtLhEVLSET + + +SUBROUTINE CtLhEVOLVE (FINI, IRET) + IMPLICIT DOUBLE PRECISION (A-H, O-Z) + include 'parmsetup.inc' + LOGICAL LSTX + PARAMETER (MXX = 105, MXQ = 25, MXF = 6) + PARAMETER (MXPN = MXF * 2 + 2) + PARAMETER (MXQX= MXQ * MXX, MXPQX = MXQX * MXPN) + PARAMETER (M1=-3, M2=3, NDG=3, NDH=NDG+1, L1=M1-1, L2=M2+NDG-2) + COMMON / LhCtXXARAY / XCR, XMIN, XV(0:MXX), LSTX, NX + COMMON / LhCtQARAY1 / QINI,QMAX, QV(0:MXQ),TV(0:MXQ), NT,JT,NG + COMMON / LhCtQARAY2 / TLN(MXF), DTN(MXF), NTL(MXF), NTN(MXF) + COMMON / LhCtEVLPAC / AL, IKNL, IPD0, IHDN, NfMx + COMMON / LhCtPEVLDT / UPD(MXPQX,nmxset), KF, Nelmt + COMMON / LhCtVARIBX / XA(MXX, L1:L2), ELY(MXX), DXTZ(MXX) + COMMON / LhCtVARBAB / GB(NDG, NDH, MXX), H(NDH, MXX, M1:M2) + DIMENSION QRKP(MXF) + DIMENSION JI(-MXF : MXF+1) + EXTERNAL LhCtNSRHSP, LhCtNSRHSM, FINI + DATA DZER / 0.0 / + save nxsave, ntsave, jtsave, ngsave, & + & xcrsave, xminsave, qinisave, qmaxsave, ientry + data ientry / 0 / + ! + call getnset(iset) + ! + ientry = ientry + 1 + IRET = 0 + IF (IHDN .LE. 4) THEN + MXVAL = 2 + ElseIF (IHDN .LE. 6) THEN + MXVAL = 3 + EndIf + IF (.NOT. LSTX) CALL CtLhXARRAY + CALL CtLhPARPDF (2, 'ALAM', AL, IR) + CALL CtLhQARRAY (NINI) + NFSN = NFMX + 1 + KF = 2 * NFMX + 2 + Nelmt = KF * (Nt+1) * (Nx+1) + DO IFLV = -NFMX, NFMX+1 + JFL = NFMX + IFLV + JI(IFLV) = JFL * (NT+1) * (NX+1) + END DO + DO IZ = 1, NX + UPD(JI(0)+IZ+1,iset) = FINI (0, XV(IZ)) + UPD(JI(NFSN)+IZ+1,iset) = 0 + IF (NFMX .EQ. 0) EXIT + DO IFLV = 1, NINI + A = FINI ( IFLV, XV(IZ)) + B = FINI (-IFLV, XV(IZ)) + QRKP (IFLV) = A + B + UPD(JI(NFSN)+IZ+1,iset) = & + & UPD(JI(NFSN)+IZ+1,iset) + QRKP (IFLV) + UPD(JI(-IFLV)+IZ+1,iset) = A - B + END DO + DO IFLV = 1, NINI + UPD(JI( IFLV)+IZ+1,iset) = & + & QRKP(IFLV) - UPD(JI(NFSN)+IZ+1,iset)/NINI + END DO + END DO + DO NEFF = NINI, NFMX + IF (IKNL .EQ. 2) CALL CtLhSTUPKL (NEFF) + ICNT = NEFF - NINI + 1 + IF (NTN(ICNT) .EQ. 0) EXIT + NITR = NTN (ICNT) + DT = DTN (ICNT) + TIN = TLN (ICNT) + CALL CtLhSNEVL (IKNL, NX, NITR, JT, DT, TIN, NEFF, & + & UPD(JI(NFSN)+2,iset), UPD(JI(0)+2,iset), & + & UPD(JI(NFSN)+1,iset), UPD(JI(0)+1,iset)) + IF (NEFF .EQ. 0) GOTO 88 + DO IFLV = 1, NEFF + CALL CtLhNSEVL (LhCtNSRHSP, IKNL, NX, NITR, JT, DT, TIN, & + & NEFF, UPD(JI( IFLV)+2,iset), UPD(JI( IFLV)+1,iset)) + IF (IFLV .LE. MXVAL) & + & CALL CtLhNSEVL (LhCtNSRHSM, IKNL, NX, NITR, JT, DT, TIN, & + & NEFF, UPD(JI(-IFLV)+2,iset), UPD(JI(-IFLV)+1,iset)) + DO IS = 0, NITR + DO IX = 0, NX + TP = UPD (IS*(NX+1) + IX + 1 + JI( IFLV),iset) + TS = UPD (IS*(NX+1) + IX + 1 + JI( NFSN),iset) / NEFF + TP = TP + TS + IF (IKNL .GT. 0) TP = MAX (TP, DZER) + IF (IFLV .LE. MXVAL) THEN + TM = UPD (IS*(NX+1) + IX + 1 + JI(-IFLV),iset) + IF (IKNL .GT. 0) THEN + TM = MAX (TM, DZER) + TP = MAX (TP, TM) + EndIf + Else + TM = 0. + EndIf + UPD (JI( IFLV) + IS*(NX+1) + IX + 1,iset) = (TP + TM)/2. + UPD (JI(-IFLV) + IS*(NX+1) + IX + 1,iset) = (TP - TM)/2. + END DO + END DO + END DO + DO IFLV = NEFF + 1, NFMX + DO IS = 0, NITR + DO IX = 0, NX + UPD(JI( IFLV) + IS*(NX+1) + IX + 1,iset) = 0 + UPD(JI(-IFLV) + IS*(NX+1) + IX + 1,iset) = 0 + END DO + END DO + END DO +88 CONTINUE + IF (NFMX .EQ. NEFF) EXIT + DO IFLV = -NFMX, NFMX+1 + JI(IFLV) = JI(IFLV) + NITR * (NX+1) + END DO + CALL CtLhHQRK (NX, TT, NEFF+1, UPD(JI(0)+2,iset), & + & UPD(JI(NEFF+1)+2,iset)) + DO IZ = 1, NX + QRKP (NEFF+1) = 2. * UPD(JI( NEFF+1) + IZ + 1,iset) + UPD (JI(NFSN)+IZ+1,iset) = UPD (JI(NFSN)+IZ+1,iset) & + & + QRKP (NEFF+1) + VS00 = UPD (JI(NFSN)+IZ+1,iset) / (NEFF+1) + UPD(JI( NEFF+1) + IZ + 1,iset) = QRKP(NEFF+1) - VS00 + DO IFL = 1, NEFF + A = UPD(JI( IFL)+IZ+1,iset) + B = UPD(JI(-IFL)+IZ+1,iset) + QRKP(IFL) = A + B + UPD(JI( IFL)+IZ+1,iset) = QRKP(IFL) - VS00 + IF (IFL .LE. MXVAL) UPD(JI(-IFL)+IZ+1,iset) = A - B + END DO + END DO + END DO + if(ientry .eq. 1) then + nxsave = nx + ntsave = nt + jtsave = jt + ngsave = ng + xcrsave = xcr + xminsave = xmin + qinisave = qini + qmaxsave = qmax + endif + if((nx .ne. nxsave) .or. & + & (nt .ne. ntsave) .or. & + & (jt .ne. jtsave) .or. & + & (ng .ne. ngsave) .or. & + & (xcr .ne. xcrsave) .or. & + & (xmin .ne. xminsave) .or. & + & (qini .ne. qinisave) .or. & + & (qmax .ne. qmaxsave)) then + write(6,669) nx, nt, jt, ng, xcr, xmin, & + & qini, qmax, ientry +669 format(1x,'evolve.f: nx,nt,jt,ng=',4i4, & + & ' xcr,xmin=',2f9.6, & + & ' qini, qmax',f7.4,1x,e12.5,' ientry=',i6) + nxsave = nx + ntsave = nt + jtsave = jt + ngsave = ng + qinisave = qini + qmaxsave = qmax + xcrsave = xcr + xminsave = xmin + endif + Return +END SUBROUTINE CtLhEVOLVE + + +FUNCTION CtLhFINTRP (FF, X0, DX, NX, XV, ERR, IR) + IMPLICIT DOUBLE PRECISION (A-H, O-Z) + PARAMETER (D0=0D0, D1=1D0, D2=2D0, D3=3D0, D4=4D0, D10=1D1) + PARAMETER (MX = 3) + DIMENSION FF (0:NX), XX(MX) + DATA SML, XX / 1.D-5, 0., 1.0, 2.0 / + DATA IW1, IW3, IW5 / 3 * 0 / + IR = 0 + X = XV + ERR = 0. + ANX = NX + CtLhFINTRP = 0. + IF (NX .LT. 1) THEN + CALL CtLhWARNI(IW1, 'Nx < 1, error in CtLhFINTRP.', & + & 'NX', NX, 1, 256, 1) + IR = 1 + RETURN + ELSE + MNX = MIN(NX+1, MX) + ENDIF + IF (DX .LE. 0) THEN + CALL CtLhWARNR(IW3, 'DX < 0, error in CtLhFINTRP.', & + & 'DX', DX, D0, D1, 1) + IR = 2 + RETURN + ENDIF + XM = X0 + DX * NX + IF (X .LT. X0-SML .OR. X .GT. XM+SML) THEN + CALL CtLhWARNR(IW5, & + & 'X out of range in CtLhFINTRP, Extrapolation used.', & + & 'X',X,X0,XM,1) + IR = 3 + ENDIF + TX = (X - X0) / DX + IF (TX .LE. 1.) THEN + IX = 0 + ELSEIF (TX .GE. ANX-1.) THEN + IX = NX - 2 + ELSE + IX = Int(TX) + ENDIF + DDX = TX - IX + CALL CtLhRATINT (XX, FF(IX), MNX, DDX, TEM, ERR) + CtLhFINTRP = TEM + RETURN +END FUNCTION CtLhFINTRP + + +FUNCTION CtLhGausInt(F,XL,XR,AERR,RERR,ERR,IRT) + IMPLICIT DOUBLE PRECISION (A-H, O-Z) + DIMENSION XLIMS(100), R(93), W(93) + INTEGER PTR(4),NORD(4) + external f + DATA PTR,NORD/4,10,22,46, 6,12,24,48/ + DATA R/.2386191860,.6612093865,.9324695142, & + & .1252334085,.3678314990,.5873179543,.7699026742,.9041172563, & + & .9815606342,.0640568929,.1911188675,.3150426797,.4337935076, & + & .5454214714,.6480936519,.7401241916,.8200019860,.8864155270, & + & .9382745520,.9747285560,.9951872200,.0323801710,.0970046992, & + & .1612223561,.2247637903,.2873624873,.3487558863,.4086864820, & + & .4669029048,.5231609747,.5772247261,.6288673968,.6778723796, & + & .7240341309,.7671590325,.8070662040,.8435882616,.8765720203, & + & .9058791367,.9313866907,.9529877032,.9705915925,.9841245837, & + & .9935301723,.9987710073,.0162767488,.0488129851,.0812974955, & + & .1136958501,.1459737146,.1780968824,.2100313105,.2417431561, & + & .2731988126,.3043649444,.3352085229,.3656968614,.3957976498, & + & .4254789884,.4547094222,.4834579739,.5116941772,.5393881083, & + & .5665104186,.5930323648,.6189258401,.6441634037,.6687183100, & + & .6925645366,.7156768123,.7380306437,.7596023411,.7803690438, & + & .8003087441,.8194003107,.8376235112,.8549590334,.8713885059, & + & .8868945174,.9014606353,.9150714231,.9277124567,.9393703398, & + & .9500327178,.9596882914,.9683268285,.9759391746,.9825172636, & + & .9880541263,.9925439003,.9959818430,.9983643759,.9996895039/ + DATA W/.4679139346,.3607615730,.1713244924, & + & .2491470458,.2334925365,.2031674267,.1600783285,.1069393260, & + & .0471753364,.1279381953,.1258374563,.1216704729,.1155056681, & + & .1074442701,.0976186521,.0861901615,.0733464814,.0592985849, & + & .0442774388,.0285313886,.0123412298,.0647376968,.0644661644, & + & .0639242386,.0631141923,.0620394232,.0607044392,.0591148397, & + & .0572772921,.0551995037,.0528901894,.0503590356,.0476166585, & + & .0446745609,.0415450829,.0382413511,.0347772226,.0311672278, & + & .0274265097,.0235707608,.0196161605,.0155793157,.0114772346, & + & .0073275539,.0031533461,.0325506145,.0325161187,.0324471637, & + & .0323438226,.0322062048,.0320344562,.0318287589,.0315893308, & + & .0313164256,.0310103326,.0306713761,.0302999154,.0298963441, & + & .0294610900,.0289946142,.0284974111,.0279700076,.0274129627, & + & .0268268667,.0262123407,.0255700360,.0249006332,.0242048418, & + & .0234833991,.0227370697,.0219666444,.0211729399,.0203567972, & + & .0195190811,.0186606796,.0177825023,.0168854799,.0159705629, & + & .0150387210,.0140909418,.0131282296,.0121516047,.0111621020, & + & .0101607705,.0091486712,.0081268769,.0070964708,.0060585455, & + & .0050142027,.0039645543,.0029107318,.0018539608,.0007967921/ + DATA TOLABS,TOLREL,NMAX/1.E-35,5.E-4,100/ + TOLABS=AERR + TOLREL=RERR + + CtLhGausInt=0. + NLIMS=2 + XLIMS(1)=XL + XLIMS(2)=XR +10 AA=(XLIMS(NLIMS)-XLIMS(NLIMS-1))/2D0 + BB=(XLIMS(NLIMS)+XLIMS(NLIMS-1))/2D0 + TVAL=0. + DO 15 I=1,3 +15 TVAL=TVAL+W(I)*(F(BB+AA*R(I))+F(BB-AA*R(I))) + TVAL=TVAL*AA + DO 25 J=1,4 + VAL=0. + DO 20 I=PTR(J),PTR(J)-1+NORD(J) +20 VAL=VAL+W(I)*(F(BB+AA*R(I))+F(BB-AA*R(I))) + VAL=VAL*AA + TOL=MAX(TOLABS,TOLREL*ABS(VAL)) + IF (ABS(TVAL-VAL).LT.TOL) THEN + CtLhGausInt=CtLhGausInt+VAL + NLIMS=NLIMS-2 + IF (NLIMS.NE.0) GOTO 10 + RETURN + END IF +25 TVAL=VAL + IF (NMAX.EQ.2) THEN + CtLhGausInt=VAL + RETURN + END IF + IF (NLIMS.GT.(NMAX-2)) THEN + write(*,50) CtLhGausInt,NMAX,BB-AA,BB+AA + RETURN + END IF + XLIMS(NLIMS+1)=BB + XLIMS(NLIMS+2)=BB+AA + XLIMS(NLIMS)=BB + NLIMS=NLIMS+2 + GOTO 10 +50 FORMAT (' CtLhGausInt FAILS, CtLhGausInt,NMAX,XL,XR=', & + & G15.7,I5,2G15.7) + END + SUBROUTINE CtLhHINTEG (NX, F, H) + IMPLICIT DOUBLE PRECISION (A-H, O-Z) + PARAMETER (MXX = 105, MXQ = 25, MXF = 6) + PARAMETER (MXPN = MXF * 2 + 2) + PARAMETER (MXQX= MXQ * MXX, MXPQX = MXQX * MXPN) + PARAMETER (M1=-3, M2=3, NDG=3, NDH=NDG+1, L1=M1-1, L2=M2+NDG-2) + COMMON / LhCtHINTEC / GH(NDG, MXX) + COMMON / LhCtVARIBX / XA(MXX, L1:L2), ELY(MXX), DXTZ(MXX) + DIMENSION F(NX), H(NX), G(MXX) + DZ = 1D0 / (NX-1) + DO 20 I = 1, NX-2 + NP = NX - I + 1 + TEM = GH(1,I)*F(I) + GH(2,I)*F(I+1) + GH(3,I)*F(I+2) + DO 30 KZ = 3, NP + IY = I + KZ - 1 + W = XA(I,1) / XA(IY,1) + G(KZ) = DXTZ(IY)*(F(IY)-W*F(I))/(1.-W) + 30 CONTINUE + HTEM = CtLhSMPSNA (NP-2, DZ, G(3), ERR) + TEM1 = F(I) * ELY(I) + H(I) = TEM + HTEM + TEM1 + 20 END DO + H(NX-1) = F(NX) - F(NX-1) + F(NX-1) * (ELY(NX-1) - XA(NX-1,0)) + H(NX) = 0 + RETURN + END + SUBROUTINE CtLhHQRK (NX, TT, NQRK, Y, F) + IMPLICIT DOUBLE PRECISION (A-H, O-Z) + PARAMETER (MXX = 105, MXQ = 25, MXF = 6) + DIMENSION Y(NX), F(NX) + IF (NX .GT. 1) GOTO 11 +11 CONTINUE + DO IZ = 1, NX + IF (NX .GT. 1) THEN + F(IZ) = 0 + EXIT + EndIf + END DO + RETURN + END + + + SUBROUTINE CtLhINTEGR (NX, M, F, G, IR) + IMPLICIT DOUBLE PRECISION (A-H, O-Z) + CHARACTER MSG*80 + PARAMETER (MXX = 105, MXQ = 25, MXF = 6) + PARAMETER (MXPN = MXF * 2 + 2) + PARAMETER (MXQX= MXQ * MXX, MXPQX = MXQX * MXPN) + PARAMETER (M1=-3, M2=3, NDG=3, NDH=NDG+1, L1=M1-1, L2=M2+NDG-2) + COMMON / LhCtVARIBX / XA(MXX, L1:L2), ELY(MXX), DXTZ(MXX) + COMMON / LhCtVARBAB / GB(NDG, NDH, MXX), H(NDH, MXX, M1:M2) + DIMENSION F(NX), G(NX) + DATA IWRN1, IWRN2 / 0, 0 / + IRR = 0 + IF (NX .LT. 1 .OR. XA(NX-1,1) .EQ. 0D0) THEN + MSG = 'NX out of range in CtLhINTEGR call' + CALL CtLhWARNI (IWRN1, MSG, 'NX', NX, 0, MXX, 0) + IRR = 1 + EndIf + IF (M .LT. M1 .OR. M .GT. M2) THEN + MSG ='Exponent M out of range in CtLhINTEGR' + CALL CtLhWARNI (IWRN2, MSG, 'M', M, M1, M2, 1) + IRR = 2 + EndIf + G(NX) = 0D0 + TEM = H(1, NX-1, -M) * F(NX-2) + H(2, NX-1, -M) * F(NX-1) & + & + H(3, NX-1, -M) * F(NX) + IF (M .EQ. 0) THEN + G(NX-1) = TEM + Else + G(NX-1) = TEM * XA(NX-1, M) + EndIf + DO 10 I = NX-2, 2, -1 + TEM = TEM + H(1,I,-M)*F(I-1) + H(2,I,-M)*F(I) & + & + H(3,I,-M)*F(I+1) + H(4,I,-M)*F(I+2) + IF (M .EQ. 0) THEN + G(I) = TEM + Else + G(I) = TEM * XA(I, M) + EndIf + 10 END DO + TEM = TEM + H(2,1,-M)*F(1) + H(3,1,-M)*F(2) + H(4,1,-M)*F(3) + IF (M .EQ. 0) THEN + G(1) = TEM + Else + G(1) = TEM * XA(1, M) + EndIf + IR = IRR + RETURN + END + + + SUBROUTINE CtLhKERNEL & + &(XX, FF1, FG1, GF1, GG1, PNSP, PNSM, FF2, FG2, GF2, GG2, NFL, IRT) + IMPLICIT DOUBLE PRECISION (A-H, O-Z) + PARAMETER (PI = 3.141592653589793d0, PI2 = PI ** 2) + PARAMETER (D0 = 0.0, D1 = 1.0) + DATA CF, CG, TR, IWRN / 1.33333333333333d0, 3.0d0, 0.5d0, 0 / + IRT = 0 + TRNF = TR * NFL + X = XX + IF (X .LE. 0. .OR. X .GE. 1.) THEN + CALL CtLhWARNR(IWRN, 'X out of range in CtLhKERNEL', 'X', X, & + & D0, D1, 1) + IRT = 1 + RETURN + EndIf + XI = 1./ X + X2 = X ** 2 + XM1I = 1./ (1.- X) + XP1I = 1./ (1.+ X) + XLN = LOG (X) + XLN2 = XLN ** 2 + XLN1M = LOG (1.- X) + SPEN2 = CtLhSPENC2 (X) + FFP = (1.+ X2) * XM1I + FGP = (2.- 2.* X + X2) / X + GFP = 1. - 2.* X + 2.* X2 + GGP = XM1I + XI - 2. + X - X2 + FFM = (1.+ X2) * XP1I + FGM = - (2.+ 2.* X + X2) / X + GFM = 1. + 2.* X + 2.* X2 + GGM = XP1I - XI - 2. - X - X2 + FF1 = CF * FFP * (1.- X) + FG1 = CF * FGP * X + GF1 = 2.* TRNF * GFP + GG1 = 2.* CG * GGP * X * (1.-X) + PCF2 = -2.* FFP *XLN*XLN1M - (3.*XM1I + 2.*X)*XLN & + & - (1.+X)/2.*XLN2 - 5.*(1.-X) + PCFG = FFP * (XLN2 + 11.*XLN/3.+ 67./9.- PI**2 / 3.) & + & + 2.*(1.+X) * XLN + 40.* (1.-X) / 3. + PCFT = (FFP * (- XLN - 5./3.) - 2.*(1.-X)) * 2./ 3. + PQQB = 2.* FFM * SPEN2 + 2.*(1.+X)*XLN + 4.*(1.-X) + PQQB = (CF**2-CF*CG/2.) * PQQB + PQQ2 = CF**2 * PCF2 + CF*CG * PCFG / 2. + CF*TRNF * PCFT + PNSP = (PQQ2 + PQQB) * (1.-X) + PNSM = (PQQ2 - PQQB) * (1.-X) + FFCF2 = - 1. + X + (1.- 3.*X) * XLN / 2. - (1.+ X) * XLN2 / 2. & + & - FFP * (3.* XLN / 2. + 2.* XLN * XLN1M) & + & + FFM * 2.* SPEN2 + FFCFG = 14./3.* (1.-X) & + & + FFP * (11./6.* XLN + XLN2 / 2. + 67./18. - PI2 / 6.) & + & - FFM * SPEN2 + FFCFT = - 16./3. + 40./3.* X + (10.* X + 16./3.* X2 + 2.) * XLN & + & - 112./9.* X2 + 40./9./X - 2.* (1.+ X) * XLN2 & + & - FFP * (10./9. + 2./3. * XLN) + FGCF2 = - 5./2.- 7./2.* X + (2.+ 7./2.* X) * XLN + (X/2.-1.)*XLN2 & + & - 2.* X * XLN1M & + & - FGP * (3.* XLN1M + XLN1M ** 2) + FGCFG = 28./9. + 65./18.* X + 44./9. * X2 - (12.+ 5.*X + 8./3.*X2)& + & * XLN + (4.+ X) * XLN2 + 2.* X * XLN1M & + & + FGP * (-2.*XLN*XLN1M + XLN2/2. + 11./3.*XLN1M + XLN1M**2 & + & - PI2/6. + 0.5) & + & + FGM * SPEN2 + FGCFT = -4./3.* X - FGP * (20./9.+ 4./3.*XLN1M) + GFCFT = 4.- 9.*X + (-1.+ 4.*X)*XLN + (-1.+ 2.*X)*XLN2 + 4.*XLN1M & + & + GFP * (-4.*XLN*XLN1M + 4.*XLN + 2.*XLN2 - 4.*XLN1M & + & + 2.*XLN1M**2 - 2./3.* PI2 + 10.) + GFCGT = 182./9.+ 14./9.*X + 40./9./X + (136./3.*X - 38./3.)*XLN & + & - 4.*XLN1M - (2.+ 8.*X)*XLN2 & + & + GFP * (-XLN2 + 44./3.*XLN - 2.*XLN1M**2 + 4.*XLN1M & + & + PI2/3. - 218./9.) & + & + GFM * 2. * SPEN2 + GGCFT = -16.+ 8.*X + 20./3.*X2 + 4./3./X + (-6.-10.*X)*XLN & + & - 2.* (1.+ X) * XLN2 + GGCGT = 2.- 2.*X + 26./9.*X2 - 26./9./X - 4./3.*(1.+X)*XLN & + & - GGP * 20./9. + GGCG2 = 27./2.*(1.-X) + 67./9.*(X2-XI) + 4.*(1.+X)*XLN2 & + & + (-25.+ 11.*X - 44.*X2)/3.*XLN & + & + GGP * (67./9.- 4.*XLN*XLN1M + XLN2 - PI2/3.) & + & + GGM * 2.* SPEN2 + FF2 = CF * TRNF * FFCFT + CF ** 2 * FFCF2 + CF * CG * FFCFG + FG2 = CF * TRNF * FGCFT + CF ** 2 * FGCF2 + CF * CG * FGCFG + GF2 = CF * TRNF * GFCFT + CG * TRNF * GFCGT + GG2 = CF * TRNF * GGCFT + CG ** 2 * GGCG2 + CG * TRNF * GGCGT + XLG = (LOG(1./(1.-X)) + 1.) + XG2 = XLG ** 2 + FF2 = FF2 * X * (1.- X) + FG2 = FG2 * X / XG2 + GF2 = GF2 * X / XG2 + GG2 = GG2 * X * (1.- X) + RETURN + END + + + SUBROUTINE CtLhLAMCWZ + IMPLICIT DOUBLE PRECISION (A-H, O-Z) + COMMON / LhCtQCDPAR_LHA / AL, NF, NORDER, SET + LOGICAL SET + CALL CtLhSETL1 (NF, AL) + END + + + FUNCTION LhCtNAMQCD(NNAME) + IMPLICIT DOUBLE PRECISION (A-H, O-Z) + CHARACTER NNAME*(*), NAME*8 + COMMON / LhCtQCDPAR_LHA / AL, NF, NORDER, SET + LOGICAL SET + CHARACTER ONECH*(1) + ONECH = '0' + IASC0 = ICHAR(ONECH) + NAME = NNAME + LhCtNAMQCD=0 + IF ( (NAME .EQ. 'ALAM') .OR. (NAME .EQ. 'LAMB') .OR. & + & (NAME .EQ. 'LAM') .OR. (NAME .EQ. 'LAMBDA') ) & + & LhCtNAMQCD=1 + IF ( (NAME .EQ. 'NFL') .OR. (NAME(1:3) .EQ. '#FL') .OR. & + & (NAME .EQ. '# FL') ) & + & LhCtNAMQCD=2 + DO 10 I=1, 9 + IF (NAME .EQ. 'M'//CHAR(I+IASC0)) & + & LhCtNAMQCD=I+2 + 10 CONTINUE + DO 20 I= 0, NF + IF (NAME .EQ. 'LAM'//CHAR(I+IASC0)) & + & LhCtNAMQCD=I+13 + 20 CONTINUE + IF (NAME(:3).EQ.'ORD' .OR. NAME(:3).EQ.'NRD') LhCtNAMQCD = 24 + RETURN + END + + + FUNCTION LhCtNFL(AMU) + IMPLICIT DOUBLE PRECISION (A-H, O-Z) + COMMON / LhCtCWZPRM / ALAM(0:9), AMHAT(0:9), AMN, NHQ + COMMON / LhCtQCDPAR_LHA / AL, NF, NORDER, SET + LOGICAL SET + IF (.NOT. SET) CALL CtLhLAMCWZ + LhCtNFL = NF - NHQ + IF ((LhCtNFL .EQ. NF) .OR. (AMU .LE. AMN)) GOTO 20 + DO 10 I = NF - NHQ + 1, NF + IF (AMU .GE. AMHAT(I)) THEN + LhCtNFL = I + ELSE + GOTO 20 + ENDIF + 10 CONTINUE + 20 RETURN + END + + + SUBROUTINE CtLhNSEVL (RHS, IKNL,NX,NT,JT,DT,TIN,NEFF,U0,UN) + IMPLICIT DOUBLE PRECISION (A-H, O-Z) + PARAMETER (MXX = 105, MXQ = 25, MXF = 6) + PARAMETER (MXPN = MXF * 2 + 2) + PARAMETER (MXQX= MXQ * MXX, MXPQX = MXQX * MXPN) + PARAMETER (M1=-3, M2=3, NDG=3, NDH=NDG+1, L1=M1-1, L2=M2+NDG-2) + COMMON / LhCtVARIBX / XA(MXX, L1:L2), ELY(MXX), DXTZ(MXX) + DIMENSION U0(NX), UN(0:NX, 0:NT) + DIMENSION Y0(MXX), Y1(MXX), YP(MXX), F0(MXX), F1(MXX), FP(MXX) + external rhs + DDT = DT / JT + IF (NX .GT. MXX) THEN + WRITE (*,*) 'Nx =', NX, ' greater than Max pts in CtLhNSEVL.' + STOP 'Program stopped in CtLhNSEVL' + EndIf +! ++ remove unused quantities (jcp) +! ++ TMD = TIN + DT * NT / 2. +! ++ AMU = EXP(TMD) +! ++ TEM = 6./ (33.- 2.* NEFF) / CtLhALPI(AMU) +! ++ TLAM = TMD - TEM + DO 9 IX = 1, NX + UN(IX, 0) = U0(IX) + 9 END DO + UN(0, 0) = 3D0*U0(1) - 3D0*U0(2) - U0(1) + TT = TIN + DO 10 IZ = 1, NX + Y0(IZ) = U0(IZ) + 10 END DO + DO 20 IS = 1, NT + DO 202 JS = 1, JT + IRND = (IS-1) * JT + JS + IF (IRND .EQ. 1) THEN + CALL RHS (TT, Neff, Y0, F0) + DO 250 IZ = 1, NX + Y0(IZ) = Y0(IZ) + DDT * F0(IZ) + 250 CONTINUE + TT = TT + DDT + CALL RHS (TT, NEFF, Y0, F1) + DO 251 IZ = 1, NX + Y1(IZ) = U0(IZ) + DDT * (F0(IZ) + F1(IZ)) / 2D0 + 251 CONTINUE + Else + CALL RHS (TT, NEFF, Y1, F1) + DO 252 IZ = 1, NX + YP(IZ) = Y1(IZ) + DDT * (3D0 * F1(IZ) - F0(IZ)) / 2D0 + 252 CONTINUE + TT = TT + DDT + CALL RHS (TT, NEFF, YP, FP) + DO 253 IZ = 1, NX + Y1(IZ) = Y1(IZ) + DDT * (FP(IZ) + F1(IZ)) / 2D0 + F0(IZ) = F1(IZ) + 253 CONTINUE + EndIf + 202 CONTINUE + DO 260 IZ = 1, NX + UN (IZ, IS) = Y1(IZ) + 260 CONTINUE + UN(0, IS) = 3D0*Y1(1) - 3D0*Y1(2) + Y1(3) + 20 END DO + RETURN + END + + + SUBROUTINE LhCtNSRHSM (TT, NEFF, FI, FO) + IMPLICIT DOUBLE PRECISION (A-H, O-Z) + LOGICAL LSTX + PARAMETER (MXX = 105, MXQ = 25, MXF = 6) + PARAMETER (M1=-3, M2=3, NDG=3, NDH=NDG+1, L1=M1-1, L2=M2+NDG-2) + COMMON / LhCtVARIBX / XA(MXX, L1:L2), ELY(MXX), DXTZ(MXX) + COMMON / LhCtXXARAY / XCR, XMIN, XV(0:MXX), LSTX, NX + COMMON / LhCtXYARAY / ZZ(MXX, MXX), ZV(0:MXX) + COMMON / LhCtKRNL01 / AFF2(MXX),AFG2(MXX),AGF2(MXX),AGG2(MXX), & + & ANSP (MXX), ANSM (MXX), ZFG2, ZGF2, ZQQB + COMMON / LhCtKRN2ND / FFG(MXX, MXX), GGF(MXX, MXX), PNS(MXX, MXX) + COMMON / LhCtEVLPAC / AL, IKNL, IPD0, IHDN, NfMx + DIMENSION G1(MXX), FI(NX), FO(NX) + DIMENSION W0(MXX), W1(MXX), WH(MXX) + S = EXP(TT) + Q = AL * EXP (S) + CPL = CtLhALPI(Q) + CPL2= CPL ** 2 / 2. * S + CPL = CPL * S + CALL CtLhINTEGR (NX, 0, FI, W0, IR1) + CALL CtLhINTEGR (NX, 1, FI, W1, IR2) + CALL CtLhHINTEG (NX, FI, WH) + DO 230 IZ = 1, NX + FO(IZ) = 2.* FI(IZ) + 4./3.* ( 2.* WH(IZ) - W0(IZ) - W1(IZ)) + FO(IZ) = CPL * FO(IZ) + 230 END DO + IF (IKNL .EQ. 2) THEN + DZ = 1./ (NX - 1) + DO 21 IX = 1, NX-1 + NP = NX - IX + 1 + IS = NP + DO 31 KZ = 2, NP + IY = IX + KZ - 1 + IT = NX - IY + 1 + XY = ZZ (IS, IT) + G1(KZ) = PNS (IS,IT) * (FI(IY) - XY * FI(IX)) + 31 CONTINUE + TEM1 = CtLhSMPNOL (NP, DZ, G1, ERR) + TMP2 = (TEM1 - FI(IX) * ANSM(IX)) * CPL2 + FO(IX) = FO(IX) + TMP2 + 21 END DO + EndIf + RETURN + END + + + SUBROUTINE LhCtNSRHSP (TT, NEFF, FI, FO) + IMPLICIT DOUBLE PRECISION (A-H, O-Z) + LOGICAL LSTX + PARAMETER (MXX = 105, MXQ = 25, MXF = 6) + PARAMETER (M1=-3, M2=3, NDG=3, NDH=NDG+1, L1=M1-1, L2=M2+NDG-2) + COMMON / LhCtVARIBX / XA(MXX, L1:L2), ELY(MXX), DXTZ(MXX) + COMMON / LhCtXXARAY / XCR, XMIN, XV(0:MXX), LSTX, NX + COMMON / LhCtXYARAY / ZZ(MXX, MXX), ZV(0:MXX) + COMMON / LhCtKRNL01 / AFF2(MXX),AFG2(MXX),AGF2(MXX),AGG2(MXX), & + & ANSP (MXX), ANSM (MXX), ZFG2, ZGF2, ZQQB + COMMON / LhCtKRN2ND / FFG(MXX, MXX), GGF(MXX, MXX), PNS(MXX, MXX) + COMMON / LhCtEVLPAC / AL, IKNL, IPD0, IHDN, NfMx + DIMENSION G1(MXX), FI(NX), FO(NX) + DIMENSION W0(MXX), W1(MXX), WH(MXX) + S = EXP(TT) + Q = AL * EXP (S) + CPL = CtLhALPI(Q) + CPL2= CPL ** 2 / 2. * S + CPL = CPL * S + CALL CtLhINTEGR (NX, 0, FI, W0, IR1) + CALL CtLhINTEGR (NX, 1, FI, W1, IR2) + CALL CtLhHINTEG (NX, FI, WH) + DO 230 IZ = 1, NX + FO(IZ) = 2.* FI(IZ) + 4./3.* ( 2.* WH(IZ) - W0(IZ) - W1(IZ)) + FO(IZ) = CPL * FO(IZ) + 230 END DO + IF (IKNL .EQ. 2) THEN + DZ = 1./ (NX - 1) + DO 21 IX = 1, NX-1 + NP = NX - IX + 1 + DO 31 KZ = 2, NP + IY = IX + KZ - 1 + XY = ZZ (NX-IX+1, NX-IY+1) + G1(KZ) = PNS (IX,IY) * (FI(IY) - XY * FI(IX)) + 31 CONTINUE + TEM1 = CtLhSMPNOL (NP, DZ, G1, ERR) + TMP2 = (TEM1 + FI(IX) * (-ANSP(IX) + ZQQB)) * CPL2 + FO(IX) = FO(IX) + TMP2 + 21 END DO + EndIf + RETURN + END + + + FUNCTION CtLhPARDIS (IPRTN, XX, QQ) + IMPLICIT DOUBLE PRECISION (A-H, O-Z) + include 'parmsetup.inc' + Character Msg*80 + LOGICAL LSTX + PARAMETER (MXX = 105, MXQ = 25, MXF = 6) + PARAMETER (MXPN = MXF * 2 + 2) + PARAMETER (MXQX= MXQ * MXX, MXPQX = MXQX * MXPN) + PARAMETER (M1=-3, M2=3, NDG=3, NDH=NDG+1, L1=M1-1, L2=M2+NDG-2) + PARAMETER (Smll = 1D-9) + parameter(nqvec = 4) + COMMON / LhCtXXARAY / XCR, XMIN, XV(0:MXX), LSTX, NX + COMMON / LhCtXYARAY / ZZ(MXX, MXX), ZV(0:MXX) + COMMON / LhCtVARIBX / XA(MXX, L1:L2), ELY(MXX), DXTZ(MXX) + COMMON / LhCtQARAY1 / QINI,QMAX, QV(0:MXQ),TV(0:MXQ), NT,JT,NG + COMMON / LhCtQARAY2 / TLN(MXF), DTN(MXF), NTL(MXF), NTN(MXF) + COMMON / LhCtEVLPAC / AL, IKNL, IPD0, IHDN, NfMx + COMMON / LhCtPEVLDT / UPD(MXPQX,nmxset), KF, Nelmt + COMMON / LhCtCOMQMS / VALQMS(9) + dimension fvec(4), fij(4) + dimension xvpow(0:mxx) + Data Iwrn1, Iwrn2, Iwrn3, OneP / 3*0, 1.00001 / + !**** choice of interpolation variable + data xpow / 0.3d0 / + data nxsave / 0 / + save xvpow, nxsave + save xlast, qlast + save jq, jx, JLx, JLq, ss, sy2, sy3, s23, ty2, ty3 + save const1 , const2, const3, const4, const5, const6 + save tt, t13, t12, t23, t34 , t24, tmp1, tmp2, tdet +! + call getnset(iset) +! + if(nx .ne. nxsave) then + xvpow(0) = 0D0 + do i = 1, nx + xvpow(i) = xv(i)**xpow + enddo + nxsave = nx + endif + + X = XX + Q = QQ + +! if((x.lt.xmin).or.(x.gt.1.d0)) print 98,x +! 98 format(' WARNING: X=',e12.5,' OUT OF RANGE') +! if((q.lt.qini).or.(q.gt.qmax)) print 99,q +! 99 format(' WARNING: Q=',e12.5,' OUT OF RANGE') + +! enforce threshold early to improve speed... + ii = iabs(IPRTN) + if(ii .ne. 0) then + if(QQ .lt. VALQMS(ii) ) then + ctlhpardis = 0.d0 + return + endif + endif + +! force pardis = 0.0d0 at exactly =1.0d0 - added mrw 10/May/06 + if(xx .eq. 1.0d0) then + ctlhpardis = 0.0d0 + return + endif + +! skip the initialization in x if same as in the previous call. + if(x .eq. xlast) goto 100 + xlast = x + + JLx = -1 + JU = Nx+1 + 11 If (JU-JLx .GT. 1) Then + JM = (JU+JLx) / 2 + If (X .Ge. XV(JM)) Then + JLx = JM + Else + JU = JM + Endif + Goto 11 + Endif + If (JLx .LE. -1) Then + Print '(A,1pE12.4)','Severe error: x <= 0 in ParDis x=', x + Stop + ElseIf (JLx .Eq. 0) Then + Jx = 0 + Msg = '0 < X < Xmin in ParDis; extrapolation used!' + CALL CtLhWARNR (IWRN1, Msg, 'X', X, Xmin, 1D0, 1) + Elseif (JLx .LE. Nx-2) Then + Jx = JLx - 1 + Elseif (JLx.Eq.Nx-1 .or. x.LT.OneP) Then + Jx = JLx - 2 + Else + Print '(A,1pE12.4)','Severe error: x > 1 in ParDis x=', x + Stop + Endif + ss = x**xpow + If (JLx.Ge.2 .and. JLx.Le.Nx-2) Then + svec1 = xvpow(jx) + svec2 = xvpow(jx+1) + svec3 = xvpow(jx+2) + svec4 = xvpow(jx+3) + s12 = svec1 - svec2 + s13 = svec1 - svec3 + s23 = svec2 - svec3 + s24 = svec2 - svec4 + s34 = svec3 - svec4 + sy2 = ss - svec2 + sy3 = ss - svec3 + const1 = s13/s23 + const2 = s12/s23 + const3 = s34/s23 + const4 = s24/s23 + s1213 = s12 + s13 + s2434 = s24 + s34 + sdet = s12*s34 - s1213*s2434 + tmp = sy2*sy3/sdet + const5 = (s34*sy2-s2434*sy3)*tmp/s12 + const6 = (s1213*sy2-s12*sy3)*tmp/s34 + EndIf + + 100 continue + +! skip the initialization in q if same as in the previous call. + if(q .eq. qlast) goto 110 + qlast = q + + tt = log(log(Q/Al)) + + JLq = -1 + JU = NT+1 + 12 If (JU-JLq .GT. 1) Then + JM = (JU+JLq) / 2 + If (Q .GE. QV(JM)) Then + JLq = JM + Else + JU = JM + Endif + Goto 12 + Endif + If (JLq .LE. 0) Then + Jq = 0 + If (JLq .LT. 0) Then + Msg = 'Q < Q0 in ParDis; extrapolation used!' + CALL CtLhWARNR (IWRN2, Msg, 'Q', Q, Qini, 1D0, 1) + EndIf + Elseif (JLq .LE. Nt-2) Then + Jq = JLq - 1 + Else + Jq = Nt - 3 + If (JLq .GE. Nt) Then + Msg = 'Q > Qmax in ParDis; extrapolation used!' + CALL CtLhWARNR (IWRN3, Msg, 'Q', Q, Qmax, 1D0, 1) + Endif + Endif + + If (JLq.GE.1 .and. JLq.LE.Nt-2) Then + tvec1 = Tv(jq) + tvec2 = Tv(jq+1) + tvec3 = Tv(jq+2) + tvec4 = Tv(jq+3) + t12 = tvec1 - tvec2 + t13 = tvec1 - tvec3 + t23 = tvec2 - tvec3 + t24 = tvec2 - tvec4 + t34 = tvec3 - tvec4 + ty2 = tt - tvec2 + ty3 = tt - tvec3 + tmp1 = t12 + t13 + tmp2 = t24 + t34 + tdet = t12*t34 - tmp1*tmp2 + EndIf + + 110 continue + + jtmp = ((IPRTN + NfMx)*(NT+1)+(jq-1))*(NX+1)+jx+1 + Do it = 1, nqvec + J1 = jtmp + it*(NX+1) + If (Jx .Eq. 0) Then + fij(1) = 0 + fij(2) = Upd(J1+1,iset) * Xa(1,2) + fij(3) = Upd(J1+2,iset) * Xa(2,2) + fij(4) = Upd(J1+3,iset) * Xa(3,2) + Call CtLhPolint4 (XVpow(0), Fij(1), 4, ss, Fx, Dfx) + + If (x .GT. 0D0) Fvec(it) = Fx / x**2 + ElseIf (JLx .Eq. Nx-1) Then + Call CtLhPolint4 (XVpow(Nx-3), Upd(J1,iset), 4, ss, Fx, Dfx) + Fvec(it) = Fx + Else + sf2 = Upd(J1+1,iset) + sf3 = Upd(J1+2,iset) + Fvec(it) = (const5*(Upd(J1,iset) & + & - sf2*const1 + sf3*const2) & + & + const6*(Upd(J1+3,iset) & + & + sf2*const3 - sf3*const4) & + & + sf2*sy3 - sf3*sy2) / s23 + Endif + enddo + If (JLq .LE. 0) Then + Call CtLhPolint4 (TV(0), Fvec(1), 4, tt, ff, Dfq) + ElseIf (JLq .GE. Nt-1) Then + Call CtLhPolint4 (TV(Nt-3), Fvec(1), 4, tt, ff, Dfq) + Else + tf2 = fvec(2) + tf3 = fvec(3) + g1 = ( tf2*t13 - tf3*t12) / t23 + g4 = (-tf2*t34 + tf3*t24) / t23 + h00 = ((t34*ty2-tmp2*ty3)*(fvec(1)-g1)/t12 & + & + (tmp1*ty2-t12*ty3)*(fvec(4)-g4)/t34) + ff = (h00*ty2*ty3/tdet + tf2*ty3 - tf3*ty2) / t23 + EndIf + CtLhPARDIS = ff + Return + END + + + SUBROUTINE CtLhPARPDF (IACT, NAME, VALUE, IRET) + IMPLICIT DOUBLE PRECISION (A-H, O-Z) + CHARACTER NAME*(*), Uname*10 + LOGICAL START1 + DATA ILEVEL, LRET / 1, 1 / + JRET = IRET + CALL CtLhUPC (NAME, Ln, Uname) + IF (IACT .EQ. 0 .OR. IACT .EQ. 4) then +! > IVALUE = NINT (VALUE) !tentatively remove this since it see + print *,'Fatal error: iact=',iact + stop + ENDIF + START1 = (IACT .NE. 1) .AND. (IACT .NE. 2) +! prepare to remove this stuff, since I think IACT=1 or 2 always + if(start1) then + print *,'Fatal error: start1=',start1 + stop + endif + IF (START1) ILEVEL = 1 + GOTO (1, 2), ILEVEL + 1 START1 = .TRUE. + ILEVEL = 0 + CALL CtLhParQcd (IACT, Uname(1:Ln), VALUE, JRET) + IF (JRET .EQ. 1) GOTO 11 + IF (JRET .EQ. 2) GOTO 12 + IF (JRET .EQ. 3) GOTO 13 + IF (JRET .GT. 4) GOTO 15 + ILEVEL = ILEVEL + 1 + 2 CALL CtLhEVLPAR (IACT, Uname(1:Ln), VALUE, JRET) + IF (JRET .EQ. 1) GOTO 11 + IF (JRET .EQ. 2) GOTO 12 + IF (JRET .EQ. 3) GOTO 13 + IF (JRET .GT. 4) GOTO 15 + ILEVEL = ILEVEL + 1 + IF (.NOT. START1) GOTO 1 + IF (JRET .EQ. 0) GOTO 10 + GOTO 14 + 10 CONTINUE + 11 CONTINUE + 12 CONTINUE + 13 CONTINUE + 14 CONTINUE + 15 CONTINUE + IF (JRET .NE. 4) LRET = JRET + IF (LRET.EQ.0 .OR. LRET.EQ.2 .OR. LRET.EQ.3) THEN + PRINT *, 'Error in CtLhPARPDF: IRET, IACT, NAME, VALUE =', & + & LRET, IACT, NAME, VALUE + PRINT *, 'fatal error in CtLhparpdf' + stop + EndIf + IRET= JRET + RETURN + END + + + SUBROUTINE CtLhParQcd(IACT,NAME,VALUE,IRET) + IMPLICIT DOUBLE PRECISION (A-H, O-Z) + INTEGER IACT,IRET + CHARACTER*(*) NAME + IRET=1 + IF (IACT.EQ.0) THEN + WRITE (NINT(VALUE), *) 'LAM(BDA), NFL, ORD(ER), Mi, ', & + & '(i in 1 to 9), LAMi (i in 1 to NFL)' + IRET=4 + ELSEIF (IACT.EQ.1) THEN + CALL CtLhQCDSET (NAME,VALUE,IRET) + ELSEIF (IACT.EQ.2) THEN + CALL CtLhQCDGET (NAME,VALUE,IRET) + ELSE + IRET=3 + ENDIF + RETURN + END + + + FUNCTION CtLhPFF1 (XX) + IMPLICIT DOUBLE PRECISION (A-H, O-Z) + LOGICAL LA, LB, LSTX + PARAMETER (D0=0D0, D1=1D0, D2=2D0, D3=3D0, D4=4D0, D10=1D1) + PARAMETER (MXX = 105, MXQ = 25, MXF = 6) + PARAMETER (M1=-3, M2=3, NDG=3, NDH=NDG+1, L1=M1-1, L2=M2+NDG-2) + PARAMETER (MX = 3) + COMMON / LhCtXXARAY / XCR, XMIN, XV(0:MXX), LSTX, NX + COMMON / LhCtKRNL00 / DZ, XL(MX), NNX + COMMON / LhCtVARIBX / XA(MXX, L1:L2), ELY(MXX), DXTZ(MXX) + COMMON / LhCtKRN1ST / FF1(0:MXX),FG1(0:MXX),GF1(0:MXX),GG1(0:MXX),& + & FF2(0:MXX), FG2(0:MXX), GF2(0:MXX), GG2(0:MXX), & + & PNSP(0:MXX), PNSM(0:MXX) + SAVE + DATA LA, LB / 2 * .FALSE. / + LB = .TRUE. + ENTRY CtLhTFF1(ZZ) + LA = .TRUE. + IF (LA .AND. .NOT.LB) THEN + Z = ZZ + X = CtLhXFRMZ (Z) + Else + X = XX + EndIf + IF (X .GE. D1) THEN + CtLhPFF1 = 0 + RETURN + ElseIF (X .GE. XMIN) THEN + Z = CtLhZFRMX (X) + TEM = CtLhFINTRP (FF1, -DZ, DZ, NX, Z, ERR, IRT) + Else + CALL CtLhPOLIN1 (XL, FF1(1), MX, X, TEM, ERR) + EndIf + IF (LA) THEN + IF (LB) THEN + CtLhPFF1 = TEM / (1.-X) + LB =.FALSE. + Else + CtLhTFF1 = TEM / (1.-X) * CtLhDXDZ(Z) + EndIf + LA =.FALSE. + Else + IF (LB) THEN +! +++ something is wrong, since QFF1 and RFF1 are not used. +! +++ but this code appears to only be used for extrapolation +! +++ to small x, which is unreliable anyway, so ignore for now (jcp) + QFF1 = TEM + LB =.FALSE. + Else + RFF1 = TEM * X / (1.-X) + EndIf + EndIf + RETURN + ENTRY CtLhFNSP (XX) + X = XX + IF (X .GE. D1) THEN + CtLhFNSP = 0. + RETURN + ElseIF (X .GE. XMIN) THEN + Z = CtLhZFRMX (X) + TEM = CtLhFINTRP (PNSP, -DZ, DZ, NX, Z, ERR, IRT) + Else + CALL CtLhPOLIN1 (XL, PNSP(1), MX, X, TEM, ERR) + EndIf + CtLhFNSP = TEM / (1.- X) + RETURN + ENTRY CtLhFNSM (XX) + X = XX + IF (X .GE. D1) THEN + CtLhFNSM = 0. + RETURN + ElseIF (X .GE. XMIN) THEN + Z = CtLhZFRMX (X) + TEM = CtLhFINTRP (PNSM, -DZ, DZ, NX, Z, ERR, IRT) + Else + CALL CtLhPOLIN1 (XL, PNSM(1), MX, X, TEM, ERR) + EndIf + CtLhFNSM = TEM / (1.- X) + RETURN + ENTRY CtLhRGG1 (XX) + X = XX + IF (X .GE. D1) THEN + !error corrected? (jcp) + CtLhRGG1= 0 + RETURN + ElseIF (X .GE. XMIN) THEN + Z = CtLhZFRMX (X) + TEM = CtLhFINTRP (GG1, -DZ, DZ, NX, Z, ERR, IRT) + Else + CALL CtLhPOLIN1 (XL, GG1(1), MX, X, TEM, ERR) + EndIf + IF (LA) THEN + !error corrected? (jcp) + CtLhRGG1 = TEM / X / (1.-X) + LA =.FALSE. + Else + IF (LB) THEN + !error corrected? (jcp) + CtLhRGG1 = TEM / X + LB =.FALSE. + Else + CtLhRGG1 = TEM / (1.-X) + EndIf + EndIf + RETURN + ENTRY CtLhRFF2 (XX) + X = XX + IF (X .GE. D1) THEN + !error corrected? (jcp) + CtLhRFF2 = 0 + RETURN + ElseIF (X .GE. XMIN) THEN + Z = CtLhZFRMX (X) + TEM = CtLhFINTRP (FF2, -DZ, DZ, NX, Z, ERR, IRT) + Else + CALL CtLhPOLIN1 (XL, FF2(1), MX, X, TEM, ERR) + EndIf + IF (LA) THEN + !error corrected? (jcp) + CtLhRFF2 = TEM / X / (1.-X) + LA =.FALSE. + Else + IF (LB) THEN + !error corrected? (jcp) + CtLhRFF2 = TEM / X + LB =.FALSE. + Else + CtLhRFF2 = TEM / (1.-X) + EndIf + EndIf + RETURN + ENTRY CtLhRGG2 (XX) + X = XX + IF (X .GE. D1) THEN + !error corrected? (jcp) + CtLhRGG2 = 0 + RETURN + ElseIF (X .GE. XMIN) THEN + Z = CtLhZFRMX (X) + TEM = CtLhFINTRP (GG2, -DZ, DZ, NX, Z, ERR, IRT) + Else + CALL CtLhPOLIN1 (XL, GG2(1), MX, X, TEM, ERR) + EndIf + IF (LA) THEN + !error corrected? (jcp) + CtLhRGG2 = TEM / X / (1.-X) + LA =.FALSE. + Else + IF (LB) THEN + !error corrected? (jcp) + CtLhRGG2 = TEM / X + LB =.FALSE. + Else + CtLhRGG2 = TEM / (1.-X) + EndIf + EndIf + RETURN + END + + + SUBROUTINE CtLhPOLIN1 (XA,YA,N,X,Y,DY) + IMPLICIT DOUBLE PRECISION (A-H, O-Z) + PARAMETER (NMAX=10) + DIMENSION XA(N),YA(N),C(NMAX),D(NMAX) + NS=1 + DIF=ABS(X-XA(1)) + DO 11 I=1,N + DIFT=ABS(X-XA(I)) + IF (DIFT.LT.DIF) THEN + NS=I + DIF=DIFT + ENDIF + C(I)=YA(I) + D(I)=YA(I) + 11 END DO + Y=YA(NS) + NS=NS-1 + DO 13 M=1,N-1 + DO 12 I=1,N-M + HO=XA(I)-X + HP=XA(I+M)-X + W=C(I+1)-D(I) + DEN=HO-HP + DEN=W/DEN + D(I)=HP*DEN + C(I)=HO*DEN + 12 CONTINUE + IF (2*NS.LT.N-M)THEN + DY=C(NS+1) + ELSE + DY=D(NS) + NS=NS-1 + ENDIF + Y=Y+DY + 13 END DO + RETURN + END + + + SUBROUTINE CtLhQARRAY (NINI) + IMPLICIT DOUBLE PRECISION (A-H, O-Z) + PARAMETER (MXX = 105, MXQ = 25, MXF = 6) + PARAMETER (MXPN = MXF * 2 + 2) + PARAMETER (MXQX= MXQ * MXX, MXPQX = MXQX * MXPN) + COMMON / LhCtQARAY1 / QINI,QMAX, QV(0:MXQ),TV(0:MXQ), NT,JT,NG + COMMON / LhCtQARAY2 / TLN(MXF), DTN(MXF), NTL(MXF), NTN(MXF) + COMMON / LhCtEVLPAC / AL, IKNL, IPD0, IHDN, NfMx + NCNT = 0 + IF (NT .GE. mxq) NT = mxq - 1 + S = LOG(QINI/AL) + TINI = LOG(S) + S = LOG(QMAX/AL) + TMAX = LOG(S) + 1 DT0 = (TMAX - TINI) / float(NT) + NINI = LhCtNFL(QINI) + NFMX = LhCtNFL(QMAX) + Call CtLhParQcd (2, 'ORDER', Ord, Ir) + Call CtLhParQcd (2, 'ALAM', Al0, Ir) + Call CtLhParQcd (2, 'NFL', Afl0, Ir) + AFL = NfMx + Call CtLhParQcd (1, 'NFL', AFL, Ir) + Iordr = Nint (Ord) + Ifl0 = Nint (Afl0) + Call CtLhSetLam (Ifl0, Al0, Iordr) + NG = NFMX - NINI + 1 + QIN = QINI + QOUT = QINI + S = LOG(QIN/AL) + TIN = LOG(S) + TLN(1) = TIN + NTL(1) = 0 + QV(0) = QINI + TV(0) = Tin + DO 20 NEFF = NINI, NFMX + ICNT = NEFF - NINI + 1 + IF (NEFF .LT. NFMX) THEN + THRN = CtLhAMHATF (NEFF + 1) + QOUN = MIN (QMAX, THRN) + Else + QOUN = QMAX + EndIf + IF (QOUN-QOUT .LE. 0.0001) THEN + DT = 0 + NITR = 0 + Else + QOUT = QOUN + S = LOG(QOUT/AL) + TOUT = LOG(S) + TEM = TOUT - TIN + NITR = INT (TEM / DT0) + 1 + DT = TEM / NITR + EndIf + DTN (ICNT) = DT + NTN (ICNT) = NITR + TLN (ICNT) = TIN + NTL (ICNT+1) = NTL(ICNT) + NITR + IF (NITR .NE. 0) THEN + DO 205 I = 1, NITR + TV (NTL(ICNT)+I) = TIN + DT * I + S = EXP (TV(NTL(ICNT)+I)) + QV (NTL(ICNT)+I) = AL * EXP (S) + 205 CONTINUE + EndIf + QIN = QOUT + TIN = TOUT + 20 END DO + NCNT = NCNT + 1 + NTP = NTL (NG + 1) + ND = NTP - NT + IF (NTP .GE. MXQ) THEN + NT = MXQ - ND - NCNT + GOTO 1 + EndIf + NT = NTP + RETURN + END + + + SUBROUTINE CtLhQCDGET(NAME,VALUE,IRET) + IMPLICIT DOUBLE PRECISION (A-H, O-Z) + CHARACTER*(*) NAME + COMMON / LhCtCWZPRM / ALAM(0:9), AMHAT(0:9), AMN, NHQ + COMMON / LhCtQCDPAR_LHA / AL, NF, NORDER, SET + COMMON / LhCtCOMQMS / VALQMS(9) + LOGICAL SET + PARAMETER (PI=3.141592653589793d0, EULER=0.57721566) + ICODE = LhCtNAMQCD(NAME) + IRET = 1 + IF (ICODE .EQ. 1) THEN + VALUE = AL + ELSEIF (ICODE .EQ. 2) THEN + VALUE = NF + ELSEIF ((ICODE .GE. 3) .AND. (ICODE .LE. 12)) THEN + VALUE = VALQMS(ICODE - 2) + ELSEIF ((ICODE .GE. 13) .AND. (ICODE .LE. 13+NF)) THEN + VALUE = ALAM(ICODE - 13) + ELSEIF (ICODE .EQ. 24) THEN + VALUE = NORDER + ELSE + IRET=0 + ENDIF + END + + + SUBROUTINE CtLhQCDSET (NAME,VALUE,IRET) + IMPLICIT DOUBLE PRECISION (A-H, O-Z) + CHARACTER*(*) NAME + COMMON / LhCtCOMQMS / VALQMS(9) + COMMON / LhCtQCDPAR_LHA / AL, NF, NORDER, SET + LOGICAL SET + PARAMETER (PI=3.141592653589793d0, EULER=0.57721566) + IVALUE = NINT(VALUE) + ICODE = LhCtNAMQCD(NAME) + IF (ICODE .EQ. 0) THEN + IRET=0 +! print *,'warning empty CtLhQCDSET call: NAME=', +! & NAME,' VALUE=',VALUE + ELSE + IRET = 1 + SET = .FALSE. + IF (ICODE .EQ. 1) THEN + IF (VALUE.LE.0) GOTO 12 + AL=VALUE + ELSEIF (ICODE .EQ. 2) THEN + IF ( (IVALUE .LT. 0) .OR. (IVALUE .GT. 9)) GOTO 12 + NF = IVALUE + ELSEIF ((ICODE .GE. 3) .AND. (ICODE .LE. 11)) THEN + IF (VALUE .LT. 0) GOTO 12 + Scle = Min (Value , VALQMS(ICODE - 2)) + AlfScle = CtLhALPI(Scle) * Pi + VALQMS(ICODE - 2) = VALUE + Call CtLhAlfSet (Scle, AlfScle) + ELSEIF ((ICODE .GE. 13) .AND. (ICODE .LE. 13+NF)) THEN + IF (VALUE .LE. 0) GOTO 12 + CALL CtLhSETL1 (ICODE-13, VALUE) + ELSEIF (ICODE .EQ. 24) THEN + IF ((IVALUE .LT. 1) .OR. (IVALUE .GT. 2)) GOTO 12 + NORDER = IVALUE + ENDIF + IF (.NOT. SET) CALL CtLhLAMCWZ + ENDIF + RETURN + 12 IRET=2 + RETURN + END + + + FUNCTION CtLhQZBRNT(FUNC, X1, X2, TOLIN, IRT) + IMPLICIT DOUBLE PRECISION (A-H, O-Z) + PARAMETER (ITMAX = 1000, EPS = 3.E-12) + external func + TOL = ABS(TOLIN) + A=X1 + B=X2 + FA=FUNC(A) + FB=FUNC(B) + IF(FB*FA.GT.0.) THEN + WRITE (*, *) 'Root must be bracketed for CtLhQZBRNT.' + IRT = 1 + ENDIF + FC=FB + DO 11 ITER=1,ITMAX + IF(FB*FC.GT.0.) THEN + C=A + FC=FA + D=B-A + E=D + ENDIF + IF(ABS(FC).LT.ABS(FB)) THEN + A=B + B=C + C=A + FA=FB + FB=FC + FC=FA + ENDIF + TOL1=2.*EPS*ABS(B)+0.5*TOL + XM=.5*(C-B) + IF(ABS(XM).LE.TOL1 .OR. FB.EQ.0.)THEN + CtLhQZBRNT=B + RETURN + ENDIF + IF(ABS(E).GE.TOL1 .AND. ABS(FA).GT.ABS(FB)) THEN + S=FB/FA + IF(A.EQ.C) THEN + P=2.*XM*S + Q=1.-S + ELSE + Q=FA/FC + R=FB/FC + P=S*(2.*XM*Q*(Q-R)-(B-A)*(R-1.)) + Q=(Q-1.)*(R-1.)*(S-1.) + ENDIF + IF(P.GT.0.) Q=-Q + P=ABS(P) + IF(2.*P .LT. MIN(3.*XM*Q-ABS(TOL1*Q),ABS(E*Q))) THEN + E=D + D=P/Q + ELSE + D=XM + E=D + ENDIF + ELSE + D=XM + E=D + ENDIF + A=B + FA=FB + IF(ABS(D) .GT. TOL1) THEN + B=B+D + ELSE + B=B+SIGN(TOL1,XM) + ENDIF + FB=FUNC(B) + 11 END DO + WRITE (*, *) 'CtLhQZBRNT exceeding maximum iterations.' + IRT = 2 + CtLhQZBRNT=B + RETURN + END + + + SUBROUTINE CtLhRATINT(XA,YA,N,X,Y,DY) + IMPLICIT DOUBLE PRECISION (A-H, O-Z) + PARAMETER (NMAX=10,TINY=1.E-25) + DIMENSION XA(N),YA(N),C(NMAX),D(NMAX) + NS=1 + HH=ABS(X-XA(1)) + DO 11 I=1,N + H=ABS(X-XA(I)) + IF (H.EQ.0.)THEN + Y=YA(I) + DY=0.0 + RETURN + ELSE IF (H.LT.HH) THEN + NS=I + HH=H + ENDIF + C(I)=YA(I) + D(I)=YA(I)+TINY + 11 END DO + Y=YA(NS) + NS=NS-1 + DO 13 M=1,N-1 + DO 12 I=1,N-M + W=C(I+1)-D(I) + H=XA(I+M)-X + T=(XA(I)-X)*D(I)/H + DD=T-C(I+1) + DD=W/DD + D(I)=C(I+1)*DD + C(I)=T*DD + 12 CONTINUE + IF (2*NS.LT.N-M)THEN + DY=C(NS+1) + ELSE + DY=D(NS) + NS=NS-1 + ENDIF + Y=Y+DY + 13 END DO + RETURN + END + + + FUNCTION CtLhRTALF (EFLLN) + IMPLICIT DOUBLE PRECISION (A-H, O-Z) + include 'parmsetup.inc' + PARAMETER (PI = 3.141592653589793d0) + COMMON / CtLhRTALFC / ALFST, JORD, NEFF + EFMULM = EXP (EFLLN) + TEM1 = PI / ALFST + TEM2 = 1. / CtLhALPQCD (JORD, NEFF, EFMULM, I) + CtLhRTALF = TEM1 - TEM2 + END + + + Subroutine CtLhbldat1 + IMPLICIT DOUBLE PRECISION (A-H, O-Z) + include 'parmsetup.inc' + LOGICAL LSTX + PARAMETER (MXX = 105, MXQ = 25, MxF = 6) + PARAMETER (MxPN = MxF * 2 + 2) + PARAMETER (MxQX= MXQ * MXX, MxPQX = MxQX * MxPN) + COMMON / LhCtXXARAY / XCR, XMIN, XV(0:MXX), LSTX, NX + COMMON / LhCtQARAY1 / QINI,QMAX, QV(0:MXQ),TV(0:MXQ), NT,JT,NG + COMMON / LhCtEVLPAC / AL, IKNL, IPD0, IHDN, NfMx + COMMON / LhCtPEVLDT / UPD(MXPQX,nmxset), KF, Nelmt + PARAMETER (NF0 = 4, Nshp = 8,NEX = Nshp+2) + XMIN = .999999D-4 + XCR = 1.5 + JT = 1 + Return + END + + + SUBROUTINE CtLhSETL1 (NEF, VLAM) + IMPLICIT DOUBLE PRECISION (A-H, O-Z) + LOGICAL SET + COMMON / LhCtCWZPRM / ALAM(0:9), AMHAT(0:9), AMN, NHQ + COMMON / LhCtQCDPAR_LHA / AL, NF, NORDER, SET + COMMON / LhCtCOMQMS / VALQMS(9) + IF (NEF .LT. 0 .OR. NEF .GT. NF) THEN + WRITE(*,*)'NEF out of range in CtLhSETL1: NEF NF =',NEF,NF + STOP + ENDIF + AMHAT(0) = 0. + DO 5 N = 1, NF + AMHAT(N) = VALQMS(N) + 5 CONTINUE + ALAM(NEF) = VLAM + DO 10 N = NEF, 1, -1 + CALL CtLhTRNLAM(NORDER, N, -1, IR1) + 10 CONTINUE + DO 20 N = NEF, NF-1 + CALL CtLhTRNLAM(NORDER, N, 1, IR1) + 20 CONTINUE + DO 30, N = NF, 1, -1 + IF ((ALAM(N) .GE. 0.7 * AMHAT(N)) & + & .OR. (ALAM(N-1) .GE. 0.7 * AMHAT(N)))THEN + NHQ = NF - N + GOTO 40 + ENDIF + 30 CONTINUE + NHQ = NF + 40 CONTINUE + DO 50, N = NF-NHQ, 1, -1 + AMHAT(N) = 0 + ALAM(N-1) = ALAM(N) + 50 CONTINUE + AMN = ALAM(NF) + DO 60, N = 0, NF-1 + IF (ALAM(N) .GT. AMN) AMN = ALAM(N) + 60 CONTINUE + AMN = AMN * 1.0001 + AL = ALAM(NF) + SET = .TRUE. + RETURN + END + + + SUBROUTINE CtLhSETLAM (NEF, WLAM, IRDR) + IMPLICIT DOUBLE PRECISION (A-H, O-Z) + COMMON / LhCtQCDPAR_LHA / AL, NF, NORDER, SET + LOGICAL SET + IF ((NEF .LT. 0) .OR. (NEF .GT. NF)) THEN + WRITE(*,*)'NEF out of range in CtLhSETLAM: NEF NF=',NEF,NF + STOP + ENDIF + VLAM = WLAM + IF (IRDR .NE. NORDER) then + PRINT *,'fatal error: wanted cnvl1' + stop + ENDIF + CALL CtLhSETL1 (NEF, VLAM) + END + + + Subroutine CtLhbldat2 + IMPLICIT DOUBLE PRECISION (A-H, O-Z) + COMMON / LhCtCOMQMS / VALQMS(9) + COMMON / LhCtQCDPAR_LHA / AL, NF, NORDER, SET + LOGICAL SET + AL = .226d0 + NF = 5 + NORDER = 2 + SET = .FALSE. + VALQMS(1) = 0. + VALQMS(2) = 0. + VALQMS(3) = 0.2d0 + VALQMS(4) = 1.3d0 + VALQMS(5) = 4.5d0 + VALQMS(6) = 174.d0 + VALQMS(7) = 0. + VALQMS(8) = 0. + VALQMS(9) = 0. + Return + END + + + FUNCTION CtLhSMPNOL (NX, DX, FN, ERR) + IMPLICIT DOUBLE PRECISION (A-H, O-Z) + DIMENSION FN(NX) + MS = MOD(NX, 2) + IF (NX .LE. 1 .OR. NX .GT. 1000) THEN + PRINT *, 'NX =', NX, ' OUT OF RANGE IN CtLhSMPNOL!' + STOP + ELSEIF (NX .EQ. 2) THEN + TEM = DX * FN(2) + ELSEIF (NX .EQ. 3) THEN + TEM = DX * FN(2) * 2. + ELSE + IF (MS .EQ. 0) THEN + TEM = DX * (23.* FN(2) - 16.* FN(3) + 5.* FN(4)) / 12. + TMP = DX * (3.* FN(2) - FN(3)) / 2. + ERR = ABS(TEM - TMP) + TEM = TEM + CtLhSMPSNA (NX-1, DX, FN(2), ER1) + ERR = ABS(ER1) + ERR + ELSE + TEM = DX * (8.* FN(2) - 4.* FN(3) + 8.* FN(4)) / 3. + TMP = DX * (3.* FN(2) + 2.* FN(3) + 3.* FN(4)) / 2. + ERR = ABS(TEM - TMP) + TEM = TEM + CtLhSMPSNA (NX-4, DX, FN(5), ER1) + ERR = ABS(ER1) + ERR + ENDIF + ENDIF + CtLhSMPNOL = TEM + RETURN + END + + + FUNCTION CtLhSMPSNA (NX, DX, F, ERR) + IMPLICIT DOUBLE PRECISION (A-H, O-Z) + PARAMETER (D0=0D0, D1=1D0, D2=2D0, D3=3D0, D4=4D0, D10=1D1) + PARAMETER (MAXX = 1000) + DIMENSION F(NX) + DATA IW1, IW2, TINY / 2*0, 1.E-35 / + IF (DX .LE. 0.) THEN + CALL CtLhWARNR(IW2,'DX cannot be < 0. in CtLhSMPSNA', 'DX', & + & DX, D0, D1, 0) + CtLhSMPSNA = 0. + RETURN + ENDIF + IF (NX .LE. 0 .OR. NX .GT. MAXX) THEN + CALL CtLhWARNI(IW1, 'NX out of range in CtLhSMPSNA', 'NX', NX, & + & 1, MAXX, 1) + SIMP = 0. + ELSEIF (NX .EQ. 1) THEN + SIMP = 0. + ELSEIF (NX .EQ. 2) THEN + SIMP = (F(1) + F(2)) / 2. + ERRD = (F(1) - F(2)) / 2. + ELSE + MS = MOD(NX, 2) + IF (MS .EQ. 0) THEN + ADD = (9.*F(NX) + 19.*F(NX-1) - 5.*F(NX-2) + F(NX-3)) / 24. + NZ = NX - 1 + ELSE + ADD = 0. + NZ = NX + ENDIF + IF (NZ .EQ. 3) THEN + SIMP = (F(1) + 4.* F(2) + F(3)) / 3. + TRPZ = (F(1) + 2.* F(2) + F(3)) / 2. + ELSE + SE = F(2) + SO = 0 + NM1 = NZ - 1 + DO 60 I = 4, NM1, 2 + IM1 = I - 1 + SE = SE + F(I) + SO = SO + F(IM1) + 60 CONTINUE + SIMP = (F(1) + 4.* SE + 2.* SO + F(NZ)) / 3. + TRPZ = (F(1) + 2.* (SE + SO) + F(NZ)) / 2. + ENDIF + ERRD = TRPZ - SIMP + SIMP = SIMP + ADD + ENDIF + CtLhSMPSNA = SIMP * DX + IF (ABS(SIMP) .GT. TINY) THEN + ERR = ERRD / SIMP + ELSE + ERR = 0. + ENDIF + RETURN + END + + + SUBROUTINE CtLhSNEVL(IKNL,NX,NT,JT,DT,TIN,NEFF,UI,GI,US,GS) + IMPLICIT DOUBLE PRECISION (A-H, O-Z) + PARAMETER (MXX = 105, MXQ = 25, MXF = 6) + PARAMETER (MXQX= MXQ * MXX) + PARAMETER (M1=-3, M2=3, NDG=3, NDH=NDG+1, L1=M1-1, L2=M2+NDG-2) + COMMON / LhCtVARIBX / XA(MXX, L1:L2), ELY(MXX), DXTZ(MXX) + DIMENSION UI(NX), US(0:NX, 0:NT) + DIMENSION GI(NX), GS(0:NX, 0:NT) + DIMENSION Y0(MXX), Y1(MXX), YP(MXX), F0(MXX), F1(MXX), FP(MXX) + DIMENSION Z0(MXX), Z1(MXX), ZP(MXX), G0(MXX), G1(MXX), GP(MXX) + DATA D0 / 0.0 / + JTT = 2 * JT + DDT = DT / JTT + IF (NX .GT. MXX) THEN + WRITE (*,*) 'Nx =', NX, ' too many pts in CtLhSNEVL' + STOP 'Program stopped in CtLhSNEVL' + EndIf +! ++ remove unused quantities (jcp) +! ++ TMD = TIN + DT * NT / 2. +! ++ AMU = EXP(TMD) +! ++ TEM = 6./ (33.- 2.* NEFF) / CtLhALPI(AMU) +! ++ TLAM = TMD - TEM + DO 9 IX = 1, NX + US (IX, 0) = UI(IX) + GS (IX, 0) = GI(IX) + 9 END DO + US ( 0, 0) = (UI(1) - UI(2))* 3D0 + UI(3) + GS ( 0, 0) = (GI(1) - GI(2))* 3D0 + GI(3) + TT = TIN + DO 10 IZ = 1, NX + Y0(IZ) = UI(IZ) + Z0(IZ) = GI(IZ) + 10 END DO + DO 20 IS = 1, NT + DO 202 JS = 1, JTT + IRND = (IS-1) * JTT + JS + IF (IRND .EQ. 1) THEN + CALL CtLhSNRHS (TT, NEFF, Y0,Z0, F0,G0) + DO 250 IZ = 1, NX + Y0(IZ) = Y0(IZ) + DDT * F0(IZ) + Z0(IZ) = Z0(IZ) + DDT * G0(IZ) + 250 CONTINUE + TT = TT + DDT + CALL CtLhSNRHS (TT, NEFF, Y0, Z0, F1, G1) + DO 251 IZ = 1, NX + Y1(IZ) = UI(IZ) + DDT * (F0(IZ) + F1(IZ)) / 2D0 + Z1(IZ) = GI(IZ) + DDT * (G0(IZ) + G1(IZ)) / 2D0 + 251 CONTINUE + Else + CALL CtLhSNRHS (TT, NEFF, Y1, Z1, F1, G1) + DO 252 IZ = 1, NX + YP(IZ) = Y1(IZ) + DDT * (3D0 * F1(IZ) - F0(IZ)) / 2D0 + ZP(IZ) = Z1(IZ) + DDT * (3D0 * G1(IZ) - G0(IZ)) / 2D0 + 252 CONTINUE + TT = TT + DDT + CALL CtLhSNRHS (TT, NEFF, YP, ZP, FP, GP) + DO 253 IZ = 1, NX + Y1(IZ) = Y1(IZ) + DDT * (FP(IZ) + F1(IZ)) / 2D0 + Z1(IZ) = Z1(IZ) + DDT * (GP(IZ) + G1(IZ)) / 2D0 + F0(IZ) = F1(IZ) + G0(IZ) = G1(IZ) + 253 CONTINUE + EndIf + 202 CONTINUE + DO 260 IX = 1, NX + IF (IKNL .GT. 0) THEN + US (IX, IS) = MAX(Y1(IX), D0) + GS (IX, IS) = MAX(Z1(IX), D0) + Else + US (IX, IS) = Y1(IX) + GS (IX, IS) = Z1(IX) + EndIf + 260 CONTINUE + US(0, IS) = 3D0*Y1(1) - 3D0*Y1(2) + Y1(3) + GS(0, IS) = 3D0*Z1(1) - 3D0*Z1(2) + Z1(3) + 20 END DO + RETURN + END + + + SUBROUTINE CtLhSNRHS (TT, NEFF, FI, GI, FO, GO) + IMPLICIT DOUBLE PRECISION (A-H, O-Z) + LOGICAL LSTX + PARAMETER (MXX = 105, MXQ = 25, MXF = 6) + PARAMETER (M1=-3, M2=3, NDG=3, NDH=NDG+1, L1=M1-1, L2=M2+NDG-2) + COMMON / LhCtVARIBX / XA(MXX, L1:L2), ELY(MXX), DXTZ(MXX) + COMMON / LhCtXXARAY / XCR, XMIN, XV(0:MXX), LSTX, NX + COMMON / LhCtXYARAY / ZZ(MXX, MXX), ZV(0:MXX) + COMMON / LhCtKRNL01 / AFF2(MXX),AFG2(MXX),AGF2(MXX),AGG2(MXX), & + & ANSP (MXX), ANSM (MXX), ZFG2, ZGF2, ZQQB + COMMON / LhCtKRN2ND / FFG(MXX, MXX), GGF(MXX, MXX), PNS(MXX, MXX) + COMMON / LhCtEVLPAC / AL, IKNL, IPD0, IHDN, NfMx + DIMENSION GI(NX), GO(NX), G1(MXX), G2(MXX), G3(MXX), G4(MXX) + DIMENSION FI(NX), FO(NX), W0(MXX), W1(MXX), WH(MXX), WM(MXX) + DIMENSION R0(MXX), R1(MXX), R2(MXX), RH(MXX), RM(MXX) + S = EXP(TT) + Q = AL * EXP (S) + CPL = CtLhALPI(Q) + CPL2= CPL ** 2 / 2. * S + CPL = CPL * S + CALL CtLhINTEGR (NX,-1, FI, WM, IR1) + CALL CtLhINTEGR (NX, 0, FI, W0, IR2) + CALL CtLhINTEGR (NX, 1, FI, W1, IR3) + CALL CtLhINTEGR (NX,-1, GI, RM, IR4) + CALL CtLhINTEGR (NX, 0, GI, R0, IR5) + CALL CtLhINTEGR (NX, 1, GI, R1, IR6) + CALL CtLhINTEGR (NX, 2, GI, R2, IR7) + CALL CtLhHINTEG (NX, FI, WH) + CALL CtLhHINTEG (NX, GI, RH) + IF (IKNL .GT. 0) THEN + DO 230 IZ = 1, NX + FO(IZ) = ( 2D0 * FI(IZ) & + & + 4D0 / 3D0 * ( 2D0 * WH(IZ) - W0(IZ) - W1(IZ) )) & + & + NEFF * ( R0(IZ) - 2D0 * R1(IZ) + 2D0 * R2(IZ) ) + FO(IZ) = FO(IZ) * CPL + GO(IZ) = 4D0 / 3D0 * ( 2D0 * WM(IZ) - 2D0 * W0(IZ) + W1(IZ) ) & + & + (33D0 - 2D0 * NEFF) / 6D0 * GI(IZ) & + & + 6D0 * (RH(IZ) + RM(IZ) - 2D0 * R0(IZ) + R1(IZ) - R2(IZ)) + GO(IZ) = GO(IZ) * CPL + 230 END DO + Else + DO 240 IZ = 1, NX + FO(IZ) = NEFF * (-R0(IZ) + 2.* R1(IZ) ) & + & + 2.* FI(IZ) + 4./ 3.* ( 2.* WH(IZ) - W0(IZ) - W1(IZ) ) + FO(IZ) = FO(IZ) * CPL + GO(IZ) = 4./ 3.* ( 2.* W0(IZ) - W1(IZ) ) & + &+ (33.- 2.* NEFF) / 6.* GI(IZ) + 6.*(RH(IZ) + R0(IZ) - 2.* R1(IZ)) + GO(IZ) = GO(IZ) * CPL + 240 END DO + EndIf + IF (IKNL .EQ. 2) THEN + DZ = 1./(NX - 1) + DO 21 I = 1, NX-1 + NP = NX - I + 1 + IS = NP + g2(1)=0d0 + g3(1)=0d0 + DO 31 KZ = 2, NP + IY = I + KZ - 1 + IT = NX - IY + 1 + XY = ZZ (IS, IT) + G1(KZ) = FFG(I, IY) * (FI(IY) - XY**2 *FI(I)) + G4(KZ) = GGF(I, IY) * (GI(IY) - XY**2 *GI(I)) + !FG + G2(KZ) = FFG(IS,IT) * (GI(IY) - xy*GI(I)) + !GF (usual notat + G3(KZ) = GGF(IS,IT) * (FI(IY) - XY*FI(I)) + 31 CONTINUE + TEM1 = CtLhSMPNOL (NP, DZ, G1, ERR) + TEM2 = CtLhSMPSNA (NP, DZ, G2, ERR) + TEM3 = CtLhSMPSNA (NP, DZ, G3, ERR) + TEM4 = CtLhSMPNOL (NP, DZ, G4, ERR) + TEM1 = TEM1 - FI(I) * (AFF2(I) + ZGF2) + TEM4 = TEM4 - GI(I) * (AGG2(I) + ZFG2) + tem2 = tem2 + GI(I)*AFG2(I) + tem3= tem3 + FI(I)*AGF2(I) + TMF = TEM1 + TEM2 + TMG = TEM3 + TEM4 + FO(I) = FO(I) + TMF * CPL2 + GO(I) = GO(I) + TMG * CPL2 + 21 END DO + EndIf + RETURN + END + + + FUNCTION CtLhSPENC2 (X) + IMPLICIT DOUBLE PRECISION (A-H, O-Z) + EXTERNAL CtLhSPN2IN + COMMON / LhCtSPENCC / XX + DATA U1, AERR, RERR / 1.D0, 1.E-7, 5.E-3 / + XX = X + TEM = CtLhGausInt(CtLhSPN2IN, XX, U1, AERR, RERR, ERR, IRT) + CtLhSPENC2 = TEM + LOG (XX) ** 2 / 2. + RETURN + END + + + FUNCTION CtLhSPN2IN (ZZ) + IMPLICIT DOUBLE PRECISION (A-H, O-Z) + COMMON / LhCtSPENCC / X + Z = ZZ + TEM = LOG (1.+ X - Z) / Z + CtLhSPN2IN = TEM + RETURN + END + + + SUBROUTINE CtLhSTUPKL (NFL) + IMPLICIT DOUBLE PRECISION (A-H, O-Z) + LOGICAL LSTX + PARAMETER (D0=0D0, D1=1D0, D2=2D0, D3=3D0, D4=4D0, D10=1D1) + PARAMETER (MXX = 105, MXQ = 25, MXF = 6) + PARAMETER (MX = 3) + PARAMETER (M1=-3, M2=3, NDG=3, NDH=NDG+1, L1=M1-1, L2=M2+NDG-2) + COMMON / LhCtXXARAY / XCR, XMIN, XV(0:MXX), LSTX, NX + COMMON / LhCtXYARAY / ZZ(MXX, MXX), ZV(0:MXX) + COMMON / LhCtVARIBX / XA(MXX, L1:L2), ELY(MXX), DXTZ(MXX) + COMMON / LhCtKRN1ST / FF1(0:MXX),FG1(0:MXX),GF1(0:MXX),GG1(0:MXX),& + & FF2(0:MXX), FG2(0:MXX), GF2(0:MXX), GG2(0:MXX), & + & PNSP(0:MXX), PNSM(0:MXX) + COMMON / LhCtKRN2ND / FFG(MXX, MXX), GGF(MXX, MXX), PNS(MXX, MXX) + COMMON / LhCtKRNL00 / DZ, XL(MX), NNX + COMMON / LhCtKRNL01 / AFF2(MXX),AFG2(MXX),AGF2(MXX),AGG2(MXX), & + & ANSP (MXX), ANSM (MXX), ZFG2, ZGF2, ZQQB + EXTERNAL CtLhPFF1, CtLhRGG1, CtLhRFF2, CtLhRGG2 + EXTERNAL CtLhFNSP, CtLhFNSM + dimension aff1(mxx),agg1(mxx) + PARAMETER (PI = 3.141592653589793d0, PI2 = PI**2) + DATA CF, CG, TR / 1.33333333333333d0, 3.0, 0.5 / + ! zeta(3.0) + data zeta3/1.20205690315959d0/ + SAVE + DATA AERR, RERR / 0.0, 0.02 / + NNX = NX + DZ = 1./ (NX - 1) + DO 5 I0 = 1, MX + XL(I0) = XV(I0) + 5 END DO + DO 10 I = 1, NX-1 + XZ = XV(I) + CALL CtLhKERNEL (XZ, FF1(I), GF1(I), FG1(I), GG1(I), PNSP(I), & + & PNSM(I), FF2(I), GF2(I), FG2(I), GG2(I), NFL, IRT) + 10 END DO + FF1(0) = FF1(1) * 3. - FF1(2) * 3. + FF1(3) + FG1(0) = FG1(1) * 3. - FG1(2) * 3. + FG1(3) + GF1(0) = GF1(1) * 3. - GF1(2) * 3. + GF1(3) + GG1(0) = GG1(1) * 3. - GG1(2) * 3. + GG1(3) + PNSP(0) = PNSP(1) * 3. - PNSP(2) * 3. + PNSP(3) + PNSM(0) = PNSM(1) * 3. - PNSM(2) * 3. + PNSM(3) + FF2(0) = FF2(1) * 3. - FF2(2) * 3. + FF2(3) + FG2(0) = FG2(1) * 3. - FG2(2) * 3. + FG2(3) + GF2(0) = GF2(1) * 3. - GF2(2) * 3. + GF2(3) + GG2(0) = GG2(1) * 3. - GG2(2) * 3. + GG2(3) + FF1(NX) = FF1(NX-1) * 3. - FF1(NX-2) * 3. + FF1(NX-3) + FG1(NX) = FG1(NX-1) * 3. - FG1(NX-2) * 3. + FG1(NX-3) + GF1(NX) = GF1(NX-1) * 3. - GF1(NX-2) * 3. + GF1(NX-3) + GG1(NX) = GG1(NX-1) * 3. - GG1(NX-2) * 3. + GG1(NX-3) + PNSM(NX) = PNSM(NX-1) * 3. - PNSM(NX-2) * 3. + PNSM(NX-3) + PNSP(NX) = PNSP(NX-1) * 3. - PNSP(NX-2) * 3. + PNSP(NX-3) + FF2(NX) = FF2(NX-1) * 3. - FF2(NX-2) * 3. + FF2(NX-3) + FG2(NX) = FG2(NX-1) * 3. - FG2(NX-2) * 3. + FG2(NX-3) + GF2(NX) = GF2(NX-1) * 3. - GF2(NX-2) * 3. + GF2(NX-3) + GG2(NX) = GG2(NX-1) * 3. - GG2(NX-2) * 3. + GG2(NX-3) + RER = RERR * 4. + AFF1(1) = CtLhGausInt(CtLhPFF1,D0,XV(1),AERR,RERR,ER1,IRT) + DGG1 = NFL / 3. + TMPG = CtLhGausInt(CtLhRGG1,D0,XV(1),AERR,RERR,ER3,IRT) + AGG1(1) = TMPG + DGG1 + ANSM(1) = CtLhGausInt(CtLhFNSM,D0,XV(1),AERR,RER,ER2,IRT) + ANSP(1) = CtLhGausInt(CtLhFNSP,D0,XV(1),AERR,RER,ER2,IRT) + AER = AFF1(1) * RER + AFF2(1) = CtLhGausInt(CtLhRFF2, D0, XV(1), AER, RER, ER2, IRT) + AER = AGG1(1) * RER + AGG2(1) = CtLhGausInt(CtLhRGG2, D0, XV(1), AER, RER, ER4, IRT) + DO 20 I2 = 2, NX-1 + TEM =CtLhGausInt(CtLhPFF1,XV(I2-1),XV(I2),AERR,RERR,ER1,IRT) + AFF1(I2) = TEM + AFF1(I2-1) + AER = ABS(TEM * RER) + AFF2(I2)=CtLhGausInt(CtLhRFF2,XV(I2-1),XV(I2),AER,RER,ER2,IRT) & + & +AFF2(I2-1) + TEM = CtLhGausInt(CtLhRGG1,XV(I2-1),XV(I2),AERR,RERR,ER3,IRT) + TMPG = TMPG + TEM + AGG1(I2) = TMPG + DGG1 + AER = ABS(TEM * RER) + AGG2(I2)=CtLhGausInt(CtLhRGG2,XV(I2-1),XV(I2),AER,RER,ER4,IRT) & + & +AGG2(I2-1) + ANSP(I2)=CtLhGausInt(CtLhFNSP,XV(I2-1),XV(I2),AERR,RER,ER4,IRT) & + & +ANSP(I2-1) + ANSM(I2)=CtLhGausInt(CtLhFNSM,XV(I2-1),XV(I2),AERR,RER,ER4,IRT) & + & +ANSM(I2-1) + 20 END DO + ANSP(NX)=CtLhGausInt(CtLhFNSP,XV(NX-1),D1,AERR,RER,ERR, & + & IRT) + ANSP(NX-1) + ANSM(NX)=CtLhGausInt(CtLhFNSM,XV(NX-1),D1,AERR,RER,ERR, & + & IRT) + ANSM(NX-1) + TRNF = TR * NFL + !loop over x + do i2=1,nx-1 + x=xv(i2) +! XI = 1./ X !unused - jcp + X2 = X ** 2 + X3= x**3 + XLN = DLOG (X) + XLN2 = XLN ** 2 + XLN1M = DLOG (1.- X) + xLi2m=CtLhxLi(2,-x) + xLi2=CtLhxLi(2,x) + xLi3=CtLhxLi(3,x) + xLi31m=CtLhxLi(3,1d0-x) + xLi32=CtLhxLi(3,x2) + xln1m2=xln1m*xln1m + xln1p=dlog(1d0+x) + x1m=1d0-x + x1p=1d0+x + x3m=3d0-x + x3p=3d0+x + wgfcft= & + & (9 + 4*Pi2 - 22*x + 13*x2 + 6*(3 - 4*x + x2)*xln1m + & + & 40*xln - 24*xLi2)/9. + wgfcf2= & + & (6*(2*(-9 + Pi2) + 3*x*(5 + x)) +4*(3 +2*Pi2+3*x*(-3 + 2*x))* & + & xln1m + 6*x3m*x1m*xln1m2 - 6*(x*(8 + 3*x) + 4*xln1m2)* & + & xln - 3*(-4 + x)*x*xln2)/12 - 2*(3 + 2*xln1m)*xLi2 - 4*xLi31m + wgfcfg= & + & (3637-186*Pi2-x*(3198+72*Pi2+x*(231 + 208*x)))/108.- xln + & + & (3*xln1m*(-33 - 4*Pi2 + (50 - 17*x)*x - 3*x3m*x1m*xln1m) + & + & 2*(x*(198 + x*(27+8*x))+9*xln1m*(3 - 4*x + x2 + 2*xln1m))* & + & xln - 9*x*(4 + x)*xln2)/18- x1p*x3p*xln*xln1p- & + & (x1p*x3p - 4*xln)*xLi2m + (31d0/3d0 +4*xln1m- 4*xln)*xLi2 + & + & 4*xLi31m + 12*xLi3 - 2*xLi32 - 10*zeta3 + wfgcft= & + & (18 - 81*x + 6*Pi2*x + 123*x2 - 6*Pi2*x2 - 60*x3 + & + & 4*Pi2*x3 - 6*(-2 + 3*x - 3*x2 + 2*x3)*xln1m2 -33*x*xln + & + & 15*x2*xln - 24*x3*xln - 9*x*xln2 + 9*x2*xln2 - & + & 12*x3*xln2 - 12*x1m*xln1m*(-1 + 2*x2 + 2*xln - x*xln + & + & 2*x2*xln) - 24*xLi2)/9. + wfgcgt= & + & (2*(-67 + 2*Pi2 + x*(64 + x*(-91 + 3*Pi2 + 94*x)) + & + & x1m*(7+x*(-5+16*x))*xln1m -3*x1m*(2+ x*(-1+2*x))*xln1m2 - & + & 20*xln - 3*x*xln*(13 + 16*x*x1p - 3*x1p*xln) + & + & 6*x1p*(2+x+2*x2)*xln*xln1p+6*x1p*(2+x+2*x2)*xLi2m))/9. + AGF2(I2) = CF*TRNF*WGFCFT+CF**2* WGFCF2+CF*CG*WGFCFG + AFG2(I2) = CF*TRNF*WFGCFT +CG*TRNF*WFGCGT + !i2 + enddo + AGF2(nx)=0d0 + AFG2(nx)=0d0 + ZGF2=-28./27.*Cf**2+94./27.*Cf*Cg -52./27.*Cf*TrNf + ZFG2= 37./27.*Cf*TrNf + 35./54.*Cg*TrNf + ZQQB=1.43862321154902*(Cf**2-0.5*Cf*Cg) + DO 21 IX = 1, NX-1 + X = XV(IX) + NP = NX - IX + 1 + IS = NP + XG2 = (LOG(1./(1.-X)) + 1.) ** 2 + FFG (IS, IS) = FG2(NX) * DXTZ(I) * XG2 + GGF (IS, IS) = GF2(NX) * DXTZ(I) * XG2 + PNS (IS, IS) =PNSM(NX) * DXTZ(I) + DO 31 KZ = 2, NP + IY = IX + KZ - 1 + IT = NX - IY + 1 + XY = X / XV(IY) + XM1 = 1.- XY + XG2 = (LOG(1./XM1) + 1.) ** 2 + Z = ZZ (IX, IY) + TZ = (Z + DZ) / DZ + IZ = Int(TZ) + IZ = MAX (IZ, 0) + IZ = MIN (IZ, NX-1) + DT = TZ - IZ + TEM = (FF2(IZ) * (1.- DT) + FF2(IZ+1) * DT) / XM1 / XY + FFG (IX, IY) = TEM * DXTZ(IY) + TEM = (FG2(IZ) * (1.- DT) + FG2(IZ+1) * DT) * XG2 / XY + FFG (IS, IT) = TEM * DXTZ(IY) + TEM = (GF2(IZ) * (1.- DT) + GF2(IZ+1) * DT) * XG2 / XY + GGF (IS, IT) = TEM * DXTZ(IY) + TEM = (GG2(IZ) * (1.- DT) + GG2(IZ+1) * DT) / XM1 / XY + GGF (IX, IY) = TEM * DXTZ(IY) + TEM = (PNSP(IZ) * (1.- DT) + PNSP(IZ+1) * DT) / XM1 + PNS (IX, IY) = TEM * DXTZ(IY) + TEM = (PNSM(IZ) * (1.- DT) + PNSM(IZ+1) * DT) / XM1 + PNS (IS, IT) = TEM * DXTZ(IY) + 31 CONTINUE + 21 END DO + RETURN + END + + + SUBROUTINE CtLhTRNLAM (IRDR, NF, IACT, IRT) + IMPLICIT DOUBLE PRECISION (A-H, O-Z) + COMMON / LhCtCWZPRM / ALAM(0:9), AMHAT(0:9), AMN, NHQ + COMMON / LhCtTRNCOM / VMULM, JRDR, N, N1 + EXTERNAL CtLhZBRLAM + DATA ALM0, BLM0, RERR / 0.01, 10.0, 0.0001 / + DATA IR1, SML / 0, 1.E-5 / + IRT = 0 + N = NF + JRDR = IRDR + JACT = IACT + VLAM = ALAM(N) + IF (JACT .GT. 0) THEN + N1 = N + 1 + THMS = AMHAT(N1) + ALM = LOG (THMS/VLAM) + BLM = BLM0 + ELSE + N1 = N -1 + THMS = AMHAT(N) + ALM = ALM0 + THMS = MAX (THMS, SML) + BLM = LOG (THMS/VLAM) + ENDIF + IF (VLAM .GE. 0.7 * THMS) THEN + IF (JACT .EQ. 1) THEN + AMHAT(N1) = 0 + ELSE + AMHAT(N) = 0 + ENDIF + IRT = 4 + ALAM(N1) = VLAM + RETURN + ENDIF + IF (ALM .GE. BLM) THEN + WRITE (*, *) 'CtLhTRNLAM has ALM >= BLM: ', ALM, BLM + WRITE (*, *) 'I do not know how to continue' + STOP + ENDIF + VMULM = THMS/VLAM + ERR = RERR * LOG (VMULM) + WLLN = CtLhQZBRNT (CtLhZBRLAM, ALM, BLM, ERR, IR1) + ALAM(N1) = THMS / EXP (WLLN) + IF (IR1 .NE. 0) THEN + WRITE (*, *) 'CtLhQZBRNT failed in CtLhTRNLAM; ', & + & 'NF, VLAM =', NF, VLAM + WRITE (*, *) 'I do not know how to continue' + STOP + ENDIF + RETURN + END + + + SUBROUTINE CtLhUPC (A, La, UpA) + CHARACTER A*(*), UpA*(*), C*(1) + INTEGER I, La, Ld + La = Len(A) + Lb = Len(UpA) + If (Lb .Lt. La) Stop 'UpCase conversion length mismatch!' + Ld = ICHAR('A')-ICHAR('a') + DO 1 I = 1, Lb + If (I .Le. La) Then + c = A(I:I) + IF ( LGE(C, 'a') .AND. LLE(C, 'z') ) THEN + UpA (I:I) = CHAR(Ichar(c) + ld) + Else + UpA (I:I) = C + ENDIF + Else + UpA (I:I) = ' ' + Endif + 1 END DO + + RETURN + END + + + SUBROUTINE CtLhWARNI (IWRN, MSG, NMVAR, IVAB, & + & IMIN, IMAX, IACT) + CHARACTER*(*) MSG, NMVAR + Save Iw + Data Nmax / 100 / + IW = IWRN + IV = IVAB + + IF (IW .EQ. 0) THEN + PRINT '(1X,A/1X, 2A,I10)', MSG, NMVAR,' = ', IV + IF (IACT .EQ. 1) THEN + PRINT '(A/2I10)', ' The limits are: ', IMIN, IMAX + ENDIF + ENDIF + If (Iw .LT. Nmax) Then + PRINT '(1X,A/1X, 2A,I10)', MSG, NMVAR,' = ', IV + Elseif (Iw .Eq. Nmax) Then + Print '(/A/)', 'CtLhWARNI Severe Warning: Too many errors' + Endif + IWRN = IW + 1 + RETURN + END + + + SUBROUTINE CtLhWARNR (IWRN, MSG, NMVAR, VARIAB, & + & VMIN, VMAX, IACT) + IMPLICIT DOUBLE PRECISION (A-H, O-Z) + PARAMETER (D0=0D0, D1=1D0, D2=2D0, D3=3D0, D4=4D0, D10=1D1) + CHARACTER*(*) MSG, NMVAR + Save Iw +! Data Nmax / 100 / + Data Nmax / 10 / + IW = IWRN + VR = VARIAB + IF (IW .EQ. 0) THEN + PRINT '(1X, A/1X,2A,1PD16.7)', MSG, NMVAR, ' = ', VR + IF (IACT .EQ. 1) THEN + PRINT '(A/2(1PE15.4))', ' The limits are: ', VMIN, VMAX + ENDIF + ENDIF + If (Iw .LT. Nmax) Then + PRINT '(I5, 2A/1X,2A,1PD16.7)', IW, ' ', MSG, & + & NMVAR, ' = ', VR + Elseif (Iw .Eq. Nmax) Then + Print '(/A/)', 'CtLhWARNR Severe Warning: Too many errors' + Endif + IWRN = IW + 1 + RETURN + END + + + SUBROUTINE CtLhXARRAY + IMPLICIT DOUBLE PRECISION (A-H, O-Z) + LOGICAL LSTX + PARAMETER (D0 = 0.0, D10=10.0) + PARAMETER (MXX = 105, MXQ = 25, MXF = 6) + PARAMETER (MXPN = MXF * 2 + 2) + PARAMETER (MXQX= MXQ * MXX, MXPQX = MXQX * MXPN) + PARAMETER (M1=-3, M2=3, NDG=3, NDH=NDG+1, L1=M1-1, L2=M2+NDG-2) + Character Msg*80 + COMMON / LhCtVARIBX / XA(MXX, L1:L2), ELY(MXX), DXTZ(MXX) + COMMON / LhCtVARBAB / GB(NDG, NDH, MXX), H(NDH, MXX, M1:M2) + COMMON / LhCtHINTEC / GH(NDG, MXX) + COMMON / LhCtXXARAY / XCR, XMIN, XV(0:MXX), LSTX, NX + COMMON / LhCtXYARAY / ZZ(MXX, MXX), ZV(0:MXX) + DIMENSION G1(NDG,NDH), G2(NDG,NDH), A(NDG) + DATA F12, F22, F32 / 1D0, 1D0, 1D0 / + DATA (G1(I,NDH), G2(I,1), I=1,NDG) / 0.0,0.0,0.0,0.0,0.0,0.0 / + DATA PUNY / 1D-30 / + XV(0) = 0D0 + DZ = 1D0 / (NX-1) + DO 10 I = 1, NX - 1 + Z = DZ * (I-1) + ZV(I) = Z + X = CtLhXFRMZ (Z) + DXTZ(I) = CtLhDXDZ(Z) / X + XV (I) = X + XA(I, 1) = X + XA(I, 0) = LOG (X) + DO 20 L = L1, L2 + IF (L .NE. 0 .AND. L .NE. 1) XA(I, L) = X ** L + 20 CONTINUE + 10 END DO + XV(1) = Xmin + XV(NX) = 1D0 + ZV(Nx) = 1D0 + DXTZ(NX) = CtLhDXDZ(1.D0) + DO 21 L = L1, L2 + XA (NX, L) = 1D0 + 21 CONTINUE + XA (NX, 0) = 0D0 + DO 11 I = 1, NX-1 + ELY(I) = LOG(1D0 - XV(I)) + 11 END DO + ELY(NX) = 3D0* ELY(NX-1) - 3D0* ELY(NX-2) + ELY(NX-3) + DO 17 IX = 1, NX + ZZ (IX, IX) = 1. + DO 17 IY = IX+1, NX + XY = XV(IX) / XV(IY) + ZZ (IX, IY) = CtLhZFRMX (XY) + ZZ (NX-IX+1, NX-IY+1) = XY + 17 CONTINUE + DO 30 I = 1, NX-1 + IF (I .NE. NX-1) THEN + F11 = 1D0/XV(I) + F21 = 1D0/XV(I+1) + F31 = 1D0/XV(I+2) + F13 = XV(I) + F23 = XV(I+1) + F33 = XV(I+2) + DET = F11*F22*F33 + F21*F32*F13 + F31*F12*F23 & + & - F31*F22*F13 - F21*F12*F33 - F11*F32*F23 + IF (ABS(DET) .LT. PUNY) THEN + Msg='Determinant close to zero; will be arbitrarily set to:' + CALL CtLhWARNR(IWRN, Msg, 'DET', PUNY, D0, D0, 0) + DET = PUNY + EndIf + G2(1,2) = (F22*F33 - F23*F32) / DET + G2(1,3) = (F32*F13 - F33*F12) / DET + G2(1,4) = (F12*F23 - F13*F22) / DET + G2(2,2) = (F23*F31 - F21*F33) / DET + G2(2,3) = (F33*F11 - F31*F13) / DET + G2(2,4) = (F13*F21 - F11*F23) / DET + G2(3,2) = (F21*F32 - F22*F31) / DET + G2(3,3) = (F31*F12 - F32*F11) / DET + G2(3,4) = (F11*F22 - F12*F21) / DET + B2 = LOG (XV(I+2)/XV(I)) + B3 = XV(I) * (B2 - 1.) + XV(I+2) + GH (1,I) = B2 * G2 (2,2) + B3 * G2 (3,2) + GH (2,I) = B2 * G2 (2,3) + B3 * G2 (3,3) + GH (3,I) = B2 * G2 (2,4) + B3 * G2 (3,4) + EndIf + DO 51 J = 1, NDH + DO 52 L = 1, NDG + IF (I .EQ. 1) THEN + GB(L,J,I) = G2(L,J) + ElseIF (I .EQ. NX-1) THEN + GB(L,J,I) = G1(L,J) + Else + GB(L,J,I) = (G1(L,J) + G2(L,J)) / 2D0 + EndIf + 52 CONTINUE + 51 CONTINUE + DO 35 MM = M1, M2 + DO 40 K = 1, NDG + KK = K + MM - 2 + IF (KK .EQ. 0) THEN + A(K) = XA(I+1, 0) - XA(I, 0) + Else + A(K) = (XA(I+1, KK) - XA(I, KK)) / DBLE(KK) + EndIf + 40 CONTINUE + DO 41 J = 1, NDH + TEM = 0 + DO 43 L = 1, NDG + TEM = TEM + A(L) * GB(L,J,I) + 43 CONTINUE + H(J,I,MM) = TEM + 41 CONTINUE + 35 CONTINUE + DO 42 J = 1, NDG + DO 44 L = 1, NDG + G1(L,J) = G2(L,J+1) + 44 END DO + 42 END DO + 30 END DO + LSTX = .TRUE. + RETURN + END + + + FUNCTION CtLhXFRMZ (Z) + IMPLICIT DOUBLE PRECISION (A-H, O-Z) + LOGICAL LSTX + PARAMETER (D0=0D0, D1=1D0, D2=2D0, D3=3D0, D4=4D0, D10=1D1) + PARAMETER (MXX = 105) + COMMON / LhCtXXARAY / XCR, XMIN, XV(0:MXX), LSTX, NX + COMMON / LhCtINVERT / ZA + EXTERNAL CtLhZFXL + DATA TEM, RER / D1, 1E-3 / + DATA ZLOW, ZHIGH, IWRN2 / -10.0, 1.00002, 0 / + EPS = TEM * RER + ZA = Z + IF (Z .LE. ZHIGH .AND. Z .GT. ZLOW) THEN + XLA = LOG (XMIN) * 1.5 + XLB = 0.00001 + TEM = CtLhZBRNT (CtLhZFXL, XLA, XLB, EPS, IRT) + Else + CALL CtLhWARNR (IWRN2, 'Z out of range in CtLhXFRMZ, X set=0.', & + & 'Z', Z, ZLOW, ZHIGH, 1) + TEM = 0 + EndIf + CtLhXFRMZ = EXP(TEM) + RETURN + END + + + FUNCTION CtLhxLi(n,x) + implicit NONE + integer NCUT, i,n,m3 + real*8 CtLhxLi,Out,x,pi2by6,zeta3,c1,c2 + real*8 r,xt,L,xln1m + parameter (m3=8) + dimension c1(2:m3),c2(2:m3) + data NCUT/27/ + data c1/0.75,-0.5833333333333333d0,0.454861111111111d0, & + & -0.3680555555555555d0,0.3073611111111111d0, & + & -0.2630555555555555d0,0.2294880243764172d0/ + data c2/-0.5d0,0.5d0,-0.4583333333333333d0,0.416666666666666d0, & + & -0.3805555555555555d0,0.35d0,-0.3241071428571428d0/ + data zeta3,pi2by6 /1.20205690315959d0,1.64493406684823d0/ + L=0.0 + i=0 + r=1.0 + if (abs(x).gt.r) then + PRINT *,'Li: x out of range (-1,1) , x=',x + STOP + endif + if (n.lt.0) then + PRINT *,'Polylogarithm Li undefined for n=',n + STOP + elseif (n.eq.0) then + Out=x/(1d0-x) + elseif (n.eq.1) then + Out=-dlog(1-x) + elseif (n.eq.2) then + !Calculate dilogarithm + !separately for x<0.5 an + if (x.ge.(-0.5).and.x.le.0.5) then + do while(i.le.NCUT) + i=i+1 + r=r*x + L=L+r/i/i + enddo + Out=L + elseif (x.eq.0) then + Out=0d0 + !n.eq.2,x>0.5 + elseif(x.gt.0.5) then + xt = 1.0-x + L = pi2by6 - dlog(x)*dlog(xt) + do while(i.le.NCUT) + i=i+1 + r=r*xt + L=L-r/i/i + enddo + Out=L + elseif (x.lt.(-0.5)) then + xt=-x/(1d0-x) + L=-0.5*dlog(1-x)**2 + do while (i.le.NCUT) + i=i+1 + r=r*xt + L=L-r/i/i + enddo + Out=L + endif + !use the expansion of Li3 near x + elseif (n.eq.3.and.x.ge.0.8) then + L=zeta3+pi2by6*dlog(x) + xt=(1d0-x) + xln1m=dlog(xt) + do i=2,m3 + L=L+(c1(i)+c2(i)*xln1m)*xt**i + enddo + Out=L + !n>3 or x=3,x<0.8 + else + do while(i.le.NCUT) + i=i+1 + r=r*x + L=L+r/dble(i)**dble(n) + enddo + Out=L + endif + CtLhxLi=Out + ! CtLhxLi + END + + + FUNCTION CtLhZBRLAM (WLLN) + IMPLICIT DOUBLE PRECISION (A-H, O-Z) + COMMON / LhCtTRNCOM / VMULM, JRDR, N, N1 + WMULM = EXP (WLLN) + TEM1 = 1./ CtLhALPQCD(JRDR, N1, WMULM, I) + TEM2 = 1./ CtLhALPQCD(JRDR, N, VMULM, I) + CtLhZBRLAM = TEM1 - TEM2 + END + + + FUNCTION CtLhZBRNT(FUNC, X1, X2, TOL, IRT) + IMPLICIT DOUBLE PRECISION (A-H, O-Z) + PARAMETER (ITMAX = 1000, EPS = 3.E-12) + external func + IRT = 0 + TOL = ABS(TOL) + A=X1 + B=X2 + FA=FUNC(A) + FB=FUNC(B) + IF(FB*FA.GT.0.) THEN + PRINT *, 'Root must be bracketed for CtLhZBRNT. Set = 0' + IRT = 1 + CtLhZBRNT=0. + RETURN + ENDIF + FC=FB + DO 11 ITER=1,ITMAX + IF(FB*FC.GT.0.) THEN + C=A + FC=FA + D=B-A + E=D + ENDIF + IF(ABS(FC).LT.ABS(FB)) THEN + A=B + B=C + C=A + FA=FB + FB=FC + FC=FA + ENDIF + TOL1=2.*EPS*ABS(B)+0.5*TOL + XM=.5*(C-B) + IF(ABS(XM).LE.TOL1 .OR. FB.EQ.0.)THEN + CtLhZBRNT=B + RETURN + ENDIF + IF(ABS(E).GE.TOL1 .AND. ABS(FA).GT.ABS(FB)) THEN + S=FB/FA + IF(A.EQ.C) THEN + P=2.*XM*S + Q=1.-S + ELSE + Q=FA/FC + R=FB/FC + P=S*(2.*XM*Q*(Q-R)-(B-A)*(R-1.)) + Q=(Q-1.)*(R-1.)*(S-1.) + ENDIF + IF(P.GT.0.) Q=-Q + P=ABS(P) + IF(2.*P .LT. MIN(3.*XM*Q-ABS(TOL1*Q),ABS(E*Q))) THEN + E=D + D=P/Q + ELSE + D=XM + E=D + ENDIF + ELSE + D=XM + E=D + ENDIF + A=B + FA=FB + IF(ABS(D) .GT. TOL1) THEN + B=B+D + ELSE + B=B+SIGN(TOL1,XM) + ENDIF + FB=FUNC(B) + 11 END DO + PRINT *, 'CtLhZBRNT exceeding maximum iterations.' + IRT = 2 + CtLhZBRNT=B + RETURN + END + + + FUNCTION CtLhZFRMX (XX) + IMPLICIT DOUBLE PRECISION (A-H, O-Z) + LOGICAL LSTX + PARAMETER (D0=0D0, D1=1D0, D2=2D0, D3=3D0, D4=4D0, D10=1D1) + PARAMETER (MXX = 105) + COMMON / LhCtXXARAY / XCR, XMIN, XV(0:MXX), LSTX, NX + DATA IWRN1, HUGE, TINY / 0, 1.E35, 1.E-35 / + F(X) = (XCR-XMIN) * LOG (X/XMIN) + LOG (XCR/XMIN) * (X-XMIN) + D(X) = (XCR-XMIN) / X + LOG (XCR/XMIN) + X = XX + IF (X .GE. XMIN) THEN + TEM = F(X) / F(D1) + ElseIF (X .GE. D0) THEN + X = MAX (X, TINY) + TEM = F(X) / F(D1) + Else + CALL CtLhWARNR(IWRN1, 'X out of range in CtLhZFRMX' & + & , 'X', X, TINY, HUGE, 1) + TEM = 99. + STOP + EndIf + CtLhZFRMX = TEM + RETURN + ENTRY CtLhDZDX (XX) + X = XX + IF (X .GE. XMIN) THEN + TEM = D(X) / F(D1) + ElseIF (X .GE. D0) THEN + X = MAX (X, TINY) + TEM = D(X) / F(D1) + Else + CALL CtLhWARNR(IWRN1, 'X out of range in CtLhDZDX ' & + & , 'X', X, TINY, HUGE, 1) + TEM = 99. + STOP + EndIf + CtLhDZDX = TEM + RETURN + END + + + FUNCTION CtLhZFXL (XL) + IMPLICIT DOUBLE PRECISION (A-H, O-Z) + COMMON / LhCtINVERT / ZA + X = EXP(XL) + TT = CtLhZFRMX (X) - ZA + CtLhZFXL = TT + RETURN + END + + SUBROUTINE CtLhPOLINT4 (XA,YA,N,X,Y,DY) +! fast version of polint, valid only for N=4 +! Have explicitly unrolled the loops. + + IMPLICIT DOUBLE PRECISION (A-H, O-Z) + + PARAMETER (NMAX=4) + DIMENSION XA(N),YA(N),C(NMAX),D(NMAX) + + if(n .ne. 4) then + print *,'fatal CtLhPolint4 call',n + stop + endif + + NS=1 + DIF=ABS(X-XA(1)) + + DIFT=ABS(X-XA(1)) + IF (DIFT.LT.DIF) THEN + NS=1 + DIF=DIFT + ENDIF + C(1)=YA(1) + D(1)=YA(1) + + DIFT=ABS(X-XA(2)) + IF (DIFT.LT.DIF) THEN + NS=2 + DIF=DIFT + ENDIF + C(2)=YA(2) + D(2)=YA(2) + + DIFT=ABS(X-XA(3)) + IF (DIFT.LT.DIF) THEN + NS=3 + DIF=DIFT + ENDIF + C(3)=YA(3) + D(3)=YA(3) + + DIFT=ABS(X-XA(4)) + IF (DIFT.LT.DIF) THEN + NS=4 + DIF=DIFT + ENDIF + C(4)=YA(4) + D(4)=YA(4) + + + Y=YA(NS) + NS=NS-1 + + + HO=XA(1)-X + HP=XA(2)-X + W=C(2)-D(1) + DEN=W/(HO-HP) + D(1)=HP*DEN + C(1)=HO*DEN + + + HO=XA(2)-X + HP=XA(3)-X + W=C(3)-D(2) + DEN=W/(HO-HP) + D(2)=HP*DEN + C(2)=HO*DEN + + + HO=XA(3)-X + HP=XA(4)-X + W=C(4)-D(3) + DEN=W/(HO-HP) + D(3)=HP*DEN + C(3)=HO*DEN + + IF (2*NS.LT.3)THEN + DY=C(NS+1) + ELSE + DY=D(NS) + NS=NS-1 + ENDIF + Y=Y+DY + + HO=XA(1)-X + HP=XA(3)-X + W=C(2)-D(1) + DEN=W/(HO-HP) + D(1)=HP*DEN + C(1)=HO*DEN + + HO=XA(2)-X + HP=XA(4)-X + W=C(3)-D(2) + DEN=W/(HO-HP) + D(2)=HP*DEN + C(2)=HO*DEN + + IF (2*NS.LT.2)THEN + DY=C(NS+1) + ELSE + DY=D(NS) + NS=NS-1 + ENDIF + Y=Y+DY + + HO=XA(1)-X + HP=XA(4)-X + W=C(2)-D(1) + DEN=W/(HO-HP) + D(1)=HP*DEN + C(1)=HO*DEN + + IF (2*NS.LT.4-3)THEN + DY=C(NS+1) + ELSE + DY=D(NS) + NS=NS-1 + ENDIF + Y=Y+DY + + RETURN + END + SUBROUTINE CTLHPOLINT3 (XA,YA,N,X,Y,DY) +! fast version of polint, valid only for N=3 +! Have explicitly unrolled the loops. + IMPLICIT DOUBLE PRECISION (A-H, O-Z) + PARAMETER (NMAX=3) + DIMENSION XA(N),YA(N),C(NMAX),D(NMAX) + if(n .ne. 3) then + print *,'fatal CtLhPolint3 call',n + stop + endif + NS=1 + DIF=ABS(X-XA(1)) + DIFT=ABS(X-XA(1)) + IF (DIFT.LT.DIF) THEN + NS=1 + DIF=DIFT + ENDIF + C(1)=YA(1) + D(1)=YA(1) + DIFT=ABS(X-XA(2)) + IF (DIFT.LT.DIF) THEN + NS=2 + DIF=DIFT + ENDIF + C(2)=YA(2) + D(2)=YA(2) + DIFT=ABS(X-XA(3)) + IF (DIFT.LT.DIF) THEN + NS=3 + DIF=DIFT + ENDIF + C(3)=YA(3) + D(3)=YA(3) + Y=YA(NS) + NS=NS-1 + HO=XA(1)-X + HP=XA(2)-X + W=C(2)-D(1) + DEN=W/(HO-HP) + D(1)=HP*DEN + C(1)=HO*DEN + HO=XA(2)-X + HP=XA(3)-X + W=C(3)-D(2) + DEN=W/(HO-HP) + D(2)=HP*DEN + C(2)=HO*DEN + IF (2*NS.LT.2)THEN + DY=C(NS+1) + ELSE + DY=D(NS) + NS=NS-1 + ENDIF + Y=Y+DY + HO=XA(1)-X + HP=XA(3)-X + W=C(2)-D(1) + DEN=W/(HO-HP) + D(1)=HP*DEN + C(1)=HO*DEN + IF (2*NS.LT.1)THEN + DY=C(NS+1) + ELSE + DY=D(NS) + NS=NS-1 + ENDIF + Y=Y+DY + RETURN + END diff --git a/LHAPDF/lhapdf-5.9.1/src/EVLNNPDF.f b/LHAPDF/lhapdf-5.9.1/src/EVLNNPDF.f new file mode 100644 index 00000000000..12130916dcb --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/EVLNNPDF.f @@ -0,0 +1,3065 @@ +!********************************************************************** +! +! TABLE OF CONTENTS +! +! 1. evolinit -> Initializes the evolution code by filling the COMMO +! BLOCKS which contain the constants +! 2. alphasNNPDF,ffn,vfn,funcs -> Routines related to the computatio +! 3. evolfactx -> Computes the evolution kernels in x-space. +! 4. xgrid -> Gives the x pts for the convolution +! 5. gammax -> FT algorithm for Mellin inversion +! 6. gamma -> evaluates gamma coefficients +! 7. evolfactn -> N space quantities evaluation +! 8. evolint -> convolution routines +! 9. andim_IPT -> Evaluates an dimension +! 10.matutils.f, psi.f -> Matrix operation, special functions and dg +! +! NB: pdfin & NN are in wrapXNN.f +! +!********************************************************************** + +!**** +! 1 *------------------------------------------------------------------- +!**** + SUBROUTINE LH_EVOLINIT + IMPLICIT none +! + INTEGER ipt,imodev,ivfn,itmc + COMMON/nnpdf10EVFLAGS/ipt,imodev,ivfn,itmc +! + REAL*8 ca,cf,tr + COMMON/NNPDF10COLFACT/ca,cf,tr + REAL*8 emc,zeta2,zeta3,zeta4,pi + PARAMETER (pi = 3.1415926535897932385) + COMMON /NNPDF10CONSTS/ emc,zeta2,zeta3,zeta4 +! + REAL*8 beta0(3:6),beta1(3:6),beta2(3:6) + REAL*8 b1(3:6),b2(3:6) + COMMON /NNPDF10BETA/ beta0,beta1,beta2,b1,b2 + REAL*8 q2th(4:6),asref,q2ref + REAL*8 as0,asc,asb,ast,asq + COMMON/nnpdf10VFNS/ q2th,asref,q2ref + COMMON /NNPDF10AS/ as0,asc,asb,ast,asq +! + REAL*8 q20,q2 + COMMON/NNPDF10EVSCALE/q20,q2 +! + INTEGER i, nff + REAL*8 alphas,LH_AlphaExactBeta,LH_AlphaMZ + EXTERNAL LH_AlphaExactBeta,LH_AlphaMZ +! +! Color Factors +! + CA= 3D0 + CF= 4D0/3D0 + TR= 0.5D0 +! +! Constants +! + EMC = 0.5772156649D0 + ZETA2 = 1.644934067D0 + ZETA3 = 1.2020569031D0 + ZETA4 = 1.0823232337D0 +! +! Beta function coefficients +! + DO I=3,6 + BETA0(I) = (33d0-2d0*I)/3d0 + BETA1(I) = 102d0-38d0/3d0*I + BETA2(I) = 2857d0/2d0-5033d0/18d0*I+325d0/54d0*I**2d0 + B1(I) = BETA1(I)/BETA0(I) + B2(I) = BETA2(I)/BETA0(I) + ENDDO +! + IF(IVFN.EQ.0) THEN + NFF = 3 + IF(IMODEV.EQ.1)THEN + CALL LH_FFN(q20,alphas,ipt,LH_AlphaExactBeta,NFF) + ELSEIF(IMODEV.EQ.0)THEN + CALL LH_FFN(q20,alphas,ipt,LH_AlphaMZ,NFF) + ENDIF + AS0 = ALPHAS/4d0/PI + IF(IMODEV.EQ.1)THEN + CALL LH_FFN(q2TH(4),alphas,ipt,LH_AlphaExactBeta,NFF) + ELSEIF(IMODEV.EQ.0)THEN + CALL LH_FFN(q2TH(4),alphas,ipt,LH_AlphaMZ,NFF) + ENDIF + ASC = ALPHAS/4d0/PI + IF(IMODEV.EQ.1)THEN + CALL LH_FFN(q2TH(5),alphas,ipt,LH_AlphaExactBeta,NFF) + ELSEIF(IMODEV.EQ.0)THEN + CALL LH_FFN(q2TH(5),alphas,ipt,LH_AlphaMZ,NFF) + ENDIF + ASB = ALPHAS/4d0/PI + IF(IMODEV.EQ.1)THEN + CALL LH_FFN(q2TH(6),alphas,ipt,LH_AlphaExactBeta,NFF) + ELSEIF(IMODEV.EQ.0)THEN + CALL LH_FFN(q2TH(6),alphas,ipt,LH_AlphaMZ,NFF) + ENDIF + AST = ALPHAS/4d0/PI + ELSE + IF(IMODEV.EQ.1)THEN + CALL LH_VFN(q20,alphas,ipt,LH_AlphaExactBeta) + ELSEIF(IMODEV.EQ.0)THEN + CALL LH_VFN(q20,alphas,ipt,LH_AlphaMZ) + ENDIF + AS0 = ALPHAS/4d0/PI + IF(IMODEV.EQ.1)THEN + CALL LH_VFN(q2TH(4),alphas,ipt,LH_AlphaExactBeta) + ELSEIF(IMODEV.EQ.0)THEN + CALL LH_VFN(q2TH(4),alphas,ipt,LH_AlphaMZ) + ENDIF + ASC = ALPHAS/4d0/PI + IF(IMODEV.EQ.1)THEN + CALL LH_VFN(q2TH(5),alphas,ipt,LH_AlphaExactBeta) + ELSEIF(IMODEV.EQ.0)THEN + CALL LH_VFN(q2TH(5),alphas,ipt,LH_AlphaMZ) + ENDIF + ASB = ALPHAS/4d0/PI + IF(IMODEV.EQ.1)THEN + CALL LH_VFN(q2TH(6),alphas,ipt,LH_AlphaExactBeta) + ELSEIF(IMODEV.EQ.0)THEN + CALL LH_VFN(q2TH(6),alphas,ipt,LH_AlphaMZ) + ENDIF + AST = ALPHAS/4d0/PI + ENDIF +! + ASQ = 0.d0 +! + RETURN + END + +!**** +! 2 *------------------------------------------------------------------- +!**** + FUNCTION alphaNNPDF(QQ) + IMPLICIT none +! + INTEGER nff + INTEGER ipt,imodev,ivfn,itmc + COMMON/NNPDF10EVFLAGS/ipt,imodev,ivfn,itmc +! + REAL*8 alphaNNPDF + REAL*8 qq,qq2 + REAL*8 alphas,LH_AlphaExactBeta,LH_AlphaMZ + EXTERNAL LH_AlphaExactBeta,LH_AlphaMZ +! + qq2 = qq**2. + CALL lh_evolinit +! + IF(ivfn.eq.0)THEN + WRITE(*,*)"FFN not available!" + NFF = 3 + IF(imodev.eq.1)THEN + CALL LH_FFN(qq2,alphas,ipt,LH_AlphaExactBeta,NFF) + ELSEIF(imodev.eq.0)THEN + CALL LH_FFN(qq2,alphas,ipt,LH_AlphaMZ,NFF) + ENDIF + ELSEIF(ivfn.EQ.1)THEN + IF (imodev.EQ.1)THEN + CALL LH_VFN(qq2,alphas,ipt,LH_AlphaExactBeta) + ELSEIF(imodev.EQ.0)THEN + CALL LH_VFN(qq2,alphas,ipt,LH_AlphaMZ) + ENDIF + ENDIF +! + alphaNNPDF = alphas +! + RETURN + END + +! +! FFN: returns the value of alpha_s computed for Fixed +! Flavour Number. +! VFN: returns the value of alpha_s computed for Variable +! Flavour Number. +! + SUBROUTINE LH_FFN(q2,alphas,ipt,FUNC,nf) + IMPLICIT none +! + REAL*8 emc,zeta2,zeta3,zeta4,pi + PARAMETER (pi = 3.1415926535897932385) + COMMON /NNPDF10CONSTS/ emc,zeta2,zeta3,zeta4 +! + REAL*8 q2th(4:6),asref,q2ref + REAL*8 as0,asc,asb,ast,asq + COMMON/nnpdf10VFNS/ q2th,asref,q2ref + COMMON /NNPDF10AS/ as0,asc,asb,ast,asq +! + INTEGER nf + INTEGER ipt + REAL*8 q2,qq2 + REAL*8 alphas,func,alphasref,qq2ref +! + alphasref = asref + qq2ref = q2ref + qq2 = q2 + + alphas = FUNC(nf,qq2ref,alphasref,qq2,ipt) + + RETURN + END +! +! + SUBROUTINE LH_VFN(qq2,alphas,ipt,FUNC) + IMPLICIT none +! + REAL*8 emc,zeta2,zeta3,zeta4,pi + PARAMETER (pi = 3.1415926535897932385) + COMMON /NNPDF10CONSTS/ emc,zeta2,zeta3,zeta4 + + REAL*8 q2th(4:6),asref,q2ref + REAL*8 as0,asc,asb,ast,asq + COMMON/nnpdf10VFNS/ q2th,asref,q2ref + COMMON /NNPDF10AS/ as0,asc,asb,ast,asq +! + INTEGER nfi,nff,dnf,snf,ipt + double precision q2,qq2,FUNC,alphasref,qq2ref + double precision alphas,c2,asi +! c2 is the same coefficient used in eq. 2.42 +! of hep-ph/0408244 and obtained in eq. 10 +! of hep-ph/9706430. In the following it is divided +! by (4*pi)^2 to match the notations + parameter(c2=14d0/3d0) + external FUNC + + q2=qq2 + + if(q2.ge.q2th(6))then + nff=6 + elseif(q2.ge.q2th(5))then + nff=5 + elseif(q2.ge.q2th(4))then + nff=4 + else + nff=3 + endif + if(q2ref.gt.q2th(6))then + nfi=6 + elseif(q2ref.gt.q2th(5))then + nfi=5 + elseif(q2ref.gt.q2th(4))then + nfi=4 + else + nfi=3 + endif +! + alphasref = asref + qq2ref = q2ref + + 10 if(nff.eq.nfi) then + alphas = FUNC(nfi,qq2ref,alphasref,q2,ipt) + return + else + if(nff.gt.nfi)then + dnf=1 + snf=1 + else + dnf=-1 + snf=0 + endif + asi = FUNC(nfi,qq2ref,alphasref,q2th(nfi+snf),ipt) + if(ipt.ge.2)then + if(nff.gt.nfi) asi=asi+(c2/(4d0*pi)**2d0)*asi**3d0 + if(nff.lt.nfi) asi=asi-(c2/(4d0*pi)**2d0)*asi**3d0 + endif + alphasref = asi + qq2ref = q2th(nfi+snf) + nfi = nfi+dnf + goto 10 + endif + end +! +! FUNCS for the computation of alpha_s with diff methods +! - AlphaMZ: computes alpha_s as function of alpha_s at a given +! refernce scale. +! - AlphaExactBeta: Exact solution of the QCD beta function +! equation using fourth order Runge-Kutta +! algorithm. +! + FUNCTION LH_AlphaMZ(nfi,mz2,asz,q2,ipt) + IMPLICIT none +! + REAL*8 emc,zeta2,zeta3,zeta4,pi + PARAMETER (pi = 3.1415926535897932385) + COMMON /NNPDF10CONSTS/ emc,zeta2,zeta3,zeta4 +! + REAL*8 beta0(3:6),beta1(3:6),beta2(3:6) + REAL*8 b1(3:6),b2(3:6) + COMMON/nnpdf10BETA/beta0,beta1,beta2,b1,b2 +! + INTEGER nfi,ipt + REAL*8 q2ref,q2,asi,asref + REAL*8 alo,t,as,den,mz2,asz,LH_AlphaMZ + + q2ref = mz2 + asref = asz/4./pi + asi = asref + t = log(q2/q2ref) + den = 1.+beta0(nfi)*asi*t + alo = asi/den + +! LO + as = alo + +! NLO + IF(ipt.GE.1) as = alo*(1-b1(nfi)*alo*log(den)) + +! NNLO + IF(ipt.GE.2)THEN + as = alo*(1.+(alo*(alo-asi)*(b2(nfi)-b1(nfi)**2.) & + & +as*b1(nfi)*dlog(as/asi))) + ENDIF +! + LH_AlphaMZ = 4d0*pi*as +! + RETURN + END +! +! + FUNCTION LH_AlphaExactBeta(nf,r20,as0,r2,ipt) +! + REAL*8 emc,zeta2,zeta3,zeta4,pi + PARAMETER (pi = 3.1415926535897932385) + COMMON /NNPDF10CONSTS/ emc,zeta2,zeta3,zeta4 +! + REAL*8 beta0(3:6),beta1(3:6),beta2(3:6) + REAL*8 b1(3:6),b2(3:6) + COMMON/nnpdf10BETA/beta0,beta1,beta2,b1,b2 +! + INTEGER NFMIN, NFMAX, NF, NSTEP, K1,ipt,nnf + REAL*8 LH_fbeta,LH_AlphaExactBeta + REAL*8 as,as0,r20,r2 + REAL*8 dlr,lrrat,sxth + REAL*8 xk0,xk1,xk2,xk3 + + PARAMETER (NFMIN = 3, NFMAX = 6) + PARAMETER (NSTEP=50) + PARAMETER (SXTH = 0.166666666666666D0 ) +! + NNF = NF + AS0 = AS0/4./pi + AS = AS0 + LRRAT = dLOG (R2/R20) + DLR = LRRAT / NSTEP +! +! ..Solution of the evolution equation depending on NAORD +! (fourth-order Runge-Kutta beyond the leading order) + IF (IPT.EQ.0) THEN + AS = AS0 / (1d0+ BETA0(NF) * AS0 * LRRAT) + ELSE IF (IPT.EQ.1) THEN + DO 2 K1 = 1, NSTEP + XK0 = DLR * LH_FBETA (AS,NNF,IPT) + XK1 = DLR * LH_FBETA (AS + 0.5d0 * XK0,NNF,IPT) + XK2 = DLR * LH_FBETA (AS + 0.5d0 * XK1,NNF,IPT) + XK3 = DLR * LH_FBETA (AS + XK2,NNF,IPT) + AS = AS + SXTH * (XK0 + 2d0* XK1 + 2d0* XK2 + XK3) + 2 CONTINUE + ELSE IF (IPT.EQ.2) THEN + DO 3 K1 = 1, NSTEP + XK0 = DLR * LH_FBETA (AS,nnf,ipt) + XK1 = DLR * LH_FBETA (AS + 0.5d0 * XK0,nnf,ipt) + XK2 = DLR * LH_FBETA (AS + 0.5d0 * XK1,nnf,ipt) + XK3 = DLR * LH_FBETA (AS + XK2,nnf,ipt) + AS = AS + SXTH * (XK0 + 2d0* XK1 + 2d0* XK2 + XK3) + 3 CONTINUE + END IF + + LH_alphaexactbeta = as*(4d0*pi) + + RETURN + END +! + FUNCTION LH_fbeta(a,nf,ipt) + IMPLICIT none +! + REAL*8 beta0(3:6),beta1(3:6),beta2(3:6) + REAL*8 b1(3:6),b2(3:6) + COMMON/nnpdf10BETA/beta0,beta1,beta2,b1,b2 +! + REAL*8 lh_fbeta,a + INTEGER nf,ipt + + IF(ipt.EQ.1)THEN + LH_FBETA = - A**2d0 * ( BETA0(NF) + A * BETA1(NF) ) + ELSEIF(ipt.EQ.2)THEN + LH_FBETA = - A**2d0 * ( BETA0(NF) + A * ( BETA1(NF) & + & + A * BETA2(NF) ) ) + ENDIF + + RETURN + END +! +! Find \LambdaQCD(nf) from the reference scale +! Needed for LHAPDF interface +! + function LH_LAMBDAZ(NF) + implicit none +! + REAL*8 emc,zeta2,zeta3,zeta4,pi + PARAMETER (pi = 3.1415926535897932385) + COMMON /NNPDF10CONSTS/ emc,zeta2,zeta3,zeta4 +! + REAL*8 beta0(3:6),beta1(3:6),beta2(3:6) + REAL*8 b1(3:6),b2(3:6) + COMMON/nnpdf10BETA/beta0,beta1,beta2,b1,b2 +! + REAL*8 q2th(4:6),asref,q2ref + REAL*8 as0,asc,asb,ast,asq + COMMON/nnpdf10VFNS/ q2th,asref,q2ref + COMMON /NNPDF10AS/ as0,asc,asb,ast,asq +! + INTEGER nf,i + REAL*8 LH_lambdaz + REAL*8 aref,lambda5sq,lambdaz5,qth(4:6) +! + AREF = ASREF /(4.d0*PI) + DO I= 3,6 + QTH(i) = dsqrt(Q2TH(I)) + ENDDO +! + LAMBDA5SQ = Q2REF * DEXP(-1d0/(BETA0(5)*AREF) & + & - (BETA1(5)/BETA0(5)**2d0) & + & * DLOG(BETA1(5)*AREF/(BETA0(5)+BETA1(5)*AREF))) + LAMBDAZ5 = DSQRT(LAMBDA5SQ) + IF(NF.EQ.5)THEN + LH_LAMBDAZ = LAMBDAZ5 + ELSEIF(NF.EQ.6)THEN + !!!!!! add formula!!!! + LH_LAMBDAZ = LAMBDAZ5 + ELSEIF(NF.LE.4)THEN + LH_LAMBDAZ = LAMBDAZ5 * ((QTH(5)/LAMBDAZ5)**(2d0/25d0)) & + & * dLOG(Q2TH(5)/LAMBDA5SQ)**(963d0/14375d0) + ENDIF + +! + RETURN + END +!**** +! 3 *------------------------------------------------------------------- +!**** +! +! evolfactx: Computes the ev. kernels in x-space.(DIFF FROM CODE!! N +! + SUBROUTINE LH_EVOLFACTX(obs,x) + IMPLICIT none +! + INTEGER npoints + PARAMETER(npoints=2**8) + INTEGER IPT,IMODEV,IVFN,ITMC + COMMON /NNPDF10EVFLAGS/ IPT,IMODEV,IVFN,ITMC + INTEGER ieval,niter,nmax + COMMON /nnpdf10NGRID/ ieval,niter,nmax + REAL*8 xmin,xm1,xm2,xmax + COMMON/nnpdf10GRID/xmin,xm1,xm2,xmax +! + ! NO MORE FNCTS OF NDATA + REAL*8 gm2ns(4),gm2ns24(2),gm2sg(2,2) + COMMON /nnpdf10GM2/gm2ns,gm2ns24,gm2sg + REAL*8 xx(NPOINTS),wn(NPOINTS),evkns(4,NPOINTS), & + & evksg(2,2,NPOINTS),evkns24(2,NPOINTS) + COMMON /nnpdf10XEVK/ xx,wn,evkns,evksg,evkns24 +! + REAL*8 q20,q2 + COMMON/nnpdf10EVSCALE/q20,q2 + REAL*8 q2th(4:6),asref,q2ref + REAL*8 as0,asc,asb,ast,asq + COMMON/nnpdf10VFNS/ q2th,asref,q2ref + COMMON /NNPDF10AS/ as0,asc,asb,ast,asq +! + INTEGER j,obs + REAL*8 x + REAL*8 flx + REAL*8 LH_gamm2ns,LH_gamm2sg,LH_gamm2ns24 + REAL*8 xxtmp(NPOINTS),wtmp(NPOINTS) + REAL*8 LH_gammax_nsp,LH_gammax_nsm,LH_gammax_nsvu,LH_gammax_nsvd + REAL*8 LH_gammax_ns24q,LH_gammax_ns24g + REAL*8 LH_gammax_qq, LH_gammax_qg, LH_gammax_gq, LH_gammax_gg +! + flx=0.2d0 + if(ipt.eq.2)flx=0.3d0 +! + do j=1,NPOINTS + xxtmp(j)=0.d0 + wtmp(j)=0.d0 + enddo +! + call LH_xgrid(x,xm1,xm2,xmax,flx,niter,xxtmp,wtmp,nmax) +! + DO j=1,NMAX + xx(j) = xxtmp(j) + wn(j) = wtmp(j) + evkns(1,j) = LH_gammax_nsp(xx(j),Q20,Q2) + evkns(2,j) = LH_gammax_nsm(xx(j),Q20,Q2) + evkns(3,j) = LH_gammax_nsvu(xx(j),Q20,Q2) + evkns(4,j) = LH_gammax_nsvd(xx(j),Q20,Q2) + evkns24(1,j) = LH_gammax_ns24q(xx(j),Q20,Q2) + evkns24(2,j) = LH_gammax_ns24g(xx(j),Q20,Q2) + evksg(1,1,j) = LH_gammax_qq(xx(j),Q20,Q2) + evksg(1,2,j) = LH_gammax_qg(xx(j),Q20,Q2) + evksg(2,1,j) = LH_gammax_gq(xx(j),Q20,Q2) + evksg(2,2,j) = LH_gammax_gg(xx(j),Q20,Q2) + ENDDO +! + gm2ns(1) = LH_gamm2ns(1,x,Q20,Q2) + gm2ns(2) = LH_gamm2ns(2,x,Q20,Q2) + gm2ns(3) = LH_gamm2ns(3,x,Q20,Q2) + gm2ns(4) = LH_gamm2ns(4,x,Q20,Q2) + gm2ns24(1) = LH_gamm2ns24(1,x,Q20,Q2) + gm2ns24(2) = LH_gamm2ns24(2,x,Q20,Q2) + gm2sg(1,1) = LH_gamm2sg(1,1,x,Q20,Q2) + gm2sg(1,2) = LH_gamm2sg(1,2,x,Q20,Q2) + gm2sg(2,1) = LH_gamm2sg(2,1,x,Q20,Q2) + gm2sg(2,2) = LH_gamm2sg(2,2,x,Q20,Q2) +! + RETURN + END +!**** +! 4 *------------------------------------------------------------------ +!**** +! +! Gives the pts in x for the convolution grid +! + + SUBROUTINE LH_xgrid(xmin,xmm1,xmm2,xmax,flx,NITER,xx,wn,NMAX) +! + IMPLICIT none +! + INTEGER npoints + PARAMETER(npoints=2**8) + INTEGER NINT,NINT1,NINT2,NINT3 + INTEGER ntmp,NITER,NGAUSS,NMAX + PARAMETER(NGAUSS=4) + INTEGER i,k,ii,k2,k3 + REAL*8 xmin,xmax,xm1,rtmp,xdum,xm2,xmm2,flx,xmm1 + REAL*8 sum,diff,z + REAL*8 xx(NPOINTS),wn(NPOINTS) + REAL*8 down(NPOINTS),up(NPOINTS) + REAL*8 ZS(NGAUSS),WZ(NGAUSS) +! + DATA WZ & + & / 0.347854845137454D0, & + & 0.652145154862546D0, & + & 0.652145154862546D0, & + & 0.347854845137454D0/ + + DATA ZS & + & / -0.861136311594053D0, & + & -0.339981043584856D0, & + & 0.339981043584856D0, & + & 0.861136311594053D0 / + + k=0 + + xm1=xmm1 + + DO ii=0,NITER + +! X < 0.99: 3 kind of division + + IF(xmin.lt.xmm2)THEN + + NINT=2**ii + NINT3=int(flx*NINT) + xm2=xmm2 + if(NINT3.lt.1)xm2=xmax + + if(xmin.lt.xm1)then + rtmp=abs((dlog(xm1-xmin))/(xm2-xmin)) + ntmp=int(NINT/rtmp) + NINT1=ntmp + else + NINT1=0 + endif + + NINT2=NINT-NINT1-NINT3 + + if(xmin.le.xm1)then + do i=1,NINT1 + xdum=xmin*(xm1/xmin)**(dble(i-1)/dble(NINT1)) + down(i)=xdum + enddo + endif + + if(xmin.gt.xm1)xm1=xmin + if(xmin.le.xm1)then + do i=1,NINT2 + xdum=xm1+(xm2-xm1)*(dble(i-1)/dble(NINT2)) + down(i+NINT1)=xdum + enddo + endif + + do i=1,NINT3 + xdum=1.d0-(1.d0-xm2)*((1.d0-xmax)/ & + & (1.d0-xm2))**(dble(i-1)/dble(NINT3)) + down(i+NINT1+NINT2)=xdum + enddo + +! X>= 0.99: only intervals logarithmic in log(1-x) + ELSE +! + NINT = 2**ii + + DO i=1,NINT + xdum=1.d0-(1.d0-xmin)*((1.d0-xmax)/ & + & (1.d0-xmin))**(dble(i-1)/dble(NINT)) + down(i)=xdum + ENDDO + + ENDIF + + do i = 2, NINT + up(i-1) = down(i) + enddo + up(NINT) = xmax + + DO K2 = 1, NINT + SUM = UP(K2) + DOWN(K2) + DIFF = UP(K2) - DOWN(K2) + DO K3 = 1, NGAUSS + K = K + 1 + Z = (SUM + DIFF * ZS(K3)) * 0.5d0 + WN(K) = DIFF * 0.5d0 * WZ(K3) + xx(K) = Z + IF(Z.LT.XMIN)WRITE(*,*)"WARNING",K,XX(K),k2,DOWN(K2),UP(K2) + ENDDO + ENDDO + +! + ENDDO +! + NMAX=k +! + RETURN + END +! +!**** +! 5 *------------------------------------------------------------------- +!**** +! +! File: gammax.f +! Contains the functions to compute x*Gamma(x,Q2i,Q2f) as +! Mellin inversions of the evolution operators computed +! in N-space. +! + FUNCTION LH_gammax_nsp(x,Q2i,Q2f) + IMPLICIT none + REAL*8 LH_gammax_nsp + REAL*8 x,Q2i,Q2f + REAL*8 evpdf + + call LH_fixedtalbot_nsp(evpdf,x,Q2i,Q2f) + LH_gammax_nsp = x*evpdf + + RETURN + END +! + FUNCTION LH_gammax_nsm(x,Q2i,Q2f) + IMPLICIT none + REAL*8 LH_gammax_nsm + REAL*8 x,Q2i,Q2f + REAL*8 evpdf + + call LH_fixedtalbot_nsm(evpdf,x,Q2i,Q2f) + LH_gammax_nsm = x*evpdf + + RETURN + END +! + FUNCTION LH_gammax_nsvu(x,Q2i,Q2f) + IMPLICIT none + REAL*8 LH_gammax_nsvu + REAL*8 x,Q2i,Q2f + REAL*8 evpdf + + call LH_fixedtalbot_nsvu(evpdf,x,Q2i,Q2f) + LH_gammax_nsvu = x*evpdf + + RETURN + END +! + FUNCTION LH_gammax_nsvd(x,Q2i,Q2f) + IMPLICIT none + REAL*8 LH_gammax_nsvd + REAL*8 x,Q2i,Q2f + REAL*8 evpdf + + call LH_fixedtalbot_nsvd(evpdf,x,Q2i,Q2f) + + LH_gammax_nsvd = x*evpdf + + RETURN + END +! + FUNCTION LH_gammax_ns24q(x,Q2i,Q2f) + IMPLICIT none + REAL*8 LH_gammax_ns24q + REAL*8 x,Q2i,Q2f + REAL*8 evpdf + + call LH_fixedtalbot_ns24q(evpdf,x,Q2i,Q2f) + + LH_gammax_ns24q = x*evpdf + + RETURN + END +! + FUNCTION LH_gammax_ns24g(x,Q2i,Q2f) + IMPLICIT none + REAL*8 LH_gammax_ns24g + REAL*8 x,Q2i,Q2f + REAL*8 evpdf + + call LH_fixedtalbot_ns24g(evpdf,x,Q2i,Q2f) + + LH_gammax_ns24g = x*evpdf + + RETURN + END +! + FUNCTION LH_gammax_qq(x,Q2i,Q2f) + IMPLICIT none + REAL*8 LH_gammax_qq + REAL*8 x,Q2i,Q2f + REAL*8 evpdf + + call LH_fixedtalbot_qq(evpdf,x,Q2i,Q2f) + + LH_gammax_qq = x*evpdf + + RETURN + END +! + FUNCTION LH_gammax_qg(x,Q2i,Q2f) + IMPLICIT none + REAL*8 LH_gammax_qg + REAL*8 x,Q2i,Q2f + REAL*8 evpdf + + call LH_fixedtalbot_qg(evpdf,x,Q2i,Q2f) + + LH_gammax_qg = x*evpdf + + RETURN + END +! + FUNCTION LH_gammax_gq(x,Q2i,Q2f) + IMPLICIT none + REAL*8 LH_gammax_gq + REAL*8 x,Q2i,Q2f + REAL*8 evpdf + + call LH_fixedtalbot_gq(evpdf,x,Q2i,Q2f) + + LH_gammax_gq = x*evpdf + + RETURN + END +! + FUNCTION LH_gammax_gg(x,Q2i,Q2f) + IMPLICIT none + REAL*8 LH_gammax_gg + REAL*8 x,Q2i,Q2f + REAL*8 evpdf + + call LH_fixedtalbot_gg(evpdf,x,Q2i,Q2f) + + LH_gammax_gg = x*evpdf + + RETURN + END +! +! Fixed Talbot algorithm + + SUBROUTINE LH_fixedtalbot_nsp(xfunc,x,Q2i,Q2f) + IMPLICIT none + + REAL*8 x,xfunc + REAL*8 Q2i,Q2f + integer m,j + REAL*8 theta,pi,sigma,t,tmp,r + COMPLEX*16 s,s1,tmp2,zpdfns(4),zpdfsg(2,2),ZPDFNS24(2) + + pi=acos(-1d0) + m = 16 + t=-dlog(x) + + tmp = 0d0 + tmp2 = 0d0 + + r=2d0*m/5d0/t + + do j=1,m-1 + theta = dble(j)*pi/dble(m) + sigma=theta+(theta/tan(theta)-1d0)/tan(theta) + s=r*theta*DCMPLX(1d0/tan(theta),1d0) + s1 = s + (1d0,0d0) + call LH_ZFUNC(s1,x,Q2i,Q2f,ZPDFNS,ZPDFNS24,ZPDFSG) + tmp2=exp(t*s1)*DCMPLX(1d0,sigma)*zpdfns(1) + tmp=tmp+dreal(tmp2) + enddo + + call LH_zfunc(DCMPLX(r+1d0,0d0),x,Q2i,Q2f,ZPDFNS,ZPDFNS24,ZPDFSG) + + xfunc=r/m*(tmp+.5d0*exp((r+1d0)*t)*dreal(zpdfns(1))) + + RETURN + END +! + SUBROUTINE LH_fixedtalbot_nsm(xfunc,x,Q2i,Q2f) + IMPLICIT none + + REAL*8 x,xfunc + REAL*8 Q2i,Q2f + integer m,j + REAL*8 theta,pi,sigma,t,tmp,r + COMPLEX*16 s,s1,tmp2,zpdfns(4),zpdfsg(2,2),ZPDFNS24(2) + + pi=acos(-1d0) + m = 16 + + t=-dlog(x) + + tmp = 0d0 + tmp2 = 0d0 + + r=2d0*m/5d0/t + + do j=1,m-1 + theta = dble(j)*pi/dble(m) + sigma=theta+(theta/tan(theta)-1d0)/tan(theta) + s=r*theta*DCMPLX(1d0/tan(theta),1d0) + s1 = s + (1d0,0d0) + call LH_zfunc(s1,x,Q2i,Q2f,ZPDFNS,ZPDFNS24,ZPDFSG) + tmp2=exp(t*s1)*DCMPLX(1d0,sigma)*zpdfns(2) + tmp=tmp+dreal(tmp2) + enddo + call LH_zfunc(DCMPLX(r+1d0,0d0),x,Q2i,Q2f,ZPDFNS,ZPDFNS24,ZPDFSG) + + xfunc=r/m*(tmp+.5d0*exp((r+1d0)*t)*dreal(zpdfns(2))) + + RETURN + END +! + SUBROUTINE LH_fixedtalbot_nsvu(xfunc,x,Q2i,Q2f) + IMPLICIT none + + REAL*8 x,xfunc + REAL*8 Q2i,Q2f + integer m,j + REAL*8 theta,pi,sigma,t,tmp,r + COMPLEX*16 s,s1,tmp2,zpdfns(4),zpdfsg(2,2),ZPDFNS24(2) + + pi=acos(-1d0) + m = 16 + + t=-dlog(x) + + tmp = 0d0 + tmp2 = 0d0 + + r=2d0*m/5d0/t + + do j=1,m-1 + theta = dble(j)*pi/dble(m) + sigma=theta+(theta/tan(theta)-1d0)/tan(theta) + s=r*theta*DCMPLX(1d0/tan(theta),1d0) + s1 = s + (1d0,0d0) + call LH_zfunc(s1,x,Q2i,Q2f,ZPDFNS,ZPDFNS24,ZPDFSG) + tmp2=exp(t*s1)*DCMPLX(1d0,sigma)*zpdfns(3) + tmp=tmp+dreal(tmp2) + enddo + + call LH_zfunc(DCMPLX(r+1d0,0d0),x,Q2i,Q2f,ZPDFNS,ZPDFNS24,ZPDFSG) + + xfunc=r/m*(tmp+.5d0*exp((r+1d0)*t)*dreal(zpdfns(3))) + + RETURN + END +! + SUBROUTINE LH_fixedtalbot_nsvd(xfunc,x,Q2i,Q2f) + IMPLICIT none + + REAL*8 x,xfunc + REAL*8 Q2i,Q2f + integer m,j + REAL*8 theta,pi,sigma,t,tmp,r + COMPLEX*16 s,s1,tmp2,zpdfns(4),zpdfsg(2,2),ZPDFNS24(2) + + pi=acos(-1d0) + m = 16 + + t=-dlog(x) + + tmp = 0d0 + tmp2 = 0d0 + + r=2d0*m/5d0/t + + do j=1,m-1 + theta = dble(j)*pi/dble(m) + sigma=theta+(theta/tan(theta)-1d0)/tan(theta) + s=r*theta*DCMPLX(1d0/tan(theta),1d0) + s1 = s + (1d0,0d0) + call LH_zfunc(s1,x,Q2i,Q2f,ZPDFNS,ZPDFNS24,ZPDFSG) + tmp2=exp(t*s1)*DCMPLX(1d0,sigma)*zpdfns(4) + tmp=tmp+dreal(tmp2) + enddo + call LH_zfunc(DCMPLX(r+1d0,0d0),x,Q2i,Q2f,ZPDFNS,ZPDFNS24,ZPDFSG) + + xfunc=r/m*(tmp+.5d0*exp((r+1d0)*t)*dreal(zpdfns(4))) + + RETURN + END +! + SUBROUTINE LH_fixedtalbot_ns24q(xfunc,x,Q2i,Q2f) + IMPLICIT none + + REAL*8 x,xfunc + REAL*8 Q2i,Q2f + integer m,j + REAL*8 theta,pi,sigma,t,tmp,r + COMPLEX*16 s,s1,tmp2,zpdfns(4),zpdfsg(2,2),ZPDFNS24(2) + + pi=acos(-1d0) + m=16 + + t=-dlog(x) + + tmp = 0d0 + tmp2 = 0d0 + + r=2d0*m/5d0/t + + do j=1,m-1 + theta = dble(j)*pi/dble(m) + sigma=theta+(theta/tan(theta)-1d0)/tan(theta) + s=r*theta*DCMPLX(1d0/tan(theta),1d0) + s1 = s + (1d0,0d0) + call LH_ZFUNC(s1,x,Q2i,Q2f,ZPDFNS,ZPDFNS24,ZPDFSG) + tmp2=exp(t*s1)*DCMPLX(1d0,sigma)*zpdfns24(1) + tmp=tmp+dreal(tmp2) + enddo + call LH_zfunc(DCMPLX(r+1d0,0d0),x,Q2i,Q2f,ZPDFNS,ZPDFNS24,ZPDFSG) + + xfunc=r/m*(tmp+.5d0*exp((r+1d0)*t)*dreal(zpdfns24(1))) + + RETURN + END +! + SUBROUTINE LH_fixedtalbot_ns24g(xfunc,x,Q2i,Q2f) + IMPLICIT none + + REAL*8 x,xfunc + REAL*8 Q2i,Q2f + integer m,j + REAL*8 theta,pi,sigma,t,tmp,r + COMPLEX*16 s,s1,tmp2,zpdfns(4),zpdfsg(2,2),ZPDFNS24(2) + + pi=acos(-1d0) + m=16 + + t=-dlog(x) + + tmp = 0d0 + tmp2 = 0d0 + + r=2d0*m/5d0/t + + do j=1,m-1 + theta = dble(j)*pi/dble(m) + sigma=theta+(theta/tan(theta)-1d0)/tan(theta) + s=r*theta*DCMPLX(1d0/tan(theta),1d0) + s1 = s + (1d0,0d0) + call LH_ZFUNC(s1,x,Q2i,Q2f,ZPDFNS,ZPDFNS24,ZPDFSG) + tmp2=exp(t*s1)*DCMPLX(1d0,sigma)*zpdfns24(2) + tmp=tmp+dreal(tmp2) + enddo + call LH_zfunc(DCMPLX(r+1d0,0d0),x,Q2i,Q2f,ZPDFNS,ZPDFNS24,ZPDFSG) + + xfunc=r/m*(tmp+.5d0*exp((r+1d0)*t)*dreal(zpdfns24(2))) + + RETURN + END +! + SUBROUTINE LH_fixedtalbot_qq(xfunc,x,Q2i,Q2f) + IMPLICIT none + + REAL*8 x,xfunc + REAL*8 Q2i,Q2f + integer m,j + REAL*8 theta,pi,sigma,t,tmp,r + COMPLEX*16 s,s1,tmp2,zpdfns(4),zpdfsg(2,2),ZPDFNS24(2) + + pi=acos(-1d0) + m=16 + + t=-dlog(x) + + tmp = 0d0 + tmp2 = 0d0 + + r=2d0*m/5d0/t + + do j=1,m-1 + theta = dble(j)*pi/dble(m) + sigma=theta+(theta/tan(theta)-1d0)/tan(theta) + s=r*theta*DCMPLX(1d0/tan(theta),1d0) + s1 = s + (1d0,0d0) + call LH_zfunc(s1,x,q2i,q2f,zpdfns,ZPDFNS24,zpdfsg) + tmp2=exp(t*s1)*DCMPLX(1d0,sigma)*zpdfsg(1,1) + tmp=tmp+dreal(tmp2) + enddo + call LH_zfunc(DCMPLX(r+1d0,0d0),x,q2i,q2f,zpdfns,ZPDFNS24,zpdfsg) + + xfunc=r/m*(tmp+.5d0*exp((r+1d0)*t)*dreal(zpdfsg(1,1))) + + RETURN + END +! + SUBROUTINE LH_fixedtalbot_qg(xfunc,x,Q2i,Q2f) + IMPLICIT none + + REAL*8 x,xfunc + REAL*8 Q2i,Q2f + integer m,j + REAL*8 theta,pi,sigma,t,tmp,r + COMPLEX*16 s,s1,tmp2,zpdfns(4),zpdfsg(2,2),ZPDFNS24(2) + + pi=acos(-1d0) + m=16 + + t=-dlog(x) + + tmp = 0d0 + tmp2 = 0d0 + + r=2d0*m/5d0/t + + do j=1,m-1 + theta = dble(j)*pi/dble(m) + sigma=theta+(theta/tan(theta)-1d0)/tan(theta) + s=r*theta*DCMPLX(1d0/tan(theta),1d0) + s1 = s + (1d0,0d0) + call LH_zfunc(s1,x,q2i,q2f,zpdfns,ZPDFNS24,zpdfsg) + tmp2=exp(t*s1)*DCMPLX(1d0,sigma)*zpdfsg(1,2) + tmp=tmp+dreal(tmp2) + enddo + call LH_zfunc(DCMPLX(r+1d0,0d0),x,q2i,q2f,zpdfns,ZPDFNS24,zpdfsg) + + xfunc=r/m*(tmp+.5d0*exp((r+1d0)*t)*dreal(zpdfsg(1,2))) + + return + END +! + SUBROUTINE LH_fixedtalbot_gq(xfunc,x,Q2i,Q2f) + IMPLICIT none + + REAL*8 x,xfunc + REAL*8 Q2i,Q2f + integer m,j + REAL*8 theta,pi,sigma,t,tmp,r + COMPLEX*16 s,s1,tmp2,zpdfns(4),zpdfsg(2,2),ZPDFNS24(2) + + pi=acos(-1d0) + m=16 + + t=-dlog(x) + + tmp = 0d0 + tmp2 = 0d0 + + r=2d0*m/5d0/t + + do j=1,m-1 + theta = dble(j)*pi/dble(m) + sigma=theta+(theta/tan(theta)-1d0)/tan(theta) + s=r*theta*DCMPLX(1d0/tan(theta),1d0) + s1 = s + (1d0,0d0) + call LH_zfunc(s1,x,q2i,q2f,zpdfns,ZPDFNS24,zpdfsg) + tmp2=exp(t*s1)*DCMPLX(1d0,sigma)*zpdfsg(2,1) + tmp=tmp+dreal(tmp2) + enddo + call LH_zfunc(DCMPLX(r+1d0,0d0),x,Q2i,Q2f,zpdfns,ZPDFNS24,zpdfsg) + + xfunc=r/m*(tmp+.5d0*exp((r+1d0)*t)*dreal(zpdfsg(2,1))) + + return + END +! + SUBROUTINE LH_fixedtalbot_gg(xfunc,x,Q2i,Q2f) + IMPLICIT none + + REAL*8 x,xfunc + REAL*8 Q2i,Q2f + + integer m,j + REAL*8 theta,pi,sigma,t,tmp,r + COMPLEX*16 s,s1,tmp2,zpdfns(4),zpdfsg(2,2),ZPDFNS24(2) + + pi=acos(-1d0) + m=16 + + t=-dlog(x) + + tmp = 0d0 + tmp2 = 0d0 + + r=2d0*m/5d0/t + + do j=1,m-1 + theta = dble(j)*pi/dble(m) + sigma=theta+(theta/tan(theta)-1d0)/tan(theta) + s=r*theta*DCMPLX(1d0/tan(theta),1d0) + s1 = s + (1d0,0d0) + call LH_zfunc(s1,x,Q2i,Q2f,zpdfns,ZPDFNS24,zpdfsg) + tmp2=exp(t*s1)*DCMPLX(1d0,sigma)*zpdfsg(2,2) + tmp=tmp+dreal(tmp2) + enddo + call LH_zfunc(DCMPLX(r+1d0,0d0),x,Q2i,Q2f,zpdfns,ZPDFNS24,zpdfsg) + + xfunc=r/m*(tmp+.5d0*exp((r+1d0)*t)*dreal(zpdfsg(2,2))) + + return + END + +!**** +! 6 *------------------------------------------------------------------- +!**** +! File: gamma.f +! Function for computing Gamma(2), second moment +! of the evolution factor, for the Singlet-Gluon +! coupled evolution +! + + FUNCTION LH_gamm2ns(nsflav,x,Q2i,Q2f) + IMPLICIT none +! + REAL*8 Q2i,Q2f +! + REAL*8 Q2it,Q2ft + COMMON / NNPDF10QTRANSFER / Q2it,Q2ft +! + integer nsflav + COMPLEX*16 zn + REAL*8 ain,afin,eps,x + REAL*8 LH_gamm2ns,LH_DGAUSS_INTERN + REAL*8 LH_gammax_nsp_wrp,LH_gammax_nsm_wrp,LH_gammax_nsvu_wrp, & + & LH_gammax_nsvd_wrp,LH_gammax_nsvct_wrp,LH_gammax_nsvsb_wrp + external LH_gammax_nsp_wrp,LH_gammax_nsm_wrp,LH_gammax_nsvu_wrp, & + & LH_gammax_nsvd_wrp,LH_gammax_nsvct_wrp,LH_gammax_nsvsb_wrp + + parameter(eps=1d-8) + COMPLEX*16 efnns(4),efnns24(2),efnsg(2,2) + +! NB: 2 moment + zn = (2d0,0d0) +! + call LH_ZFUNC(zn,x,Q2i,Q2f,EFNNS,EFNNS24,EFNSG) +! +! Fill auxiliary variables needed by wrapper functions +! + Q2it = Q2i + Q2ft = Q2f +! + ain=0d0 + afin=x +! + IF(NSFLAV.EQ.1) THEN + LH_gamm2ns = DREAL(efnns(1))- & + & LH_DGAUSS_INTERN(LH_gammax_nsp_wrp,ain,afin,eps) + ELSEIF(NSFLAV.EQ.2) THEN + LH_gamm2ns = DREAL(efnns(2)) & + & -LH_DGAUSS_INTERN(LH_gammax_nsm_wrp,ain,afin,eps) + ELSEIF(NSFLAV.EQ.3) THEN + LH_gamm2ns = DREAL(efnns(3)) & + & -LH_DGAUSS_INTERN(LH_gammax_nsvu_wrp,ain,afin,eps) + ELSEIF(NSFLAV.EQ.4) THEN + LH_gamm2ns = DREAL(efnns(4)) & + & -LH_DGAUSS_INTERN(LH_gammax_nsvd_wrp,ain,afin,eps) + ENDIF +! + return + END +! + FUNCTION LH_gamm2ns24(ns24flav,x,Q2i,Q2f) + IMPLICIT none +! + REAL*8 Q2i,Q2f +! + REAL*8 Q2it,Q2ft + COMMON / NNPDF10QTRANSFER / Q2it,Q2ft +! + integer ns24flav + COMPLEX*16 zn + REAL*8 ain,afin,eps,x + REAL*8 LH_gamm2ns24,LH_DGAUSS_INTERN + REAL*8 LH_gammax_ns24q_wrp,LH_gammax_ns24g_wrp + external LH_gammax_ns24q_wrp,LH_gammax_ns24g_wrp + + parameter(eps=1d-8) + COMPLEX*16 efnns(4),efnns24(2),efnsg(2,2) + +! NB: 2 moment + zn = (2d0,0d0) +! + call LH_ZFUNC(zn,x,Q2i,Q2f,EFNNS,EFNNS24,EFNSG) +! +! Fill auxiliary variables needed by wrapper functions +! + Q2it = Q2i + Q2ft = Q2f +! + ain=0d0 + afin=x +! + IF(ns24flav.EQ.1) THEN + LH_gamm2ns24 = DREAL(efnns24(1)) & + & -LH_DGAUSS_INTERN(LH_gammax_ns24q_wrp,ain,afin,eps) + ELSEIF(ns24flav.EQ.2) THEN + LH_gamm2ns24 = DREAL(efnns24(2)) & + & -LH_DGAUSS_INTERN(LH_gammax_ns24g_wrp,ain,afin,eps) + + ENDIF +! + RETURN + END + +! + FUNCTION LH_gamm2sg(l,c,x,Q2i,Q2f) + IMPLICIT none +! + REAL*8 Q2i,Q2f +! + REAL*8 Q2it,Q2ft + COMMON / NNPDF10QTRANSFER / Q2it,Q2ft +! + integer l,c + COMPLEX*16 zn + REAL*8 ain,afin,eps,x + REAL*8 LH_gamm2sg,LH_DGAUSS_INTERN + REAL*8 LH_gammax_qq_wrp,LH_gammax_qg_wrp + REAL*8 LH_gammax_gq_wrp,LH_gammax_gg_wrp + external LH_gammax_qq_wrp,LH_gammax_qg_wrp + external LH_gammax_gq_wrp,LH_gammax_gg_wrp + + parameter(eps=1d-8) + COMPLEX*16 efnns(4),efnns24(2),efnsg(2,2) + +! NB: 2 moment + zn=(2d0,0d0) +! + call LH_ZFUNC(zn,x,Q2i,Q2f,EFNNS,EFNNS24,EFNSG) +! +! Fill auxiliary variables needed by wrapper functions +! + Q2it = Q2i + Q2ft = Q2f +! + ain=0d0 + afin=x +! + IF(l.EQ.1.AND.c.EQ.1) THEN + LH_gamm2sg=DREAL(efnsg(1,1))- & + & LH_DGAUSS_INTERN(LH_gammax_qq_wrp,ain,afin,eps) + ELSEIF(l.EQ.1.AND.c.EQ.2) THEN + LH_gamm2sg=DREAL(efnsg(1,2)) & + & -LH_DGAUSS_INTERN(LH_gammax_qg_wrp,ain,afin,eps) + ELSEIF(l.EQ.2.AND.c.EQ.1) THEN + LH_gamm2sg=DREAL(efnsg(2,1)) & + & -LH_DGAUSS_INTERN(LH_gammax_gq_wrp,ain,afin,eps) + ELSEIF(l.EQ.2.AND.c.EQ.2) THEN + LH_gamm2sg=DREAL(efnsg(2,2)) & + & -LH_DGAUSS_INTERN(LH_gammax_gg_wrp,ain,afin,eps) + ENDIF + + RETURN + END +! +! Internal Wrapper functions needed to perform x-integration +! of the Gamma functions using Dgauss_Intern. +! + FUNCTION LH_gammax_nsp_wrp(y) + IMPLICIT none +! + REAL*8 LH_gammax_nsp_wrp + REAL*8 y + REAL*8 QQ2,QQ0 + REAL*8 Q2it,Q2ft + COMMON / NNPDF10QTRANSFER / Q2it,Q2ft + REAL*8 LH_gammax_nsp + EXTERNAL LH_gammax_nsp +! + QQ0 = Q2IT + QQ2 = Q2FT + LH_gammax_nsp_wrp = LH_gammax_nsp(y,QQ0,QQ2) +! + RETURN + END +! + + FUNCTION LH_gammax_nsm_wrp(y) + IMPLICIT none +! + REAL*8 LH_gammax_nsm_wrp + REAL*8 y + REAL*8 QQ2,QQ0 + REAL*8 Q2it,Q2ft + COMMON / NNPDF10QTRANSFER / Q2it,Q2ft + REAL*8 LH_gammax_nsm + EXTERNAL LH_gammax_nsm +! + QQ0 = Q2IT + QQ2 = Q2FT + LH_gammax_nsm_wrp = LH_gammax_nsm(y,QQ0,QQ2) +! + RETURN + END +! + FUNCTION LH_gammax_nsvu_wrp(y) + IMPLICIT none +! + REAL*8 LH_gammax_nsvu_wrp + REAL*8 y + REAL*8 QQ2,QQ0 + REAL*8 Q2it,Q2ft + COMMON / NNPDF10QTRANSFER / Q2it,Q2ft + REAL*8 LH_gammax_nsvu + EXTERNAL LH_gammax_nsvu +! + QQ0 = Q2IT + QQ2 = Q2FT + LH_gammax_nsvu_wrp = LH_gammax_nsvu(y,QQ0,QQ2) +! + RETURN + END +! + FUNCTION LH_gammax_nsvd_wrp(y) + IMPLICIT none +! + REAL*8 LH_gammax_nsvd_wrp + REAL*8 y + REAL*8 Q2it,Q2ft + REAL*8 QQ2,QQ0 + COMMON / NNPDF10QTRANSFER / Q2it,Q2ft + REAL*8 LH_gammax_nsvd + EXTERNAL LH_gammax_nsvd +! + QQ0 = Q2IT + QQ2 = Q2FT + LH_gammax_nsvd_wrp = LH_gammax_nsvd(y,QQ0,QQ2) +! + RETURN + END +! + FUNCTION LH_gammax_ns24q_wrp(y) + IMPLICIT none +! + REAL*8 LH_gammax_ns24q_wrp + REAL*8 y + REAL*8 Q2it,Q2ft + REAL*8 QQ2,QQ0 + COMMON / NNPDF10QTRANSFER / Q2it,Q2ft + REAL*8 LH_gammax_ns24q + EXTERNAL LH_gammax_ns24q +! + QQ0 = Q2IT + QQ2 = Q2FT + LH_gammax_ns24q_wrp = LH_gammax_ns24q(y,QQ0,QQ2) +! + RETURN + END +! + FUNCTION LH_gammax_ns24g_wrp(y) + IMPLICIT none +! + REAL*8 LH_gammax_ns24g_wrp + REAL*8 y + REAL*8 Q2it,Q2ft + REAL*8 QQ2,QQ0 + COMMON / NNPDF10QTRANSFER / Q2it,Q2ft + REAL*8 LH_gammax_ns24g + EXTERNAL LH_gammax_ns24g +! + QQ0 = Q2IT + QQ2 = Q2FT + LH_gammax_ns24g_wrp = LH_gammax_ns24g(y,QQ0,QQ2) +! + RETURN + END +! + FUNCTION LH_gammax_qq_wrp(y) + IMPLICIT none +! + REAL*8 LH_gammax_qq_wrp + REAL*8 y + REAL*8 Q2it,Q2ft + REAL*8 QQ2,QQ0 + COMMON / NNPDF10QTRANSFER / Q2it,Q2ft + REAL*8 LH_gammax_qq + EXTERNAL LH_gammax_qq +! + QQ0 = Q2IT + QQ2 = Q2FT + LH_gammax_qq_wrp = LH_gammax_qq(y,QQ0,QQ2) +! + RETURN + END +! + FUNCTION LH_gammax_qg_wrp(y) + IMPLICIT none +! + REAL*8 LH_gammax_qg_wrp + REAL*8 y + REAL*8 Q2it,Q2ft + REAL*8 QQ2,QQ0 + COMMON / NNPDF10QTRANSFER / Q2it,Q2ft + REAL*8 LH_gammax_qg + EXTERNAL LH_gammax_qg +! + QQ0 = Q2IT + QQ2 = Q2FT + LH_gammax_qg_wrp = LH_gammax_qg(y,QQ0,QQ2) +! + RETURN + END +! + FUNCTION LH_gammax_gq_wrp(y) + IMPLICIT none +! + REAL*8 LH_gammax_gq_wrp + REAL*8 y + REAL*8 Q2it,Q2ft + REAL*8 QQ2,QQ0 + COMMON / NNPDF10QTRANSFER / Q2it,Q2ft + REAL*8 LH_gammax_gq + EXTERNAL LH_gammax_gq +! + QQ0 = Q2IT + QQ2 = Q2FT + LH_gammax_gq_wrp = LH_gammax_gq(y,QQ0,QQ2) +! + RETURN + END +! + FUNCTION LH_gammax_gg_wrp(y) + IMPLICIT none +! + REAL*8 LH_gammax_gg_wrp + REAL*8 y + REAL*8 Q2it,Q2ft + REAL*8 QQ2,QQ0 + COMMON / NNPDF10QTRANSFER / Q2it,Q2ft + REAL*8 LH_gammax_gg + EXTERNAL LH_gammax_qg +! + QQ0 = Q2IT + QQ2 = Q2FT + LH_gammax_gg_wrp = LH_gammax_gg(y,QQ0,QQ2) +! + RETURN + END + +!**** +! 7 *------------------------------------------------------------------- +!**** +! File: evolfactn.f +! Returns the evolution factors in N space +! - Fixed Flavour Number Scheme (IVFN=0) +! - Zero Mass-Variable Flavour Number Scheme (IVFN=1) +! + SUBROUTINE LH_ZFUNC(ZN,X,Q20,Q2,ZFUNCNS,ZFUNCNS24,ZFUNCSG) + IMPLICIT none +! + INTEGER IPT,IMODEV,IVFN,ITMC + COMMON /NNPDF10EVFLAGS/ IPT,IMODEV,IVFN,ITMC +! + REAL*8 q2th(4:6),asref,q2ref + REAL*8 as0,asc,asb,ast,asq + COMMON /nnpdf10VFNS/ q2th,asref,q2ref + COMMON /NNPDF10AS/ as0,asc,asb,ast,asq +! + INTEGER I,J + INTEGER NFI,NFF,STEP +! + REAL*8 Q20,Q2 + REAL*8 X +! + COMPLEX*16 ZN + COMPLEX*16 EFNNS(4),EFNSG(2,2) + COMPLEX*16 EFNNS0(4),EFNSG0(2,2),EFNSG1(2,2) + COMPLEX*16 ZFUNCNS(4),ZFUNCNS24(2),ZFUNCSG(2,2) +! + COMPLEX*16 EFNNSBQ(4),EFNNSCB(4),EFNNSBT(4),EFNNSTQ(4) + COMPLEX*16 EFNSGBQ(2,2),EFNSGCB(2,2),EFNSGBT(2,2),EFNSGTQ(2,2) +! +! Allow backward evolution +! + IF(Q20.LE.Q2) STEP = 1 + IF(Q20.GT.Q2) STEP = -1 +! +! Determine # of active flavours at the initial (NFI) and +! final (NFF) scale. +! + IF(Q20.GE.Q2TH(6)) THEN + NFI=6 + ELSEIF(Q20.GE.Q2TH(5)) THEN + NFI=5 + ELSEIF(Q20.GE.Q2TH(4)) THEN + NFI=4 + ELSE + NFI=3 + ENDIF +! + IF(Q2.GT.Q2TH(6)) THEN + NFF=6 + ELSEIF(Q2.GT.Q2TH(5)) THEN + NFF=5 + ELSEIF(Q2.GT.Q2TH(4)) THEN + NFF=4 + ELSE + NFF=3 + ENDIF + IF(IVFN.EQ.0) NFF=4 +! +! No call to Coefficient Functions! +! Evolution Kernel + DO I=1,4 + EFNNS0(I) = (0d0,0d0) + ENDDO + DO I=1,2 + DO J=1,2 + EFNSG0(I,J) = (0.D0,0.D0) + EFNSG1(I,J) = (0.D0,0.D0) + EFNSG(I,J) = (0.D0,0.D0) + END DO + END DO +! +! Fixed Flavour Number Scheme (NF=4) + IF (IVFN.EQ.0) THEN + NFI = 4 + CALL LH_EVOLFACTN(ZN,Q20,Q2,NFI,EFNNS,EFNSG1) + ZFUNCNS24(1) = EFNSG1(1,1) + ZFUNCNS24(2) = EFNSG1(1,2) +! +! (Zero Mass-) Variable Flavour Number Scheme + ELSEIF(IVFN.EQ.1) THEN + IF(NFF.EQ.NFI) THEN + CALL LH_EVOLFACTN(ZN,Q20,Q2,NFI,EFNNS,EFNSG1) + ELSE + CALL LH_EVOLFACTN(ZN,Q20,Q2TH(NFI+STEP),NFI,EFNNS0,EFNSG0) + DO I=1,4 + EFNNS(I) = EFNNS0(I) + ENDDO + CALL LH_MEQUAL_C(EFNSG,EFNSG0,2,2) + 10 NFI = NFI+STEP + IF(NFI.NE.NFF) THEN + CALL LH_EVOLFACTN(ZN,Q2TH(NFI),Q2TH(NFI+STEP),NFI, & + & EFNNS0,EFNSG0) + ELSE + CALL LH_EVOLFACTN(ZN,Q2TH(NFI),Q2,NFI,EFNNS0,EFNSG0) + ENDIF + DO I=1,4 + EFNNS(I) = EFNNS(I)*EFNNS0(I) + ENDDO + CALL LH_MMULT_C(EFNSG0,2,2,EFNSG,2,2,EFNSG1) + + IF(NFI.NE.NFF) THEN + CALL LH_MEQUAL_C(EFNSG,EFNSG1,2,2) + GOTO 10 + ENDIF + ENDIF +! +! Evolution of T_24 + IF(Q2.LE.Q2TH(5))THEN + ZFUNCNS24(1) = EFNSG1(1,1) + ZFUNCNS24(2) = EFNSG1(1,2) + ELSEIF(Q2.LE.Q2TH(6)) THEN + CALL LH_EVOLFACTN(ZN,Q20,Q2TH(5),4,EFNNSCB,EFNSGCB) + CALL LH_EVOLFACTN(ZN,Q2TH(5),Q2 ,5,EFNNSBQ,EFNSGBQ) + ZFUNCNS24(1) = EFNNSBQ(1)*EFNSGCB(1,1) + ZFUNCNS24(2) = EFNNSBQ(1)*EFNSGCB(1,2) + ELSE + CALL LH_EVOLFACTN(ZN,Q20,Q2TH(5),4,EFNNSCB,EFNSGCB) + CALL LH_EVOLFACTN(ZN,Q2TH(5),Q2TH(6),5,EFNNSBT,EFNSGBT) + CALL LH_EVOLFACTN(ZN,Q2TH(6),Q2,6,EFNNSTQ,EFNSGTQ) + ZFUNCNS24(1) = EFNNSTQ(1)*EFNNSBT(1)*EFNSGCB(1,1) + ZFUNCNS24(2) = EFNNSTQ(1)*EFNNSBT(1)*EFNSGCB(1,2) + ENDIF + ENDIF +! +! Output + DO I=1,4 + ZFUNCNS(I) = EFNNS(I) + ENDDO + + DO I=1,2 + ZFUNCNS24(I)= ZFUNCNS24(I) + ENDDO + + DO I=1,2 + DO J=1,2 + ZFUNCSG(I,J)= EFNSG1(I,J) + ENDDO + ENDDO + + RETURN + END +! +! Returns the evolution factors, in N space, from Q20 to Q2 with NF +! active flavours, for Non Singlet and Singlet-Gluon. +! + SUBROUTINE LH_EVOLFACTN(ZN,Q2I,Q2F,NF,EFNNS,EFNSG) + IMPLICIT none +! + INTEGER IPT,IMODEV,IVFN,ITMC + COMMON /NNPDF10EVFLAGS/ IPT,IMODEV,IVFN,ITMC +! + REAL*8 q20,q2 + COMMON/nnpdf10EVSCALE/q20,q2 + REAL*8 q2th(4:6),asref,q2ref + REAL*8 as0,asc,asb,ast,asq + COMMON /nnpdf10VFNS/ q2th,asref,q2ref + COMMON /NNPDF10AS/ as0,asc,asb,ast,asq +! + REAL*8 beta0(3:6),beta1(3:6),beta2(3:6) + REAL*8 b1(3:6),b2(3:6) + COMMON/nnpdf10BETA/beta0,beta1,beta2,b1,b2 + REAL*8 emc,zeta2,zeta3,zeta4,pi + PARAMETER (pi = 3.1415926535897932385) + COMMON /NNPDF10CONSTS/ emc,zeta2,zeta3,zeta4 +! + INTEGER NF + INTEGER I,J,K + REAL*8 Q2I,Q2F,ASI,ASF,T + REAL*8 TMP + COMPLEX*16 ZN + COMPLEX*16 EFNNS(4),EFNSG(2,2),EFNSGTMP(2,2) + COMPLEX*16 EXPNS,EXPM,EXPP + COMPLEX*16 UNS0,UNS1(3),LP,LM + COMPLEX*16 U(20,2,2) + COMPLEX*16 EM(2,2),EP(2,2) +! + COMPLEX*16 U1(2,2) + COMPLEX*16 L(2,2),LU1(2,2),U1L(2,2) + COMPLEX*16 USUM(2,2),USUMTMP(2,2),UINV(2,2),USUML(2,2) + COMPLEX*16 DETINV +! +! Compute alphas + IF(Q2I.EQ.Q20) THEN + ASI = AS0 + ELSEIF(Q2I.EQ.Q2TH(4)) THEN + ASI = ASC + ELSEIF(Q2I.EQ.Q2TH(5)) THEN + ASI = ASB + ELSEIF(Q2I.EQ.Q2TH(6)) THEN + ASI = AST + ENDIF + + IF(Q2F.EQ.Q20) THEN + ASF = AS0 + ELSEIF(Q2F.EQ.Q2TH(4)) THEN + ASF = ASC + ELSEIF(Q2F.EQ.Q2TH(5)) THEN + ASF = ASB + ELSEIF(Q2F.EQ.Q2TH(6)) THEN + ASF = AST + ELSE + ASF = ASQ + ENDIF +! +! Evaluation of evolution factors + T = DLOG(ASF/ASI) + DO I=1,4 + EFNNS(I) = (0d0,0d0) + ENDDO + + DETINV=0.D0 + DO I=1,2 + DO J=1,2 + UINV(I,J)=(0d0,0d0) + EFNSG(I,J) = (0d0,0d0) + EFNSGTMP(I,J) = (0d0,0d0) + ENDDO + ENDDO +! +! U matrices + CALL LH_UMATRIX(ZN,NF,LP,LM,EP,EM,U,UNS0,UNS1) +! +! LO evolution factor +! +! Non singlet + EXPNS = EXP ( - UNS0 * T ) +! +! Singlet + EXPM = EXP ( - LM * T ) + EXPP = EXP ( - LP * T ) + + DO I=1,2 + DO J=1,2 + ! eq.(22) + L(I,J) = EXPM * EM(I,J) + EXPP * EP(I,J) + ENDDO + ENDDO + + IF(IPT.EQ.0)THEN +! +! LO solution + DO I= 1,4 + EFNNS(I) = EXPNS + ENDDO + DO I=1,2 + DO J=1,2 + EFNSG(I,J) = L(I,J) + ENDDO + ENDDO + + ELSEIF(IPT.EQ.1)THEN +! +! NLO solution + IF(IMODEV.EQ.0)THEN +! +! Truncated solution IMODEV=0 + DO I=1,3 + EFNNS(I)= EXPNS * ((1D0,0D0) + UNS1(I) * (ASF-ASI)) + ENDDO + EFNNS(4)=EFNNS(3) + + DO I=1,2 + DO J=1,2 + U1(I,J)=U(1,I,J) + ENDDO + ENDDO + + CALL LH_MMULT_C(U1,2,2,L,2,2,U1L) + CALL LH_MMULT_C(L,2,2,U1,2,2,LU1) + DO I=1,2 + DO J=1,2 + EFNSG(I,J) = L(I,J) + ASF * U1L(I,J) - ASI * LU1(I,J) + ENDDO + ENDDO + + ELSEIF(IMODEV.EQ.1)THEN +! +! Iterated solution IMODEV=1 + TMP = 0D0 + TMP = DLOG(( 1D0 + B1(NF) * ASF )/(1D0 + B1(NF)*ASI))/B1(NF) + DO I=1,3 + EFNNS(I) = EXPNS * EXP( TMP * UNS1(I)) + ENDDO + EFNNS(4)=EFNNS(3) +! + USUM(1,1) = (1d0,0d0) + USUM(1,2) = (0d0,0d0) + USUM(2,1) = (0d0,0d0) + USUM(2,2) = (1d0,0d0) + USUMTMP(1,1) = (1d0,0d0) + USUMTMP(1,2) = (0d0,0d0) + USUMTMP(2,1) = (0d0,0d0) + USUMTMP(2,2) = (1d0,0d0) +! + DO K=1,20 + DO I=1,2 + DO J=1,2 + USUM(I,J) = USUM(I,J)+ & + & (ASF**(DBLE(K)) * U(K,I,J)) + USUMTMP(I,J) = USUMTMP(I,J) + & + & (ASI**(DBLE(K)) * U(K,I,J)) + ENDDO + ENDDO + ENDDO +! + DETINV = 1.D0 / ( USUMTMP(1,1) * USUMTMP(2,2)- & + & USUMTMP(1,2) * USUMTMP(2,1) ) + UINV(1,1) = DETINV * USUMTMP(2,2) + UINV(1,2) = - DETINV * USUMTMP(1,2) + UINV(2,1) = - DETINV * USUMTMP(2,1) + UINV(2,2) = DETINV * USUMTMP(1,1) +! + CALL LH_MMULT_C(USUM,2,2,L,2,2,USUML) + CALL LH_MMULT_C(USUML,2,2,UINV,2,2,EFNSGTMP) + + DO I=1,2 + DO J=1,2 + EFNSG(I,J)= EFNSGTMP(I,J) + ENDDO + ENDDO + ENDIF + ENDIF +! + RETURN + END + +! +! File: umatrix.f +! +! Computes the matrices used for the singlet evolution. +! Equation numbers refer to the "Notes on PT evolution" +! + SUBROUTINE LH_UMATRIX(ZN,NF,LP,LM,EP,EM,U,UNS0,UNS1) + IMPLICIT none +! + INTEGER IPT,IMODEV,IVFN,ITMC + COMMON /NNPDF10EVFLAGS/ IPT,IMODEV,IVFN,ITMC +! + REAL*8 beta0(3:6),beta1(3:6),beta2(3:6) + REAL*8 b1(3:6),b2(3:6) + COMMON/nnpdf10BETA/beta0,beta1,beta2,b1,b2 +! + INTEGER NF + COMPLEX*16 ZN + COMPLEX*16 UNS0,UNS1(3) + COMPLEX*16 U(20,2,2) + COMPLEX*16 LP,LM + COMPLEX*16 EP(2,2),EM(2,2) +! + INTEGER I,J,K,JJ,KK,II + COMPLEX*16 QQ0,QG0,GQ0,GG0 + COMPLEX*16 SQ,LDIFF + COMPLEX*16 DP(2,2),DM(2,2) + COMPLEX*16 G0(2,2),G1(2,2) + COMPLEX*16 G0NS(3),G1NS(3) + COMPLEX*16 R(20,2,2),RT(20,2,2) + COMPLEX*16 R0(2,2),R1(2,2) + COMPLEX*16 R1PP(2,2),R1PM(2,2),R1MP(2,2),R1MM(2,2) + COMPLEX*16 U1PP(2,2),U1PM(2,2),U1MP(2,2),U1MM(2,2) +! + CALL LH_ANDIM_LO(ZN,NF,G0NS,G0) + UNS0 = G0NS(1) / BETA0(NF) +! + DO K=1,20 + DO I=1,2 + DO J=1,2 + R(K,I,J)=(0.D0,0.D0) + RT(K,I,J)=(0.D0,0.D0) + U(K,I,J)=(0.D0,0.D0) + ENDDO + ENDDO + ENDDO +! + DO I=1,2 + DO J=1,2 + ! eq. (18) + R0(I,J) = G0(I,J) / BETA0(NF) + END DO + END DO +! + QQ0 = R0(1,1) + QG0 = R0(1,2) + GQ0 = R0(2,1) + GG0 = R0(2,2) +! + ! eq.(20) + SQ = SQRT((QQ0-GG0)**2d0 + 4.d0*QG0*GQ0) + LP = .5d0*(QQ0 + GG0 + SQ) + LM = .5d0*(QQ0 + GG0 - SQ) +! + ! eq.(21) + EM(1,1) = (QQ0 - LP) / (LM - LP) + EM(1,2)= QG0 / (LM - LP) + EM(2,1) = GQ0 / (LM - LP) + EM(2,2) = (GG0 - LP) / (LM - LP) +! + EP(1,1) = (QQ0 - LM) / (LP - LM) + EP(1,2) = QG0 / (LP - LM) + EP(2,1) = GQ0 / (LP - LM) + EP(2,2) = (GG0 - LM) / (LP - LM) +! +! NLO coefficients + IF (IPT.GE.1) THEN + CALL LH_ANDIM_NLO(ZN,NF,G1NS,G1) +! +! NON SINGLET + DO I=1,3 + UNS1(I)= -(G1NS(I)/BETA0(NF)) + B1(NF)*UNS0 + ENDDO +! +! SINGLET + DO I=1,2 + DO J=1,2 + ! eq. (18) + R(1,I,J) = G1(I,J)/BETA0(NF) - B1(NF)*R0(I,J) + ! R1_T=R1 + RT(1,I,J) = G1(I,J)/BETA0(NF) - B1(NF)*R0(I,J) + R1(I,J) = R(1,I,J) + ENDDO + ENDDO +! +! Computation of U1 according to eq.(25) + CALL LH_MMULT_C(EP,2,2,R1,2,2,DP) + CALL LH_MMULT_C(EM,2,2,R1,2,2,DM) +! + CALL LH_MMULT_C(DP,2,2,EP,2,2,R1PP) + CALL LH_MMULT_C(DP,2,2,EM,2,2,R1PM) + CALL LH_MMULT_C(DM,2,2,EP,2,2,R1MP) + CALL LH_MMULT_C(DM,2,2,EM,2,2,R1MM) +! + DO I = 1,2 + DO J = 1,2 + U1PP(I,J) = R1PP(I,J) + U1PM(I,J) = R1PM(I,J)/(LM - LP - 1d0) + U1MP(I,J) = R1MP(I,J)/(LP - LM - 1d0) + U1MM(I,J) = R1MM(I,J) + U(1,I,J) = -(U1MM(I,J)+U1PP(I,J)) + U1PM(I,J) + U1MP(I,J) + ENDDO + ENDDO +! + IF(IMODEV.EQ.0)THEN + DO K=2,20 + DO I=1,2 + DO J=1,2 + U(K,I,J)=0.D0 + ENDDO + ENDDO + ENDDO + + ELSEIF(IMODEV.EQ.1)THEN +! +! Computation of U_k (k>=2) at NLO according to eqs (23,26,27) + LDIFF = LM - LP + + DO K=2,20 + DO I=1,2 + DO J=1,2 + ! eq (27) + R(K,I,J) = - B1(NF) * R(K-1,I,J) + ENDDO + ENDDO + ENDDO + + DO K=2,20 + DO I=1,2 + DO J=1,2 + RT(K,I,J) = R(K,I,J) + DO JJ=1,K-1 + DO KK=1,2 + RT(K,I,J) = RT(K,I,J) + & + & ( R(JJ,I,KK) * U(K-JJ,KK,J) ) + ! eq (26) + ENDDO + ENDDO + ENDDO + ENDDO +! + DO I=1,2 + DO J=1,2 + DO II=1,2 + DO JJ=1,2 + ! eq(23) + U(K,I,J) = U(K,I,J) & + & -(EM(I,II)*RT(K,II,JJ)*EM(JJ,J)/DBLE(K))& + & -(EP(I,II)*RT(K,II,JJ)*EP(JJ,J)/DBLE(K))& + & -(EM(I,II)*RT(K,II,JJ)* EP(JJ,J)/ & + & ( DBLE(K) + LDIFF )) & + & -(EP(I,II)*RT(K,II,JJ) & + & * EM(JJ,J) / ( DBLE(K) - LDIFF )) + ENDDO + ENDDO + ENDDO + ENDDO + ENDDO + ENDIF + ENDIF +! + RETURN + END + +!**** +! 8 *------------------------------------------------------------------- +!**** +! +! EVOLINT.F Evaluate convolution in x space (DIFF FROM SRC CODE: NO +! + SUBROUTINE LH_PDFEVOLX(x,pdftmp) + IMPLICIT none +! + INTEGER IPT,IMODEV,IVFN,ITMC + COMMON /NNPDF10EVFLAGS/ IPT,IMODEV,IVFN,ITMC + REAL*8 EPSEVOL + COMMON /NNPDF10EVOLACC/ EPSEVOL +! + REAL*8 gm2ns(4),gm2ns24(2),gm2sg(2,2) + COMMON /nnpdf10GM2/gm2ns,gm2ns24,gm2sg +! + REAL*8 q20,q2 + COMMON/nnpdf10EVSCALE/q20,q2 + REAL*8 q2th(4:6),asref,q2ref + REAL*8 as0,asc,asb,ast,asq + COMMON /nnpdf10VFNS/ q2th,asref,q2ref + COMMON /NNPDF10AS/ as0,asc,asb,ast,asq +! + INTEGER i,j,k +! + REAL*8 x + REAL*8 pdfevolx1(13),pdf0(13),pdftmp(13) + REAL*8 pdfevolx24(2) + REAL*8 LH_pdfevolxint_ns,LH_pdfevolxint_sg,LH_pdfevolxint_ns24 + EXTERNAL LH_pdfevolxint_ns,LH_pdfevolxint_ns24,LH_pdfevolxint_sg +! + call LH_PDFIN(x,pdf0) +! + do i=1,13 + pdfevolx1(i)=0d0 + pdftmp(i)=0d0 + enddo +! + DO k=1,2 + DO j=1,2 + pdfevolx1(j) = LH_pdfevolxint_sg(k,j,x) + ENDDO + pdftmp(k) = pdfevolx1(1)+gm2sg(k,1)*pdf0(1)+ & + & pdfevolx1(2)+gm2sg(k,2)*pdf0(2) + ENDDO +! + pdfevolx1(3) = LH_pdfevolxint_ns(3,3,x) + pdftmp(3) = pdfevolx1(3) + gm2ns(3)*pdf0(3) +! + pdfevolx1(4) = LH_pdfevolxint_ns(4,4,x) + pdftmp(4) = pdfevolx1(4) + gm2ns(4)*pdf0(4) +! + pdfevolx1(5) = LH_pdfevolxint_ns(4,5,x) + pdftmp(5) = pdfevolx1(5) + gm2ns(4)*pdf0(5) +! + pdfevolx1(6) = LH_pdfevolxint_ns(3,6,x) + pdftmp(6) = pdfevolx1(6) + gm2ns(3)*pdf0(6) +! + pdfevolx1(7) = LH_pdfevolxint_ns(4,7,x) + pdftmp(7) = pdfevolx1(7) + gm2ns(4)*pdf0(7) +! + pdfevolx1(8) = LH_pdfevolxint_ns(3,8,x) + pdftmp(8) = pdfevolx1(8) + gm2ns(3)*pdf0(8) +! + DO k=9,11 + pdfevolx1(k) = LH_pdfevolxint_ns(1,k,x) + pdftmp(k) = pdfevolx1(k) + gm2ns(1)*pdf0(k) + ENDDO +! + IF(IVFN.EQ.0) THEN + DO k=12,13 + pdftmp(k) = pdftmp(1) + ENDDO + ELSE + DO j=1,2 + pdfevolx24(j) = LH_pdfevolxint_ns24(j,x) + ENDDO + pdftmp(12) = pdfevolx24(1) + gm2ns24(1)*pdf0(1) & + & + pdfevolx24(2) + gm2ns24(2)*pdf0(2) + pdftmp(13) = pdftmp(1) + ENDIF +! + RETURN + END +! + FUNCTION LH_pdfevolxint_sg(ll,cc,xc) + IMPLICIT none +! + INTEGER npoints + PARAMETER(npoints=2**8) + INTEGER ieval,niter,nmax + COMMON /nnpdf10NGRID/ ieval,niter,nmax + REAL*8 EPSEVOL + COMMON /NNPDF10EVOLACC/ EPSEVOL +! +! qnt ridefinite gm2ns(4,ndata)-> gm2ns(4) + REAL*8 xx(NPOINTS),wn(NPOINTS),evkns(4,NPOINTS), & + & evksg(2,2,NPOINTS),evkns24(2,NPOINTS) + COMMON /nnpdf10XEVK/ xx,wn,evkns,evksg,evkns24 +! + REAL*8 q20,q2 + COMMON/nnpdf10EVSCALE/q20,q2 + REAL*8 q2th(4:6),asref,q2ref + REAL*8 as0,asc,asb,ast,asq + COMMON/nnpdf10VFNS/ q2th,asref,q2ref + COMMON /NNPDF10AS/ as0,asc,asb,ast,asq +! + REAL*8 LH_pdfevolxint_sg + INTEGER NGAUSS + PARAMETER(NGAUSS=4) + INTEGER ll,cc + INTEGER j,k,idum,kk + INTEGER nint + REAL*8 xc,EPSTMP + REAL*8 trap1,trap2 + REAL*8 y,pdf0(13),pdf1(13) +! + CALL LH_PDFIN(xc,pdf0) +! + trap2=0.d0 + idum=0 + k=0 + kk=0 +! + 187 NINT=2**kk + kk=kk+1 + trap1=trap2 + trap2=0.d0 +! + DO j=1+k,NGAUSS*NINT+k + idum=idum+1 + y=xx(j) + CALL LH_PDFIN(xc/y,pdf1) + trap2 = trap2 & + & + wn(j)*evksg(ll,cc,j)*(pdf1(cc)/y-y*pdf0(cc))/y + ENDDO + + k=idum +! + EPSTMP=DABS((trap2-trap1)/trap2) + IF(EPSTMP.GT.EPSEVOL.and.idum.lt.NMAX)then + GOTO 187 + ELSE + LH_pdfevolxint_sg=trap2 + ENDIF +! + RETURN + END +! + FUNCTION LH_pdfevolxint_ns(nsflag,iflav,xc) + IMPLICIT none +! + INTEGER npoints + PARAMETER(npoints=2**8) + INTEGER ieval,niter,nmax + COMMON /nnpdf10NGRID/ ieval,niter,nmax + REAL*8 EPSEVOL + COMMON /NNPDF10EVOLACC/ EPSEVOL +! +! qnt ridefinite gm2ns(4,ndata)-> gm2ns(4) + REAL*8 xx(NPOINTS),wn(NPOINTS),evkns(4,NPOINTS), & + & evksg(2,2,NPOINTS),evkns24(2,NPOINTS) + COMMON /nnpdf10XEVK/ xx,wn,evkns,evksg,evkns24 +! + REAL*8 LH_PDFEVOLXINT_NS +! + INTEGER nsflag,iflav + INTEGER j,k,idum,kk + INTEGER nint + REAL*8 xc,EPSTMP + REAL*8 trap1,trap2 + REAL*8 y,pdf0(13),pdf1(13) + INTEGER NGAUSS + PARAMETER(NGAUSS=4) +! + call LH_PDFIN(xc,pdf0) +! + trap2=0.d0 + idum=0 + k=0 + kk=0 +! + 187 NINT=2**kk + kk=kk+1 + trap1=trap2 + trap2=0.d0 +! + do j=1+k,NGAUSS*NINT+k + idum=idum+1 + y=xx(j) + call LH_PDFIN(xc/y,pdf1) + + trap2 = trap2 & + & + wn(j)*evkns(nsflag,j)*(pdf1(iflav)/y-y*pdf0(iflav))/y + enddo + k=idum +! + EPSTMP=DABS((trap2-trap1)/trap2) + IF(EPSTMP.GT.EPSEVOL.and.idum.lt.NMAX)then + goto 187 + else + LH_pdfevolxint_ns=trap2 + endif +! + RETURN + END +! + FUNCTION LH_pdfevolxint_ns24(ns24flag,xc) + IMPLICIT none +! + INTEGER npoints + PARAMETER(npoints=2**8) + INTEGER ieval,niter,nmax + COMMON /nnpdf10NGRID/ ieval,niter,nmax + REAL*8 EPSEVOL + COMMON /NNPDF10EVOLACC/ EPSEVOL +! +! qnt ridefinite gm2ns(4,ndata)-> gm2ns(4) + REAL*8 xx(NPOINTS),wn(NPOINTS),evkns(4,NPOINTS), & + & evksg(2,2,NPOINTS),evkns24(2,NPOINTS) + COMMON /nnpdf10XEVK/ xx,wn,evkns,evksg,evkns24 +! + REAL*8 LH_pdfevolxint_ns24 +! + INTEGER ns24flag + INTEGER j,k,idum,kk + INTEGER nint + REAL*8 xc,epstmp + REAL*8 trap1,trap2 + REAL*8 y,pdf0(13),pdf1(13) + INTEGER NGAUSS + PARAMETER(NGAUSS=4) +! + call LH_PDFIN(xc,pdf0) +! + trap2=0.d0 + idum=0 + k=0 + kk=0 +! + 187 NINT=2**kk + kk=kk+1 + trap1=trap2 + trap2=0.d0 +! + do j=1+k,NGAUSS*NINT+k + idum=idum+1 + y=xx(j) + call LH_PDFIN(xc/y,pdf1) + trap2 = trap2 & + & + wn(j)*evkns24(ns24flag,j) & + & *(pdf1(ns24flag)/y-y*pdf0(ns24flag))/y + enddo + k=idum +! + EPSTMP=DABS((trap2-trap1)/trap2) + IF(EPSTMP.GT.EPSEVOL.and.idum.lt.NMAX)then + goto 187 + else + LH_pdfevolxint_ns24=trap2 + endif +! + RETURN + END + +!**** +! 9 *------------------------------------------------------------------- +!**** +! +! Change of basis from NN basis to pdfparam +! based on Flavour Assumptions see eq. 86 of notes PTevol.pdf +! +! Convert from the INPUTPARAMETRIZATION convention for PDF ordering: +! to the EVOLUTION convention: + +! 1 2 3 4 5 6 7 8 9 10 11 12 13 +! Sigma g u_v d_v s_v c_v b_v t_v T_3 T_8 T_15 T_24 T_35 + +! Convention for pdfs parametrized with nets +! PDFIN(1) -> Singlet +! PDFIN(2) -> Gluon +! PDFIN(3) -> Triplet T_3 +! PDFIN(4) -> TotalValence V +! PDFIN(5) -> SeaAsymmetry Delta_S + +! Convention for input PDFs to evolution equations +! PDFOUT(1) = Singlet +! PDFOUT(2) = Gluon +! PDFOUT(3) = u_v = ( V + T_3 + 2 Delta_S )/2 +! PDFOUT(4) = d_v = ( V - T_3 - 2 Delta_S )/2 +! PDFOUT(5) = s_v = 0 +! PDFOUT(6) = c_v = 0 +! PDFOUT(7) = b_v = 0 +! PDFOUT(8) = t_v = 0 +! PDFOUT(9) = T_3 +! PDFOUT(10)= T_8 = ( 1 / ( 2 + C ) ) * ( 3*C*V + 2(1-C)*Singlet ) +! PDFOUT(11) = T_15 = Singlet +! PDFOUT(12) = T_24 = Singlet +! PDFOUT(13) = T_35 = Singlet + +!*************************** +! + SUBROUTINE LH_pdfinpar2evln(PDFIN,PDFOUT) + implicit none +! + integer I,J + integer MXPDF + parameter(MXPDF=13) + integer NTOTPDF + parameter(NTOTPDF=5) +! + REAL*8 PDFIN(NTOTPDF),PDFOUT(MXPDF) + REAL*8 par2evln(mxpdf,ntotpdf) + COMMON/nnpdf10PPAR2EVLN/PAR2EVLN +! + CALL LH_initpar2evln +! + DO I=1,MXPDF + PDFOUT(I) = 0D0 + DO J=1,NTOTPDF + PDFOUT(I) = PDFOUT(I) + PAR2EVLN(I,J) * PDFIN(J) + ENDDO + ENDDO +! + RETURN + END +! +! + SUBROUTINE LH_initpar2evln + IMPLICIT none +! + integer I,J + integer MXPDF + parameter(MXPDF=13) + integer NTOTPDF + parameter(NTOTPDF=5) + integer MXPAR + parameter(MXPAR=2e2) + real*8 CS + parameter(CS = 0.5) +! + REAL*8 par2evln(mxpdf,ntotpdf) + COMMON/nnpdf10PPAR2EVLN/PAR2EVLN +! + do i = 1,mxpdf + do j = 1, ntotpdf + par2evln(i,j) = 0d0 + enddo + enddo + PAR2EVLN(1,1) = 1d0 + PAR2EVLN(2,2) = 1d0 + PAR2EVLN(3,3) = 0.5d0 + PAR2EVLN(3,4) = 0.5d0 + PAR2EVLN(3,5) = 1d0 + PAR2EVLN(4,3) = - 0.5d0 + PAR2EVLN(4,4) = 0.5d0 + PAR2EVLN(4,5) = - 1d0 + PAR2EVLN(9,3) = 1d0 + PAR2EVLN(10,1) = 2.d0*(1d0 - CS)/(2d0 + CS) + PAR2EVLN(10,4) = 3d0*CS/(2d0 + CS) + PAR2EVLN(11,1) = 1d0 + PAR2EVLN(12,1) = 1d0 + PAR2EVLN(13,1) = 1d0 +! + return + END +! +! Change of basis from our basis to LHAPDF one: +! Computes the PDFs of the single partons starting from the T_i and +! combinations which are used in the evolution. +! +! The combinations used in the evolution are numbered +! according to the following table: +! +! 1 2 3 4 5 6 7 8 9 10 11 12 13 +! Sigma g u_v d_v s_v c_v b_v t_v T_3 T_8 T_15 T_24 T_35 +! +! The output PDFs are numbered according to the Les Houches +! convention: +! +! -6 -5 -4 -3 -2 -1 0 1 2 3 4 5 6 +! tbar bbar cbar sbar ubar dbar g d u s c b t +! +! + SUBROUTINE LH_PDFEVLN2LHA(pdfin,pdfout) + IMPLICIT none +! + INTEGER I,J + integer MXPDF + parameter(MXPDF=13) +! + REAL*8 pdfin(MXPDF),pdfout(-6:6) + REAL*8 evln2lha(mxpdf,mxpdf) + COMMON/nnpdf10EEVLN2LHA/EVLN2LHA +! + CALL LH_INITEVLN2LHA +! + DO I = 1,MXPDF + PDFOUT(I-7)=0D0 + DO J = 1,MXPDF + PDFOUT(I-7) = PDFOUT(I-7) + EVLN2LHA(I,J)*PDFIN(J) + ENDDO + ENDDO +! + RETURN + END +! +! + SUBROUTINE LH_INITEVLN2LHA + IMPLICIT none +! + INTEGER I,J +! + INTEGER IPT,IMODEV,IVFN,ITMC + COMMON /NNPDF10EVFLAGS/ IPT,IMODEV,IVFN,ITMC + integer MXPDF + parameter(MXPDF=13) +! + REAL*8 evln2lha(mxpdf,mxpdf) + COMMON/nnpdf10EEVLN2LHA/EVLN2LHA +! +! Write it as a matrix for LHAPDF interface +! PDFOUT(I-7) = EVLN2LHA(I,J) * PDFIN(J) +! + IF(IVFN.EQ.1) THEN +! + do i = 1,mxpdf + do j = 1,mxpdf + evln2lha(i,j) = 0d0 + enddo + enddo +! + DO i=1,mxpdf + evln2lha(i,1) = 10d0 + ENDDO + evln2lha(7,1) = 0d0 +! + evln2lha(7,2) = 120d0 +! + evln2lha(5,3) = - 60d0 + evln2lha(9,3) = + 60d0 +! + evln2lha(6,4) = - 60d0 + evln2lha(8,4) = + 60d0 +! + evln2lha(4,5) = - 60d0 + evln2lha(10,5) = + 60d0 +! + evln2lha(3,6) = - 60d0 + evln2lha(11,6) = + 60d0 +! + evln2lha(2,7) = - 60d0 + evln2lha(12,7) = + 60d0 +! + evln2lha(1,8) = - 60d0 + evln2lha(13,8) = + 60d0 +! + evln2lha(5,9) = + 30d0 + evln2lha(6,9) = - 30d0 + evln2lha(8,9) = - 30d0 + evln2lha(9,9) = + 30d0 +! + evln2lha(4,10) = - 20d0 + evln2lha(5,10) = + 10d0 + evln2lha(6,10) = + 10d0 + evln2lha(8,10) = + 10d0 + evln2lha(9,10) = + 10d0 + evln2lha(10,10)= - 20d0 +! + evln2lha(3,11) = - 15d0 + evln2lha(4,11) = + 5d0 + evln2lha(5,11) = + 5d0 + evln2lha(6,11) = + 5d0 + evln2lha(8,11) = + 5d0 + evln2lha(9,11) = + 5d0 + evln2lha(10,11)= + 5d0 + evln2lha(11,11)= - 15d0 +! + evln2lha(2,12) = - 12d0 + evln2lha(3,12) = + 3d0 + evln2lha(4,12) = + 3d0 + evln2lha(5,12) = + 3d0 + evln2lha(6,12) = + 3d0 + evln2lha(8,12) = + 3d0 + evln2lha(9,12) = + 3d0 + evln2lha(10,12)= + 3d0 + evln2lha(11,12)= + 3d0 + evln2lha(12,12)= - 12d0 +! + evln2lha(1,13) = - 10d0 + evln2lha(2,13) = + 2d0 + evln2lha(3,13) = + 2d0 + evln2lha(4,13) = + 2d0 + evln2lha(5,13) = + 2d0 + evln2lha(6,13) = + 2d0 + evln2lha(8,13) = + 2d0 + evln2lha(9,13) = + 2d0 + evln2lha(10,13)= + 2d0 + evln2lha(11,13)= + 2d0 + evln2lha(12,13)= + 2d0 + evln2lha(13,13)= - 10d0 +! + do i = 1,mxpdf + do j = 1,mxpdf + evln2lha(i,j) = evln2lha(i,j) / 120d0 + enddo + enddo + + ELSE +! + do i = 1,mxpdf + do j = 1,mxpdf + evln2lha(i,j) = 0d0 + enddo + enddo +! + DO i=1,mxpdf + evln2lha(i,1) = 3d0 + ENDDO + evln2lha(7,1) = 0d0 +! + evln2lha(7,2) = 24d0 +! + evln2lha(5,3) = - 12d0 + evln2lha(9,3) = + 12d0 +! + evln2lha(6,4) = - 12d0 + evln2lha(8,4) = + 12d0 +! + evln2lha(4,5) = - 12d0 + evln2lha(10,5) = + 12d0 +! + evln2lha(3,6) = - 12d0 + evln2lha(11,6) = + 12d0 +! + evln2lha(5,9) = + 6d0 + evln2lha(6,9) = - 6d0 + evln2lha(8,9) = - 6d0 + evln2lha(9,9) = + 6d0 +! + evln2lha(4,10) = - 4d0 + evln2lha(5,10) = + 2d0 + evln2lha(6,10) = + 2d0 + evln2lha(8,10) = + 2d0 + evln2lha(9,10) = + 2d0 + evln2lha(10,10)= - 4d0 +! + evln2lha(3,11) = - 3d0 + evln2lha(4,11) = + 1d0 + evln2lha(5,11) = + 1d0 + evln2lha(6,11) = + 1d0 + evln2lha(8,11) = + 1d0 + evln2lha(9,11) = + 1d0 + evln2lha(10,11)= + 1d0 + evln2lha(11,11)= - 3d0 +! + do i = 1,mxpdf + do j = 1,mxpdf + evln2lha(i,j) = evln2lha(i,j) / 24d0 + enddo + enddo +! + ENDIF +! + RETURN + END + +! +! pdfevln2inpar.f +! +! Convert from the EVOLUTION convention: +! 1 2 3 4 5 6 7 8 9 10 11 12 13 +! Sigma g u_v d_v s_v c_v b_v t_v T_3 T_8 T_15 T_24 T_35 +! +! to the INPUTPARAMETRIZATION convention for PDF ordering: +! based on Flavour Assumptions +! + + subroutine LH_PDFEVLN2INPAR(PDFIN,PDFOUT) + implicit none +! + integer MXPDF + parameter(MXPDF=13) + integer NTOTPDF + parameter(NTOTPDF=5) + real*8 PDFIN(MXPDF),PDFOUT(NTOTPDF) + +! JPDF=1 -> Singlet + PDFOUT(1) = PDFIN(1) + +! JPDF=2 -> Gluon + PDFOUT(2) = PDFIN(2) + +! JPDF=3 -> Triplet + PDFOUT(3) = PDFIN(9) + +! JPDF=4 -> Total Valence -> V_T = u_V + d_V + PDFOUT(4) = PDFIN(3) + PDFIN(4) + +! JPDF=5 -> Sea Asymmetry -> Delta_S = ( u_V - d_V - T_3 )/2 + PDFOUT(5) = ( PDFIN(3) - PDFIN(4) - PDFIN(9) )/2d0 + + return + END + +!***** +! 10 *------------------------------------------------------------------ +!***** +! +! File: andim_lo.f +! Returns the LO anomalous dimensions in the +! + SUBROUTINE LH_ANDIM_LO(N,NF,P0NS,P0SG) + IMPLICIT none +! + REAL*8 ca,cf,tr + COMMON/NNPDF10COLFACT/ca,cf,tr + REAL*8 emc,zeta2,zeta3,zeta4,pi + PARAMETER (pi = 3.1415926535897932385) + COMMON /NNPDF10CONSTS/ emc,zeta2,zeta3,zeta4 + COMPLEX*16 LH_PSI, S1 +! + COMPLEX*16 NS,N1,N2,NM + COMPLEX*16 PQQA,PQGA,PGQA,PGGA,PGGB + COMPLEX*16 N + INTEGER NF + COMPLEX*16 P0NS + COMPLEX*16 P0SG (2,2) +! + NS = N * N + N1 = N + cmplx(1d0,0d0) + N2 = N + (2d0,0d0) + NM = N - (1d0,0d0) +! + S1 = cmplx(EMC,0d0) + LH_PSI(N1) + PQQA = (3d0,0d0) - 4d0* S1 + 2d0/(N * N1) + PQGA = 4d0* (NS + N + 2d0) / (N * N1 * N2) + PGQA = 2d0 * (NS + N + 2d0) / (N * N1 * NM) + PGGA = 11d0/3D0 - 4d0* S1 + 4d0/(N * NM) + 4d0/(N1 * N2) + PGGB = - 4d0/3D0 +! +! Output to the array + P0NS = CF * PQQA +! + P0SG(1,1) = CF * PQQA + P0SG(1,2) = TR * dble(NF) * PQGA + P0SG(2,1) = CF * PGQA + P0SG(2,2) = CA * PGGA + TR *dble(NF) * PGGB +! + RETURN + END +! +! File: andim_nlo.f +! Returns the NLO anomalous dimensions in the +! + SUBROUTINE LH_ANDIM_NLO(N,NF,P1NS,P1SG) + IMPLICIT none +! + REAL*8 ca,cf,tr + COMMON/NNPDF10COLFACT/ca,cf,tr + REAL*8 emc,zeta2,zeta3,zeta4,pi + PARAMETER (pi = 3.1415926535897932385) + COMMON /NNPDF10CONSTS/ emc,zeta2,zeta3,zeta4 +! + COMPLEX*16 LH_DPSI,LH_PSI, S1, S2 + INTEGER I,J + COMPLEX*16 NS,NT,NFO,NFI,NSI,NSE,NE,NN + COMPLEX*16 N1,N2,NM,NMS,N1S,N1T,N2S,N2T + COMPLEX*16 N3,N4,N5,N6 + COMPLEX*16 S11,S12,S13,S14,S15,S16 + COMPLEX*16 SPMOM,SLC,SLV,SSCHLM,SSTR2M,SSTR3M,SSCHLP + COMPLEX*16 SSTR2P,SSTR3P + COMPLEX*16 PPSA,PQGA,PGQA,PGGA,PQGB,PGQB,PGGB,PGQC,PGGC + COMPLEX*16 PNPA,PNMA,PNSB,PNSC + COMPLEX*16 N + INTEGER NF + COMPLEX*16 P1NS(3) + COMPLEX*16 P1SG(2,2) +! + S1 = EMC + LH_PSI(N+1d0) + S2 = ZETA2 - LH_DPSI(N+1d0,1) +! + NS = N * N + NT = NS * N + NFO = NT * N + NFI = NFO * N + NSI = NFI * N + NSE = NSI * N + NE = NSE * N + NN = NE * N +! + NM = N - 1d0 + N1 = N + 1d0 + N2 = N + 2d0 + NMS = NM * NM + N1S = N1 * N1 + N1T = N1S * N1 + N2S = N2 * N2 + N2T = N2S * N2 + +! ..Analytic continuations of the occuring sums as given in GRV (1990) +! (with an improved parametrization of the moments of Sp(x)/(1+x).) +! + N3 = N + 3D0 + N4 = N + 4D0 + N5 = N + 5D0 + N6 = N + 6D0 + S11 = S1 + 1D0/N1 + S12 = S11 + 1D0/N2 + S13 = S12 + 1D0/N3 + S14 = S13 + 1D0/N4 + S15 = S14 + 1D0/N5 + S16 = S15 + 1D0/N6 + SPMOM = 1.0000D0 * (ZETA2 - S1 / N ) / N - & + & 0.9992D0 * (ZETA2 - S11/ N1) / N1 + & + & 0.9851D0 * (ZETA2 - S12/ N2) / N2 - & + & 0.9005D0 * (ZETA2 - S13/ N3) / N3 + & + & 0.6621D0 * (ZETA2 - S14/ N4) / N4 - & + & 0.3174D0 * (ZETA2 - S15/ N5) / N5 + & + & 0.0699D0 * (ZETA2 - S16/ N6) / N6 +! + SLC = - 5D0/8D0 * ZETA3 + SLV = - ZETA2/2D0* (LH_PSI(N1/2D0) - LH_PSI(N/2D0)) & + & + S1/NS + SPMOM + SSCHLM = SLC - SLV + SSTR2M = ZETA2 - LH_DPSI (N1/2D0,1) + SSTR3M = 0.5D0 * LH_DPSI (N1/2D0,2) + ZETA3 + + SSCHLP = SLC + SLV + SSTR2P = ZETA2 - LH_DPSI(N2/2D0,1) + SSTR3P = 0.5D0 * LH_DPSI(N2/2D0,2) + ZETA3 + +! +! ..The contributions to P1NS as given in Gonzalez-Arroyo et al. (1979) +! (Note that the anomalous dimensions in the literature often differ +! from these moments of the splitting functions by factors -1 or -2, +! in addition to possible different normalizations of the coupling) +! + + PNMA = ( 16D0* S1 * (2D0* N + 1D0) / (NS * N1S) + & + & 16D0* (2D0* S1 - 1D0/(N * N1)) * ( S2 - SSTR2M ) + & + & 64D0* SSCHLM + 24D0* S2 - 3D0 - 8D0* SSTR3M - & + & 8D0* (3D0* NT + NS -1D0) / (NT * N1T) + & + & 16D0* (2D0* NS + 2D0* N +1D0) / (NT * N1T) ) * (-0.5D0) + PNPA = ( 16D0* S1 * (2D0* N + 1D0) / (NS * N1S) + & + & 16D0* (2D0* S1 - 1D0/(N * N1)) * ( S2 - SSTR2P ) + & + & 64D0* SSCHLP + 24D0* S2 - 3D0 - 8D0* SSTR3P - & + & 8D0* (3D0* NT + NS -1D0) / (NT * N1T) - & + & 16D0* (2D0* NS + 2D0* N +1D0)/(NT * N1T) ) * (-0.5D0) + + PNSB = ( S1 * (536D0/9D0 + 8D0* (2D0* N + 1D0) / (NS * N1S)) - & + & (16D0* S1 + 52D0/3D0- 8D0/(N * N1)) * S2 - 43D0/6D0 - & + & (151D0* NFO + 263D0* NT + 97D0* NS + 3D0* N + 9D0) * & + & 4D0/ (9D0* NT * N1T) ) * (-0.5D0) + PNSC = ( -160D0/9D0* S1 + 32D0/3.* S2 + 4D0/3D0 + & + & 16D0*(11D0*NS+5D0*N-3D0)/(9D0* NS * N1S))*(-0.5D0) +! +! ..The contributions to P1SG as given in Floratos et al. (1981) +! ..Pure singlet (PS) and QG +! + PPSA = (5d0* NFI + 32d0* NFO + 49d0* NT+38d0* NS + 28d0* N + 8d0)& + & / (NM * NT * N1T * N2S) * 2d0 +! + PQGA = (-2d0* S1 * S1 + 2d0* S2 - 2d0* SSTR2P) & + & * (NS + N + 2d0) / (N * N1 * N2) & + & + (8d0* S1 * (2d0* N + 3d0)) / (N1S * N2S) & + & + 2d0* (NN + 6d0* NE + 15d0* NSE + 25d0* NSI + 36d0* NFI & + & + 85d0* NFO + 128d0* NT + 104d0* NS + 64d0* N + 16d0) & + & / (NM * NT * N1T * N2T) + PQGB = (2d0* S1 * S1 - 2d0* S2 + 5d0) * (NS + N + 2d0) & + & / (N * N1 * N2) - 4d0* S1 / NS & + & + (11d0* NFO + 26d0* NT + 15d0* NS + 8d0* N + 4d0) & + & / (NT * N1T * N2) + +! +! ..GQ and GG + PGQA = (- S1 * S1 + 5d0* S1 - S2) * (NS + N + 2d0) & + & / (NM * N * N1) - 2d0* S1 / N1S & + & - (12d0* NSI + 30d0* NFI + 43d0* NFO + 28d0* NT - NS & + & - 12d0* N - 4d0) / (2d0* NM * NT * N1T) + PGQB = (S1*S1 + S2 - SSTR2P) * (NS + N + 2d0) / (NM * N * N1) & + & - S1 * (17d0* NFO + 41d0* NS - 22d0* N - 12d0) & + & / (3d0* NMS * NS * N1) & + & + (109d0* NN + 621d0* NE + 1400d0* NSE + 1678d0* NSI & + & + 695d0* NFI - 1031d0* NFO - 1304d0* NT - 152d0* NS & + & + 432d0* N + 144d0) / (9d0* NMS * NT * N1T * N2S) + PGQC = (S1 - 8d0/3d0) * (NS + N + 2d0) / (NM * N * N1) + 1d0/ N1S + PGQC = 4d0/3d0* PGQC +! + PGGA = - (2d0* NFI + 5d0* NFO + 8d0* NT + 7d0* NS- 2d0* N - 2d0) & + & * 8d0* S1 / (NMS * NS * N1S * N2S) - 67d0/9d0* S1 + 8d0/3d0& + & - 4d0* SSTR2P * (NS + N + 1d0) / (NM * N * N1 * N2) & + & + 2d0* S1 * SSTR2P - 4d0* SSCHLP + 0.5d0 * SSTR3P & + & + (457d0* NN + 2742d0* NE + 6040d0* NSE + 6098d0* NSI & + & + 1567d0* NFI - 2344d0* NFO - 1632d0* NT + 560d0* NS & + & + 1488d0* N + 576d0) / (18d0* NMS * NT * N1T * N2T) + PGGB = (38d0* NFO + 76d0* NT + 94d0* NS + 56d0* N + 12d0) *(-2d0)& + & / (9d0* NM * NS * N1S * N2) + 20d0/9d0* S1 - 4d0/3d0 + PGGC = (2d0* NSI + 4d0* NFI + NFO - 10d0* NT - 5d0* NS - 4d0* N & + & - 4d0) * (-2d0) / (NM * NT * N1T * N2) - 1d0 +! +! Output to the array + DO I=1,2 + DO J=1,2 + P1SG(I,J)=0d0 + ENDDO + ENDDO + + do I=1,3 + P1NS(I)=0d0 + enddo +! +! NON SINGLET +! +! Plus + P1NS(1) = CF *((CF-CA/2d0)* PNPA + CA* PNSB + TR*dble(NF)* PNSC) + +! Minus=Valence + P1NS(2) = CF *((CF-CA/2d0)* PNMA + CA* PNSB + TR*dble(NF)* PNSC) + P1NS(3) = P1NS(2) +! +! SINGLET + P1SG(1,1) = P1NS(1) + TR*dble(NF)*CF*PPSA*4d0 + P1SG(1,2) = TR*dble(NF) * (CA * PQGA + CF * PQGB)*4d0 + P1SG(2,1) = (CF*CF*PGQA + CF*CA*PGQB+TR*dble(NF)*CF*PGQC)*4d0 + P1SG(2,2) = (CA*CA*PGGA + TR*dble(NF)*(CA*PGGB+CF*PGGC))*4d0 +! + RETURN + END +!***** +! 10 *------------------------------------------------------------------ +!***** +! +! matutils.f +! A collection of Fortran utilities to deal with matrices: +! - multiplication (mmult_c, mmult_r). +! - equating (mequal_c,mequal_r) +! + SUBROUTINE LH_MMULT_C(A,ROWSA,COLSA,B,ROWSB,COLSB,C) + IMPLICIT none +! + INTEGER ROWSA,COLSA,ROWSB,COLSB + COMPLEX*16 A(ROWSA,COLSA), B(ROWSB,COLSB), C(ROWSA,COLSB) + INTEGER I,J,K +! +! Check that the matrices we would like to multiply have the +! correct dimensions +! + IF (COLSA .NE. ROWSB) THEN + WRITE(*,*) 'Coglione... dimensioni delle matrici sbagliate!' + RETURN + ELSE +! +! Initialize the output matrix to zero +! + DO I = 1,ROWSA + DO J = 1,COLSB + C(I,J) = (0.0d0,0.0d0) + ENDDO + ENDDO +! +! Perform the multiplication according to: +! C[i,j] = Sum_k(A[i,k]*B[k,i]) +! + DO I = 1,ROWSA + DO J = 1,COLSB + DO K = 1,COLSA + C(I,J) = C(I,J) + A(I,K) * B(K,J) + ENDDO + ENDDO + ENDDO +! + ENDIF + RETURN + END +! +! + SUBROUTINE LH_MMULT_R(A,ROWSA,COLSA,B,ROWSB,COLSB,C) + IMPLICIT none +! + INTEGER ROWSA,COLSA,ROWSB,COLSB +! + REAL*8 A(ROWSA,COLSA), B(ROWSB,COLSB), C(ROWSA,COLSB) +! + INTEGER I,J,K +! +! Check that the matrices we would like to multiply have the +! correct dimensions + IF (COLSA .NE. ROWSB) THEN + WRITE(*,*) 'wrong dimensions in matrix' + RETURN + ELSE +! +! Initialize the output matrix to zero + DO I = 1,ROWSA + DO J = 1,COLSB + C(I,J) = 0.0d0 + ENDDO + ENDDO + +! +! Perform the multiplication according to: +! C[i,j] = Sum_k(A[i,k]*B[k,i]) + DO I = 1,ROWSA + DO J = 1,COLSB + DO K = 1,COLSA + C(I,J) = C(I,J) + A(I,K) * B(K,J) + ENDDO + ENDDO + ENDDO +! + ENDIF + RETURN + END +! +! + SUBROUTINE LH_MEQUAL_C(A,B,I,J) + IMPLICIT none +! + INTEGER I,J + INTEGER K,L + COMPLEX*16 A(I,J), B(I,J) +! + DO K=1,I + DO L=1,J + A(K,L) = B(K,L) + ENDDO + ENDDO + RETURN + END +! +! + SUBROUTINE LH_MEQUAL_R(A,B,I,J) + IMPLICIT none +! + INTEGER I,J + INTEGER K,L + REAL*8 A(I,J), B(I,J) +! + DO K=1,I + DO L=1,J + A(K,L) = B(K,L) + ENDDO + ENDDO + RETURN + END +! +! psi.f +! CalculATE complex psi function, PZI(Z), and its m'th derivatives +! DPZI(Z,M) from the asymtotic expansions. The +! functional equations are used for |Im(Z)| < 10 to shift the +! argument to Re(Z) >= 10 before applying the expansions. +! + FUNCTION LH_PSI (Z) + IMPLICIT COMPLEX*16 (A-Z) + SUB = 0D0 + ZZ = Z +! + IF (DABS(DIMAG(ZZ)) .LT. 10.D0) THEN +! + 1 CONTINUE + IF (DBLE(ZZ) .LT. 10.D0) THEN + SUB = SUB - 1d0/ ZZ + ZZ = ZZ + 1d0 + GOTO 1 + END IF +! + END IF +! +! ..Use of the asymtotic expansion (at the shifted argument) +! Abramowitz-Stegun eq. 6.3.18 plus one term +! + RZ = 1d0/ ZZ + DZ = RZ * RZ + LH_PSI = SUB + LOG(ZZ) - 0.5d0 * RZ - DZ/5040D0 * ( 420d0+ DZ * & + & ( - 42d0 + DZ * (20d0 - 21d0 * DZ) ) ) +! + RETURN + END +! +! + FUNCTION LH_DPSI (Z,M) + IMPLICIT COMPLEX*16 (A-Z) +! + INTEGER M, K1, K2 + SUB = 0D0 + ZZ = Z +! +! ..Shift of the argument using the functional equations + IF (DABS(DIMAG(ZZ)) .LT. 10.D0) THEN +! + 1 CONTINUE + SUBM = -1d0/ZZ + DO 10 K1 = 1, M + SUBM = - SUBM * K1 / ZZ + 10 CONTINUE +! + IF (DBLE(ZZ) .LT. 10.D0) THEN + SUB = SUB + SUBM + ZZ = ZZ + 1d0 + GOTO 1 + END IF +! + END IF +! +! ..Expansion (Bernoulli) coefficients for the first derivative + A1 = 1D0 + A2 = 1d0/2D0 + A3 = 1d0/6D0 + A4 = -1d0/30D0 + A5 = 1d0/42D0 + A6 = -1d0/30D0 + A7 = 5d0/66D0 +! +! ..Expansion coefficients for the higher derivatives + IF (M .EQ. 1) GOTO 2 + DO 11 K2 = 2, M + A1 = A1 * (dble(K2)-1d0) + A2 = A2 * dble(K2) + A3 = A3 * (dble(K2)+1d0) + A4 = A4 * (dble(K2)+3d0) + A5 = A5 * (dble(K2)+5d0) + A6 = A6 * (dble(K2)+7d0) + A7 = A7 * (dble(K2)+9d0) + 11 CONTINUE + 2 CONTINUE +! +! ..Use of the asymtotic expansion (at the shifted argument) +! + RZ = 1d0/ ZZ + DZ = RZ * RZ + LH_DPSI = SUB + (-1)**(M+1d0) * RZ**M * ( A1 + RZ * (A2 + RZ * & + & (A3 + DZ * (A4 + DZ * (A5 + DZ * (A6 + A7 * DZ ))))) ) +! + RETURN + END +! +! dgauss_intern.f +! + DOUBLE PRECISION FUNCTION LH_DGAUSS_INTERN(F,A,B,EPS) + DOUBLE PRECISION W(12),X(12),A,B,EPS,DELTA,CONST,AA,BB,Y,C1,C2,S8,& + & S16,U,F + DATA CONST /1.0D-25/ + DATA W & + & / 0.1012285362903762591525313543D0, & + & 0.2223810344533744705443559944D0, & + & 0.3137066458778872873379622020D0, & + & 0.3626837833783619829651504493D0, & + & 0.0271524594117540948517805725D0, & + & 0.0622535239386478928628438370D0, & + & 0.0951585116824927848099251076D0, & + & 0.1246289712555338720524762822D0, & + & 0.1495959888165767320815017305D0, & + & 0.1691565193950025381893120790D0, & + & 0.1826034150449235888667636680D0, & + & 0.1894506104550684962853967232D0 / + DATA X & + & / 0.9602898564975362316835608686D0, & + & 0.7966664774136267395915539365D0, & + & 0.5255324099163289858177390492D0, & + & 0.1834346424956498049394761424D0, & + & 0.9894009349916499325961541735D0, & + & 0.9445750230732325760779884155D0, & + & 0.8656312023878317438804678977D0, & + & 0.7554044083550030338951011948D0, & + & 0.6178762444026437484466717640D0, & + & 0.4580167776572273863424194430D0, & + & 0.2816035507792589132304605015D0, & + & 0.0950125098376374401853193354D0 / + DELTA=CONST*DABS(A-B) + LH_DGAUSS_INTERN=0. + AA=A + 5 Y=B-AA + IF(DABS(Y) .LE. DELTA) RETURN + 2 BB=AA+Y + C1=0.5D0*(AA+BB) + C2=C1-AA + S8=0. + S16=0. + DO 1 I = 1,4 + U=X(I)*C2 + 1 S8=S8+W(I)*(F(C1+U)+F(C1-U)) + DO 3 I = 5,12 + U=X(I)*C2 + 3 S16=S16+W(I)*(F(C1+U)+F(C1-U)) + S8=S8*C2 + S16=S16*C2 + IF(DABS(S16-S8) .GT. EPS*(1.0D0+DABS(S16))) GOTO 4 + LH_DGAUSS_INTERN=LH_DGAUSS_INTERN+S16 + AA=BB + GOTO 5 + 4 Y=0.5D0*Y + IF(DABS(Y) .GT. DELTA) GOTO 2 + PRINT 7 + LH_DGAUSS_INTERN=0. + RETURN + 7 FORMAT(1X,'DGAUSS_INTERN ... TOO HIGH ACCURACY REQUIRED') + END diff --git a/LHAPDF/lhapdf-5.9.1/src/LHpdflib.F b/LHAPDF/lhapdf-5.9.1/src/LHpdflib.F new file mode 100644 index 00000000000..3b9130d82a4 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/LHpdflib.F @@ -0,0 +1,450 @@ +! -*- F90 -*- + + +! Initialize a PDF set, determining the path to the PDF set directory automatically +! subroutine InitPDFsetByCodes(code1, code2, code3) +! write(*,*) "Not implemented yet: this will move the 'glue' interface to ", & +! "LHAPDF proper and use the InitPDFsetByName function to ", & +! "get the path automatically." +! return +! end subroutine InitPDFsetByCodes + + + +! Initialize a PDF set, determining the path to the PDF set +! directory automatically +subroutine InitPDFsetByName(setname) + implicit none + character setname*(*) + integer nset + nset = 1 + call commoninit() + call InitPDFsetByNameM(nset,setname) + return +end subroutine InitPDFsetByName + + + +! Initialize a PDF set, determining the path to the PDF set +! directory automatically +subroutine InitPDFsetByNameM(nset,setname) + implicit none + include 'parmsetup.inc' + include 'commonlhapdfc.inc' + include 'commonlhacontrol.inc' + character setname*(*) + integer nset + character*512 dirpath, setpath + + ! Initialise common blocks + call commoninit() + + ! Find the directory with the PDFsets + call getdirpath(dirpath) + + ! Now build the path to the PDF set + setpath = dirpath(:len_trim(dirpath)) // "/" // setname(:len_trim(setname)) + + ! Initialize using the detected PDF set + call InitPDFsetM(nset, setpath(:len_trim(setpath))) + return +end subroutine InitPDFsetByNameM + + + +subroutine InitPDFset(setpath) + implicit none + integer nset + character setpath*(*) + nset = 1 + call commoninit() + call InitPDFsetM(nset,setpath) + return +end subroutine InitPDFset + + +subroutine InitLHAPDF() + call commoninit() +end subroutine InitLHAPDF + + +subroutine InitPDFsetM(nset,setpath) + implicit none + include 'parmsetup.inc' + include 'commonlhacontrol.inc' + character*512 filename + common/lhafilename/filename + character setpath*(*) + character*512 inputfile(nmxset) + character*64 string + character*16 s1,s2 + character*10 lhaversion + integer id,token,Ctoken + integer lhaonce + save lhaonce,inputfile + data lhaonce/0/ + integer lhasilent + common/lhasilent/lhasilent + integer nset,nnset + integer stat + + filename=setpath +#ifndef LOW_MEMORY + ! check if this set is already initialized - will not work for lite + if(inputfile(nset)(:len_trim(setpath)).eq.setpath) return +#endif + + ! Initialise common blocks + call commoninit() + call getlhapdfversion(lhaversion) + + inputfile(nset)=setpath + lhasilent = 0 + if (lhaparm(19).eq.'SILENT') then + lhasilent = 1 + elseif (lhaparm(19).eq.'LOWKEY') then + if (lhaonce .eq. 0) then + lhaonce = 1 + else + lhasilent = 1 + endif + endif + + call setnset(nset) + open(unit=1, file=setpath, status='old', iostat=stat) + if (stat .ne. 0) then + write(*,*) 'File ', setpath(:len_trim(setpath)), ' cannot be opened !' + write(*,*) 'If you have not already done so:' + write(*,*) 'Use the bin/lhapdf-getdata script to download the file.' + write(*,*) 'Set the environmental variable LHAPATH to specify the directory if not as default (above).' + close(1) + call exit(1) + end if + read(1,*) s1,s2 + if (( index(s2,'1.0').ne.1) & + .and.(index(s2,'1.1').ne.1) & + .and.(index(s2,'2.0').ne.1) & + .and.(index(s2,'2.1').ne.1) & + .and.(index(s2,'3.0').ne.1) & + .and.(index(s2,'3.1').ne.1) & + .and.(index(s2,'4.0').ne.1) & + .and.(index(s2,'5.0').ne.1) & + .and.(index(s2,'5.3').ne.1) & + .and.(index(s2,'5.4').ne.1) & + .and.(index(s2,'5.5').ne.1) & + .and.(index(s2,'5.6').ne.1) & + .and.(index(s2,'5.7').ne.1) & + .and.(index(s2,'5.8').ne.1)) then + write(*,*) 'Version ',s2,' not supported by this version of LHAPDF' + stop + else + if (lhasilent.eq.0) then + write(*,*) '*************************************' + write(*,*) '* LHAPDF Version ',lhaversion,' *' + write(*,*) '* Configured for the following: *' +#ifdef ALL + write(*,*) '* All PDFs *' +#endif +#ifndef ALL +#ifdef MRST + write(*,*) '* MRSTMAIN *' +#endif +#ifdef MRST06 + write(*,*) '* MRST06 *' +#endif +#ifdef MRST98 + write(*,*) '* MRST98 *' +#endif +#ifdef MRSTQED + write(*,*) '* MRSTQED *' +#endif +#ifdef CTEQ + write(*,*) '* CTEQ *' +#endif +#ifdef MSTW + write(*,*) '* MSTW *' +#endif +#ifdef ALEKHIN + write(*,*) '* ALEKHIN *' +#endif +#ifdef NNPDF + write(*,*) '* NNPDF *' +#endif +#ifdef BOTJE + write(*,*) '* BOTJE *' +#endif +#ifdef FERMI + write(*,*) '* FERMI *' +#endif +#ifdef ZEUS + write(*,*) '* ZEUS *' +#endif +#ifdef H1 + write(*,*) '* H1 *' +#endif +#ifdef HERA + write(*,*) '* HERA *' +#endif +#ifdef GRV + write(*,*) '* GRV *' +#endif +#ifdef GJR + write(*,*) '* GJR/JR *' +#endif +#ifdef HKN + write(*,*) '* HKN *' +#endif +#ifdef PIONS + write(*,*) '* PIONS *' +#endif +#ifdef PHOTONS + write(*,*) '* PHOTONS *' +#endif +#ifdef USER + write(*,*) '* USER *' +#endif +#endif +#ifdef LOW_MEMORY + write(*,*) '* LOW MEMORY option *' +#endif +#ifdef FULL_MEMORY + write(*,*) '* FULL MEMORY option *' +#endif + 1111 format(' * Maximum ',i2,' concurrent set(s) *') + write(*,1111),nmxset + write(*,*) '*************************************' + write(*,*) + endif + endif + id=Ctoken() +1 read(1,*) string + id=token(string) + ! print *,'id = ',id,string + if (id.eq.0) then + write(*,*) 'File description error:' + write(*,*) 'Command not understood: ',string + stop + endif + if (id.eq.1) call descriptionPDF(nset,id) + ! print *,'1/2' + if (id.eq.2) then + call initEvolve(nset) + endif + ! print *,'2/3' + if (id.eq.3) call initAlphasPDF(nset) + ! print *,'3/4' + if (id.eq.4) call initInputPDF(nset) + ! print *,'4/5' + if (id.eq.5) call initListPDF(nset) + ! print *,'5/6' + if (id.eq.6) call initQCDparams(nset) + ! print *,'6/7' + if (id.eq.7) call initMinMax(nset) + ! print *,'7/8' + if (id.ne.8) goto 1 + close(1) + ! print *,'calling InitEvolveCode',nset + call InitEvolveCode(nset) + + ! Initialize the default member 0 + call InitPDFM(nset,0) + + return + entry getsetpath(setpath) + call getnset(nnset) + setpath=inputfile(nnset) + return + +end subroutine InitPDFsetM + + + +integer function token(s) + implicit none + character*16 s + integer not,i,Ctoken + parameter(not=8) + character*16 t(not) + data t/'Description:','Evolution:','Alphas:', 'Parametrization:', & + 'Parameterlist:','QCDparams:','MinMax:','End:'/ + integer count(not) + save count + + token=0 + do i=1,not + if (s.eq.t(i)) token=i + enddo + if (token.ne.0) then + count(token)=count(token)+1 + if (count(token).eq.2) then + write(*,*) 'File description error:' + write(*,*) 'Second definition of entry: ',s + stop + endif + endif + return + + entry Ctoken() + do i=1,not + count(i)=0 + enddo + Ctoken=0 + return +end function token + + + +subroutine LHAprint(iprint) + implicit none + include 'commonlhacontrol.inc' + integer lhasilent,iprint + common/lhasilent/lhasilent + call commoninit() + lhasilent = iprint + ! If using stream #6, don't silence! + if(iprint.ne.6) lhaparm(19)='SILENT' + return +end subroutine LHAprint + + + +subroutine setPDFpath(pathname) + implicit none + include 'commonlhapdfc.inc' + include 'commonlhacontrol.inc' + include 'parmsetup.inc' + character*(*) pathname + integer j + + call commoninit() + lhaparm(20) = 'LHAPATH' + do j=1,len_trim(lhapath) + lhapath(j:j)='' + enddo + lhapath = pathname + return +end subroutine setPDFpath + + + +subroutine lhaset(lhaparm2,lhavalue2) + implicit none + include 'commonlhacontrol.inc' + character*20 lhaparm2(20) + double precision lhavalue2(20) + integer j + + call commoninit() + do j=1,20 + lhaparm(j)=lhaparm2(j) + lhavalue(j)=lhavalue2(j) + enddo + return +end subroutine lhaset + + + +subroutine setlhaparm(lparm) + implicit none + include 'commonlhacontrol.inc' + character*(*) lparm + integer nparm + + call commoninit() + + if(lparm.eq.'EKS98') then + lhaparm(15)='EKS98' + else if(lparm.eq.'EPS08') then + lhaparm(15)='EPS08' + else if(lparm.eq.'EPS09') then + lhaparm(15)='EPS09' + else if(lparm(1:5).eq.'EPS09') then + lhaparm(15)=lparm(1:LEN_TRIM(lparm)) + else if(lparm.eq.'15') then + lhaparm(15)='' + else if(lparm.eq.'NOSTAT') then + lhaparm(16)='NOSTAT' + else if (lparm.eq.'16') then + lhaparm(16)='' + else if (lparm.eq.'LHAPDF') then + lhaparm(17)='LHAPDF' + else if (lparm.eq.'17') then + lhaparm(17)='' + else if (lparm.eq.'EXTRAPOLATE') then + lhaparm(18)='EXTRAPOLATE' + else if (lparm.eq.'18') then + lhaparm(18)='' + else if (lparm.eq.'SILENT') then + lhaparm(19)='SILENT' + else if (lparm.eq.'LOWKEY') then + lhaparm(19)='LOWKEY' + else if (lparm.eq.'19') then + lhaparm(19)='' + else + print *,'WARNING from SetLHAPARM - value',lparm,'not recognized!' + endif + return + + entry getlhaparm(nparm,lparm) + lparm = lhaparm(nparm) + return +end subroutine setlhaparm + + + +subroutine getdirpath(dirpath) + ! This routine is to determine the directory path for the PDFsets + ! directory. It has a two-fold purpose: + ! 1) to return the value as an argument in dirpath for the native + ! LHAPDF use (ie via initPDFSetByName + ! 2) to fill the value of lhapath in the LHAPDFC common for use in + ! lhaglue. + implicit none + include 'commonlhapdfc.inc' + include 'commonlhacontrol.inc' + include 'parmsetup.inc' + character*(*) dirpath + + ! First look in the LHAPDFC array (lhaparm(20), set by setPDFpath). + ! Next, check environmental variable LHAPATH. + ! Finally, use binreloc via getdatapath(...). + ! Will use default path if this all fails. + if (lhaparm(20) /= 'LHAPATH') then + call getenv('LHAPATH', lhapath) + !call get_environment_variable('LHAPATH',lhapath) + if (lhapath.eq.'') then + call getdatapath(dirpath) + lhapath = dirpath + endif + endif + dirpath = lhapath + return +end subroutine getdirpath + + +!-- Get the maximum number of concurrent PDF sets. +subroutine GetMaxNumSets(MaxNumSets) + implicit none + include 'parmsetup.inc' + integer MaxNumSets + MaxNumSets = nmxset +end subroutine GetMaxNumSets + + +logical function has_photon() + implicit none + include 'parmsetup.inc' + integer nset + character*16 name(nmxset) + integer nmem(nmxset),ndef(nmxset),mem + common/NAME/name,nmem,ndef,mem +! + call getnset(nset) + has_photon = .FALSE. + + if(name(nset).eq.'MRST4qed') has_photon = .TRUE. + if(name(nset).eq.'NNPDF20intqed') has_photon = .TRUE. +! + return +! +end function has_photon diff --git a/LHAPDF/lhapdf-5.9.1/src/LHpdflib.f b/LHAPDF/lhapdf-5.9.1/src/LHpdflib.f new file mode 100644 index 00000000000..3b9130d82a4 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/LHpdflib.f @@ -0,0 +1,450 @@ +! -*- F90 -*- + + +! Initialize a PDF set, determining the path to the PDF set directory automatically +! subroutine InitPDFsetByCodes(code1, code2, code3) +! write(*,*) "Not implemented yet: this will move the 'glue' interface to ", & +! "LHAPDF proper and use the InitPDFsetByName function to ", & +! "get the path automatically." +! return +! end subroutine InitPDFsetByCodes + + + +! Initialize a PDF set, determining the path to the PDF set +! directory automatically +subroutine InitPDFsetByName(setname) + implicit none + character setname*(*) + integer nset + nset = 1 + call commoninit() + call InitPDFsetByNameM(nset,setname) + return +end subroutine InitPDFsetByName + + + +! Initialize a PDF set, determining the path to the PDF set +! directory automatically +subroutine InitPDFsetByNameM(nset,setname) + implicit none + include 'parmsetup.inc' + include 'commonlhapdfc.inc' + include 'commonlhacontrol.inc' + character setname*(*) + integer nset + character*512 dirpath, setpath + + ! Initialise common blocks + call commoninit() + + ! Find the directory with the PDFsets + call getdirpath(dirpath) + + ! Now build the path to the PDF set + setpath = dirpath(:len_trim(dirpath)) // "/" // setname(:len_trim(setname)) + + ! Initialize using the detected PDF set + call InitPDFsetM(nset, setpath(:len_trim(setpath))) + return +end subroutine InitPDFsetByNameM + + + +subroutine InitPDFset(setpath) + implicit none + integer nset + character setpath*(*) + nset = 1 + call commoninit() + call InitPDFsetM(nset,setpath) + return +end subroutine InitPDFset + + +subroutine InitLHAPDF() + call commoninit() +end subroutine InitLHAPDF + + +subroutine InitPDFsetM(nset,setpath) + implicit none + include 'parmsetup.inc' + include 'commonlhacontrol.inc' + character*512 filename + common/lhafilename/filename + character setpath*(*) + character*512 inputfile(nmxset) + character*64 string + character*16 s1,s2 + character*10 lhaversion + integer id,token,Ctoken + integer lhaonce + save lhaonce,inputfile + data lhaonce/0/ + integer lhasilent + common/lhasilent/lhasilent + integer nset,nnset + integer stat + + filename=setpath +#ifndef LOW_MEMORY + ! check if this set is already initialized - will not work for lite + if(inputfile(nset)(:len_trim(setpath)).eq.setpath) return +#endif + + ! Initialise common blocks + call commoninit() + call getlhapdfversion(lhaversion) + + inputfile(nset)=setpath + lhasilent = 0 + if (lhaparm(19).eq.'SILENT') then + lhasilent = 1 + elseif (lhaparm(19).eq.'LOWKEY') then + if (lhaonce .eq. 0) then + lhaonce = 1 + else + lhasilent = 1 + endif + endif + + call setnset(nset) + open(unit=1, file=setpath, status='old', iostat=stat) + if (stat .ne. 0) then + write(*,*) 'File ', setpath(:len_trim(setpath)), ' cannot be opened !' + write(*,*) 'If you have not already done so:' + write(*,*) 'Use the bin/lhapdf-getdata script to download the file.' + write(*,*) 'Set the environmental variable LHAPATH to specify the directory if not as default (above).' + close(1) + call exit(1) + end if + read(1,*) s1,s2 + if (( index(s2,'1.0').ne.1) & + .and.(index(s2,'1.1').ne.1) & + .and.(index(s2,'2.0').ne.1) & + .and.(index(s2,'2.1').ne.1) & + .and.(index(s2,'3.0').ne.1) & + .and.(index(s2,'3.1').ne.1) & + .and.(index(s2,'4.0').ne.1) & + .and.(index(s2,'5.0').ne.1) & + .and.(index(s2,'5.3').ne.1) & + .and.(index(s2,'5.4').ne.1) & + .and.(index(s2,'5.5').ne.1) & + .and.(index(s2,'5.6').ne.1) & + .and.(index(s2,'5.7').ne.1) & + .and.(index(s2,'5.8').ne.1)) then + write(*,*) 'Version ',s2,' not supported by this version of LHAPDF' + stop + else + if (lhasilent.eq.0) then + write(*,*) '*************************************' + write(*,*) '* LHAPDF Version ',lhaversion,' *' + write(*,*) '* Configured for the following: *' +#ifdef ALL + write(*,*) '* All PDFs *' +#endif +#ifndef ALL +#ifdef MRST + write(*,*) '* MRSTMAIN *' +#endif +#ifdef MRST06 + write(*,*) '* MRST06 *' +#endif +#ifdef MRST98 + write(*,*) '* MRST98 *' +#endif +#ifdef MRSTQED + write(*,*) '* MRSTQED *' +#endif +#ifdef CTEQ + write(*,*) '* CTEQ *' +#endif +#ifdef MSTW + write(*,*) '* MSTW *' +#endif +#ifdef ALEKHIN + write(*,*) '* ALEKHIN *' +#endif +#ifdef NNPDF + write(*,*) '* NNPDF *' +#endif +#ifdef BOTJE + write(*,*) '* BOTJE *' +#endif +#ifdef FERMI + write(*,*) '* FERMI *' +#endif +#ifdef ZEUS + write(*,*) '* ZEUS *' +#endif +#ifdef H1 + write(*,*) '* H1 *' +#endif +#ifdef HERA + write(*,*) '* HERA *' +#endif +#ifdef GRV + write(*,*) '* GRV *' +#endif +#ifdef GJR + write(*,*) '* GJR/JR *' +#endif +#ifdef HKN + write(*,*) '* HKN *' +#endif +#ifdef PIONS + write(*,*) '* PIONS *' +#endif +#ifdef PHOTONS + write(*,*) '* PHOTONS *' +#endif +#ifdef USER + write(*,*) '* USER *' +#endif +#endif +#ifdef LOW_MEMORY + write(*,*) '* LOW MEMORY option *' +#endif +#ifdef FULL_MEMORY + write(*,*) '* FULL MEMORY option *' +#endif + 1111 format(' * Maximum ',i2,' concurrent set(s) *') + write(*,1111),nmxset + write(*,*) '*************************************' + write(*,*) + endif + endif + id=Ctoken() +1 read(1,*) string + id=token(string) + ! print *,'id = ',id,string + if (id.eq.0) then + write(*,*) 'File description error:' + write(*,*) 'Command not understood: ',string + stop + endif + if (id.eq.1) call descriptionPDF(nset,id) + ! print *,'1/2' + if (id.eq.2) then + call initEvolve(nset) + endif + ! print *,'2/3' + if (id.eq.3) call initAlphasPDF(nset) + ! print *,'3/4' + if (id.eq.4) call initInputPDF(nset) + ! print *,'4/5' + if (id.eq.5) call initListPDF(nset) + ! print *,'5/6' + if (id.eq.6) call initQCDparams(nset) + ! print *,'6/7' + if (id.eq.7) call initMinMax(nset) + ! print *,'7/8' + if (id.ne.8) goto 1 + close(1) + ! print *,'calling InitEvolveCode',nset + call InitEvolveCode(nset) + + ! Initialize the default member 0 + call InitPDFM(nset,0) + + return + entry getsetpath(setpath) + call getnset(nnset) + setpath=inputfile(nnset) + return + +end subroutine InitPDFsetM + + + +integer function token(s) + implicit none + character*16 s + integer not,i,Ctoken + parameter(not=8) + character*16 t(not) + data t/'Description:','Evolution:','Alphas:', 'Parametrization:', & + 'Parameterlist:','QCDparams:','MinMax:','End:'/ + integer count(not) + save count + + token=0 + do i=1,not + if (s.eq.t(i)) token=i + enddo + if (token.ne.0) then + count(token)=count(token)+1 + if (count(token).eq.2) then + write(*,*) 'File description error:' + write(*,*) 'Second definition of entry: ',s + stop + endif + endif + return + + entry Ctoken() + do i=1,not + count(i)=0 + enddo + Ctoken=0 + return +end function token + + + +subroutine LHAprint(iprint) + implicit none + include 'commonlhacontrol.inc' + integer lhasilent,iprint + common/lhasilent/lhasilent + call commoninit() + lhasilent = iprint + ! If using stream #6, don't silence! + if(iprint.ne.6) lhaparm(19)='SILENT' + return +end subroutine LHAprint + + + +subroutine setPDFpath(pathname) + implicit none + include 'commonlhapdfc.inc' + include 'commonlhacontrol.inc' + include 'parmsetup.inc' + character*(*) pathname + integer j + + call commoninit() + lhaparm(20) = 'LHAPATH' + do j=1,len_trim(lhapath) + lhapath(j:j)='' + enddo + lhapath = pathname + return +end subroutine setPDFpath + + + +subroutine lhaset(lhaparm2,lhavalue2) + implicit none + include 'commonlhacontrol.inc' + character*20 lhaparm2(20) + double precision lhavalue2(20) + integer j + + call commoninit() + do j=1,20 + lhaparm(j)=lhaparm2(j) + lhavalue(j)=lhavalue2(j) + enddo + return +end subroutine lhaset + + + +subroutine setlhaparm(lparm) + implicit none + include 'commonlhacontrol.inc' + character*(*) lparm + integer nparm + + call commoninit() + + if(lparm.eq.'EKS98') then + lhaparm(15)='EKS98' + else if(lparm.eq.'EPS08') then + lhaparm(15)='EPS08' + else if(lparm.eq.'EPS09') then + lhaparm(15)='EPS09' + else if(lparm(1:5).eq.'EPS09') then + lhaparm(15)=lparm(1:LEN_TRIM(lparm)) + else if(lparm.eq.'15') then + lhaparm(15)='' + else if(lparm.eq.'NOSTAT') then + lhaparm(16)='NOSTAT' + else if (lparm.eq.'16') then + lhaparm(16)='' + else if (lparm.eq.'LHAPDF') then + lhaparm(17)='LHAPDF' + else if (lparm.eq.'17') then + lhaparm(17)='' + else if (lparm.eq.'EXTRAPOLATE') then + lhaparm(18)='EXTRAPOLATE' + else if (lparm.eq.'18') then + lhaparm(18)='' + else if (lparm.eq.'SILENT') then + lhaparm(19)='SILENT' + else if (lparm.eq.'LOWKEY') then + lhaparm(19)='LOWKEY' + else if (lparm.eq.'19') then + lhaparm(19)='' + else + print *,'WARNING from SetLHAPARM - value',lparm,'not recognized!' + endif + return + + entry getlhaparm(nparm,lparm) + lparm = lhaparm(nparm) + return +end subroutine setlhaparm + + + +subroutine getdirpath(dirpath) + ! This routine is to determine the directory path for the PDFsets + ! directory. It has a two-fold purpose: + ! 1) to return the value as an argument in dirpath for the native + ! LHAPDF use (ie via initPDFSetByName + ! 2) to fill the value of lhapath in the LHAPDFC common for use in + ! lhaglue. + implicit none + include 'commonlhapdfc.inc' + include 'commonlhacontrol.inc' + include 'parmsetup.inc' + character*(*) dirpath + + ! First look in the LHAPDFC array (lhaparm(20), set by setPDFpath). + ! Next, check environmental variable LHAPATH. + ! Finally, use binreloc via getdatapath(...). + ! Will use default path if this all fails. + if (lhaparm(20) /= 'LHAPATH') then + call getenv('LHAPATH', lhapath) + !call get_environment_variable('LHAPATH',lhapath) + if (lhapath.eq.'') then + call getdatapath(dirpath) + lhapath = dirpath + endif + endif + dirpath = lhapath + return +end subroutine getdirpath + + +!-- Get the maximum number of concurrent PDF sets. +subroutine GetMaxNumSets(MaxNumSets) + implicit none + include 'parmsetup.inc' + integer MaxNumSets + MaxNumSets = nmxset +end subroutine GetMaxNumSets + + +logical function has_photon() + implicit none + include 'parmsetup.inc' + integer nset + character*16 name(nmxset) + integer nmem(nmxset),ndef(nmxset),mem + common/NAME/name,nmem,ndef,mem +! + call getnset(nset) + has_photon = .FALSE. + + if(name(nset).eq.'MRST4qed') has_photon = .TRUE. + if(name(nset).eq.'NNPDF20intqed') has_photon = .TRUE. +! + return +! +end function has_photon diff --git a/LHAPDF/lhapdf-5.9.1/src/Makefile.am b/LHAPDF/lhapdf-5.9.1/src/Makefile.am new file mode 100644 index 00000000000..ca5fa3e15a5 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/Makefile.am @@ -0,0 +1,211 @@ +noinst_LTLIBRARIES = libLHAPDFCore.la +EXTRA_DIST = parmsetup.inc binreloc.h \ + common.inc commonlhacontrol.inc commonlhaglsta.inc \ + commonlhapdfc.inc commonlhapdf.inc commonlhasets.inc + +#MODULECODE = modules.f +MODULECODE = commoninit.f +LHAPDFCODE = version.cc LHpdflib.F description.f evolution.f \ + parameter.F QCDparams.f alphas.f inputPDF.F +CUSTOMCODE = wrapevolve.F Sqcdnum.f Szeus.f uncertainties.f +PHOTONCODE = wrapsasg.f wrapgrvg.f wrapdog.f wrapdgg.f wraplacg.f wrapgsg.f \ + wrapgsg96.f wrapacfgpg.f wrapwhitg.f +PIONCODE = wrapowpi.f wrapsmrspi.f wrapgrvpi.f wrapabfkwpi.f +MRSTCODE = wrapmrst.f +MRST06CODE = wrapmrst2006.f +MRST98CODE = wrapmrst98.f +MRSTQEDCODE = wrapmrstqed.f +MRSTSCODE = Smrst.f +CTEQCODE = wrapcteq5.f wrapcteq65.f wrapcteq6.f wrapcteq6lg.f wrapct12.f +NNPDFCODE = wrapNNPDF.f wrapNNPDFgrid.f wrapNNPDF20grid.f wrapNNPDF20qedgrid.f +MSTWCODE = wrapmstw.f +GJRCODE = wrapgjr.f +GRVCODE = wrapgrv.f +H1CODE = wraph1.f +ZEUSCODE = wrapzeus.f +HERACODE = wraphera.f wrapheragrid.f +ALEKHINCODE = wrapa02m.f wrapabkm09.f wrapabm11.f +HKNCODE = wraphkn.f +USERCODE = wrapUSER.f wrapusergrid.f +MRSTLITE = wrapmrst-lite.f +MRST06LITE = wrapmrst2006-lite.f +MRSTQEDLITE = wrapmrstqed-lite.f +MRSTSLITE = Smrst-lite.f +CTEQLITE = wrapcteq5.f wrapcteq65-lite.f wrapcteq6-lite.f wrapcteq6lg.f wrapct12.f +NNPDFLITE = wrapNNPDF.f wrapNNPDFgrid-lite.f wrapNNPDF20grid-lite.f wrapNNPDF20qedgrid-lite.f +MSTWLITE = wrapmstw-lite.f +GJRLITE = wrapgjr-lite.f +H1LITE = wraph1-lite.f +HERALITE = wraphera.f wrapheragrid-lite.f +ALEKHINLITE = wrapa02m-lite.f wrapabkm09-lite.f wrapabm11-lite.f +HKNLITE = wraphkn-lite.f +QCDNUMCODE = QCDNUM.F wrapQCDNUM.F wrapQCDNUM3.f wrapQCDNUM4.f +EVLCTEQCODE = wrapEVLCTEQ.f EVLCTEQ.f +EVLNNPDFCODE = EVLNNPDF.f wrapXNN.f +LHAGLUECODE = lhaglue.f +EKSCODE = eks98.f eksarp.f eps08.f eps09.f +PATHFINDCODE = getdatapath.cc binreloc.c + +libLHAPDFCore_la_SOURCES = $(MODULECODE) $(LHAPDFCODE) \ + $(EVLCTEQCODE) $(CUSTOMCODE) \ + $(EKSCODE) $(PATHFINDCODE) +if ENABLE_LHAGLUE +libLHAPDFCore_la_SOURCES += $(LHAGLUECODE) +endif + +if WANT_ALL +AM_CPPFLAGS += -DALL +endif + +if WANT_QCDNUM +libLHAPDFCore_la_SOURCES += $(QCDNUMCODE) +AM_CPPFLAGS += -DQCDNUM +endif + +if WANT_PIONS +libLHAPDFCore_la_SOURCES += $(PIONCODE) +AM_CPPFLAGS += -DPIONS +endif + +if WANT_PHOTONS +libLHAPDFCore_la_SOURCES += $(PHOTONCODE) +AM_CPPFLAGS += -DPHOTONS +endif + +if WANT_USER +libLHAPDFCore_la_SOURCES += $(USERCODE) +AM_CPPFLAGS += -DUSER +endif + +if ENABLE_LOWMEM +libLHAPDFCore_la_SOURCES += $(MRSTSLITE) +AM_CPPFLAGS += -DLOW_MEMORY +if WANT_MRST +libLHAPDFCore_la_SOURCES += $(MRSTLITE) +AM_CPPFLAGS += -DMRST +endif +if WANT_MRST06 +libLHAPDFCore_la_SOURCES += $(MRST06LITE) +AM_CPPFLAGS += -DMRST06 +endif +if WANT_MRST98 +libLHAPDFCore_la_SOURCES += $(MRST98CODE) +AM_CPPFLAGS += -DMRST98 +endif +if WANT_MRSTQED +libLHAPDFCore_la_SOURCES += $(MRSTQEDLITE) +AM_CPPFLAGS += -DMRSTQED +endif +if WANT_CTEQ +libLHAPDFCore_la_SOURCES += $(CTEQLITE) +AM_CPPFLAGS += -DCTEQ +endif +if WANT_GRV +libLHAPDFCore_la_SOURCES += $(GRVCODE) +AM_CPPFLAGS += -DGRV +endif +if WANT_NNPDF +libLHAPDFCore_la_SOURCES += $(NNPDFLITE) $(EVLNNPDFCODE) +AM_CPPFLAGS += -DNNPDF +endif +if WANT_MSTW +libLHAPDFCore_la_SOURCES += $(MSTWLITE) +AM_CPPFLAGS += -DMSTW +endif +if WANT_GJR +libLHAPDFCore_la_SOURCES += $(GJRLITE) +AM_CPPFLAGS += -DGJR +endif +if WANT_H1 +libLHAPDFCore_la_SOURCES += $(H1LITE) +AM_CPPFLAGS += -DH1 +endif +if WANT_ZEUS +libLHAPDFCore_la_SOURCES += $(ZEUSCODE) +AM_CPPFLAGS += -DZEUS +endif +if WANT_HERA +libLHAPDFCore_la_SOURCES += $(HERALITE) +AM_CPPFLAGS += -DHERA +endif +if WANT_ALEKHIN +libLHAPDFCore_la_SOURCES += $(ALEKHINLITE) +AM_CPPFLAGS += -DALEKHIN +endif +if WANT_HKN +libLHAPDFCore_la_SOURCES += $(HKNLITE) +AM_CPPFLAGS += -DHKN +endif +else +libLHAPDFCore_la_SOURCES += $(MRSTSCODE) +AM_CPPFLAGS += -DFULL_MEMORY +if WANT_MRST +libLHAPDFCore_la_SOURCES += $(MRSTCODE) +AM_CPPFLAGS += -DMRST +endif +if WANT_MRST06 +libLHAPDFCore_la_SOURCES += $(MRST06CODE) +AM_CPPFLAGS += -DMRST06 +endif +if WANT_MRST98 +libLHAPDFCore_la_SOURCES += $(MRST98CODE) +AM_CPPFLAGS += -DMRST98 +endif +if WANT_MRSTQED +libLHAPDFCore_la_SOURCES += $(MRSTQEDCODE) +AM_CPPFLAGS += -DMRSTQED +endif +if WANT_CTEQ +libLHAPDFCore_la_SOURCES += $(CTEQCODE) +AM_CPPFLAGS += -DCTEQ +endif +if WANT_GRV +libLHAPDFCore_la_SOURCES += $(GRVCODE) +AM_CPPFLAGS += -DGRV +endif +if WANT_NNPDF +libLHAPDFCore_la_SOURCES += $(NNPDFCODE) $(EVLNNPDFCODE) +AM_CPPFLAGS += -DNNPDF +endif +if WANT_MSTW +libLHAPDFCore_la_SOURCES += $(MSTWCODE) +AM_CPPFLAGS += -DMSTW +endif +if WANT_GJR +libLHAPDFCore_la_SOURCES += $(GJRCODE) +AM_CPPFLAGS += -DGJR +endif +if WANT_H1 +libLHAPDFCore_la_SOURCES += $(H1CODE) +AM_CPPFLAGS += -DH1 +endif +if WANT_ZEUS +libLHAPDFCore_la_SOURCES += $(ZEUSCODE) +AM_CPPFLAGS += -DZEUS +endif +if WANT_HERA +libLHAPDFCore_la_SOURCES += $(HERACODE) +AM_CPPFLAGS += -DHERA +endif +if WANT_ALEKHIN +libLHAPDFCore_la_SOURCES += $(ALEKHINCODE) +AM_CPPFLAGS += -DALEKHIN +endif +if WANT_BOTJE +AM_CPPFLAGS += -DBOTJE +endif +if WANT_FERMI +AM_CPPFLAGS += -DFERMI +endif +if WANT_HKN +libLHAPDFCore_la_SOURCES += $(HKNCODE) +AM_CPPFLAGS += -DHKN +endif +endif + +if USING_WIN32 +AM_CPPFLAGS += -DWIN32 +else +AM_CPPFLAGS += $(BINRELOC_CFLAGS) -DENABLE_BINRELOC +endif +AM_FFLAGS += -I. -I$(srcdir) diff --git a/LHAPDF/lhapdf-5.9.1/src/Makefile.in b/LHAPDF/lhapdf-5.9.1/src/Makefile.in new file mode 100644 index 00000000000..36dc1d94651 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/Makefile.in @@ -0,0 +1,819 @@ +# Makefile.in generated by automake 1.10.2 from Makefile.am. +# @configure_input@ + +# Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, +# 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. +# This Makefile.in is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY, to the extent permitted by law; without +# even the implied warranty of MERCHANTABILITY or FITNESS FOR A +# PARTICULAR PURPOSE. + +@SET_MAKE@ + +VPATH = @srcdir@ +pkgdatadir = $(datadir)/@PACKAGE@ +pkglibdir = $(libdir)/@PACKAGE@ +pkgincludedir = $(includedir)/@PACKAGE@ +am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd +install_sh_DATA = $(install_sh) -c -m 644 +install_sh_PROGRAM = $(install_sh) -c +install_sh_SCRIPT = $(install_sh) -c +INSTALL_HEADER = $(INSTALL_DATA) +transform = $(program_transform_name) +NORMAL_INSTALL = : +PRE_INSTALL = : +POST_INSTALL = : +NORMAL_UNINSTALL = : +PRE_UNINSTALL = : +POST_UNINSTALL = : +build_triplet = @build@ +host_triplet = @host@ +@ENABLE_LHAGLUE_TRUE@am__append_1 = $(LHAGLUECODE) +@WANT_ALL_TRUE@am__append_2 = -DALL +@WANT_QCDNUM_TRUE@am__append_3 = $(QCDNUMCODE) +@WANT_QCDNUM_TRUE@am__append_4 = -DQCDNUM +@WANT_PIONS_TRUE@am__append_5 = $(PIONCODE) +@WANT_PIONS_TRUE@am__append_6 = -DPIONS +@WANT_PHOTONS_TRUE@am__append_7 = $(PHOTONCODE) +@WANT_PHOTONS_TRUE@am__append_8 = -DPHOTONS +@WANT_USER_TRUE@am__append_9 = $(USERCODE) +@WANT_USER_TRUE@am__append_10 = -DUSER +@ENABLE_LOWMEM_TRUE@am__append_11 = $(MRSTSLITE) +@ENABLE_LOWMEM_TRUE@am__append_12 = -DLOW_MEMORY +@ENABLE_LOWMEM_TRUE@@WANT_MRST_TRUE@am__append_13 = $(MRSTLITE) +@ENABLE_LOWMEM_TRUE@@WANT_MRST_TRUE@am__append_14 = -DMRST +@ENABLE_LOWMEM_TRUE@@WANT_MRST06_TRUE@am__append_15 = $(MRST06LITE) +@ENABLE_LOWMEM_TRUE@@WANT_MRST06_TRUE@am__append_16 = -DMRST06 +@ENABLE_LOWMEM_TRUE@@WANT_MRST98_TRUE@am__append_17 = $(MRST98CODE) +@ENABLE_LOWMEM_TRUE@@WANT_MRST98_TRUE@am__append_18 = -DMRST98 +@ENABLE_LOWMEM_TRUE@@WANT_MRSTQED_TRUE@am__append_19 = $(MRSTQEDLITE) +@ENABLE_LOWMEM_TRUE@@WANT_MRSTQED_TRUE@am__append_20 = -DMRSTQED +@ENABLE_LOWMEM_TRUE@@WANT_CTEQ_TRUE@am__append_21 = $(CTEQLITE) +@ENABLE_LOWMEM_TRUE@@WANT_CTEQ_TRUE@am__append_22 = -DCTEQ +@ENABLE_LOWMEM_TRUE@@WANT_GRV_TRUE@am__append_23 = $(GRVCODE) +@ENABLE_LOWMEM_TRUE@@WANT_GRV_TRUE@am__append_24 = -DGRV +@ENABLE_LOWMEM_TRUE@@WANT_NNPDF_TRUE@am__append_25 = $(NNPDFLITE) $(EVLNNPDFCODE) +@ENABLE_LOWMEM_TRUE@@WANT_NNPDF_TRUE@am__append_26 = -DNNPDF +@ENABLE_LOWMEM_TRUE@@WANT_MSTW_TRUE@am__append_27 = $(MSTWLITE) +@ENABLE_LOWMEM_TRUE@@WANT_MSTW_TRUE@am__append_28 = -DMSTW +@ENABLE_LOWMEM_TRUE@@WANT_GJR_TRUE@am__append_29 = $(GJRLITE) +@ENABLE_LOWMEM_TRUE@@WANT_GJR_TRUE@am__append_30 = -DGJR +@ENABLE_LOWMEM_TRUE@@WANT_H1_TRUE@am__append_31 = $(H1LITE) +@ENABLE_LOWMEM_TRUE@@WANT_H1_TRUE@am__append_32 = -DH1 +@ENABLE_LOWMEM_TRUE@@WANT_ZEUS_TRUE@am__append_33 = $(ZEUSCODE) +@ENABLE_LOWMEM_TRUE@@WANT_ZEUS_TRUE@am__append_34 = -DZEUS +@ENABLE_LOWMEM_TRUE@@WANT_HERA_TRUE@am__append_35 = $(HERALITE) +@ENABLE_LOWMEM_TRUE@@WANT_HERA_TRUE@am__append_36 = -DHERA +@ENABLE_LOWMEM_TRUE@@WANT_ALEKHIN_TRUE@am__append_37 = $(ALEKHINLITE) +@ENABLE_LOWMEM_TRUE@@WANT_ALEKHIN_TRUE@am__append_38 = -DALEKHIN +@ENABLE_LOWMEM_TRUE@@WANT_HKN_TRUE@am__append_39 = $(HKNLITE) +@ENABLE_LOWMEM_TRUE@@WANT_HKN_TRUE@am__append_40 = -DHKN +@ENABLE_LOWMEM_FALSE@am__append_41 = $(MRSTSCODE) +@ENABLE_LOWMEM_FALSE@am__append_42 = -DFULL_MEMORY +@ENABLE_LOWMEM_FALSE@@WANT_MRST_TRUE@am__append_43 = $(MRSTCODE) +@ENABLE_LOWMEM_FALSE@@WANT_MRST_TRUE@am__append_44 = -DMRST +@ENABLE_LOWMEM_FALSE@@WANT_MRST06_TRUE@am__append_45 = $(MRST06CODE) +@ENABLE_LOWMEM_FALSE@@WANT_MRST06_TRUE@am__append_46 = -DMRST06 +@ENABLE_LOWMEM_FALSE@@WANT_MRST98_TRUE@am__append_47 = $(MRST98CODE) +@ENABLE_LOWMEM_FALSE@@WANT_MRST98_TRUE@am__append_48 = -DMRST98 +@ENABLE_LOWMEM_FALSE@@WANT_MRSTQED_TRUE@am__append_49 = $(MRSTQEDCODE) +@ENABLE_LOWMEM_FALSE@@WANT_MRSTQED_TRUE@am__append_50 = -DMRSTQED +@ENABLE_LOWMEM_FALSE@@WANT_CTEQ_TRUE@am__append_51 = $(CTEQCODE) +@ENABLE_LOWMEM_FALSE@@WANT_CTEQ_TRUE@am__append_52 = -DCTEQ +@ENABLE_LOWMEM_FALSE@@WANT_GRV_TRUE@am__append_53 = $(GRVCODE) +@ENABLE_LOWMEM_FALSE@@WANT_GRV_TRUE@am__append_54 = -DGRV +@ENABLE_LOWMEM_FALSE@@WANT_NNPDF_TRUE@am__append_55 = $(NNPDFCODE) $(EVLNNPDFCODE) +@ENABLE_LOWMEM_FALSE@@WANT_NNPDF_TRUE@am__append_56 = -DNNPDF +@ENABLE_LOWMEM_FALSE@@WANT_MSTW_TRUE@am__append_57 = $(MSTWCODE) +@ENABLE_LOWMEM_FALSE@@WANT_MSTW_TRUE@am__append_58 = -DMSTW +@ENABLE_LOWMEM_FALSE@@WANT_GJR_TRUE@am__append_59 = $(GJRCODE) +@ENABLE_LOWMEM_FALSE@@WANT_GJR_TRUE@am__append_60 = -DGJR +@ENABLE_LOWMEM_FALSE@@WANT_H1_TRUE@am__append_61 = $(H1CODE) +@ENABLE_LOWMEM_FALSE@@WANT_H1_TRUE@am__append_62 = -DH1 +@ENABLE_LOWMEM_FALSE@@WANT_ZEUS_TRUE@am__append_63 = $(ZEUSCODE) +@ENABLE_LOWMEM_FALSE@@WANT_ZEUS_TRUE@am__append_64 = -DZEUS +@ENABLE_LOWMEM_FALSE@@WANT_HERA_TRUE@am__append_65 = $(HERACODE) +@ENABLE_LOWMEM_FALSE@@WANT_HERA_TRUE@am__append_66 = -DHERA +@ENABLE_LOWMEM_FALSE@@WANT_ALEKHIN_TRUE@am__append_67 = $(ALEKHINCODE) +@ENABLE_LOWMEM_FALSE@@WANT_ALEKHIN_TRUE@am__append_68 = -DALEKHIN +@ENABLE_LOWMEM_FALSE@@WANT_BOTJE_TRUE@am__append_69 = -DBOTJE +@ENABLE_LOWMEM_FALSE@@WANT_FERMI_TRUE@am__append_70 = -DFERMI +@ENABLE_LOWMEM_FALSE@@WANT_HKN_TRUE@am__append_71 = $(HKNCODE) +@ENABLE_LOWMEM_FALSE@@WANT_HKN_TRUE@am__append_72 = -DHKN +@USING_WIN32_TRUE@am__append_73 = -DWIN32 +@USING_WIN32_FALSE@am__append_74 = $(BINRELOC_CFLAGS) -DENABLE_BINRELOC +subdir = src +DIST_COMMON = $(srcdir)/Makefile.am $(srcdir)/Makefile.in \ + $(srcdir)/parmsetup.inc.in +ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 +am__aclocal_m4_deps = $(top_srcdir)/m4/binreloc.m4 \ + $(top_srcdir)/m4/compilerflags.m4 $(top_srcdir)/m4/libtool.m4 \ + $(top_srcdir)/m4/ltoptions.m4 $(top_srcdir)/m4/ltsugar.m4 \ + $(top_srcdir)/m4/ltversion.m4 $(top_srcdir)/m4/lt~obsolete.m4 \ + $(top_srcdir)/m4/python.m4 $(top_srcdir)/configure.ac +am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \ + $(ACLOCAL_M4) +mkinstalldirs = $(install_sh) -d +CONFIG_HEADER = $(top_builddir)/config/config.h \ + $(top_builddir)/include/LHAPDF/FortranWrappers.h \ + $(top_builddir)/include/LHAPDF/LHAPDFConfig.h +CONFIG_CLEAN_FILES = parmsetup.inc +LTLIBRARIES = $(noinst_LTLIBRARIES) +libLHAPDFCore_la_LIBADD = +am__libLHAPDFCore_la_SOURCES_DIST = commoninit.f version.cc LHpdflib.F \ + description.f evolution.f parameter.F QCDparams.f alphas.f \ + inputPDF.F wrapEVLCTEQ.f EVLCTEQ.f wrapevolve.F Sqcdnum.f \ + Szeus.f uncertainties.f eks98.f eksarp.f eps08.f eps09.f \ + getdatapath.cc binreloc.c lhaglue.f QCDNUM.F wrapQCDNUM.F \ + wrapQCDNUM3.f wrapQCDNUM4.f wrapowpi.f wrapsmrspi.f \ + wrapgrvpi.f wrapabfkwpi.f wrapsasg.f wrapgrvg.f wrapdog.f \ + wrapdgg.f wraplacg.f wrapgsg.f wrapgsg96.f wrapacfgpg.f \ + wrapwhitg.f wrapUSER.f wrapusergrid.f Smrst-lite.f \ + wrapmrst-lite.f wrapmrst2006-lite.f wrapmrst98.f \ + wrapmrstqed-lite.f wrapcteq5.f wrapcteq65-lite.f \ + wrapcteq6-lite.f wrapcteq6lg.f wrapct12.f wrapgrv.f \ + wrapNNPDF.f wrapNNPDFgrid-lite.f wrapNNPDF20grid-lite.f \ + wrapNNPDF20qedgrid-lite.f EVLNNPDF.f wrapXNN.f wrapmstw-lite.f \ + wrapgjr-lite.f wraph1-lite.f wrapzeus.f wraphera.f \ + wrapheragrid-lite.f wrapa02m-lite.f wrapabkm09-lite.f \ + wrapabm11-lite.f wraphkn-lite.f Smrst.f wrapmrst.f \ + wrapmrst2006.f wrapmrstqed.f wrapcteq65.f wrapcteq6.f \ + wrapNNPDFgrid.f wrapNNPDF20grid.f wrapNNPDF20qedgrid.f \ + wrapmstw.f wrapgjr.f wraph1.f wrapheragrid.f wrapa02m.f \ + wrapabkm09.f wrapabm11.f wraphkn.f +am__objects_1 = commoninit.lo +am__objects_2 = version.lo LHpdflib.lo description.lo evolution.lo \ + parameter.lo QCDparams.lo alphas.lo inputPDF.lo +am__objects_3 = wrapEVLCTEQ.lo EVLCTEQ.lo +am__objects_4 = wrapevolve.lo Sqcdnum.lo Szeus.lo uncertainties.lo +am__objects_5 = eks98.lo eksarp.lo eps08.lo eps09.lo +am__objects_6 = getdatapath.lo binreloc.lo +am__objects_7 = lhaglue.lo +@ENABLE_LHAGLUE_TRUE@am__objects_8 = $(am__objects_7) +am__objects_9 = QCDNUM.lo wrapQCDNUM.lo wrapQCDNUM3.lo wrapQCDNUM4.lo +@WANT_QCDNUM_TRUE@am__objects_10 = $(am__objects_9) +am__objects_11 = wrapowpi.lo wrapsmrspi.lo wrapgrvpi.lo wrapabfkwpi.lo +@WANT_PIONS_TRUE@am__objects_12 = $(am__objects_11) +am__objects_13 = wrapsasg.lo wrapgrvg.lo wrapdog.lo wrapdgg.lo \ + wraplacg.lo wrapgsg.lo wrapgsg96.lo wrapacfgpg.lo wrapwhitg.lo +@WANT_PHOTONS_TRUE@am__objects_14 = $(am__objects_13) +am__objects_15 = wrapUSER.lo wrapusergrid.lo +@WANT_USER_TRUE@am__objects_16 = $(am__objects_15) +am__objects_17 = Smrst-lite.lo +@ENABLE_LOWMEM_TRUE@am__objects_18 = $(am__objects_17) +am__objects_19 = wrapmrst-lite.lo +@ENABLE_LOWMEM_TRUE@@WANT_MRST_TRUE@am__objects_20 = \ +@ENABLE_LOWMEM_TRUE@@WANT_MRST_TRUE@ $(am__objects_19) +am__objects_21 = wrapmrst2006-lite.lo +@ENABLE_LOWMEM_TRUE@@WANT_MRST06_TRUE@am__objects_22 = \ +@ENABLE_LOWMEM_TRUE@@WANT_MRST06_TRUE@ $(am__objects_21) +am__objects_23 = wrapmrst98.lo +@ENABLE_LOWMEM_TRUE@@WANT_MRST98_TRUE@am__objects_24 = \ +@ENABLE_LOWMEM_TRUE@@WANT_MRST98_TRUE@ $(am__objects_23) +am__objects_25 = wrapmrstqed-lite.lo +@ENABLE_LOWMEM_TRUE@@WANT_MRSTQED_TRUE@am__objects_26 = \ +@ENABLE_LOWMEM_TRUE@@WANT_MRSTQED_TRUE@ $(am__objects_25) +am__objects_27 = wrapcteq5.lo wrapcteq65-lite.lo wrapcteq6-lite.lo \ + wrapcteq6lg.lo wrapct12.lo +@ENABLE_LOWMEM_TRUE@@WANT_CTEQ_TRUE@am__objects_28 = \ +@ENABLE_LOWMEM_TRUE@@WANT_CTEQ_TRUE@ $(am__objects_27) +am__objects_29 = wrapgrv.lo +@ENABLE_LOWMEM_TRUE@@WANT_GRV_TRUE@am__objects_30 = $(am__objects_29) +am__objects_31 = wrapNNPDF.lo wrapNNPDFgrid-lite.lo \ + wrapNNPDF20grid-lite.lo wrapNNPDF20qedgrid-lite.lo +am__objects_32 = EVLNNPDF.lo wrapXNN.lo +@ENABLE_LOWMEM_TRUE@@WANT_NNPDF_TRUE@am__objects_33 = \ +@ENABLE_LOWMEM_TRUE@@WANT_NNPDF_TRUE@ $(am__objects_31) \ +@ENABLE_LOWMEM_TRUE@@WANT_NNPDF_TRUE@ $(am__objects_32) +am__objects_34 = wrapmstw-lite.lo +@ENABLE_LOWMEM_TRUE@@WANT_MSTW_TRUE@am__objects_35 = \ +@ENABLE_LOWMEM_TRUE@@WANT_MSTW_TRUE@ $(am__objects_34) +am__objects_36 = wrapgjr-lite.lo +@ENABLE_LOWMEM_TRUE@@WANT_GJR_TRUE@am__objects_37 = $(am__objects_36) +am__objects_38 = wraph1-lite.lo +@ENABLE_LOWMEM_TRUE@@WANT_H1_TRUE@am__objects_39 = $(am__objects_38) +am__objects_40 = wrapzeus.lo +@ENABLE_LOWMEM_TRUE@@WANT_ZEUS_TRUE@am__objects_41 = \ +@ENABLE_LOWMEM_TRUE@@WANT_ZEUS_TRUE@ $(am__objects_40) +am__objects_42 = wraphera.lo wrapheragrid-lite.lo +@ENABLE_LOWMEM_TRUE@@WANT_HERA_TRUE@am__objects_43 = \ +@ENABLE_LOWMEM_TRUE@@WANT_HERA_TRUE@ $(am__objects_42) +am__objects_44 = wrapa02m-lite.lo wrapabkm09-lite.lo wrapabm11-lite.lo +@ENABLE_LOWMEM_TRUE@@WANT_ALEKHIN_TRUE@am__objects_45 = \ +@ENABLE_LOWMEM_TRUE@@WANT_ALEKHIN_TRUE@ $(am__objects_44) +am__objects_46 = wraphkn-lite.lo +@ENABLE_LOWMEM_TRUE@@WANT_HKN_TRUE@am__objects_47 = $(am__objects_46) +am__objects_48 = Smrst.lo +@ENABLE_LOWMEM_FALSE@am__objects_49 = $(am__objects_48) +am__objects_50 = wrapmrst.lo +@ENABLE_LOWMEM_FALSE@@WANT_MRST_TRUE@am__objects_51 = \ +@ENABLE_LOWMEM_FALSE@@WANT_MRST_TRUE@ $(am__objects_50) +am__objects_52 = wrapmrst2006.lo +@ENABLE_LOWMEM_FALSE@@WANT_MRST06_TRUE@am__objects_53 = \ +@ENABLE_LOWMEM_FALSE@@WANT_MRST06_TRUE@ $(am__objects_52) +@ENABLE_LOWMEM_FALSE@@WANT_MRST98_TRUE@am__objects_54 = \ +@ENABLE_LOWMEM_FALSE@@WANT_MRST98_TRUE@ $(am__objects_23) +am__objects_55 = wrapmrstqed.lo +@ENABLE_LOWMEM_FALSE@@WANT_MRSTQED_TRUE@am__objects_56 = \ +@ENABLE_LOWMEM_FALSE@@WANT_MRSTQED_TRUE@ $(am__objects_55) +am__objects_57 = wrapcteq5.lo wrapcteq65.lo wrapcteq6.lo \ + wrapcteq6lg.lo wrapct12.lo +@ENABLE_LOWMEM_FALSE@@WANT_CTEQ_TRUE@am__objects_58 = \ +@ENABLE_LOWMEM_FALSE@@WANT_CTEQ_TRUE@ $(am__objects_57) +@ENABLE_LOWMEM_FALSE@@WANT_GRV_TRUE@am__objects_59 = \ +@ENABLE_LOWMEM_FALSE@@WANT_GRV_TRUE@ $(am__objects_29) +am__objects_60 = wrapNNPDF.lo wrapNNPDFgrid.lo wrapNNPDF20grid.lo \ + wrapNNPDF20qedgrid.lo +@ENABLE_LOWMEM_FALSE@@WANT_NNPDF_TRUE@am__objects_61 = \ +@ENABLE_LOWMEM_FALSE@@WANT_NNPDF_TRUE@ $(am__objects_60) \ +@ENABLE_LOWMEM_FALSE@@WANT_NNPDF_TRUE@ $(am__objects_32) +am__objects_62 = wrapmstw.lo +@ENABLE_LOWMEM_FALSE@@WANT_MSTW_TRUE@am__objects_63 = \ +@ENABLE_LOWMEM_FALSE@@WANT_MSTW_TRUE@ $(am__objects_62) +am__objects_64 = wrapgjr.lo +@ENABLE_LOWMEM_FALSE@@WANT_GJR_TRUE@am__objects_65 = \ +@ENABLE_LOWMEM_FALSE@@WANT_GJR_TRUE@ $(am__objects_64) +am__objects_66 = wraph1.lo +@ENABLE_LOWMEM_FALSE@@WANT_H1_TRUE@am__objects_67 = $(am__objects_66) +@ENABLE_LOWMEM_FALSE@@WANT_ZEUS_TRUE@am__objects_68 = \ +@ENABLE_LOWMEM_FALSE@@WANT_ZEUS_TRUE@ $(am__objects_40) +am__objects_69 = wraphera.lo wrapheragrid.lo +@ENABLE_LOWMEM_FALSE@@WANT_HERA_TRUE@am__objects_70 = \ +@ENABLE_LOWMEM_FALSE@@WANT_HERA_TRUE@ $(am__objects_69) +am__objects_71 = wrapa02m.lo wrapabkm09.lo wrapabm11.lo +@ENABLE_LOWMEM_FALSE@@WANT_ALEKHIN_TRUE@am__objects_72 = \ +@ENABLE_LOWMEM_FALSE@@WANT_ALEKHIN_TRUE@ $(am__objects_71) +am__objects_73 = wraphkn.lo +@ENABLE_LOWMEM_FALSE@@WANT_HKN_TRUE@am__objects_74 = \ +@ENABLE_LOWMEM_FALSE@@WANT_HKN_TRUE@ $(am__objects_73) +am_libLHAPDFCore_la_OBJECTS = $(am__objects_1) $(am__objects_2) \ + $(am__objects_3) $(am__objects_4) $(am__objects_5) \ + $(am__objects_6) $(am__objects_8) $(am__objects_10) \ + $(am__objects_12) $(am__objects_14) $(am__objects_16) \ + $(am__objects_18) $(am__objects_20) $(am__objects_22) \ + $(am__objects_24) $(am__objects_26) $(am__objects_28) \ + $(am__objects_30) $(am__objects_33) $(am__objects_35) \ + $(am__objects_37) $(am__objects_39) $(am__objects_41) \ + $(am__objects_43) $(am__objects_45) $(am__objects_47) \ + $(am__objects_49) $(am__objects_51) $(am__objects_53) \ + $(am__objects_54) $(am__objects_56) $(am__objects_58) \ + $(am__objects_59) $(am__objects_61) $(am__objects_63) \ + $(am__objects_65) $(am__objects_67) $(am__objects_68) \ + $(am__objects_70) $(am__objects_72) $(am__objects_74) +libLHAPDFCore_la_OBJECTS = $(am_libLHAPDFCore_la_OBJECTS) +DEFAULT_INCLUDES = -I.@am__isrc@ -I$(top_builddir)/config -I$(top_builddir)/include/LHAPDF +depcomp = $(SHELL) $(top_srcdir)/config/depcomp +am__depfiles_maybe = depfiles +PPF77COMPILE = $(F77) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) \ + $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FFLAGS) $(FFLAGS) +LTPPF77COMPILE = $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) \ + --mode=compile $(F77) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) \ + $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FFLAGS) $(FFLAGS) +F77LD = $(F77) +F77LINK = $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=link \ + $(F77LD) $(AM_FFLAGS) $(FFLAGS) $(AM_LDFLAGS) $(LDFLAGS) -o $@ +COMPILE = $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) \ + $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) +LTCOMPILE = $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) \ + --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) \ + $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) +CCLD = $(CC) +LINK = $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) \ + --mode=link $(CCLD) $(AM_CFLAGS) $(CFLAGS) $(AM_LDFLAGS) \ + $(LDFLAGS) -o $@ +CXXCOMPILE = $(CXX) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) \ + $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CXXFLAGS) $(CXXFLAGS) +LTCXXCOMPILE = $(LIBTOOL) --tag=CXX $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) \ + --mode=compile $(CXX) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) \ + $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CXXFLAGS) $(CXXFLAGS) +CXXLD = $(CXX) +CXXLINK = $(LIBTOOL) --tag=CXX $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) \ + --mode=link $(CXXLD) $(AM_CXXFLAGS) $(CXXFLAGS) $(AM_LDFLAGS) \ + $(LDFLAGS) -o $@ +F77COMPILE = $(F77) $(AM_FFLAGS) $(FFLAGS) +LTF77COMPILE = $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) \ + --mode=compile $(F77) $(AM_FFLAGS) $(FFLAGS) +SOURCES = $(libLHAPDFCore_la_SOURCES) +DIST_SOURCES = $(am__libLHAPDFCore_la_SOURCES_DIST) +ETAGS = etags +CTAGS = ctags +DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST) +ACLOCAL = @ACLOCAL@ +AMTAR = @AMTAR@ +AM_CPPFLAGS = @AM_CPPFLAGS@ $(am__append_2) $(am__append_4) \ + $(am__append_6) $(am__append_8) $(am__append_10) \ + $(am__append_12) $(am__append_14) $(am__append_16) \ + $(am__append_18) $(am__append_20) $(am__append_22) \ + $(am__append_24) $(am__append_26) $(am__append_28) \ + $(am__append_30) $(am__append_32) $(am__append_34) \ + $(am__append_36) $(am__append_38) $(am__append_40) \ + $(am__append_42) $(am__append_44) $(am__append_46) \ + $(am__append_48) $(am__append_50) $(am__append_52) \ + $(am__append_54) $(am__append_56) $(am__append_58) \ + $(am__append_60) $(am__append_62) $(am__append_64) \ + $(am__append_66) $(am__append_68) $(am__append_69) \ + $(am__append_70) $(am__append_72) $(am__append_73) \ + $(am__append_74) +AM_CXXFLAGS = @AM_CXXFLAGS@ +AM_FCFLAGS = @AM_FCFLAGS@ +AM_FFLAGS = @AM_FFLAGS@ -I. -I$(srcdir) +AR = @AR@ +AUTOCONF = @AUTOCONF@ +AUTOHEADER = @AUTOHEADER@ +AUTOMAKE = @AUTOMAKE@ +AWK = @AWK@ +BINRELOC_CFLAGS = @BINRELOC_CFLAGS@ +BINRELOC_LIBS = @BINRELOC_LIBS@ +CC = @CC@ +CCDEPMODE = @CCDEPMODE@ +CFLAGS = @CFLAGS@ +CPP = @CPP@ +CPPFLAGS = @CPPFLAGS@ +CXX = @CXX@ +CXXCPP = @CXXCPP@ +CXXDEPMODE = @CXXDEPMODE@ +CXXFLAGS = @CXXFLAGS@ +CYGPATH_W = @CYGPATH_W@ +DEFS = @DEFS@ +DEPDIR = @DEPDIR@ +DOXYGEN = @DOXYGEN@ +DSYMUTIL = @DSYMUTIL@ +DUMPBIN = @DUMPBIN@ +ECHO_C = @ECHO_C@ +ECHO_N = @ECHO_N@ +ECHO_T = @ECHO_T@ +EGREP = @EGREP@ +EXEEXT = @EXEEXT@ +F77 = @F77@ +FC = @FC@ +FCFLAGS = @FCFLAGS@ +FCLIBS = @FCLIBS@ +FFLAGS = @FFLAGS@ +FGREP = @FGREP@ +GREP = @GREP@ +INSTALL = @INSTALL@ +INSTALL_DATA = @INSTALL_DATA@ +INSTALL_PROGRAM = @INSTALL_PROGRAM@ +INSTALL_SCRIPT = @INSTALL_SCRIPT@ +INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@ +LD = @LD@ +LDFLAGS = @LDFLAGS@ +LIBOBJS = @LIBOBJS@ +LIBS = @LIBS@ +LIBTOOL = @LIBTOOL@ +LIPO = @LIPO@ +LN_S = @LN_S@ +LTLIBOBJS = @LTLIBOBJS@ +MAKEINFO = @MAKEINFO@ +MKDIR_P = @MKDIR_P@ +MKOCTFILE = @MKOCTFILE@ +NM = @NM@ +NMEDIT = @NMEDIT@ +NMXSET = @NMXSET@ +OBJDUMP = @OBJDUMP@ +OBJEXT = @OBJEXT@ +OCTAVE = @OCTAVE@ +OTOOL = @OTOOL@ +OTOOL64 = @OTOOL64@ +PACKAGE = @PACKAGE@ +PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@ +PACKAGE_NAME = @PACKAGE_NAME@ +PACKAGE_STRING = @PACKAGE_STRING@ +PACKAGE_TARNAME = @PACKAGE_TARNAME@ +PACKAGE_VERSION = @PACKAGE_VERSION@ +PATH_SEPARATOR = @PATH_SEPARATOR@ +PYTHON = @PYTHON@ +RANLIB = @RANLIB@ +SED = @SED@ +SET_MAKE = @SET_MAKE@ +SHELL = @SHELL@ +STRIP = @STRIP@ +SWIG = @SWIG@ +SWVERS = @SWVERS@ +VERSION = @VERSION@ +VERSIONFLAGS = @VERSIONFLAGS@ +abs_builddir = @abs_builddir@ +abs_srcdir = @abs_srcdir@ +abs_top_builddir = @abs_top_builddir@ +abs_top_srcdir = @abs_top_srcdir@ +ac_ct_CC = @ac_ct_CC@ +ac_ct_CXX = @ac_ct_CXX@ +ac_ct_DUMPBIN = @ac_ct_DUMPBIN@ +ac_ct_FC = @ac_ct_FC@ +am__include = @am__include@ +am__leading_dot = @am__leading_dot@ +am__quote = @am__quote@ +am__tar = @am__tar@ +am__untar = @am__untar@ +bindir = @bindir@ +build = @build@ +build_alias = @build_alias@ +build_cpu = @build_cpu@ +build_os = @build_os@ +build_vendor = @build_vendor@ +builddir = @builddir@ +datadir = @datadir@ +datarootdir = @datarootdir@ +docdir = @docdir@ +dvidir = @dvidir@ +exec_prefix = @exec_prefix@ +host = @host@ +host_alias = @host_alias@ +host_cpu = @host_cpu@ +host_os = @host_os@ +host_vendor = @host_vendor@ +htmldir = @htmldir@ +includedir = @includedir@ +infodir = @infodir@ +install_sh = @install_sh@ +libdir = @libdir@ +libexecdir = @libexecdir@ +localedir = @localedir@ +localstatedir = @localstatedir@ +lt_ECHO = @lt_ECHO@ +mandir = @mandir@ +mkdir_p = @mkdir_p@ +oldincludedir = @oldincludedir@ +pdfdir = @pdfdir@ +prefix = @prefix@ +program_transform_name = @program_transform_name@ +psdir = @psdir@ +sbindir = @sbindir@ +sharedstatedir = @sharedstatedir@ +srcdir = @srcdir@ +sysconfdir = @sysconfdir@ +target_alias = @target_alias@ +top_build_prefix = @top_build_prefix@ +top_builddir = @top_builddir@ +top_srcdir = @top_srcdir@ +noinst_LTLIBRARIES = libLHAPDFCore.la +EXTRA_DIST = parmsetup.inc binreloc.h \ + common.inc commonlhacontrol.inc commonlhaglsta.inc \ + commonlhapdfc.inc commonlhapdf.inc commonlhasets.inc + + +#MODULECODE = modules.f +MODULECODE = commoninit.f +LHAPDFCODE = version.cc LHpdflib.F description.f evolution.f \ + parameter.F QCDparams.f alphas.f inputPDF.F + +CUSTOMCODE = wrapevolve.F Sqcdnum.f Szeus.f uncertainties.f +PHOTONCODE = wrapsasg.f wrapgrvg.f wrapdog.f wrapdgg.f wraplacg.f wrapgsg.f \ + wrapgsg96.f wrapacfgpg.f wrapwhitg.f + +PIONCODE = wrapowpi.f wrapsmrspi.f wrapgrvpi.f wrapabfkwpi.f +MRSTCODE = wrapmrst.f +MRST06CODE = wrapmrst2006.f +MRST98CODE = wrapmrst98.f +MRSTQEDCODE = wrapmrstqed.f +MRSTSCODE = Smrst.f +CTEQCODE = wrapcteq5.f wrapcteq65.f wrapcteq6.f wrapcteq6lg.f wrapct12.f +NNPDFCODE = wrapNNPDF.f wrapNNPDFgrid.f wrapNNPDF20grid.f wrapNNPDF20qedgrid.f +MSTWCODE = wrapmstw.f +GJRCODE = wrapgjr.f +GRVCODE = wrapgrv.f +H1CODE = wraph1.f +ZEUSCODE = wrapzeus.f +HERACODE = wraphera.f wrapheragrid.f +ALEKHINCODE = wrapa02m.f wrapabkm09.f wrapabm11.f +HKNCODE = wraphkn.f +USERCODE = wrapUSER.f wrapusergrid.f +MRSTLITE = wrapmrst-lite.f +MRST06LITE = wrapmrst2006-lite.f +MRSTQEDLITE = wrapmrstqed-lite.f +MRSTSLITE = Smrst-lite.f +CTEQLITE = wrapcteq5.f wrapcteq65-lite.f wrapcteq6-lite.f wrapcteq6lg.f wrapct12.f +NNPDFLITE = wrapNNPDF.f wrapNNPDFgrid-lite.f wrapNNPDF20grid-lite.f wrapNNPDF20qedgrid-lite.f +MSTWLITE = wrapmstw-lite.f +GJRLITE = wrapgjr-lite.f +H1LITE = wraph1-lite.f +HERALITE = wraphera.f wrapheragrid-lite.f +ALEKHINLITE = wrapa02m-lite.f wrapabkm09-lite.f wrapabm11-lite.f +HKNLITE = wraphkn-lite.f +QCDNUMCODE = QCDNUM.F wrapQCDNUM.F wrapQCDNUM3.f wrapQCDNUM4.f +EVLCTEQCODE = wrapEVLCTEQ.f EVLCTEQ.f +EVLNNPDFCODE = EVLNNPDF.f wrapXNN.f +LHAGLUECODE = lhaglue.f +EKSCODE = eks98.f eksarp.f eps08.f eps09.f +PATHFINDCODE = getdatapath.cc binreloc.c +libLHAPDFCore_la_SOURCES = $(MODULECODE) $(LHAPDFCODE) $(EVLCTEQCODE) \ + $(CUSTOMCODE) $(EKSCODE) $(PATHFINDCODE) $(am__append_1) \ + $(am__append_3) $(am__append_5) $(am__append_7) \ + $(am__append_9) $(am__append_11) $(am__append_13) \ + $(am__append_15) $(am__append_17) $(am__append_19) \ + $(am__append_21) $(am__append_23) $(am__append_25) \ + $(am__append_27) $(am__append_29) $(am__append_31) \ + $(am__append_33) $(am__append_35) $(am__append_37) \ + $(am__append_39) $(am__append_41) $(am__append_43) \ + $(am__append_45) $(am__append_47) $(am__append_49) \ + $(am__append_51) $(am__append_53) $(am__append_55) \ + $(am__append_57) $(am__append_59) $(am__append_61) \ + $(am__append_63) $(am__append_65) $(am__append_67) \ + $(am__append_71) +all: all-am + +.SUFFIXES: +.SUFFIXES: .F .c .cc .f .lo .o .obj +$(srcdir)/Makefile.in: $(srcdir)/Makefile.am $(am__configure_deps) + @for dep in $?; do \ + case '$(am__configure_deps)' in \ + *$$dep*) \ + ( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \ + && { if test -f $@; then exit 0; else break; fi; }; \ + exit 1;; \ + esac; \ + done; \ + echo ' cd $(top_srcdir) && $(AUTOMAKE) --gnu src/Makefile'; \ + cd $(top_srcdir) && \ + $(AUTOMAKE) --gnu src/Makefile +.PRECIOUS: Makefile +Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status + @case '$?' in \ + *config.status*) \ + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \ + *) \ + echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \ + cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \ + esac; + +$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh + +$(top_srcdir)/configure: $(am__configure_deps) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh +$(ACLOCAL_M4): $(am__aclocal_m4_deps) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh +parmsetup.inc: $(top_builddir)/config.status $(srcdir)/parmsetup.inc.in + cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ + +clean-noinstLTLIBRARIES: + -test -z "$(noinst_LTLIBRARIES)" || rm -f $(noinst_LTLIBRARIES) + @list='$(noinst_LTLIBRARIES)'; for p in $$list; do \ + dir="`echo $$p | sed -e 's|/[^/]*$$||'`"; \ + test "$$dir" != "$$p" || dir=.; \ + echo "rm -f \"$${dir}/so_locations\""; \ + rm -f "$${dir}/so_locations"; \ + done +libLHAPDFCore.la: $(libLHAPDFCore_la_OBJECTS) $(libLHAPDFCore_la_DEPENDENCIES) + $(CXXLINK) $(libLHAPDFCore_la_OBJECTS) $(libLHAPDFCore_la_LIBADD) $(LIBS) + +mostlyclean-compile: + -rm -f *.$(OBJEXT) + +distclean-compile: + -rm -f *.tab.c + +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/binreloc.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/getdatapath.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/version.Plo@am__quote@ + +.F.o: + $(PPF77COMPILE) -c -o $@ $< + +.F.obj: + $(PPF77COMPILE) -c -o $@ `$(CYGPATH_W) '$<'` + +.F.lo: + $(LTPPF77COMPILE) -c -o $@ $< +.F.f: + $(F77COMPILE) -F $< + +.c.o: +@am__fastdepCC_TRUE@ $(COMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $< +@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$<' object='$@' libtool=no @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(COMPILE) -c $< + +.c.obj: +@am__fastdepCC_TRUE@ $(COMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ `$(CYGPATH_W) '$<'` +@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$<' object='$@' libtool=no @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(COMPILE) -c `$(CYGPATH_W) '$<'` + +.c.lo: +@am__fastdepCC_TRUE@ $(LTCOMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $< +@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$<' object='$@' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LTCOMPILE) -c -o $@ $< + +.cc.o: +@am__fastdepCXX_TRUE@ $(CXXCOMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $< +@am__fastdepCXX_TRUE@ mv -f $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po +@AMDEP_TRUE@@am__fastdepCXX_FALSE@ source='$<' object='$@' libtool=no @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCXX_FALSE@ DEPDIR=$(DEPDIR) $(CXXDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCXX_FALSE@ $(CXXCOMPILE) -c -o $@ $< + +.cc.obj: +@am__fastdepCXX_TRUE@ $(CXXCOMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ `$(CYGPATH_W) '$<'` +@am__fastdepCXX_TRUE@ mv -f $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po +@AMDEP_TRUE@@am__fastdepCXX_FALSE@ source='$<' object='$@' libtool=no @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCXX_FALSE@ DEPDIR=$(DEPDIR) $(CXXDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCXX_FALSE@ $(CXXCOMPILE) -c -o $@ `$(CYGPATH_W) '$<'` + +.cc.lo: +@am__fastdepCXX_TRUE@ $(LTCXXCOMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $< +@am__fastdepCXX_TRUE@ mv -f $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Plo +@AMDEP_TRUE@@am__fastdepCXX_FALSE@ source='$<' object='$@' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCXX_FALSE@ DEPDIR=$(DEPDIR) $(CXXDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCXX_FALSE@ $(LTCXXCOMPILE) -c -o $@ $< + +.f.o: + $(F77COMPILE) -c -o $@ $< + +.f.obj: + $(F77COMPILE) -c -o $@ `$(CYGPATH_W) '$<'` + +.f.lo: + $(LTF77COMPILE) -c -o $@ $< + +mostlyclean-libtool: + -rm -f *.lo + +clean-libtool: + -rm -rf .libs _libs + +ID: $(HEADERS) $(SOURCES) $(LISP) $(TAGS_FILES) + list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \ + unique=`for i in $$list; do \ + if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ + done | \ + $(AWK) '{ files[$$0] = 1; nonempty = 1; } \ + END { if (nonempty) { for (i in files) print i; }; }'`; \ + mkid -fID $$unique +tags: TAGS + +TAGS: $(HEADERS) $(SOURCES) $(TAGS_DEPENDENCIES) \ + $(TAGS_FILES) $(LISP) + tags=; \ + here=`pwd`; \ + list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \ + unique=`for i in $$list; do \ + if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ + done | \ + $(AWK) '{ files[$$0] = 1; nonempty = 1; } \ + END { if (nonempty) { for (i in files) print i; }; }'`; \ + if test -z "$(ETAGS_ARGS)$$tags$$unique"; then :; else \ + test -n "$$unique" || unique=$$empty_fix; \ + $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \ + $$tags $$unique; \ + fi +ctags: CTAGS +CTAGS: $(HEADERS) $(SOURCES) $(TAGS_DEPENDENCIES) \ + $(TAGS_FILES) $(LISP) + tags=; \ + list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \ + unique=`for i in $$list; do \ + if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ + done | \ + $(AWK) '{ files[$$0] = 1; nonempty = 1; } \ + END { if (nonempty) { for (i in files) print i; }; }'`; \ + test -z "$(CTAGS_ARGS)$$tags$$unique" \ + || $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \ + $$tags $$unique + +GTAGS: + here=`$(am__cd) $(top_builddir) && pwd` \ + && cd $(top_srcdir) \ + && gtags -i $(GTAGS_ARGS) $$here + +distclean-tags: + -rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags + +distdir: $(DISTFILES) + @srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ + topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ + list='$(DISTFILES)'; \ + dist_files=`for file in $$list; do echo $$file; done | \ + sed -e "s|^$$srcdirstrip/||;t" \ + -e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \ + case $$dist_files in \ + */*) $(MKDIR_P) `echo "$$dist_files" | \ + sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \ + sort -u` ;; \ + esac; \ + for file in $$dist_files; do \ + if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \ + if test -d $$d/$$file; then \ + dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \ + if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \ + cp -pR $(srcdir)/$$file $(distdir)$$dir || exit 1; \ + fi; \ + cp -pR $$d/$$file $(distdir)$$dir || exit 1; \ + else \ + test -f $(distdir)/$$file \ + || cp -p $$d/$$file $(distdir)/$$file \ + || exit 1; \ + fi; \ + done +check-am: all-am +check: check-am +all-am: Makefile $(LTLIBRARIES) +installdirs: +install: install-am +install-exec: install-exec-am +install-data: install-data-am +uninstall: uninstall-am + +install-am: all-am + @$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am + +installcheck: installcheck-am +install-strip: + $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ + install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ + `test -z '$(STRIP)' || \ + echo "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'"` install +mostlyclean-generic: + +clean-generic: + +distclean-generic: + -test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES) + +maintainer-clean-generic: + @echo "This command is intended for maintainers to use" + @echo "it deletes files that may require special tools to rebuild." +clean: clean-am + +clean-am: clean-generic clean-libtool clean-noinstLTLIBRARIES \ + mostlyclean-am + +distclean: distclean-am + -rm -rf ./$(DEPDIR) + -rm -f Makefile +distclean-am: clean-am distclean-compile distclean-generic \ + distclean-tags + +dvi: dvi-am + +dvi-am: + +html: html-am + +info: info-am + +info-am: + +install-data-am: + +install-dvi: install-dvi-am + +install-exec-am: + +install-html: install-html-am + +install-info: install-info-am + +install-man: + +install-pdf: install-pdf-am + +install-ps: install-ps-am + +installcheck-am: + +maintainer-clean: maintainer-clean-am + -rm -rf ./$(DEPDIR) + -rm -f Makefile +maintainer-clean-am: distclean-am maintainer-clean-generic + +mostlyclean: mostlyclean-am + +mostlyclean-am: mostlyclean-compile mostlyclean-generic \ + mostlyclean-libtool + +pdf: pdf-am + +pdf-am: + +ps: ps-am + +ps-am: + +uninstall-am: + +.MAKE: install-am install-strip + +.PHONY: CTAGS GTAGS all all-am check check-am clean clean-generic \ + clean-libtool clean-noinstLTLIBRARIES ctags distclean \ + distclean-compile distclean-generic distclean-libtool \ + distclean-tags distdir dvi dvi-am html html-am info info-am \ + install install-am install-data install-data-am install-dvi \ + install-dvi-am install-exec install-exec-am install-html \ + install-html-am install-info install-info-am install-man \ + install-pdf install-pdf-am install-ps install-ps-am \ + install-strip installcheck installcheck-am installdirs \ + maintainer-clean maintainer-clean-generic mostlyclean \ + mostlyclean-compile mostlyclean-generic mostlyclean-libtool \ + pdf pdf-am ps ps-am tags uninstall uninstall-am + +# Tell versions [3.59,3.63) of GNU make to not export all variables. +# Otherwise a system limit (for SysV at least) may be exceeded. +.NOEXPORT: diff --git a/LHAPDF/lhapdf-5.9.1/src/QCDNUM.F b/LHAPDF/lhapdf-5.9.1/src/QCDNUM.F new file mode 100644 index 00000000000..34de8fc2b9a --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/QCDNUM.F @@ -0,0 +1,27359 @@ +! -*- F90 -*- + + +!DECK ID>, QCDCOM. + +!DECK ID>, QCDCOM. + +!------------------------QCDNUM COMMON BLOCKS--------------------- + +!DECK ID>, QCDNUM. + +!DECK ID>, QNINIT. + +! ================= + SUBROUTINE QNINIT +! ================= + +!--- QNINIT: initialisation. +!--- Called by user. + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + CHARACTER*8 CHVERS,CHDATE + COMMON/QCVERS/ CHVERS,CHDATE + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + REAL & + &WGTFF1,WGTFG1, & + &WGTGF1,WGTGG1, & + &WGTPP2,WGTPM2,WGTNS2, & + &WGTFF2,WGTFG2, & + &WGTGF2,WGTGG2, & + &WGTC2Q,WGTC2G,YNTC2Q, & + &WGTCLQ,WGTCLG,WGTC3Q + + COMMON/QCWEIT/ & + &WGTFF1(MXX*(MXX+1)/2) ,WGTFG1(MXX*(MXX+1)/2,3:5), & + &WGTGF1(MXX*(MXX+1)/2) ,WGTGG1(MXX*(MXX+1)/2,3:5), & + &WGTPP2(MXX*(MXX+1)/2,3:5),WGTPM2(MXX*(MXX+1)/2,3:5), & + &WGTNS2(MXX*(MXX+1)/2,3:5), & + &WGTFF2(MXX*(MXX+1)/2,3:5),WGTFG2(MXX*(MXX+1)/2,3:5), & + &WGTGF2(MXX*(MXX+1)/2,3:5),WGTGG2(MXX*(MXX+1)/2,3:5), & + &WGTC2Q(MXX*(MXX+1)/2) ,WGTC2G(MXX*(MXX+1)/2,3:5), & + &WGTCLQ(MXX*(MXX+1)/2) ,WGTCLG(MXX*(MXX+1)/2,3:5), & + &WGTC3Q(MXX*(MXX+1)/2) ,YNTC2Q(MXX) + + COMMON/QCWADR/ IWADR(MXX,MXX) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + CHARACTER*5 PNAM,STFNAM + LOGICAL LNFP + COMMON /QCLNFP/ LNFP(0:30,3:5) + COMMON /QCPNAM/ PNAM(0:30) + COMMON /QCPWGT/ PWGT(0:10,0:30,3:5) + COMMON /QCFNAM/ STFNAM(7) + + + LOGICAL LTIME + REAL T_START,T_END,T_SPENT + COMMON/QCTIME/T_START(10),T_END(10),T_SPENT(10),N_CALLS(10), & + &E_CALLS(10),LTIME + COMMON/QCFCNT/IFCNT(-1:1,5) + + CHARACTER*7 TSNAM + COMMON/QCTRCE/ TSNAM(0:19) + COMMON/QCTRCI/ NTCAL(0:19),ITADR +! +! common added by MRW 18/3/05 to make silent mode for LHAPDF +! + common/lhasilent/lhasilent +! + + CHVERS = '16.12 ' + CHDATE = '12-08-98' + + LDOUBL = .TRUE. + if(lhasilent.eq.0) then + WRITE(6,'(/////)') + WRITE(6, & + &'(8X,''+-----------------------------------------------+'')') + WRITE(6, & + &'(8X,''| |'')') +! LDOUBL = .TRUE. + WRITE(6, & + &'(8X,''| You are using the double precision version of |'')') + WRITE(6, & + &'(8X,''| |'')') + WRITE(6, & + &'(8X,''| Q C D N U M '',A8, & + & '' |'')') CHVERS + WRITE(6, & + &'(8X,''| |'')') + WRITE(6, & + &'(8X,''| Author : Michiel Botje |'')') + WRITE(6, & + &'(8X,''| Email : h24@nikhef.nl |'')') + WRITE(6, & + &'(8X,''| |'')') + WRITE(6, & + &'(8X,''| Date : '',A8, & + & '' |'')') CHDATE + WRITE(6, & + &'(8X,''| Max NX : '',I3, & + & '' |'')') MXX-1 + WRITE(6, & + &'(8X,''| Max NQ2 : '',I3, & + & '' |'')') MQ2-1 + WRITE(6, & + &'(8X,''| |'')') + WRITE(6, & + &'(8X,''+-----------------------------------------------+'')') + WRITE(6,'(/////)') + endif + + IORD = 2 + IOLAST = -999 + Q0ALFA = 50. + ALPHA0 = 0.180 + QALAST = -999. + ASLAST = -999. + SCAX0 = 0.20 + SCAQ0 = 1.D10 + + PI = 3.14159265359 + PROTON = 0.9382796 + EUTRON = 0.9395731 + UCLEON = (PROTON + EUTRON) / 2. + UDSCBT(1) = 0.005 + UDSCBT(2) = 0.01 + UDSCBT(3) = 0.3 + UDSCBT(4) = 1.5 + UDSCBT(5) = 5.0 + UDSCBT(6) = 188. + CBMSTF(4) = UDSCBT(4) + CBMSTF(5) = UDSCBT(4) + CBMSTF(6) = UDSCBT(5) + CBMSTF(7) = UDSCBT(5) + CHARGE(4) = 4./9. + CHARGE(5) = 4./9. + CHARGE(6) = 1./9. + CHARGE(7) = 1./9. + AAM2H = 1. + BBM2H = 0. + AAM2L = 1. + BBM2L = 0. + AAAR2 = 1. + BBBR2 = 0. + FL_FAC = 0. + C1S3 = 1./3. + C2S3 = 2./3. + C4S3 = 4./3. + C5S3 = 5./3. + C8S3 = 8./3. + C14S3 = 14./3. + C16S3 = 16./3. + C20S3 = 20./3. + C28S3 = 28./3. + C38S3 = 38./3. + C40S3 = 40./3. + C44S3 = 44./3. + C52S3 = 52./3. + C136S3 = 136./3. + C11S6 = 11./6. + C2S9 = 2./9. + C4S9 = 4./9. + C10S9 = 10./9. + C14S9 = 14./9. + C16S9 = 16./9. + C40S9 = 40./9. + C44S9 = 44./9. + C62S9 = 62./9. + C112S9 = 112./9. + C182S9 = 182./9. + C11S12 = 11./12. + C35S18 = 35./18. + C11S3 = 11./3. + C22S3 = 22./3. + C61S12 = 61./12. + C215S1 = 215./12. + C29S12 = 29./12. + CPI2S3 = PI**2/3. + CPIA = 67./18. - CPI2S3/2. + CPIB = 4.*CPI2S3 + CPIC = 17./18. + 3.5*CPI2S3 + CPID = 367./36. - CPI2S3 + CPIE = 5. - CPI2S3 + CPIF = CPI2S3 - 218./9. + + CCA = 3. + CCF = (CCA*CCA-1.)/(2.*CCA) + CTF = 0.5 + CATF = CCA*CTF + CFTF = CCF*CTF + + DO I = 1,10 + T_SPENT(I) = 0. + E_CALLS(I) = 0. + N_CALLS(I) = 0 + ENDDO + LTIME = .FALSE. + + LBMARK = .FALSE. + LW1ANA = .TRUE. + LW1NUM = .FALSE. + LW2NUM = .TRUE. + LW2STF = .TRUE. + LWF2C = .FALSE. + LWF2B = .FALSE. + LWFLC = .FALSE. + LWFLB = .FALSE. + LIMCK = .TRUE. + LPLUS = .TRUE. + LALFOK = .FALSE. + LDQ2OK = .FALSE. + LWT1OK = .FALSE. + LWT2OK = .FALSE. + LWTFOK = .FALSE. + LWFCOK = .FALSE. + LWLCOK = .FALSE. + LWFBOK = .FALSE. + LWLBOK = .FALSE. + LMARK = .FALSE. + LCLOWQ = .TRUE. + LASOLD = .FALSE. + DO I = 1,30 + DO J = 1,7 + LFFCAL(J,I) = .FALSE. + ENDDO + ENDDO +!-- Invalidate all evolutions + CALL QNFALS(LEVDONE,MXX*10) + CALL QNFALS(LE_DONE,MXX) + CALL QNINUL(IQL_LAST,10) + CALL QNINUL(IQ0_LAST,10) + CALL QNINUL(IQH_LAST,10) + + ITADR = 0 + DO I = 0,19 + TSNAM(I) = ' ' + NTCAL(I) = 0 + ENDDO + + NXX = 0 + NQ2 = 0 + NGRVER = 0 + NDFAST = 30 + XMICUT = -1. + QMICUT = -1. + QMACUT = -1. + RS2CUT = -1. + QMINAS = 0. + THRS34 = -1.D10 + THRS45 = 1.D10 + + CALL VZERO_LHA (WGTFF1,MXX*(MXX+1)/2) + CALL VZERO_LHA (WGTFG1,MXX*(MXX+1)*3/2) + CALL VZERO_LHA (WGTGF1,MXX*(MXX+1)/2) + CALL VZERO_LHA (WGTGG1,MXX*(MXX+1)*3/2) + CALL VZERO_LHA (WGTPP2,MXX*(MXX+1)*3/2) + CALL VZERO_LHA (WGTPM2,MXX*(MXX+1)*3/2) + CALL VZERO_LHA (WGTNS2,MXX*(MXX+1)*3/2) + CALL VZERO_LHA (WGTFF2,MXX*(MXX+1)*3/2) + CALL VZERO_LHA (WGTFG2,MXX*(MXX+1)*3/2) + CALL VZERO_LHA (WGTGF2,MXX*(MXX+1)*3/2) + CALL VZERO_LHA (WGTGG2,MXX*(MXX+1)*3/2) + CALL VZERO_LHA (WGTC2Q,MXX*(MXX+1)/2) + CALL VZERO_LHA (WGTC2G,MXX*(MXX+1)*3/2) + CALL VZERO_LHA (YNTC2Q,MXX) + CALL VZERO_LHA (WGTCLQ,MXX*(MXX+1)/2) + CALL VZERO_LHA (WGTCLG,MXX*(MXX+1)*3/2) + CALL VZERO_LHA (WGTC3Q,MXX*(MXX+1)/2) + + CALL QNVNUL(PWGT,11*31*3) + CALL QNINUL(NFMAP,MQ2) + CALL QNINUL(MARKFF,MXX*MQ2) + CALL QNINUL(MARKFH,MXX*MQ2) + CALL QNINUL(MARKQQ,MQ2) + CALL QNINUL(IDFAST,7*30) + CALL QNINUL(IFCNT,3*5) + + CALL QNVNUL(PDFQCD,MXX*MQ2*11) + DO ID = 1,NDFMAX + DO IX = 1,MXX + DO IQ = 1,MQ2 + FSTORE(IX,IQ,30+ID) = -501. + ENDDO + ENDDO + ENDDO + + PNAM(0) = 'GLUON' + PNAM(1) = 'SINGL' + LNFP(0,3) = .TRUE. + LNFP(0,4) = .TRUE. + LNFP(0,5) = .TRUE. + LNFP(1,3) = .TRUE. + LNFP(1,4) = .TRUE. + LNFP(1,5) = .TRUE. + DO 10 I = 2,30 + PNAM(I) = 'FREE ' + LNFP(I,3) = .FALSE. + LNFP(I,4) = .FALSE. + LNFP(I,5) = .FALSE. + 10 END DO + PWGT(0,0,3) = 1. + PWGT(0,0,4) = 1. + PWGT(0,0,5) = 1. + PWGT(1,1,3) = 1. + PWGT(1,1,4) = 1. + PWGT(1,1,5) = 1. + STFNAM(1) = 'F2 ' + STFNAM(2) = 'FL ' + STFNAM(3) = 'XF3 ' + STFNAM(4) = 'F2C ' + STFNAM(5) = 'FLC ' + STFNAM(6) = 'F2B ' + STFNAM(7) = 'FLB ' + + CALL QTRACE('QNINIT ',0) + + RETURN + END + +!DECK ID>, QTRACE. + +! =============================== + SUBROUTINE QTRACE(SRNAM,IPRINT) +! =============================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + CHARACTER*7 SRNAM + + CHARACTER*7 TSNAM + COMMON/QCTRCE/ TSNAM(0:19) + COMMON/QCTRCI/ NTCAL(0:19),ITADR + + + IF(IPRINT.EQ.0) THEN + + IF(SRNAM.EQ.TSNAM(ITADR)) THEN + NTCAL(ITADR) = NTCAL(ITADR) + 1 + ELSE + ITADR = MOD(ITADR+1,20) + TSNAM(ITADR) = SRNAM + NTCAL(ITADR) = 1 + ENDIF + + ELSE + + WRITE(6,'(/'' ----------------------------'')') + + K = -20 + DO I = ITADR+1,ITADR+19 + J = MOD(I,20) + K = K+1 + WRITE(6,'(I4,2X,A7,'' #calls = '',I5)') & + & K,TSNAM(J),NTCAL(J) + ENDDO + K = 0 + WRITE(6,'(I4,2X,A7,'' #calls = '',I5,'' <--- error'')') & + & K,TSNAM(ITADR),NTCAL(ITADR) + + WRITE(6,'( '' ----------------------------'')') + + ENDIF + + RETURN + END + +!DECK ID>, QNDUMP. + +! ====================== + SUBROUTINE QNDUMP(LUN) +! ====================== + +!--- QNDUMP: write weight tables to LUN. +!--- Called by user. + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + CHARACTER*8 CHVERS,CHDATE + COMMON/QCVERS/ CHVERS,CHDATE + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + REAL & + &WGTFF1,WGTFG1, & + &WGTGF1,WGTGG1, & + &WGTPP2,WGTPM2,WGTNS2, & + &WGTFF2,WGTFG2, & + &WGTGF2,WGTGG2, & + &WGTC2Q,WGTC2G,YNTC2Q, & + &WGTCLQ,WGTCLG,WGTC3Q + + COMMON/QCWEIT/ & + &WGTFF1(MXX*(MXX+1)/2) ,WGTFG1(MXX*(MXX+1)/2,3:5), & + &WGTGF1(MXX*(MXX+1)/2) ,WGTGG1(MXX*(MXX+1)/2,3:5), & + &WGTPP2(MXX*(MXX+1)/2,3:5),WGTPM2(MXX*(MXX+1)/2,3:5), & + &WGTNS2(MXX*(MXX+1)/2,3:5), & + &WGTFF2(MXX*(MXX+1)/2,3:5),WGTFG2(MXX*(MXX+1)/2,3:5), & + &WGTGF2(MXX*(MXX+1)/2,3:5),WGTGG2(MXX*(MXX+1)/2,3:5), & + &WGTC2Q(MXX*(MXX+1)/2) ,WGTC2G(MXX*(MXX+1)/2,3:5), & + &WGTCLQ(MXX*(MXX+1)/2) ,WGTCLG(MXX*(MXX+1)/2,3:5), & + &WGTC3Q(MXX*(MXX+1)/2) ,YNTC2Q(MXX) + + COMMON/QCWADR/ IWADR(MXX,MXX) + + + REAL & + &WH_C0KG,WH_C1KG,WH_C1BKG, & + &WH_C1KQ,WH_C1BKQ,WH_D1KQ,WH_D1BKQ + + COMMON/QCHWGT/ & + &WH_C0KG(0:MXX,MQ2,4:7), & + &WH_C1KG(0:MXX,MQ2,4:7),WH_C1BKG(0:MXX,MQ2,4:7), & + &WH_C1KQ(0:MXX,MQ2,4:7),WH_C1BKQ(0:MXX,MQ2,4:7), & + &WH_D1KQ(0:MXX,MQ2,4:7),WH_D1BKQ(0:MXX,MQ2,4:7) + + + DIMENSION STOREM(6) + + CALL QTRACE('QNDUMP ',0) + + STOREM(1) = CBMSTF(4) + STOREM(2) = CBMSTF(6) + STOREM(3) = 0. + STOREM(4) = 0. + STOREM(5) = 0. + STOREM(6) = 0. + + WRITE(LUN) MXX,MQ2 + WRITE(LUN) CHVERS,CHDATE + WRITE(LUN) STOREM + WRITE(LUN) LWT1OK,LWT2OK,LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK, & + & LPLUS + WRITE(LUN) XXTAB,Q2TAB, & + & NXX,NQ2,IQF2C,IQF2B,IQFLC,IQFLB + IF(LWT1OK) THEN + WRITE(LUN) WGTFF1,WGTFG1,WGTGF1,WGTGG1 + ENDIF + IF(LWT2OK) THEN + WRITE(LUN) WGTPP2,WGTPM2,WGTNS2,WGTFF2,WGTFG2,WGTGF2,WGTGG2 + ENDIF + IF(LWTFOK) THEN + WRITE(LUN) WGTC2Q,WGTC2G,YNTC2Q,WGTCLQ,WGTCLG,WGTC3Q + ENDIF + IF(LWFCOK.OR.LWLCOK.OR.LWFBOK.OR.LWLBOK) THEN + WRITE(LUN) WH_C0KG,WH_C1KG,WH_C1BKG, & + & WH_C1KQ,WH_C1BKQ,WH_D1KQ,WH_D1BKQ + ENDIF + + RETURN + END + +!DECK ID>, QNREAD. + +! ================================= + SUBROUTINE QNREAD(LUN,ISTOP,IERR) +! ================================= + +!--- QNDUMP: read weight tables from LUN. +!--- Called by user. +!--- Input integer LUN +!--- integer ISTOP = 0 read the file +!--- ISTOP = 1 read only when ierr = 0 +!--- ISTOP = 2 stop the program when ierr .ne. 0 +!--- Output integer IERR = 0 all ok +!--- = 1 xgrid on file .ne. that in QCDNUM +!--- = 2 file contains heavy quark weight tables a +!--- qgrid on file .ne. that in QCDNUM +!--- = 3 file contains charm weight tables and +!--- c mass on the file .ne. that in QCDNUM +!--- = 4 file contains bottom weight tables and +!--- b mass on the file .ne. that in QCDNUM + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + CHARACTER*8 CHVERS,CHDATE + COMMON/QCVERS/ CHVERS,CHDATE + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + REAL & + &WGTFF1,WGTFG1, & + &WGTGF1,WGTGG1, & + &WGTPP2,WGTPM2,WGTNS2, & + &WGTFF2,WGTFG2, & + &WGTGF2,WGTGG2, & + &WGTC2Q,WGTC2G,YNTC2Q, & + &WGTCLQ,WGTCLG,WGTC3Q + + COMMON/QCWEIT/ & + &WGTFF1(MXX*(MXX+1)/2) ,WGTFG1(MXX*(MXX+1)/2,3:5), & + &WGTGF1(MXX*(MXX+1)/2) ,WGTGG1(MXX*(MXX+1)/2,3:5), & + &WGTPP2(MXX*(MXX+1)/2,3:5),WGTPM2(MXX*(MXX+1)/2,3:5), & + &WGTNS2(MXX*(MXX+1)/2,3:5), & + &WGTFF2(MXX*(MXX+1)/2,3:5),WGTFG2(MXX*(MXX+1)/2,3:5), & + &WGTGF2(MXX*(MXX+1)/2,3:5),WGTGG2(MXX*(MXX+1)/2,3:5), & + &WGTC2Q(MXX*(MXX+1)/2) ,WGTC2G(MXX*(MXX+1)/2,3:5), & + &WGTCLQ(MXX*(MXX+1)/2) ,WGTCLG(MXX*(MXX+1)/2,3:5), & + &WGTC3Q(MXX*(MXX+1)/2) ,YNTC2Q(MXX) + + COMMON/QCWADR/ IWADR(MXX,MXX) + + + REAL & + &WH_C0KG,WH_C1KG,WH_C1BKG, & + &WH_C1KQ,WH_C1BKQ,WH_D1KQ,WH_D1BKQ + + COMMON/QCHWGT/ & + &WH_C0KG(0:MXX,MQ2,4:7), & + &WH_C1KG(0:MXX,MQ2,4:7),WH_C1BKG(0:MXX,MQ2,4:7), & + &WH_C1KQ(0:MXX,MQ2,4:7),WH_C1BKQ(0:MXX,MQ2,4:7), & + &WH_D1KQ(0:MXX,MQ2,4:7),WH_D1BKQ(0:MXX,MQ2,4:7) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + CHARACTER*8 RHVERS,RHDATE + LOGICAL RWT1OK,RWT2OK,RWTFOK,RWFCOK + LOGICAL RWLCOK,RWFBOK,RWLBOK,RPLUS + LOGICAL LREADX,LREADQ,LREADB,LREADC + DIMENSION RMASS(6) + DIMENSION RXTAB(MXX),RQTAB(MQ2) + DIMENSION IRF2C(MQ2),IRF2B(MQ2),IRFLC(MQ2),IRFLB(MQ2) +! +! common added 18/3/05 by MRW + common/lhasilent/lhasilent + + CALL QTRACE('QNREAD ',0) + + REWIND LUN + +!-- Setup the weight adresses +!-- (Usually done in QNFILW, but this routine might not be called) + DO IX0 = 1,MXX + DO IX = IX0,MXX + IWADR(IX,IX0) = IWTAD(IX,IX0) + ENDDO + ENDDO + +!-- Read header information + READ(LUN,ERR=500) KXX,KQ2 + IF(KXX.NE.MXX.OR.KQ2.NE.MQ2) THEN + WRITE(6,'(/'' QNREAD: nxmax, nqmax on file '',2I5, & + & /'' nxmax, nqmax in QCDNUM'',2I5, & + & /'' Incompatible ---> STOP'')') & + & KXX,KQ2,MXX,MQ2 + STOP + ENDIF + READ(LUN,ERR=500) RHVERS,RHDATE + READ(RHVERS(1:2),'(I2)') IV + +!-- If ISTOP > 0 : stop when fileversion = QCDNUM15 or lower +!-- If ISTOP = 0 : read up to the weight tables + IF(IV.LE.15.AND.ISTOP.NE.0) THEN + WRITE(6,'(/'' QNREAD: file was written with QCDNUM'',A8, & + & '' Incompatible ---> STOP'')') & + & RHVERS + STOP + ENDIF + if(lhasilent.eq.0) & + & WRITE(6,'(/'' QNREAD: file was written with QCDNUM'',A8)') & + & RHVERS + + READ(LUN,ERR=500) RMASS + READ(LUN,ERR=500) RWT1OK,RWT2OK,RWTFOK,RWFCOK,RWLCOK,RWFBOK, & + & RWLBOK,RPLUS + READ(LUN,ERR=500) RXTAB,RQTAB, & + & NRX,NRQ,IRF2C,IRF2B,IRFLC,IRFLB + + IERR = 0 + LREADX = .FALSE. + LREADQ = .FALSE. + LREADC = .FALSE. + LREADB = .FALSE. + +!-- Check xgrid (if there is one already defined) + IF(NXX.NE.0) THEN + IF(NXX.NE.NRX) THEN + IERR = 1 + ELSE + DO IX = 1,NXX + IF(RXTAB(IX).NE.XXTAB(IX)) IERR = 1 + ENDDO + ENDIF + ENDIF + +!-- What to do when xgrid is different + IF(IERR.EQ.1) THEN + IF(ISTOP.EQ.1) THEN + WRITE(6,'(/ & + & '' QNREAD: X grid in memory different from that on file'', & + & '' ---> abandon reading'')') + RETURN + ENDIF + IF(ISTOP.EQ.2) THEN + WRITE(6,'(/ & + & '' QNREAD: X grid in memory different from that on file'', & + & '' ---> STOP'')') + STOP + ENDIF + ENDIF + + IF(IERR.EQ.1.OR.NXX.LE.0) LREADX = .TRUE. + +!-- Check Q2 grid if there is one already defined and if there are +!-- heavy quark weight tables on the file + IF(NQ2.NE.0.AND.(RWFCOK.OR.RWLCOK.OR.RWFBOK.OR.RWLBOK)) THEN + IF(NQ2.NE.NRQ) THEN + IERR = 2 + ELSE + DO IQ = 1,NQ2 + IF(RQTAB(IQ).NE.Q2TAB(IQ)) IERR = 2 + ENDDO + ENDIF + ENDIF + +!-- What to do when qgrid is different + IF(IERR.EQ.2) THEN + IF(ISTOP.EQ.1) THEN + WRITE(6,'(/ & + & '' QNREAD: Q2 grid in memory different from that on file'', & + & '' ---> abandon reading'')') + RETURN + ENDIF + IF(ISTOP.EQ.2) THEN + WRITE(6,'(/ & + & '' QNREAD: Q2 grid in memory different from that on file'', & + & '' ---> STOP'')') + STOP + ENDIF + ENDIF + + IF(IERR.EQ.2.OR.NQ2.LE.0) LREADQ = .TRUE. + +!-- Check charm mass if there are charm weight tables on the file + IF(RWFCOK.OR.RWLCOK) THEN + IF(IV.LE.15) THEN + IF(RMASS(4).NE.CBMSTF(4)) IERR = 3 + ELSE + IF(RMASS(1).NE.CBMSTF(4)) IERR = 3 + ENDIF + ENDIF + +!-- What to do when charm mass is different + IF(IERR.EQ.3) THEN + IF(ISTOP.EQ.1) THEN + WRITE(6,'(/ & + & '' QNREAD: Charm mass in memory different from that on file'',& + & '' ---> abandon reading'')') + RETURN + ENDIF + IF(ISTOP.EQ.2) THEN + WRITE(6,'(/ & + & '' QNREAD: Charm mass in memory different from that on'', & + & '' file ---> STOP'')') + STOP + ENDIF + LREADC = .TRUE. + ENDIF + +!-- Check bottom mass if there are bottom weight tables on the file + IF(RWFBOK.OR.RWLBOK) THEN + IF(IV.LE.15) THEN + IF(RMASS(5).NE.CBMSTF(6)) IERR = 4 + ELSE + IF(RMASS(2).NE.CBMSTF(6)) IERR = 4 + ENDIF + ENDIF + +!-- What to do when bottom mass is different + IF(IERR.EQ.4) THEN + IF(ISTOP.EQ.1) THEN + WRITE(6,'(/ & + & '' QNREAD: Bottom mass in memory different from that on'', & + & '' file ---> abandon reading'')') + RETURN + ENDIF + IF(ISTOP.EQ.2) THEN + WRITE(6,'(/ & + & '' QNREAD: Bottom mass in memory different from that on'', & + & '' file ---> STOP'')') + STOP + ENDIF + LREADB = .TRUE. + ENDIF + +!-- ok..... continue....... + LPLUS = RPLUS +!-- Invalidate all evolutions + CALL QNFALS(LEVDONE,MXX*10) + + IF(LREADX) THEN +!-- Copy xgrid to qcdnum common block + NXX = NRX + DO IX = 1,NXX+1 + XXTAB(IX) = RXTAB(IX) + ENDDO + WRITE(6,'(/ & + & '' QNREAD: xgrid table read in (original overwritten)'')') +!-- Invalidate all weight tables since the grid has changed + LWT1OK = .FALSE. + LWT2OK = .FALSE. + LWTFOK = .FALSE. + LWFCOK = .FALSE. + LWLCOK = .FALSE. + LWFBOK = .FALSE. + LWLBOK = .FALSE. + LMARK = .FALSE. + NGRVER = NGRVER+1 +!-- Invalidate all evolutions + CALL QNFALS(LEVDONE,MXX*10) +!--- Update IFAILC + CALL GRSETC +!--- Update NFMAP + CALL QNSETT +!--- Update heavy quark xgrid + CALL GXHDEF + ENDIF + + IF(LREADQ) THEN +!-- Copy q2 grid to common block + NQ2 = NRQ + DO IQ = 1,NQ2 + Q2TAB(IQ) = RQTAB(IQ) + ENDDO + WRITE(6,'(/ & + & '' QNREAD: qgrid table read in (original overwritten)'')') +!-- Invalidate hq weight tables since the grid has changed + LALFOK = .FALSE. + LDQ2OK = .FALSE. + LWFCOK = .FALSE. + LWLCOK = .FALSE. + LWFBOK = .FALSE. + LWLBOK = .FALSE. + LMARK = .FALSE. + NGRVER = NGRVER + 1 +!-- Invalidate all evolutions + CALL QNFALS(LEVDONE,MXX*10) +!--- Update IFAILC + CALL GRSETC +!--- Update NFMAP + CALL QNSETT + ENDIF + + IF(LREADC) THEN + IF(IV.LE.15) THEN + UDSCBT(4) = RMASS(4) + CBMSTF(4) = RMASS(4) + CBMSTF(5) = RMASS(4) + ELSE + CBMSTF(4) = RMASS(1) + CBMSTF(5) = RMASS(1) + ENDIF + WRITE(6,'(/ & + & '' QNREAD: charm mass read in (original overwritten)'')') +!-- Invalidate charm weight tables since charm mass has changed + LWFCOK = .FALSE. + LWLCOK = .FALSE. +!-- Invalidate alpha_s table + LALFOK = .FALSE. + ENDIF + + IF(LREADB) THEN + IF(IV.LE.15) THEN + UDSCBT(5) = RMASS(5) + CBMSTF(6) = RMASS(5) + CBMSTF(7) = RMASS(5) + ELSE + CBMSTF(6) = RMASS(2) + CBMSTF(7) = RMASS(2) + ENDIF + WRITE(6,'(/ & + & '' QNREAD: bottom mass read in (original overwritten)'')') +!-- Invalidate bottom weight tables since charm mass has changed + LWFBOK = .FALSE. + LWLBOK = .FALSE. +!-- Invalidate alpha_s table + LALFOK = .FALSE. + ENDIF + + IF(IV.LE.15) THEN + WRITE(6,'(/'' QNREAD: file was written with QCDNUM'',A8)') & + & RHVERS + WRITE(6,'( '' ------> Abandon reading the weight tables'')') + RETURN + ENDIF + + IF(RWT1OK) THEN + READ(LUN,ERR=500) WGTFF1,WGTFG1,WGTGF1,WGTGG1 + LWT1OK = .TRUE. + if(lhasilent.eq.0) & + & WRITE(6,'(/'' QNREAD: LO weight tables read in'')') + ENDIF + + IF(RWT2OK) THEN + READ(LUN,ERR=500) WGTPP2,WGTPM2,WGTNS2,WGTFF2,WGTFG2,WGTGF2, & + & WGTGG2 + LWT2OK = .TRUE. + if(lhasilent.eq.0) & + & WRITE(6,'(/'' QNREAD: NLO weight tables read in'')') + ENDIF + + IF(RWTFOK) THEN + READ(LUN,ERR=500) WGTC2Q,WGTC2G,YNTC2Q,WGTCLQ,WGTCLG,WGTC3Q + LWTFOK = .TRUE. + if(lhasilent.eq.0) & + & WRITE(6,'(/'' QNREAD: F2, FL weight tables read in'')') + ENDIF + + IF(RWFCOK.OR.RWLCOK.OR.RWFBOK.OR.RWLBOK) THEN + READ(LUN,ERR=500) WH_C0KG,WH_C1KG,WH_C1BKG, & + & WH_C1KQ,WH_C1BKQ,WH_D1KQ,WH_D1BKQ + LWFCOK = RWFCOK + LWLCOK = RWLCOK + LWFBOK = RWFBOK + LWLBOK = RWLBOK + if(lhasilent.eq.0) then + IF(RWFCOK) & + & WRITE(6,'(/'' QNREAD: F2C weight tables read in'')') + IF(RWLCOK) & + & WRITE(6,'(/'' QNREAD: FLC weight tables read in'')') + IF(RWFBOK) & + & WRITE(6,'(/'' QNREAD: F2B weight tables read in'')') + IF(RWLBOK) & + & WRITE(6,'(/'' QNREAD: FLB weight tables read in'')') + endif + ENDIF + + RETURN + + 500 CONTINUE + WRITE(6,'(/'' QNREAD: cannot read file on lun = '',I5, & + & '' ---> STOP'')') LUN + + CALL QTRACE('QNREAD ',1) + + STOP + + END + +!DECK ID>, QNPRIN. +! +! ====================== + SUBROUTINE QNPRIN(LUN) +! ====================== + +!--- QNPRIN: print default + current setting of QCDNUM parameters. +!--- Called by QPRINT +!--- Input parameter: LUN. To be opened by user unless LUN = 6. + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + IF(RS2CUT.GE.0.) THEN + RS2C = SQRT(RS2CUT) + ELSE + RS2C = RS2CUT + ENDIF + + WRITE(LUN,'(//'' +-------+---+-------+--------------+'', & + & ''------------------------------------+'')') + WRITE(LUN,'( '' | var |typ| deflt | value |'', & + & '' description |'')') + WRITE(LUN,'( '' +-------+---+-------+--------------+'', & + & ''------------------------------------+'')') + WRITE(LUN,'('' | W1ANA | L | T | '',6X,L1,5X, & + & '' | Analytical LO weight calculation |'')') LW1ANA + WRITE(LUN,'('' | W1NUM | L | F | '',6X,L1,5X, & + & '' | Numerical LO weight calculation |'')') LW1NUM + WRITE(LUN,'('' | W2NUM | L | T | '',6X,L1,5X, & + & '' | Numerical NLO weight calculation |'')') LW2NUM + WRITE(LUN,'('' | W2STF | L | T | '',6X,L1,5X, & + & '' | Structure function NLO weights |'')') LW2STF + WRITE(LUN,'('' | WTF2C | L | F | '',6X,L1,5X, & + & '' | F2_charm weight calculation |'')') LWF2C + WRITE(LUN,'('' | WTF2B | L | F | '',6X,L1,5X, & + & '' | F2_bottom weight calculation |'')') LWF2B + WRITE(LUN,'('' | WTFLC | L | F | '',6X,L1,5X, & + & '' | FL_charm weight calculation |'')') LWFLC + WRITE(LUN,'('' | WTFLB | L | F | '',6X,L1,5X, & + & '' | FL_bottom weight calculation |'')') LWFLB + WRITE(LUN,'('' | LIMCK | L | T | '',6X,L1,5X, & + & '' | Check x, Q2 limits and cuts |'')') LIMCK + WRITE(LUN,'('' | CLOWQ | L | T | '',6X,L1,5X, & + & '' | Heavy F2,FL only for Q2 > 1.5 GeV2 |'')') LCLOWQ + WRITE(LUN,'('' | ORDER | I | 2 | '',6X,I1,5X, & + & '' | LO (1) or NLO (2) calculations |'')') IORD + WRITE(LUN,'('' | SCAX0 | R | 0.20 | '',E12.5, & + & '' | x-grid scale from log --> linear |'')') SCAX0 + WRITE(LUN,'('' | SCAQ0 | R | +inf | '',E12.5, & + & '' | Q2-grid scale from log --> linear |'')') SCAQ0 + WRITE(LUN,'('' | MCSTF | R | 1.5 | '',E12.5, & + & '' | C mass for F2c, FLc (GeV) |'')') CBMSTF(4) + WRITE(LUN,'('' | MBSTF | R | 5.0 | '',E12.5, & + & '' | B mass for F2b, FLb (GeV) |'')') CBMSTF(6) + WRITE(LUN,'('' | MCALF | R | 1.5 | '',E12.5, & + & '' | C mass for alpha_s evolution (GeV) |'')') UDSCBT(4) + WRITE(LUN,'('' | MBALF | R | 5.0 | '',E12.5, & + & '' | B mass for alpha_s evolution (GeV) |'')') UDSCBT(5) + WRITE(LUN,'('' | MTALF | R | 188. | '',E12.5, & + & '' | T mass for alpha_s evolution (GeV) |'')') UDSCBT(6) + WRITE(LUN,'('' | ALFAS | R | 0.180 | '',E12.5, & + & '' | Value of alpha_s |'')') ALPHA0 + WRITE(LUN,'('' | ALFQ0 | R | 50. | '',E12.5, & + & '' | Q2 where alpha_s is given (GeV2) |'')') Q0ALFA + WRITE(LUN,'('' | AAAR2 | R | 1.0 | '',E12.5, & + & '' | R2 = A*M2 + B (ren. scale) |'')') AAAR2 + WRITE(LUN,'('' | BBBR2 | R | 0.0 | '',E12.5, & + & '' | R2 = A*M2 + B (ren. scale) |'')') BBBR2 + WRITE(LUN,'('' | AAM2L | R | 1.0 | '',E12.5, & + & '' | M2 = A*Q2 + B (light fact. scale) |'')') AAM2L + WRITE(LUN,'('' | BBM2L | R | 0.0 | '',E12.5, & + & '' | M2 = A*Q2 + B (light fact. scale) |'')') BBM2L + WRITE(LUN,'('' | AAM2H | R | 1.0 | '',E12.5, & + & '' | M2 = A*Q2 + B (heavy fact. scale) |'')') AAM2H + WRITE(LUN,'('' | BBM2H | R | 0.0 | '',E12.5, & + & '' | M2 = A*Q2 + B (heavy fact. scale) |'')') BBM2H + WRITE(LUN,'( '' +-------+---+-------+--------------+'', & + & ''------------------------------------+'')') + WRITE(LUN,'('' | TCHRM | R | -inf | '',E12.5, & + & '' | Charm threshold (GeV2) |'')') THRS34 + WRITE(LUN,'('' | TBOTT | R | +inf | '',E12.5, & + & '' | Bottom threshold (GeV2) |'')') THRS45 + WRITE(LUN,'('' | XMINC | R | 0.0 | '',E12.5, & + & '' | Xmin cut (.le.0 = no cut) |'')') XMICUT + WRITE(LUN,'('' | QMINC | R | 0.0 | '',E12.5, & + & '' | Qmin cut (.le.0 = no cut) |'')') QMICUT + WRITE(LUN,'('' | QMAXC | R | 0.0 | '',E12.5, & + & '' | Qmax cut (.le.0 = no cut) |'')') QMACUT + WRITE(LUN,'('' | ROOTS | R | 0.0 | '',E12.5, & + & '' | Roots cut (.le.0 = no cut) |'')') RS2C + WRITE(LUN,'('' | QMINA | R | 0.0 | '',E12.5, & + & '' | Lowest Q2 gridpoint above Lambda2 |'')') QMINAS + WRITE(LUN,'( '' +-------+---+-------+--------------+'', & + & ''------------------------------------+'')') + WRITE(LUN,'('' | ASOLD | L | F | '',6X,L1,5X, & + & '' | Use old (incorrect) a_s evolution |'')') LASOLD + WRITE(LUN,'('' | BMARK | L | F | '',6X,L1,5X, & + & '' | Do not use: for tests only |'')') LBMARK + WRITE(LUN,'('' | FLFAC | R | 0.0 | '',E12.5, & + & '' | Hands off : for experts only |'')') BBM2H + WRITE(LUN,'( '' +-------+---+-------+--------------+'', & + & ''------------------------------------+'')') + + RETURN + END + +!DECK ID>, QNVERS. +! +! ============================================== + SUBROUTINE QNVERS(VERSION,LDOUBLE,NXMAX,NQMAX) +! ============================================== + +!--- QNVERS: return version number, dp flag and max # of gridpoints. +!--- Called by user. +!--- Output variables: VERSION (character*8) +!--- LDOUBLE (logical) +!--- NXMAX, NQMAX (integer); set by parameter +!--- statement in common block QCNXQM. + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + CHARACTER*8 VERSION + LOGICAL LDOUBLE + + CHARACTER*8 CHVERS,CHDATE + COMMON/QCVERS/ CHVERS,CHDATE + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + CALL QTRACE('QNVERS ',0) + + VERSION = CHVERS + LDOUBLE = LDOUBL + NXMAX = MXX-1 + NQMAX = MQ2-1 + + RETURN + END + +!DECK ID>, QPRINT. + +! ========================== + SUBROUTINE QPRINT(LUN,OPT) +! ========================== + +!--- QPRINT: steering routine to print various QCDNUM info on +!-- logical unit number LUN (to be opened by the user). +!--- Called by user. +!--- Input integer LUN : locical unit number. +!--- character OPT: 'A' (All) print all info. +!--- 'B' (Booklist) print pdf definitions. +!--- 'P' (Parameters) Parameter/option list. +!--- 'S' (Statistics) # STF function calls. +!--- 'T' (Timelog) timelog. +!--- 'X' (Xq2grid) grid,thresholds,cuts. + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + CHARACTER*(*) OPT + CHARACTER*1 OPT1 + + + LOGICAL LTIME + REAL T_START,T_END,T_SPENT + COMMON/QCTIME/T_START(10),T_END(10),T_SPENT(10),N_CALLS(10), & + &E_CALLS(10),LTIME + COMMON/QCFCNT/IFCNT(-1:1,5) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + REAL & + &WGTFF1,WGTFG1, & + &WGTGF1,WGTGG1, & + &WGTPP2,WGTPM2,WGTNS2, & + &WGTFF2,WGTFG2, & + &WGTGF2,WGTGG2, & + &WGTC2Q,WGTC2G,YNTC2Q, & + &WGTCLQ,WGTCLG,WGTC3Q + + COMMON/QCWEIT/ & + &WGTFF1(MXX*(MXX+1)/2) ,WGTFG1(MXX*(MXX+1)/2,3:5), & + &WGTGF1(MXX*(MXX+1)/2) ,WGTGG1(MXX*(MXX+1)/2,3:5), & + &WGTPP2(MXX*(MXX+1)/2,3:5),WGTPM2(MXX*(MXX+1)/2,3:5), & + &WGTNS2(MXX*(MXX+1)/2,3:5), & + &WGTFF2(MXX*(MXX+1)/2,3:5),WGTFG2(MXX*(MXX+1)/2,3:5), & + &WGTGF2(MXX*(MXX+1)/2,3:5),WGTGG2(MXX*(MXX+1)/2,3:5), & + &WGTC2Q(MXX*(MXX+1)/2) ,WGTC2G(MXX*(MXX+1)/2,3:5), & + &WGTCLQ(MXX*(MXX+1)/2) ,WGTCLG(MXX*(MXX+1)/2,3:5), & + &WGTC3Q(MXX*(MXX+1)/2) ,YNTC2Q(MXX) + + COMMON/QCWADR/ IWADR(MXX,MXX) + + + CALL QTRACE('QPRINT ',0) + + IF(LENOCC_LHA(OPT).LT.1) GOTO 500 + OPT1 = OPT(1:1) + CALL CLTOU_LHA(OPT1) + + ! + IF(OPT1.EQ.'T') THEN + CALL QPTIME(LUN) + ELSEIF(OPT1.EQ.'P') THEN + CALL QNPRIN(LUN) + ELSEIF(OPT1.EQ.'B') THEN + CALL QNLIST(LUN) + ELSEIF(OPT1.EQ.'S') THEN + CALL QNSTAT(LUN) + ELSEIF(OPT1.EQ.'X') THEN + CALL QPGRID(LUN) + ELSEIF(OPT1.EQ.'A') THEN + CALL QNPRIN(LUN) + CALL QNLIST(LUN) + CALL QPGRID(LUN) + CALL QNSTAT(LUN) + CALL QPTIME(LUN) + ELSE + GOTO 500 + ENDIF + + RETURN + + 500 CONTINUE + + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r QPRINT ---> STOP'')') + WRITE(6,'( '' ------------------------------------'')') + WRITE(6,'( '' Input LUN :'',I5 )') LUN + WRITE(6,'( '' OPT :'',A )') OPT + WRITE(6,'(/'' Option should be A, B, P, S, T or X'')') + + STOP + + END + +!DECK ID>, QNTIME. + +! ====================== + SUBROUTINE QNTIME(OPT) +! ====================== + +!--- QNTIME: start/halt/continue the timelog. +!--- Called by user and by QPTIME. +!--- Input variable: 'Start' initialise and start the timelog. +!--- 'Hold' stop logging. +!--- 'Cont' continue logging. + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + CHARACTER*(*) OPT + CHARACTER*1 OPT1 + + + LOGICAL LTIME + REAL T_START,T_END,T_SPENT + COMMON/QCTIME/T_START(10),T_END(10),T_SPENT(10),N_CALLS(10), & + &E_CALLS(10),LTIME + COMMON/QCFCNT/IFCNT(-1:1,5) + + + CALL QTRACE('QNTIME ',0) + + IF(LENOCC_LHA(OPT).LT.1) GOTO 500 + OPT1 = OPT(1:1) + CALL CLTOU_LHA(OPT1) + + IF(OPT1.EQ.'S') THEN + + DO I = 1,10 + T_SPENT(I) = 0. + E_CALLS(I) = 0. + N_CALLS(I) = 0 + ENDDO + LTIME = .TRUE. + + N_CALLS(1) = N_CALLS(1)+1 + CALL TIMEX_LHA(T_START(1)) + + ELSEIF(OPT1.EQ.'H') THEN + + LTIME = .FALSE. + CALL TIMEX_LHA(T_END(1)) + T_SPENT(1) = T_SPENT(1)+T_END(1)-T_START(1) + T_START(1) = T_END(1) + + ELSEIF(OPT1.EQ.'C') THEN + + IF(.NOT.LTIME) THEN + LTIME = .TRUE. + N_CALLS(1) = N_CALLS(1)+1 + CALL TIMEX_LHA(T_START(1)) + ENDIF + + ELSE + + GOTO 500 + + ENDIF + + RETURN + + 500 CONTINUE + + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r QNTIME ---> STOP'')') + WRITE(6,'( '' ------------------------------------'')') + WRITE(6,'( '' Input OPT :'',A )') OPT + WRITE(6,'(/'' Option should be S, H or C '')') + + CALL QTRACE('QNTIME ',1) + + STOP + + END + +!DECK ID>, QPTIME. + +! ====================== + SUBROUTINE QPTIME(LUN) +! ====================== + +!--- QPTIME: start/print the timelog. +!--- Called by QPRINT. +!--- Input variable: LUN logical unit number + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + LOGICAL LTIME + REAL T_START,T_END,T_SPENT + COMMON/QCTIME/T_START(10),T_END(10),T_SPENT(10),N_CALLS(10), & + &E_CALLS(10),LTIME + COMMON/QCFCNT/IFCNT(-1:1,5) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + REAL & + &WGTFF1,WGTFG1, & + &WGTGF1,WGTGG1, & + &WGTPP2,WGTPM2,WGTNS2, & + &WGTFF2,WGTFG2, & + &WGTGF2,WGTGG2, & + &WGTC2Q,WGTC2G,YNTC2Q, & + &WGTCLQ,WGTCLG,WGTC3Q + + COMMON/QCWEIT/ & + &WGTFF1(MXX*(MXX+1)/2) ,WGTFG1(MXX*(MXX+1)/2,3:5), & + &WGTGF1(MXX*(MXX+1)/2) ,WGTGG1(MXX*(MXX+1)/2,3:5), & + &WGTPP2(MXX*(MXX+1)/2,3:5),WGTPM2(MXX*(MXX+1)/2,3:5), & + &WGTNS2(MXX*(MXX+1)/2,3:5), & + &WGTFF2(MXX*(MXX+1)/2,3:5),WGTFG2(MXX*(MXX+1)/2,3:5), & + &WGTGF2(MXX*(MXX+1)/2,3:5),WGTGG2(MXX*(MXX+1)/2,3:5), & + &WGTC2Q(MXX*(MXX+1)/2) ,WGTC2G(MXX*(MXX+1)/2,3:5), & + &WGTCLQ(MXX*(MXX+1)/2) ,WGTCLG(MXX*(MXX+1)/2,3:5), & + &WGTC3Q(MXX*(MXX+1)/2) ,YNTC2Q(MXX) + + COMMON/QCWADR/ IWADR(MXX,MXX) + + + CALL QNTIME('H') + + N_TOT = N_CALLS(3)+N_CALLS(4)+N_CALLS(5) + E_TOT = E_CALLS(3)+E_CALLS(4)+E_CALLS(5) + T_TOT = T_SPENT(3)+T_SPENT(4)+T_SPENT(5) + T_REST = T_SPENT(1)-T_TOT-T_SPENT(2)-T_SPENT(6) + DUMMY = 1. + F_FAST = 0. + DO J = 1,5 + F_FAST = F_FAST+IFCNT(1,J) + ENDDO + WRITE(LUN, & + & '(//'' -------------------------------------------------'')') + WRITE(LUN, & + & '( '' Routine # calls # evols CPU sec CPU/evol'')') + WRITE(LUN, & + & '( '' -------------------------------------------------'')') + WRITE(LUN, & + & '('' EVOLNM '',I10,2F10.1,F10.2)') N_CALLS(3), & + & E_CALLS(3),T_SPENT(3),T_SPENT(3)/MAX(E_CALLS(3),DUMMY) + WRITE(LUN, & + & '('' EVOLNP '',I10,2F10.1,F10.2)') N_CALLS(4), & + & E_CALLS(4),T_SPENT(4),T_SPENT(4)/MAX(E_CALLS(4),DUMMY) + WRITE(LUN, & + & '('' EVOLSG '',I10,2F10.1,F10.2)') N_CALLS(5), & + & E_CALLS(5),T_SPENT(5),T_SPENT(5)/MAX(E_CALLS(5),DUMMY) + WRITE(LUN, & + & '( '' -------------------------------------------------'')') + WRITE(LUN, & + & '('' AP total '',I10,2F10.1,F10.2)') N_TOT, & + & E_TOT,T_TOT,T_TOT/MAX(E_TOT,DUMMY) + WRITE(LUN,'('' '')') + WRITE(LUN, & + & '('' STFAST '',I10, 2F10.1)') N_CALLS(6),F_FAST,T_SPENT(6) + WRITE(LUN, & + & '('' QNFILW '',I10,10X,F10.1)') N_CALLS(2),T_SPENT(2) + WRITE(LUN, & + & '('' Other '',10X,10X,F10.1)') T_REST + WRITE(LUN, & + & '( '' -------------------------------------------------'')') + WRITE(LUN, & + & '('' Total '',10X,10X,F10.1)') T_SPENT(1) + WRITE(LUN, & + & '( '' -------------------------------------------------'')') + + + RETURN + END + +!DECK ID>, QNSTAT. + +! ====================== + SUBROUTINE QNSTAT(LUN) +! ====================== + +!--- QNSTAT: print number of structure function calculations. +!--- Called by user. +!--- Input parameter: LUN to be opened by user unless LUN = 6. + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + LOGICAL LTIME + REAL T_START,T_END,T_SPENT + COMMON/QCTIME/T_START(10),T_END(10),T_SPENT(10),N_CALLS(10), & + &E_CALLS(10),LTIME + COMMON/QCFCNT/IFCNT(-1:1,5) + + + DIMENSION ITOT(5) + + DO J = 1,5 + ITOT(J) = 0 + DO I = -1,1 + ITOT(J) = ITOT(J)+IFCNT(I,J) + ENDDO + ENDDO + + WRITE(LUN,'(//'' ------------------------------'', & + & ''--------------------------------------------'')') + WRITE(LUN,'( '' Structure function calls '', & + & '' F2 FL xF3'', & + & '' F2h FLh'')') + WRITE(LUN,'( '' ------------------------------'', & + & ''--------------------------------------------'')') + WRITE(LUN, & + & '('' Slow calculation '',5I9)') (IFCNT( 0,J),J=1,5) + WRITE(LUN, & + & '('' Fast calculation '',5I9)') (IFCNT( 1,J),J=1,5) + WRITE(LUN, & + & '('' Outside grid or cuts '',5I9)') (IFCNT(-1,J),J=1,5) + WRITE(LUN,'( '' ------------------------------'', & + & ''--------------------------------------------'')') + WRITE(LUN, & + & '('' Total '',5I9)') ( ITOT(J),J=1,5) + WRITE(LUN,'( '' ------------------------------'', & + & ''--------------------------------------------'')') + + RETURN + END + +!DECK ID>, QNIVAL. + +! ================================ + SUBROUTINE QNIVAL(OPT,FLAG,IVAL) +! ================================ + +!--- QNIVAL: set/get integer variable. +!--- Called by user or internally by s/r QNISET and QNIGET. +!--- Input parameters: 'OPT' = 'Set' or 'Get'. +!--- 'FLAG' = variable name to set or get. +!--- 'IVAL' (integer) input or output variable. + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + CHARACTER*(*) OPT + CHARACTER*1 OPT1 + CHARACTER*(*) FLAG + CHARACTER*5 FLAG5 + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + IF(LENOCC_LHA(OPT).LT.1) THEN + IERR = 1 + GOTO 500 + ENDIF + IF(LENOCC_LHA(FLAG).LT.5) THEN + IERR = 2 + GOTO 500 + ENDIF + OPT1 = OPT(1:1) + FLAG5 = FLAG(1:5) + CALL CLTOU_LHA(OPT1) + CALL CLTOU_LHA(FLAG5) + +! ---------------------- + ! + IF(OPT1.EQ.'S') THEN +! ---------------------- + + IF (FLAG5.EQ.'ORDER') THEN + IF(IVAL.LE.0.OR.IVAL.GE.3) THEN + IERR = 3 + GOTO 500 + ENDIF + IORD = IVAL +!-- Invalidate all evolutions + CALL QNFALS(LEVDONE,MXX*10) + LALFOK = .FALSE. + ELSE + IERR = 2 + GOTO 500 + ENDIF + +! -------------------------- + ! + ELSEIF(OPT1.EQ.'G') THEN +! -------------------------- + + IF (FLAG5.EQ.'ORDER') THEN + IVAL = IORD + ELSE + IERR = 2 + GOTO 500 + ENDIF + +! ------ + ! + ELSE +! ------ + + IERR = 1 + GOTO 500 + +! ------- + ! + ENDIF +! ------- + + RETURN + + 500 CONTINUE + + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r QNIVAL ---> STOP'')') + WRITE(6,'( '' ------------------------------------'')') + WRITE(6,'( '' Input OPT : '',A )') OPT + WRITE(6,'( '' VAR : '',A )') FLAG + WRITE(6,'( '' VAL : '',I10 )') IVAL + IF(IERR.EQ.1) THEN + WRITE(6,'(/'' OPT should be either SET or GET '')') + ELSEIF(IERR.EQ.2) THEN + WRITE(6,'(/'' Variable VAR not found'')') + ELSEIF(IERR.EQ.3) THEN + WRITE(6,'(/'' IVAL out of allowed range'')') + ENDIF + + CALL QTRACE('QNIVAL ',1) + + STOP + + END + +!DECK ID>, QNISET. + +! ============================ + SUBROUTINE QNISET(FLAG,IVAL) +! ============================ + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + CHARACTER*(*) FLAG + + CALL QTRACE('QNISET ',0) + + CALL QNIVAL('SET',FLAG,IVAL) + + RETURN + END + +!DECK ID>, QNIGET. + +! ============================ + SUBROUTINE QNIGET(FLAG,IVAL) +! ============================ + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + CHARACTER*(*) FLAG + + CALL QTRACE('QNIGET ',0) + + CALL QNIVAL('GET',FLAG,IVAL) + + RETURN + END + +!DECK ID>, QNRVAL. + +! =============================== + SUBROUTINE QNRVAL(OPT,FLAG,VAL) +! =============================== + +!--- QNRVAL: set/get floating point variable. +!--- Called by user or internally by s/r QNRSET and QNRGET. +!--- Input parameters: 'OPT' = 'Set' or 'Get'. +!--- 'FLAG' = variable name to set or get. +!--- 'VAL' (real or d.p.) input or output variable. + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + CHARACTER*(*) OPT + CHARACTER*1 OPT1 + CHARACTER*(*) FLAG + CHARACTER*5 FLAG5 + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + IF(LENOCC_LHA(OPT).LT.1) THEN + IERR = 1 + GOTO 500 + ENDIF + IF(LENOCC_LHA(FLAG).LT.5) THEN + IERR = 2 + GOTO 500 + ENDIF + OPT1 = OPT(1:1) + FLAG5 = FLAG(1:5) + CALL CLTOU_LHA(OPT1) + CALL CLTOU_LHA(FLAG5) + +! ---------------------- + ! + IF(OPT1.EQ.'S') THEN +! ---------------------- + + IF (FLAG5.EQ.'AAM2H'.OR.FLAG5.EQ.'AATQ2') THEN + IF(VAL.LE.0.) THEN + IERR = 3 + GOTO 500 + ENDIF + AAM2H = VAL + DO I = 1,30 + LFFCAL(4,I) = .FALSE. + LFFCAL(5,I) = .FALSE. + LFFCAL(6,I) = .FALSE. + LFFCAL(7,I) = .FALSE. + ENDDO + ELSEIF(FLAG5.EQ.'BBM2H'.OR.FLAG5.EQ.'PLUSB') THEN + BBM2H = VAL + DO I = 1,30 + LFFCAL(4,I) = .FALSE. + LFFCAL(5,I) = .FALSE. + LFFCAL(6,I) = .FALSE. + LFFCAL(7,I) = .FALSE. + ENDDO + ELSEIF(FLAG5.EQ.'AAM2L') THEN + IF(VAL.LE.0.) THEN + IERR = 3 + GOTO 500 + ENDIF + AAM2L = VAL + DO I = 1,30 + LFFCAL(1,I) = .FALSE. + LFFCAL(2,I) = .FALSE. + LFFCAL(3,I) = .FALSE. + ENDDO + ELSEIF(FLAG5.EQ.'BBM2L') THEN + BBM2L = VAL + DO I = 1,30 + LFFCAL(1,I) = .FALSE. + LFFCAL(2,I) = .FALSE. + LFFCAL(3,I) = .FALSE. + ENDDO + ELSEIF(FLAG5.EQ.'AAAR2') THEN + AAAR2 = VAL +!-- Invalidate all evolutions + CALL QNFALS(LEVDONE,MXX*10) + LALFOK = .FALSE. + DO I = 1,30 + DO J = 1,7 + LFFCAL(J,I) = .FALSE. + ENDDO + ENDDO + ELSEIF(FLAG5.EQ.'BBBR2') THEN + BBBR2 = VAL +!-- Invalidate all evolutions + CALL QNFALS(LEVDONE,MXX*10) + LALFOK = .FALSE. + DO I = 1,30 + DO J = 1,7 + LFFCAL(J,I) = .FALSE. + ENDDO + ENDDO + ELSEIF(FLAG5.EQ.'FLFAC') THEN + FL_FAC = VAL + DO I = 1,30 + LFFCAL(2,I) = .FALSE. + ENDDO + ELSEIF(FLAG5.EQ.'SCAX0') THEN + IF(VAL.LE.0.) THEN + IERR = 3 + GOTO 500 + ENDIF + SCAX0 = VAL + ELSEIF(FLAG5.EQ.'SCAQ0') THEN + IF(VAL.LE.0.) THEN + IERR = 3 + GOTO 500 + ENDIF + SCAQ0 = VAL + ELSE + IF(VAL.LE.0.) THEN + IERR = 3 + GOTO 500 + ENDIF +!-- Invalidate all evolutions + CALL QNFALS(LEVDONE,MXX*10) + !force alpha_s to be recalculated + LALFOK = .FALSE. + IF (FLAG5.EQ.'UMASS') THEN + UDSCBT(1) = VAL + ELSEIF(FLAG5.EQ.'DMASS') THEN + UDSCBT(2) = VAL + ELSEIF(FLAG5.EQ.'SMASS') THEN + UDSCBT(3) = VAL + ELSEIF(FLAG5.EQ.'CMASS') THEN + UDSCBT(4) = VAL + CBMSTF(4) = VAL + CBMSTF(5) = VAL + !invalidate F2C weight tables + LWFCOK = .FALSE. + !invalidate FLC weight tables + LWLCOK = .FALSE. + ELSEIF(FLAG5.EQ.'MCSTF') THEN + CBMSTF(4) = VAL + CBMSTF(5) = VAL + LWFCOK = .FALSE. + LWLCOK = .FALSE. + ELSEIF(FLAG5.EQ.'MCALF') THEN + UDSCBT(4) = VAL + ELSEIF(FLAG5.EQ.'BMASS') THEN + UDSCBT(5) = VAL + CBMSTF(6) = VAL + CBMSTF(7) = VAL + !invalidate F2B weight tables + LWFBOK = .FALSE. + !invalidate FLB weight tables + LWLBOK = .FALSE. + ELSEIF(FLAG5.EQ.'MBSTF') THEN + CBMSTF(6) = VAL + CBMSTF(7) = VAL + LWFBOK = .FALSE. + LWLBOK = .FALSE. + ELSEIF(FLAG5.EQ.'MBALF') THEN + UDSCBT(5) = VAL + ELSEIF(FLAG5.EQ.'MTALF') THEN + UDSCBT(6) = VAL + ELSEIF(FLAG5.EQ.'TMASS') THEN + UDSCBT(6) = VAL + ELSEIF(FLAG5.EQ.'ALFAS') THEN + ALPHA0 = VAL + ELSEIF(FLAG5.EQ.'ALFQ0') THEN + Q0ALFA = VAL + ELSE + IERR = 2 + GOTO 500 + ENDIF + ENDIF + +! -------------------------- + ! + ELSEIF(OPT1.EQ.'G') THEN +! -------------------------- + + IF (FLAG5.EQ.'SCAX0') THEN + VAL = SCAX0 + ELSEIF(FLAG5.EQ.'SCAQ0') THEN + VAL = SCAQ0 + ELSEIF(FLAG5.EQ.'AAM2H'.OR.FLAG5.EQ.'AATQ2') THEN + VAL = AAM2H + ELSEIF(FLAG5.EQ.'BBM2H'.OR.FLAG5.EQ.'PLUSB') THEN + VAL = BBM2H + ELSEIF(FLAG5.EQ.'AAM2L') THEN + VAL = AAM2L + ELSEIF(FLAG5.EQ.'BBM2L') THEN + VAL = BBM2L + ELSEIF(FLAG5.EQ.'AAAR2') THEN + VAL = AAAR2 + ELSEIF(FLAG5.EQ.'BBBR2') THEN + VAL = BBBR2 + ELSEIF(FLAG5.EQ.'FLFAC') THEN + VAL = FL_FAC + ELSEIF(FLAG5.EQ.'UMASS') THEN + VAL = UDSCBT(1) + ELSEIF(FLAG5.EQ.'DMASS') THEN + VAL = UDSCBT(2) + ELSEIF(FLAG5.EQ.'SMASS') THEN + VAL = UDSCBT(3) + ELSEIF(FLAG5.EQ.'CMASS') THEN + VAL = UDSCBT(4) + ELSEIF(FLAG5.EQ.'BMASS') THEN + VAL = UDSCBT(5) + ELSEIF(FLAG5.EQ.'TMASS') THEN + VAL = UDSCBT(6) + ELSEIF(FLAG5.EQ.'MCSTF') THEN + VAL = CBMSTF(4) + ELSEIF(FLAG5.EQ.'MBSTF') THEN + VAL = CBMSTF(6) + ELSEIF(FLAG5.EQ.'MCALF') THEN + VAL = UDSCBT(4) + ELSEIF(FLAG5.EQ.'MBALF') THEN + VAL = UDSCBT(5) + ELSEIF(FLAG5.EQ.'MTALF') THEN + VAL = UDSCBT(6) + ELSEIF(FLAG5.EQ.'ALFAS') THEN + VAL = ALPHA0 + ELSEIF(FLAG5.EQ.'ALFQ0') THEN + VAL = Q0ALFA + ELSEIF(FLAG5.EQ.'TCHRM') THEN + VAL = THRS34 + ELSEIF(FLAG5.EQ.'TBOTT') THEN + VAL = THRS45 + ELSEIF(FLAG5.EQ.'XMINC') THEN + VAL = XMICUT + ELSEIF(FLAG5.EQ.'QMINC') THEN + VAL = QMICUT + ELSEIF(FLAG5.EQ.'QMAXC') THEN + VAL = QMACUT + ELSEIF(FLAG5.EQ.'ROOTS') THEN + IF(RS2CUT.GE.0.) THEN + VAL = SQRT(RS2CUT) + ELSE + VAL = RS2CUT + ENDIF + ELSEIF(FLAG5.EQ.'QMINA') THEN + VAL = QMINAS + ELSE + IERR = 2 + GOTO 500 + ENDIF + +! ------ + ! + ELSE +! ------ + + IERR = 1 + GOTO 500 + +! ------- + ! + ENDIF +! ------- + + RETURN + + 500 CONTINUE + + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r QNRVAL ---> STOP'')') + WRITE(6,'( '' ------------------------------------'')') + WRITE(6,'( '' Input OPT : '',A )') OPT + WRITE(6,'( '' VAR : '',A )') FLAG + WRITE(6,'( '' VAL : '',E12.5)') RVAL + IF(IERR.EQ.1) THEN + WRITE(6,'(/'' OPT should be either SET or GET '')') + ELSEIF(IERR.EQ.2) THEN + WRITE(6,'(/'' Variable VAR not found'')') + ELSEIF(IERR.EQ.3) THEN + WRITE(6,'(/'' VAL should be .gt. 0 '')') + ENDIF + + CALL QTRACE('QNRVAL ',1) + + STOP + + END + +!DECK ID>, QNRSET. + +! ============================ + SUBROUTINE QNRSET(FLAG,RVAL) +! ============================ + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + CHARACTER*(*) FLAG + + CALL QTRACE('QNRSET ',0) + + CALL QNRVAL('SET',FLAG,RVAL) + + RETURN + END + +!DECK ID>, QNRGET. + +! ============================ + SUBROUTINE QNRGET(FLAG,RVAL) +! ============================ + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + CHARACTER*(*) FLAG + + CALL QTRACE('QNRGET ',0) + + CALL QNRVAL('GET',FLAG,RVAL) + + RETURN + END + +!DECK ID>, QNLVAL. + +! ================================ + SUBROUTINE QNLVAL(OPT,FLAG,LVAL) +! ================================ + +!--- QNLVAL: set/get logical variable. +!--- Called by user or internally by s/r QNLSET and QNLGET. +!--- Input parameters: 'OPT' = 'Set' or 'Get'. +!--- 'FLAG' = variable name to set or get. +!--- 'VAL' (logical) input or output variable. + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + CHARACTER*(*) OPT + CHARACTER*1 OPT1 + CHARACTER*(*) FLAG + CHARACTER*5 FLAG5 + LOGICAL LVAL + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + + + IF(LENOCC_LHA(OPT).LT.1) THEN + IERR = 1 + GOTO 500 + ENDIF + IF(LENOCC_LHA(FLAG).LT.5) THEN + IERR = 2 + GOTO 500 + ENDIF + OPT1 = OPT(1:1) + FLAG5 = FLAG(1:5) + CALL CLTOU_LHA(OPT1) + CALL CLTOU_LHA(FLAG5) + +! ---------------------- + ! + IF(OPT1.EQ.'S') THEN +! ---------------------- + + IF (FLAG5.EQ.'W1ANA' ) THEN + LW1ANA = LVAL + IF(LW1ANA) LW1NUM = .FALSE. + ELSEIF(FLAG5.EQ.'W1NUM' ) THEN + LW1NUM = LVAL + IF(LW1NUM) LW1ANA = .FALSE. + ELSEIF(FLAG5.EQ.'W2NUM' ) THEN + LW2NUM = LVAL + ELSEIF(FLAG5.EQ.'W2STF' ) THEN + LW2STF = LVAL + ELSEIF(FLAG5.EQ.'WTF2C' ) THEN + LWF2C = LVAL + ELSEIF(FLAG5.EQ.'WTFLC' ) THEN + LWFLC = LVAL + ELSEIF(FLAG5.EQ.'WTF2B' ) THEN + LWF2B = LVAL + ELSEIF(FLAG5.EQ.'WTFLB' ) THEN + LWFLB = LVAL + ELSEIF(FLAG5.EQ.'BMARK' ) THEN + LBMARK = LVAL + LALFOK = .FALSE. + ELSEIF(FLAG5.EQ.'LIMCK' ) THEN + LIMCK = LVAL + ELSEIF(FLAG5.EQ.'CLOWQ' ) THEN + LCLOWQ = LVAL + ELSEIF(FLAG5.EQ.'ASOLD' ) THEN + LASOLD = LVAL + LALFOK = .FALSE. + ELSE + IERR = 2 + GOTO 500 + ENDIF + +! -------------------------- + ! + ELSEIF(OPT1.EQ.'G') THEN +! -------------------------- + + IF (FLAG5.EQ.'W1ANA' ) THEN + LVAL = LW1ANA + ELSEIF(FLAG5.EQ.'W1NUM' ) THEN + LVAL = LW1NUM + ELSEIF(FLAG5.EQ.'W2NUM' ) THEN + LVAL = LW2NUM + ELSEIF(FLAG5.EQ.'W2STF' ) THEN + LVAL = LW2STF + ELSEIF(FLAG5.EQ.'WTF2C' ) THEN + LVAL = LWF2C + ELSEIF(FLAG5.EQ.'WTFLC' ) THEN + LVAL = LWFLC + ELSEIF(FLAG5.EQ.'WTF2B' ) THEN + LVAL = LWF2B + ELSEIF(FLAG5.EQ.'WTFLB' ) THEN + LVAL = LWFLB + ELSEIF(FLAG5.EQ.'BMARK' ) THEN + LVAL = LBMARK + ELSEIF(FLAG5.EQ.'LIMCK' ) THEN + LVAL = LIMCK + ELSEIF(FLAG5.EQ.'CLOWQ' ) THEN + LVAL = LCLOWQ + ELSEIF(FLAG5.EQ.'ASOLD' ) THEN + LVAL = LASOLD + ELSE + IERR = 2 + GOTO 500 + ENDIF + +! ------ + ! + ELSE +! ------ + + IERR = 1 + GOTO 500 + +! ------- + ! + ENDIF +! ------- + + RETURN + + 500 CONTINUE + + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r QNLVAL ---> STOP'')') + WRITE(6,'( '' ------------------------------------'')') + WRITE(6,'( '' Input OPT : '',A )') OPT + WRITE(6,'( '' VAR : '',A )') FLAG + WRITE(6,'( '' VAL : '',L2 )') LVAL + IF(IERR.EQ.1) THEN + WRITE(6,'(/'' OPT should be either SET or GET '')') + ELSEIF(IERR.EQ.2) THEN + WRITE(6,'(/'' Variable VAR not found'')') + ENDIF + + CALL QTRACE('QNLVAL ',1) + + STOP + + END + +!DECK ID>, QNLSET. + +! ============================ + SUBROUTINE QNLSET(FLAG,LVAL) +! ============================ + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + CHARACTER*(*) FLAG + LOGICAL LVAL + + CALL QTRACE('QNLSET ',0) + + CALL QNLVAL('SET',FLAG,LVAL) + + RETURN + END + +!DECK ID>, QNLGET. + +! ============================ + SUBROUTINE QNLGET(FLAG,LVAL) +! ============================ + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + CHARACTER*(*) FLAG + LOGICAL LVAL + + CALL QTRACE('QNLGET ',0) + + CALL QNLVAL('GET',FLAG,LVAL) + + RETURN + END + +!DECK ID>, GRMXMQ. + +! ============================ + SUBROUTINE GRMXMQ(NXMA,NQMA) +! ============================ + +!--- GRMXMQ: return max allowed number of x, Q2 gridpoints. +!--- Called by user. +!--- MXX and MQ2 are set by parameter statement in common QCNXQM. + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + CALL QTRACE('GRMXMQ ',0) + + NXMA = MXX-1 + NQMA = MQ2-1 + + RETURN + END + +!DECK ID>, GRGIVE. + +! ======================================== + SUBROUTINE GRGIVE(NX,XMI,XMA,NQ,QMI,QMA) +! ======================================== + +!--- GRGIVE: return current grid definition. +!--- Called by user. +!--- Output variables: NX (integer) number of x gridpoints. +!--- XMI (real or d.p.) lowest x value. +!--- XMA (real or d.p.) highest x value = 1. +!--- NQ (integer) number of Q2 gridpoints. +!--- QMI (real or d.p.) lowest Q2 value. +!--- QMA (real or d.p.) highest Q2 value. + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + CALL QTRACE('GRGIVE ',0) + + NX = NXX + XMI = XXTAB(1) + XMA = XXTAB(NXX+1) + NQ = NQ2 + QMI = Q2TAB(1) + QMA = Q2TAB(NQ2) + + RETURN + END + +!DECK ID>, GRXNUL. + +! ================= + SUBROUTINE GRXNUL +! ================= + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + CALL QTRACE('GRXNUL ',0) + +!--- Invalidate weight tables (validated by call to QNFILW) + LWT1OK = .FALSE. + LWT2OK = .FALSE. + LWTFOK = .FALSE. + LWFCOK = .FALSE. + LWLCOK = .FALSE. + LWFBOK = .FALSE. + LWLBOK = .FALSE. + LMARK = .FALSE. +!-- Invalidate all evolutions + CALL QNFALS(LEVDONE,MXX*10) + +!--- Set grid to zero + CALL QNVNUL(XXTAB,MXX) + CALL QNVNUL(XHTAB,MXX) + CALL QNINUL(IHTAB,MXX) + NXX = 0 + NGRVER = 0 + +!--- Update IFAILC + CALL GRSETC + +!--- Update NFMAP + CALL QNSETT + + + RETURN + END + +!DECK ID>, GRXINP. + +! ============================ + SUBROUTINE GRXINP(XARRAY,NX) +! ============================ + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + DIMENSION XARRAY(*) + + DATA EPSI /1.E-6/ + + CALL QTRACE('GRXINP ',0) + + IF(NX.LE.0) THEN + IERR = 1 + GOTO 500 + ENDIF + + IF((NX+NXX).GT.MXX-1) THEN + IERR = 2 + GOTO 500 + ENDIF + +!--- Invalidate weight tables (validated by call to QNFILW) + LWT1OK = .FALSE. + LWT2OK = .FALSE. + LWTFOK = .FALSE. + LWFCOK = .FALSE. + LWLCOK = .FALSE. + LWFBOK = .FALSE. + LWLBOK = .FALSE. + LMARK = .FALSE. +!-- Invalidate all evolutions + CALL QNFALS(LEVDONE,MXX*10) + +!--- if this number changes, QCDNUM knows that the grid has changed + NGRVER = NGRVER + 1 + + IF(NXX.EQ.0) THEN + DO 10 IX = 1,NX + X = XARRAY(IX) + IF(X.LE.0..OR.X.GT.1.) THEN + IERR = 3 + GOTO 500 + ENDIF + NXX = NXX+1 + XXTAB(IX) = X + 10 CONTINUE + IF(XXTAB(NXX).EQ.1.) THEN + NXX = NXX-1 + ELSE + XXTAB(NXX+1) = 1. + ENDIF + RETURN + ENDIF + + IF(XXTAB(NXX).EQ.1.) THEN + NXX = NXX-1 + ELSE + XXTAB(NXX+1) = 1. + ENDIF + + NXP = NXX+1 + + DO 100 IX = 1,NX + + X = XARRAY(IX) + + IF(X.LE.0..OR.X.GT.1.) THEN + IERR = 3 + GOTO 500 + ENDIF + +!mb IF(X.LT.XXTAB(1)-EPSI) THEN + IF(X/XXTAB(1).LT.1.-EPSI) THEN + + DO 20 JX = NXP,1,-1 + XXTAB(JX+1) = XXTAB(JX) + 20 CONTINUE + NXP = NXP+1 + XXTAB(1) = X + +!mb ELSEIF(X.GT.XXTAB(NXP)+EPSI) THEN + ELSEIF(X/XXTAB(NXP).GT.1.+EPSI) THEN + + NXP = NXP+1 + XXTAB(NXP) = X + + ELSE + + DO 30 I = 1,NXP +!mb IF(XXTAB(I).LE.X+EPSI) IX0 = I + IF(XXTAB(I)/X.LE.1.+EPSI) IX0 = I + 30 CONTINUE + +!mb IF(ABS(XXTAB(IX0)-X).LE.EPSI) THEN + IF(ABS(XXTAB(IX0)/X-1.).LE.EPSI) THEN + XXTAB(IX0) = X + ELSE + DO 40 JX = NXP,IX0+1,-1 + XXTAB(JX+1) = XXTAB(JX) + 40 CONTINUE + NXP = NXP+1 + XXTAB(IX0+1) = X + ENDIF + + ENDIF + + 100 END DO + + IF(XXTAB(NXP).EQ.1.) THEN + NXX = NXP-1 + ELSE + NXX = NXP + XXTAB(NXX+1) = 1. + ENDIF + +!--- Update IFAILC + CALL GRSETC + +!--- Update NFMAP + CALL QNSETT + +!--- Update heavy quark xgrid + CALL GXHDEF + + RETURN + + 500 CONTINUE + + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r GRXINP ---> STOP'')') + WRITE(6,'( '' ------------------------------------'')') + WRITE(6,'( '' Input X :'',E12.5)') X + WRITE(6,'( '' NX :'',I5 )') NX + IF(IERR.EQ.1) THEN + WRITE(6,'(/'' NX must be .ge. 1'')') + ELSEIF(IERR.EQ.2) THEN + WRITE(6,'(/'' Maximum number of gridpoints exceeded '')') + WRITE(6,'(/'' # existing x gridpoints ='',I5/ & + & '' # points to be added ='',I5/ & + & '' maximum # points allowed ='',I5)') & + & NXX, NX, MXX-1 + ELSEIF(IERR.EQ.3) THEN + WRITE(6,'(/'' Value of X outside allowed range (0,1]'')') + ENDIF + + CALL QTRACE('GRXINP ',1) + + STOP + + END + +!DECK ID>, GRXDEF. + +! ========================== + SUBROUTINE GRXDEF(NX,XMIN) +! ========================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + CALL QTRACE('GRXDEF ',0) + + IF(NX.LE.0) THEN + IERR = 1 + GOTO 500 + ENDIF + + IF(NX.GT.MXX-1) THEN + IERR = 2 + GOTO 500 + ENDIF + + IF(XMIN.LE.0.OR.XMIN.GE.1.) THEN + IERR = 3 + GOTO 500 + ENDIF + +!--- Invalidate weight tables (validated by call to QNFILW) + LWT1OK = .FALSE. + LWT2OK = .FALSE. + LWTFOK = .FALSE. + LWFCOK = .FALSE. + LWLCOK = .FALSE. + LWFBOK = .FALSE. + LWLBOK = .FALSE. + LMARK = .FALSE. +!-- Invalidate all evolutions + CALL QNFALS(LEVDONE,MXX*10) + +!--- if this number changes, QCDNUM knows that the grid has changed + NGRVER = NGRVER + 1 + + XMAX = 1. + YMIN = SYFROMX(XMIN) + YMAX = SYFROMX(XMAX) + BW = (YMAX-YMIN)/NX + DO I = 1,NX + YI = YMIN+(I-1)*BW + XXTAB(I) = SXFROMY(YI) + ENDDO + XXTAB(1) = XMIN + XXTAB(NX+1) = 1. + NXX = NX + +!--- Update IFAILC + CALL GRSETC + +!--- Update NFMAP + CALL QNSETT + +!--- Update heavy quark xgrid + CALL GXHDEF + + RETURN + + 500 CONTINUE + + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r GRXDEF ---> STOP'')') + WRITE(6,'( '' ------------------------------------'')') + WRITE(6,'( '' Input NX :'',I5 )') NX + WRITE(6,'( '' Xmin :'',E12.5)') XMIN + IF(IERR.EQ.1) THEN + WRITE(6,'(/'' NX must be .ge. 1'')') + ELSEIF(IERR.EQ.2) THEN + WRITE(6,'(/'' NX > max number of gridpoints'', & + & '' allowed:'',I5)') MXX-1 + ELSEIF(IERR.EQ.3) THEN + WRITE(6,'(/'' Xmin outside allowed range (0,1]'')') + ENDIF + + CALL QTRACE('GRXDEF ',1) + + STOP + + END + +!DECK ID>, GRXLIM. + +! ========================== + SUBROUTINE GRXLIM(NX,XMIN) +! ========================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + DATA EPSI / 1.E-6 / + + CALL QTRACE('GRXLIM ',0) + + IF(NX.LE.0) THEN + IERR = 1 + GOTO 500 + ENDIF + + IF(NX.GT.MXX-1) THEN + IERR = 2 + GOTO 500 + ENDIF + +!--- Invalidate weight tables (validated by call to QNFILW) + LWT1OK = .FALSE. + LWT2OK = .FALSE. + LWTFOK = .FALSE. + LWFCOK = .FALSE. + LWLCOK = .FALSE. + LWFBOK = .FALSE. + LWLBOK = .FALSE. + LMARK = .FALSE. +!-- Invalidate all evolutions + CALL QNFALS(LEVDONE,MXX*10) + + IF(XMIN.LE.0.OR.XMIN.GE.1.) THEN + IERR = 3 + GOTO 500 + ENDIF + +!--- if this number changes, QCDNUM knows that the grid has changed + NGRVER = NGRVER + 1 + + IF(NXX.EQ.0) THEN + XXTAB(1) = 1. + ELSEIF(XXTAB(NXX).EQ.1.) THEN + NXX = NXX-1 + ELSE + XXTAB(NXX+1) = 1. + ENDIF + + NXP = NXX+1 + +!mb IF(XMIN.LT.XXTAB(1)-EPSI) THEN + IF(XMIN/XXTAB(1).LT.1.-EPSI) THEN + DO 20 IX = NXP,1,-1 + XXTAB(IX+1) = XXTAB(IX) + 20 CONTINUE + NXP = NXP+1 + XXTAB(1) = XMIN + ENDIF + + IF(NX.GT.NXP-1) THEN + 30 CONTINUE + GAPMAX = 0. + DO 35 IX = 1,NXP-1 + GAP = SYFROMX(XXTAB(IX+1))-SYFROMX(XXTAB(IX)) + IF(GAP.GT.GAPMAX) THEN + GAPMAX = GAP + IX0 = IX + ENDIF + 35 CONTINUE + DO 40 IX = NXP,IX0+1,-1 + XXTAB(IX+1) = XXTAB(IX) + 40 CONTINUE + NXP = NXP+1 + XXTAB(IX0+1) = 0.5*(XXTAB(IX0)+XXTAB(IX0+2)) + IF(NXP-1.LT.NX) GOTO 30 + + ELSEIF(NX.LT.NXP-1) THEN + 50 CONTINUE + GAPMIN = 999999. + DO 55 IX = 2,NXP-1 + GAP = SYFROMX(XXTAB(IX+1))-SYFROMX(XXTAB(IX-1)) + IF(GAP.LE.GAPMIN) THEN + GAPMIN = GAP + IX0 = IX + ENDIF + 55 CONTINUE + DO 60 IX = IX0,NXP-1 + XXTAB(IX) = XXTAB(IX+1) + 60 CONTINUE + XXTAB(NXP) = 0. + NXP = NXP-1 + IF(NXP-1.GT.NX) GOTO 50 + ENDIF + + IF(XXTAB(NXP).EQ.1.) THEN + NXX = NXP-1 + ELSE + NXX = NXP + XXTAB(NXX+1) = 1. + ENDIF + +!--- Update IFAILC + CALL GRSETC + +!--- Update NFMAP + CALL QNSETT + +!--- Update heavy quark xgrid + CALL GXHDEF + + RETURN + + 500 CONTINUE + + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r GRXLIM ---> STOP'')') + WRITE(6,'( '' ------------------------------------'')') + WRITE(6,'( '' Input NX :'',I5 )') NX + WRITE(6,'( '' Xmin :'',E12.5)') XMIN + IF(IERR.EQ.1) THEN + WRITE(6,'(/'' NX must be .ge. 1'')') + ELSEIF(IERR.EQ.2) THEN + WRITE(6,'(/'' NX > max number of gridpoints'', & + & '' allowed:'',I5)') MXX-1 + ELSEIF(IERR.EQ.3) THEN + WRITE(6,'(/'' Xmin outside allowed range (0,1]'')') + ENDIF + + CALL QTRACE('GRXLIM ',1) + + STOP + + END + +!DECK ID>, GXHDEF. + +! ================= + SUBROUTINE GXHDEF +! ================= + +!-- Create a purely logarithmic grid in x (XHTAB) for use +!-- in the heavy quark structure function calculations. + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + IF(NXX.EQ.0.OR.NXX.GE.MXX) RETURN + IF(XXTAB(1).LE.0..OR.XXTAB(1).GE.1.) RETURN + + XL1 = LOG(XXTAB(1)) + XL2 = 0. + BW = (XL2-XL1)/NXX + + DO IX = 1,NXX + XL = XL1 + (IX-1)*BW + XHTAB(IX) = EXP(XL) + IHTAB(IX) = ABS(IXFROMX(XHTAB(IX))) + ENDDO + XHTAB(NXX+1) = 1. + IHTAB(NXX+1) = NXX+1 + + RETURN + END + + +!DECK ID>, SYFROMX. + +! ==================================== + DOUBLE PRECISION FUNCTION SYFROMX(X) +! ==================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + IF(X.LE.SCAX0) THEN + SYFROMX = LOG(X) + ELSE + SYFROMX = LOG(SCAX0) + (X-SCAX0)/SCAX0 + ENDIF + + RETURN + END + +!DECK ID>, SXFROMY. + +! ==================================== + DOUBLE PRECISION FUNCTION SXFROMY(Y) +! ==================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + IF(Y.LE.LOG(SCAX0)) THEN + SXFROMY = EXP(Y) + ELSE + SXFROMY = (Y-LOG(SCAX0)+1.) * SCAX0 + ENDIF + + RETURN + END + +!DECK ID>, GRXOUT. + +! ========================= + SUBROUTINE GRXOUT(XARRAY) +! ========================= + +!--- Copy XXTAB to XARRAY which should have been dimensioned +!--- to at least NXX+1 by the user. + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + DIMENSION XARRAY(*) + + CALL QTRACE('GRXOUT ',0) + + DO 10 IX = 1,NXX+1 + XARRAY(IX) = XXTAB(IX) + 10 END DO + + RETURN + END + +!DECK ID>, LOGXGR. + +! =============================== + LOGICAL FUNCTION LOGXGR(IDUMMY) +! =============================== + +!--- Figure out if xgrid is purely logarithmic + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + REAL RAT1,RAT + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + LOGXGR = .FALSE. + + IF(NXX.LE.0) RETURN + + RAT1 = XXTAB(2)/XXTAB(1) + LOGXGR = .TRUE. + DO IX = 1,NXX + RAT = XXTAB(IX+1)/XXTAB(IX) + IF(RAT.NE.RAT1) LOGXGR = .FALSE. + ENDDO + + RETURN + END + +!DECK ID>, GRQNUL. + +! ================= + SUBROUTINE GRQNUL +! ================= + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + CALL QTRACE('GRQNUL ',0) + +!--- Invalidate weight tables (validated by call to QNFILW) + LALFOK = .FALSE. + LDQ2OK = .FALSE. + LWFCOK = .FALSE. + LWLCOK = .FALSE. + LWFBOK = .FALSE. + LWLBOK = .FALSE. + LMARK = .FALSE. +!-- Invalidate all evolutions + CALL QNFALS(LEVDONE,MXX*10) + +!--- Set grid to zero + CALL QNVNUL(Q2TAB,MQ2) + NQ2 = 0 + NGRVER = 0 + +!--- Update IFAILC + CALL GRSETC + +!--- Update NFMAP + CALL QNSETT + + + RETURN + END + +!DECK ID>, GRQINP. +! +! ============================ + SUBROUTINE GRQINP(QARRAY,NQ) +! ============================ + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + DIMENSION QARRAY(*) + + DATA EPSI /1.E-6/ + + CALL QTRACE('GRQINP ',0) + + IF(NQ.LE.0) THEN + IERR = 1 + GOTO 500 + ENDIF + + IF((NQ+NQ2).GT.MQ2-1) THEN + IERR = 2 + GOTO 500 + ENDIF + +!--- Invalidate weight tables (validated by call to QNFILW) + LALFOK = .FALSE. + LDQ2OK = .FALSE. + LWFCOK = .FALSE. + LWLCOK = .FALSE. + LWFBOK = .FALSE. + LWLBOK = .FALSE. + LMARK = .FALSE. +!-- Invalidate all evolutions + CALL QNFALS(LEVDONE,MXX*10) + +!--- if this number changes, QCDNUM knows that the grid has changed + NGRVER = NGRVER + 1 + + IF(NQ2.EQ.0) THEN + DO 10 IQ = 1,NQ + Q = QARRAY(IQ) + IF(Q.LE.0.) THEN + IERR = 3 + GOTO 500 + ENDIF + NQ2 = NQ2+1 + Q2TAB(IQ) = Q + 10 CONTINUE + RETURN + ENDIF + + DO 100 IQ = 1,NQ + + Q = QARRAY(IQ) + + IF(Q.LE.0.) THEN + IERR = 3 + GOTO 500 + ENDIF + +!mb IF(Q.LT.Q2TAB(1)-EPSI) THEN + IF(Q/Q2TAB(1).LT.1.-EPSI) THEN + + DO 20 JQ = NQ2,1,-1 + Q2TAB(JQ+1) = Q2TAB(JQ) + 20 CONTINUE + NQ2 = NQ2+1 + Q2TAB(1) = Q + +!mb ELSEIF(Q.GT.Q2TAB(NQ2)+EPSI) THEN + ELSEIF(Q/Q2TAB(NQ2).GT.1.+EPSI) THEN + + NQ2 = NQ2+1 + Q2TAB(NQ2) = Q + + ELSE + + DO 30 I = 1,NQ2 +!mb IF(Q2TAB(I).LE.Q+EPSI) IQ0 = I + IF(Q2TAB(I)/Q.LE.1.+EPSI) IQ0 = I + 30 CONTINUE + +!mb IF(ABS(Q2TAB(IQ0)-Q).LE.EPSI) THEN + IF(ABS(Q2TAB(IQ0)/Q-1.).LE.EPSI) THEN + Q2TAB(IQ0) = Q + ELSE + DO 40 JQ = NQ2,IQ0+1,-1 + Q2TAB(JQ+1) = Q2TAB(JQ) + 40 CONTINUE + NQ2 = NQ2+1 + Q2TAB(IQ0+1) = Q + ENDIF + + ENDIF + + 100 END DO + +!--- Update IFAILC + CALL GRSETC + +!--- Update NFMAP + CALL QNSETT + + RETURN + + 500 CONTINUE + + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r GRQINP ---> STOP'')') + WRITE(6,'( '' ------------------------------------'')') + WRITE(6,'( '' Input Q2 :'',E12.5)') Q + WRITE(6,'( '' NQ :'',I5 )') NQ + IF(IERR.EQ.1) THEN + WRITE(6,'(/'' NQ must be .ge. 1'')') + ELSEIF(IERR.EQ.2) THEN + WRITE(6,'(/'' Maximum number of gridpoints exceeded '')') + WRITE(6,'(/'' # existing Q2 gridpoints ='',I5/ & + & '' # points to be added ='',I5/ & + & '' maximum # points allowed ='',I5)') & + & NQ2, NQ, MQ2-1 + ELSEIF(IERR.EQ.3) THEN + WRITE(6,'(/'' Value of Q2 outside allowed range > 0'')') + ENDIF + + CALL QTRACE('GRQINP ',1) + + STOP + + END + +!DECK ID>, GRQDEF. + +! =============================== + SUBROUTINE GRQDEF(NQ,QMIN,QMAX) +! =============================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + CALL QTRACE('GRQDEF ',0) + + IF(NQ.LE.1) THEN + IERR = 1 + GOTO 500 + ENDIF + + IF(NQ.GT.MQ2-1) THEN + IERR = 2 + GOTO 500 + ENDIF + + IF(QMIN.LE.0.OR.QMAX.LE.0.OR.QMIN.GE.QMAX) THEN + IERR = 3 + GOTO 500 + ENDIF + +!--- Invalidate weight tables (validated by call to QNFILW) + LALFOK = .FALSE. + LDQ2OK = .FALSE. + LWFCOK = .FALSE. + LWLCOK = .FALSE. + LWFBOK = .FALSE. + LWLBOK = .FALSE. + LMARK = .FALSE. +!-- Invalidate all evolutions + CALL QNFALS(LEVDONE,MXX*10) + +!--- if this number changes, QCDNUM knows that the grid has changed + NGRVER = NGRVER + 1 + + YMIN = SYFROMQ(QMIN) + YMAX = SYFROMQ(QMAX) + BW = (YMAX-YMIN)/(NQ-1) + DO I = 1,NQ + YI = YMIN+(I-1)*BW + Q2TAB(I) = SQFROMY(YI) + ENDDO + Q2TAB(1) = QMIN + Q2TAB(NQ) = QMAX + NQ2 = NQ + +!--- Update IFAILC + CALL GRSETC + +!--- Update NFMAP + CALL QNSETT + + RETURN + + 500 CONTINUE + + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r GRQDEF ---> STOP'')') + WRITE(6,'( '' ------------------------------------'')') + WRITE(6,'( '' Input NQ :'',I5 )') NQ + WRITE(6,'( '' Q2min :'',E12.5)') QMIN + WRITE(6,'( '' Q2max :'',E12.5)') QMAX + IF(IERR.EQ.1) THEN + WRITE(6,'(/'' NQ must be .ge. 2'')') + ELSEIF(IERR.EQ.2) THEN + WRITE(6,'(/'' NQ > max number of gridpoints'', & + & '' allowed:'',I5)') MQ2-1 + ELSEIF(IERR.EQ.3) THEN + WRITE(6,'(/'' Qmin and/or Qmax .le. 0 or Qmin .ge. Qmax'')') + ENDIF + + CALL QTRACE('GRQDEF ',1) + + STOP + + END + +!DECK ID>, GRQLIM. + +! =============================== + SUBROUTINE GRQLIM(NQ,QMIN,QMAX) +! =============================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + DATA EPSI /1.E-6/ + + CALL QTRACE('GRQLIM ',0) + + IF(NQ.LE.0) THEN + IERR = 1 + GOTO 500 + ENDIF + + IF(NQ.GT.MQ2-1) THEN + IERR = 2 + GOTO 500 + ENDIF + +!--- Invalidate weight tables (validated by call to QNFILW) + LALFOK = .FALSE. + LDQ2OK = .FALSE. + LWFCOK = .FALSE. + LWLCOK = .FALSE. + LWFBOK = .FALSE. + LWLBOK = .FALSE. + LMARK = .FALSE. +!-- Invalidate all evolutions + CALL QNFALS(LEVDONE,MXX*10) + +!--- if this number changes, QCDNUM knows that the grid has changed + NGRVER = NGRVER + 1 + + IF(NQ2.EQ.0) THEN + + IF(QMIN.LE.0..OR.QMAX.LE.0..OR.QMIN.GE.QMAX) THEN + IERR = 3 + GOTO 500 + ENDIF + + CALL GRQDEF(NQ,QMI,QMA) + + ELSE + + IF(QMIN.LE.0..OR.QMAX.LE.0..OR.QMIN.GE.QMAX) THEN + IERR = 3 + GOTO 500 + ENDIF + +!mb IF(QMIN.LT.Q2TAB(1)-EPSI) THEN + IF(QMIN/Q2TAB(1).LT.1.-EPSI) THEN + DO 20 IQ = NQ2,1,-1 + Q2TAB(IQ+1) = Q2TAB(IQ) + 20 CONTINUE + NQ2 = NQ2+1 + Q2TAB(1) = QMIN + ENDIF +!mb IF(QMAX.GT.Q2TAB(NQ2)+EPSI) THEN + IF(QMAX/Q2TAB(NQ2).GT.1.+EPSI) THEN + NQ2 = NQ2+1 + Q2TAB(NQ2) = QMAX + ENDIF + + IF(NQ.GT.NQ2) THEN + 30 CONTINUE + GAPMAX = 0. + DO 35 IQ = 1,NQ2-1 + GAP = SYFROMQ(Q2TAB(IQ+1))-SYFROMQ(Q2TAB(IQ)) + IF(GAP.GT.GAPMAX) THEN + GAPMAX = GAP + IQ0 = IQ + ENDIF + 35 CONTINUE + DO 40 IQ = NQ2,IQ0+1,-1 + Q2TAB(IQ+1) = Q2TAB(IQ) + 40 CONTINUE + NQ2 = NQ2+1 + Q2TAB(IQ0+1) = SQRT(Q2TAB(IQ0)*Q2TAB(IQ0+2)) + IF(NQ2.LT.NQ) GOTO 30 + + ELSEIF(NQ.LT.NQ2) THEN + 50 CONTINUE + GAPMIN = 999999. + DO 55 IQ = 2,NQ2-1 + GAP = SYFROMQ(Q2TAB(IQ+1))-SYFROMQ(Q2TAB(IQ-1)) + IF(GAP.LE.GAPMIN) THEN + GAPMIN = GAP + IQ0 = IQ + ENDIF + 55 CONTINUE + DO 60 IQ = IQ0,NQ2-1 + Q2TAB(IQ) = Q2TAB(IQ+1) + 60 CONTINUE + Q2TAB(NQ2) = 0. + NQ2 = NQ2-1 + IF(NQ2.GT.NQ) GOTO 50 + ENDIF + + ENDIF + +!--- Update IFAILC + CALL GRSETC + +!--- Update NFMAP + CALL QNSETT + + RETURN + + 500 CONTINUE + + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r GRQLIM ---> STOP'')') + WRITE(6,'( '' ------------------------------------'')') + WRITE(6,'( '' Input NQ :'',I5 )') NQ + WRITE(6,'( '' Q2min :'',E12.5)') QMIN + WRITE(6,'( '' Q2max :'',E12.5)') QMAX + IF(IERR.EQ.1) THEN + WRITE(6,'(/'' NQ must be .ge. 1'')') + ELSEIF(IERR.EQ.2) THEN + WRITE(6,'(/'' NQ > max number of gridpoints'', & + & '' allowed:'',I5)') MQ2-1 + ELSEIF(IERR.EQ.3) THEN + WRITE(6,'(/'' Qmin and/or Qmax .le. 0 or Qmin .ge. Qmax'')') + ENDIF + + CALL QTRACE('GRQLIM ',1) + + STOP + + END + +!DECK ID>, SYFROMQ. + +! ==================================== + DOUBLE PRECISION FUNCTION SYFROMQ(Q) +! ==================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + IF(Q.LE.SCAQ0) THEN + SYFROMQ = LOG(Q) + ELSE + SYFROMQ = LOG(SCAQ0) + (Q-SCAQ0)/SCAQ0 + ENDIF + + RETURN + END + +!DECK ID>, SQFROMY. + +! ==================================== + DOUBLE PRECISION FUNCTION SQFROMY(Y) +! ==================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + IF(Y.LE.LOG(SCAQ0)) THEN + SQFROMY = EXP(Y) + ELSE + SQFROMY = (Y-LOG(SCAQ0)+1.) * SCAQ0 + ENDIF + + RETURN + END + + +!DECK ID>, GRQOUT. + +! ========================= + SUBROUTINE GRQOUT(QARRAY) +! ========================= + +!--- Copy Q2TAB to QARRAY which should have been dimensioned +!--- to at least NQ2 by the user. + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + DIMENSION QARRAY(*) + + CALL QTRACE('GRQOUT ',0) + + DO 10 IQ = 1,NQ2 + QARRAY(IQ) = Q2TAB(IQ) + 10 END DO + + RETURN + END + +!DECK ID>, IXFROMX. + +! =========================== + INTEGER FUNCTION IXFROMX(X) +! =========================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +!--- Returns gridindex IX given a value for X. +!--- If X is outside the current gridboundary then IXFROMX = 0. +!--- If X corresponds to gridindex IX then IXFROMX = IX. +!--- If X lies above IX and below IX+1 then IXFROMX = -IX. + +!--- NB: X and XXTAB are different only if |X-XXTAB| < epsi. +!--- NB: If since the previous call the grid did not change +!--- (i.e. NGRVER is the same) and if X did not change, then +!--- IXFROMX just returns the result of the previous call. + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + SAVE XLAST,IXLAST,NGLAST + + DATA XLAST / 0. / + DATA IXLAST / 0 / + DATA NGLAST / 0 / + DATA EPSI /1.E-6/ + +! CALL QTRACE('IXFROMX',0) + + IF(X.EQ.XLAST.AND.NGRVER.EQ.NGLAST) THEN + IXFROMX = IXLAST + RETURN + ENDIF + + IX = 0 + IXLAST = 0 + NGLAST = NGRVER + XLAST = X + IXFROMX = 0 + + IF(X.GT.1..OR.NXX.LE.0) RETURN + IF(X/XXTAB(1).LT.1.-EPSI) RETURN + + DO 10 I = 1,NXX +!mb IF(XXTAB(I).LE.X+EPSI) IX = I + IF(XXTAB(I)/X.LE.1.+EPSI) IX = I + 10 END DO + +!mb IF(ABS(XXTAB(IX)-X).LE.EPSI) THEN + IF(ABS(XXTAB(IX)/X-1.).LE.EPSI) THEN + IXFROMX = IX + IXLAST = IX + ELSE + IXFROMX = -IX + IXLAST = -IX + ENDIF + + RETURN + END + +!------------------------------------------------ + +!- REAL XR,X1,X2,XLAST +!- +!-+SEQ,QCNXQM. +!-+SEQ,QCGRID. +!- +!- SAVE XLAST,IXLAST,NGLAST +!- +!- DATA XLAST / 0. / +!- DATA IXLAST / 0 / +!- DATA NGLAST / 0 / +!- +!-* CALL QTRACE('IXFROMX',0) +!- +!- XR = X +!- IF(XR.EQ.XLAST.AND.NGRVER.EQ.NGLAST) THEN +!- IXFROMX = IXLAST +!- RETURN +!- ENDIF +!- +!- IX = 0 +!- IXLAST = 0 +!- NGLAST = NGRVER +!- XLAST = X +!- IXFROMX = 0 +!- +!- IF(XR.GT.1..OR.NXX.LE.0) RETURN +!- X1 = XXTAB(1) +!- IF(XR.LT.X1) RETURN +!- +!- DO IX = 1,NXX +!- X2 = XXTAB(IX+1) +!- IF(X1.LE.XR.AND.XR.LT.X2) THEN +!- IXFROMX = -IX +!- IF(X1.EQ.XR) IXFROMX = IX +!- IXLAST = IX +!- RETURN +!- ENDIF +!- X1 = X2 +!- ENDDO +!- +!- RETURN +!- END + +!DECK ID>, IHFROMH. + +! =========================== + INTEGER FUNCTION IHFROMH(X) +! =========================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +!--- Returns gridindex IX of heavy quark grid given a value for X. +!--- If X is outside the current gridboundary then IHFROMH = 0. +!--- If X corresponds to gridindex IX then IHFROMH = IX. +!--- If X lies above IX and below IX+1 then IHFROMH = -IX. + +!--- NB: X and XHTAB are different only if |X-XHTAB| < epsi. +!--- NB: If since the previous call the grid did not change +!--- (i.e. NGRVER is the same) and if X did not change, then +!--- IHFROMH just returns the result of the previous call. + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + SAVE XLAST,IXLAST,NGLAST + + DATA XLAST / 0. / + DATA IXLAST / 0 / + DATA NGLAST / 0 / + DATA EPSI /1.E-6/ + +! CALL QTRACE('IHFROMH',0) + + IF(X.EQ.XLAST.AND.NGRVER.EQ.NGLAST) THEN + IHFROMH = IXLAST + RETURN + ENDIF + + IX = 0 + IXLAST = 0 + NGLAST = NGRVER + XLAST = X + IHFROMH = 0 + + IF(X.GT.1..OR.NXX.LE.0) RETURN + IF(X/XHTAB(1).LT.1.-EPSI) RETURN + + DO 10 I = 1,NXX +!mb IF(XHTAB(I).LE.X+EPSI) IX = I + IF(XHTAB(I)/X.LE.1.+EPSI) IX = I + 10 END DO + +!mb IF(ABS(XHTAB(IX)-X).LE.EPSI) THEN + IF(ABS(XHTAB(IX)/X-1.).LE.EPSI) THEN + IHFROMH = IX + IXLAST = IX + ELSE + IHFROMH = -IX + IXLAST = -IX + ENDIF + + RETURN + END + +!------------------------------------------------ + +!- REAL XR,X1,X2,XLAST +!- +!-+SEQ,QCNXQM. +!-+SEQ,QCGRID. +!- +!- SAVE XLAST,IXLAST,NGLAST +!- +!- DATA XLAST / 0. / +!- DATA IXLAST / 0 / +!- DATA NGLAST / 0 / +!- +!-* CALL QTRACE('IXFROMX',0) +!- +!- XR = X +!- IF(XR.EQ.XLAST.AND.NGRVER.EQ.NGLAST) THEN +!- IXFROMX = IXLAST +!- RETURN +!- ENDIF +!- +!- IX = 0 +!- IXLAST = 0 +!- NGLAST = NGRVER +!- XLAST = X +!- IXFROMX = 0 +!- +!- IF(XR.GT.1..OR.NXX.LE.0) RETURN +!- X1 = XHTAB(1) +!- IF(XR.LT.X1) RETURN +!- +!- DO IX = 1,NXX +!- X2 = XHTAB(IX+1) +!- IF(X1.LE.XR.AND.XR.LT.X2) THEN +!- IXFROMX = -IX +!- IF(X1.EQ.XR) IXFROMX = IX +!- IXLAST = IX +!- RETURN +!- ENDIF +!- X1 = X2 +!- ENDDO +!- +!- RETURN +!- END + +!DECK ID>, IXNEARX. + +! =========================== + INTEGER FUNCTION IXNEARX(X) +! =========================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +!--- Returns closest gridindex IX given a value for X. +!--- If X is outside the current gridboundary then IXNEARX = 0. +!--- If X corresponds to gridindex IX then IXNEARX = IX. +!--- If X lies above IX and below IX+1 then IXNEARX = -IX or -IX-1. + +!--- NB: X and XXTAB are different only if |X-XXTAB| < epsi. +!--- NB: If since the previous call the grid did not change +!--- (i.e. NGRVER is the same) and if X did not change, then +!--- IXNEARX just returns the result of the previous call. + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + SAVE XLAST,IXLAST,NGLAST + + DATA XLAST / 0. / + DATA IXLAST / 0 / + DATA NGLAST / 0 / + DATA EPSI /1.E-6/ + +! CALL QTRACE('IXNEARX',0) + + IF(X.EQ.XLAST.AND.NGRVER.EQ.NGLAST) THEN + IXNEARX = IXLAST + RETURN + ENDIF + + IX = 0 + IXLAST = 0 + NGLAST = NGRVER + XLAST = X + IXNEARX = 0 + + IF(X.GT.1..OR.NXX.LE.0) RETURN + IF(X/XXTAB(1).LT.1.-EPSI) RETURN + + DO 10 I = 1,NXX +!mb IF(XXTAB(I).LE.X+EPSI) IX = I + IF(XXTAB(I)/X.LE.1.+EPSI) IX = I + 10 END DO + +!mb IF(ABS(XXTAB(IX)-X).LE.EPSI) THEN + IF(ABS(XXTAB(IX)/X-1.).LE.EPSI) THEN + IXNEARX = IX + IXLAST = IX + ELSE + GAP = SYFROMX(XXTAB(IX+1))-SYFROMX(XXTAB(IX)) + DEL = SYFROMX(X)-SYFROMX(XXTAB(IX)) + IF(DEL/GAP.LE.0.5) THEN + IXNEARX = -IX + ELSE + IXNEARX = -MIN(IX+1,NXX) + ENDIF + IXLAST = IXNEARX + ENDIF + + RETURN + END + +!DECK ID>, IQFROMQ. + +! =========================== + INTEGER FUNCTION IQFROMQ(Q) +! =========================== + +!--- Returns gridindex IQ given a value for Q. +!--- If Q is outside the current gridboundary then IQFROMQ = 0. +!--- If Q corresponds to gridindex IQ then IQFROMQ = IQ. +!--- If Q lies above IQ and below IQ+1 then IQFROMQ = -IQ. + +!--- NB: Q and Q2TAB are different only if |Q-Q2TAB| < epsi. +!--- NB: If since the previous call the grid did not change +!--- (i.e. NGRVER is the same) and if Q did not change, then +!--- IQFROMQ just returns the result of the previous call. + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + SAVE QLAST,IQLAST,NGLAST + + DATA QLAST / 0. / + DATA IQLAST / 0 / + DATA NGLAST / 0 / + DATA EPSI /1.E-6/ + +! CALL QTRACE('IQFROMQ',0) + + IF(Q.EQ.QLAST.AND.NGRVER.EQ.NGLAST) THEN + IQFROMQ = IQLAST + RETURN + ENDIF + + IQ = 0 + IQLAST = 0 + NGLAST = NGRVER + QLAST = Q + IQFROMQ = 0 + + IF(NQ2.EQ.0) RETURN + IF(Q/Q2TAB(1).LT.1.-EPSI) RETURN + IF(Q/Q2TAB(NQ2).GT.1.+EPSI) RETURN + + DO 10 I = 1,NQ2 +!mb IF(Q2TAB(I).LE.Q+EPSI) IQ = I + IF(Q2TAB(I)/Q.LE.1.+EPSI) IQ = I + 10 END DO + +!mb IF(ABS(Q2TAB(IQ)-Q).LE.EPSI) THEN + IF(ABS(Q2TAB(IQ)/Q-1.).LE.EPSI) THEN + IQFROMQ = IQ + IQLAST = IQ + ELSE + IQFROMQ = -IQ + IQLAST = -IQ + ENDIF + + RETURN + END + +!------------------------------------------------ + +!- REAL QR,Q1,Q2,QLAST +!- +!-+SEQ,QCNXQM. +!-+SEQ,QCGRID. +!- +!- SAVE QLAST,IQLAST,NGLAST +!- +!- DATA QLAST / 0. / +!- DATA IQLAST / 0 / +!- DATA NGLAST / 0 / +!- +!-* CALL QTRACE('IQFROMQ',0) +!- +!- QR = Q +!- IF(QR.EQ.QLAST.AND.NGRVER.EQ.NGLAST) THEN +!- IQFROMQ = IQLAST +!- RETURN +!- ENDIF +!- +!- IQ = 0 +!- IQLAST = 0 +!- NGLAST = NGRVER +!- QLAST = Q +!- IQFROMQ = 0 +!- +!- +!- IF(NQ2.LE.0) RETURN +!- Q1 = Q2TAB(1) +!- IF(QR.LT.Q1) RETURN +!- Q2 = Q2TAB(NQ2) +!- IF(QR.GT.Q2) RETURN +!- IF(QR.EQ.Q2) THEN +!- IQFROMQ = NQ2 +!- IQLAST = NQ2 +!- RETURN +!- ENDIF +!- +!- DO IQ = 1,NQ2-1 +!- Q2 = Q2TAB(IQ+1) +!- IF(Q1.LE.QR.AND.QR.LT.Q2) THEN +!- IQFROMQ = -IQ +!- IF(Q1.EQ.QR) IQFROMQ = IQ +!- IQLAST = IQ +!- RETURN +!- ENDIF +!- Q1 = Q2 +!- ENDDO +!- +!- RETURN +!- END + +!DECK ID>, IQNEARQ. + +! =========================== + INTEGER FUNCTION IQNEARQ(Q) +! =========================== + +!--- Returns closest gridindex IQ given a value for Q. +!--- If Q is outside the current gridboundary then IQNEARQ = 0. +!--- If Q corresponds to gridindex IQ then IQNEARQ = IQ. +!--- If Q lies above IQ and below IQ+1 then IQNEARQ = -IQ or -IQ-1. + +!--- NB: Q and Q2TAB are different only if |Q-Q2TAB| < epsi. +!--- NB: If since the previous call the grid did not change +!--- (i.e. NGRVER is the same) and if Q did not change, then +!--- IQNEARQ just returns the result of the previous call. + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + SAVE QLAST,IQLAST,NGLAST + + DATA QLAST / 0. / + DATA IQLAST / 0 / + DATA NGLAST / 0 / + DATA EPSI /1.E-6/ + +! CALL QTRACE('IQNEARQ',0) + + IF(Q.EQ.QLAST.AND.NGRVER.EQ.NGLAST) THEN + IQNEARQ = IQLAST + RETURN + ENDIF + + IQ = 0 + IQLAST = 0 + NGLAST = NGRVER + QLAST = Q + IQNEARQ = 0 + + IF(NQ2.EQ.0) RETURN + IF(Q/Q2TAB(1).LT.1.-EPSI) RETURN + IF(Q/Q2TAB(NQ2).GT.1.+EPSI) RETURN + + DO 10 I = 1,NQ2 +!mb IF(Q2TAB(I).LE.Q+EPSI) IQ = I + IF(Q2TAB(I)/Q.LE.1.+EPSI) IQ = I + 10 END DO + +!mb IF(ABS(Q2TAB(IQ)-Q).LE.EPSI) THEN + IF(ABS(Q2TAB(IQ)/Q-1.).LE.EPSI) THEN + IQNEARQ = IQ + IQLAST = IQ + ELSE + GAP = LOG(Q2TAB(IQ+1)/Q2TAB(IQ)) + DEL = LOG(Q/Q2TAB(IQ)) + IF(DEL/GAP.LE.0.5) THEN + IQNEARQ = -IQ + ELSE + IQNEARQ = -MIN(IQ+1,NQ2) + ENDIF + IQLAST = IQNEARQ + ENDIF + + RETURN + END + +!DECK ID>, XFROMIX. + +! ===================================== + DOUBLE PRECISION FUNCTION XFROMIX(IX) +! ===================================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +!--- Returns x given the gridindex IX. +!--- If IX is out of range [1,NXX] then XFROMIX = 0. + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + +! CALL QTRACE('XFROMIX',0) + + IF(IX.LE.0) THEN + XFROMIX = 0. + ELSEIF(IX.GT.NXX) THEN + XFROMIX = 0. + ELSE + XFROMIX = XXTAB(IX) + ENDIF + + RETURN + END + +!DECK ID>, QFROMIQ. +! +! ===================================== + DOUBLE PRECISION FUNCTION QFROMIQ(IQ) +! ===================================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +!--- Returns Q2 given the gridindex IQ. +!--- If IQ is out of range [1,NQ2] then QFROMIQ = 0. + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + +! CALL QTRACE('QFROMIQ',0) + + IF(IQ.LE.0) THEN + QFROMIQ = 0. + ELSEIF(IQ.GT.NQ2) THEN + QFROMIQ = 0. + ELSE + QFROMIQ = Q2TAB(IQ) + ENDIF + + RETURN + END + +!DECK ID>, GRCUTS. + +! ==================================== + SUBROUTINE GRCUTS(XMI,QMI,QMA,ROOTS) +! ==================================== + +!--- GRCUTS: user input of cuts. +!--- Input : Double precision XMI: reject x .lt. XMI +!--- QMI: reject Q2 .lt. QMI +!--- QMA: reject Q2 .gt. QMA +!--- ROOTS: reject Q2 .gt. x * roots**2 +!--- Output: XMICUT, QMICUT, QMACUT, RS2CUT in +seq,QCGRID. +!--- NB : No cut is applied when XMI etc .le. 0 (XMICUT etc = -1.) + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + CALL QTRACE('GRCUTS ',0) + + IF(XMI.LE.0..OR.XMI.GE.1.) THEN + XMICUT = -1. + ELSE + XMICUT = XMI + ENDIF + + IF(QMI.LE.0.) THEN + QMICUT = -1. + ELSE + QMICUT = QMI + ENDIF + + IF(QMA.LE.0.) THEN + QMACUT = -0.5 + ELSE + QMACUT = QMA + ENDIF + + IF(ROOTS.LE.0.) THEN + RS2CUT = -1. + ELSE + RS2CUT = ROOTS*ROOTS + ENDIF + + IF(QMICUT.GE.QMACUT.AND.QMACUT.GT.0.) THEN + + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r GRCUTS ---> STOP'')') + WRITE(6,'( '' ------------------------------------'')') + WRITE(6,'( '' Input Xmin :'',E12.5)') XMI + WRITE(6,'( '' Q2min :'',E12.5)') QMI + WRITE(6,'( '' Q2max :'',E12.5)') QMA + WRITE(6,'( '' rootS :'',E12.5)') ROOTS + WRITE(6,'(/'' Value of Q2min .ge. Q2max'')') + + CALL QTRACE('GRCUTS ',1) + + STOP + + ENDIF + + CALL GRSETC + + RETURN + END + +!DECK ID>, GRSETC. + +! ================= + SUBROUTINE GRSETC +! ================= + +!--- Input: XMIN, QMIN, QMAX, RS2CUT + grid-definitions, all this +!--- as stored in QCGRID. +!--- Output: integer array IFAILC(IX,IQ) (see below). +!--- Called by GRCUTS (user input of cuts) and +!--- by all grid definition routines (update of IFAILC). + +!--- Fill the array IFAILC(IX,IQ) such that +!--- IFAILC = 0 : gridpoint passes all cuts +!--- IFAILC = ijkl : i = 0/1 no/yes fail roots cut +!--- j = 0/1 no/yes fail qmax cut +!--- k = 0/1 no/yes fail qmin cut +!--- l = 0/1 no/yes fail xmin cut + +!--- For any x,Q2 passing the cuts the four surrounding gridpoints +!--- will also be flagged as passing the cut. This then guarantees +!--- that parton distributions are available on the surrounding +!--- gridpoints for interpolation purposes. + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + DO IX = 1,MXX + DO IQ = 1,MQ2 + IFAILC(IX,IQ) = 11111 + ENDDO + ENDDO + IF(NXX.LE.0) RETURN + IF(NQ2.LE.0) RETURN + + DO IQ = 1,NQ2 + DO IX = 1,NXX + IXP1 = MIN(IX+1,NXX) + IQP1 = MIN(IQ+1,NQ2) + IQM1 = MAX(IQ-1,1) + IFAILC(IX,IQ) = 0 + IF(XXTAB(IXP1).LE.XMICUT.AND.XMICUT.GT.0.) & + & IFAILC(IX,IQ) = IFAILC(IX,IQ)+1 + IF(Q2TAB(IQP1).LE.QMICUT.AND.QMICUT.GT.0.) & + & IFAILC(IX,IQ) = IFAILC(IX,IQ)+10 + IF(Q2TAB(IQM1).GE.QMACUT.AND.QMACUT.GT.0.) & + & IFAILC(IX,IQ) = IFAILC(IX,IQ)+100 + IF(Q2TAB(IQM1).GE.XXTAB(IXP1)*RS2CUT.AND.RS2CUT.GT.0.) & + & IFAILC(IX,IQ) = IFAILC(IX,IQ)+1000 + IF(Q2TAB(IQP1).LE.QMINAS.AND.QMINAS.GT.0.) & + & IFAILC(IX,IQ) = IFAILC(IX,IQ)+10000 + + ENDDO + ENDDO + +!-- Invalidate all evolutions + CALL QNFALS(LEVDONE,MXX*10) + + RETURN + END + +!DECK ID>, IFAILXQ. + +! ============================= + INTEGER FUNCTION IFAILXQ(X,Q) +! ============================= + +!--- User interface to ICUTXQ + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + CALL QTRACE('IFAILXQ',0) + + IFAILXQ = ICUTXQ(X,Q,0) + + RETURN + END + +!DECK ID>, ICUTXQ. + +! ================================== + INTEGER FUNCTION ICUTXQ(X,Q,IPRIN) +! ================================== + +!--- ICUTXQ = ijkl : i = 0/1 no/yes fail ROOTS cut +!--- j = 0/1 no/yes fail QMAX cut +!--- k = 0/1 no/yes fail QMIN cut +!--- l = 0/1 no/yes fail XMIN cut + +!--- Input integer IPRIN = 0/1 no/yes printout. + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + CHARACTER*4 PASS(0:1) + + DATA PASS /'pass','fail'/ + +!-- No x-grid available + IF(NXX.LE.0) THEN + ICUTXQ = 11111 + RETURN + ENDIF +!-- No Q2 grid available + IF(NQ2.LE.0) THEN + ICUTXQ = 11111 + RETURN + ENDIF +!-- x > 1 + IF(X.GT.1.0) THEN + ICUTXQ = 11111 + RETURN + ENDIF + + I1 = 0 + I2 = 0 + I3 = 0 + I4 = 0 + I5 = 0 + + IF((X.LT.XXTAB(1)).OR.(X.LT.XMICUT.AND.XMICUT.GT.0.)) & + & I1 = 1 + IF((Q.LT.Q2TAB(1)).OR.(Q.LT.QMICUT.AND.QMICUT.GT.0.)) & + & I2 = 1 + IF((Q.GT.Q2TAB(NQ2)).OR.(Q.GT.QMACUT.AND.QMACUT.GT.0.)) & + & I3 = 1 + IF(Q.GT.X*RS2CUT.AND.RS2CUT.GT.0.) & + & I4 = 1 + IF((Q.LT.Q2TAB(1)).OR.(Q.LT.QMINAS.AND.QMINAS.GT.0.)) & + & I5 = 1 + + ICUTXQ = 10000*I5 + 1000*I4 + 100*I3 + 10*I2 + I1 + + IF(IPRIN.EQ.1) THEN + + XMIPR = XMICUT + IF(XMICUT.LE.0.) XMIPR = XXTAB(1) + QMIPR = QMICUT + IF(QMICUT.LE.0.) QMIPR = Q2TAB(1) + QMAPR = QMACUT + IF(QMACUT.LE.0.) QMAPR = Q2TAB(NQ2) + WRITE(6,'('' '')') + WRITE(6,'('' x ='',E12.5,'' xmin = '',E12.5, & + & '' pass/fail = '',A4)') X, XMIPR, PASS(I1) + WRITE(6,'('' Q2 ='',E12.5,'' Qmin = '',E12.5, & + & '' pass/fail = '',A4)') Q, QMIPR, PASS(I2) + WRITE(6,'('' Q2 ='',E12.5,'' Qmax = '',E12.5, & + & '' pass/fail = '',A4)') Q, QMAPR, PASS(I3) + WRITE(6,'('' s ='',E12.5,'' Smax = '',E12.5, & + & '' pass/fail = '',A4)') Q/X, RS2CUT, PASS(I4) + WRITE(6,'('' Q2 ='',E12.5,'' Qmin_alphas = '',E12.5, & + & '' pass/fail = '',A4)') Q, QMINAS, PASS(I5) + WRITE(6,'('' '')') + + ENDIF + + RETURN + END + +!DECK ID>, IFAILIJ. + +! =============================== + INTEGER FUNCTION IFAILIJ(IX,IQ) +! =============================== + +!--- User interface to ICUTIJ + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + CALL QTRACE('IFAILIJ',0) + + IFAILIJ = ICUTIJ(IX,IQ,0) + + RETURN + END + +!DECK ID>, ICUTIJ. + +! ==================================== + INTEGER FUNCTION ICUTIJ(JX,JQ,IPRIN) +! ==================================== + +!--- ICUTIJ = ijklm : i = 0/1 no/yes fail QMINA cut +!--- j = 0/1 no/yes fail ROOTS cut +!--- k = 0/1 no/yes fail QMAX cut +!--- l = 0/1 no/yes fail QMIN cut +!--- m = 0/1 no/yes fail XMIN cut + +!--- ijklm is taken from array IFAILC. +!--- IFAILC is set by s/r GRSETC + +!--- Input integer IPRIN = 0/1 no/yes printout. + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + CHARACTER*4 PASS(0:1) + + DATA PASS /'pass','fail'/ + + ICUTIJ = 11111 + +!-- No x-grid available + IF(NXX.LE.0) RETURN +!-- No Q2 grid available + IF(NQ2.LE.0) RETURN + + IX = ABS(JX) + IQ = ABS(JQ) + IF(IX.GE.1.AND.IX.LE.NXX.AND.IQ.GE.1.AND.IQ.LE.NQ2) & + & ICUTIJ = IFAILC(IX,IQ) + + IF(IPRIN.EQ.1) THEN + + IF(IX.GE.1.AND.IX.LE.NXX.AND.IQ.GE.1.AND.IQ.LE.NQ2) THEN + X = XXTAB(IX) + Q = Q2TAB(IQ) + ELSE + X = 0. + Q = 0. + ENDIF + I5 = ICUTIJ/10000. + I4 = (ICUTIJ-10000*I5)/1000. + I3 = (ICUTIJ-10000*I5-1000*I4)/100. + I2 = (ICUTIJ-10000*I5-1000*I4-100*I3)/10. + I1 = ICUTIJ-10000*I5-1000*I4-100*I3-10*I2 + + XMIPR = XMICUT + IF(XMICUT.LE.0.) XMIPR = XXTAB(1) + QMIPR = QMICUT + IF(QMICUT.LE.0.) QMIPR = Q2TAB(1) + QMAPR = QMACUT + IF(QMACUT.LE.0.) QMAPR = Q2TAB(NQ2) + WRITE(6,'('' '')') + WRITE(6,'('' IX = '',I5,'' x ='',E12.5,'' xmin = '', & + & E12.5,'' pass/fail = '',A4)') IX, X, XMIPR, PASS(I1) + WRITE(6,'('' IQ = '',I5,'' Q2 ='',E12.5,'' Qmin = '', & + & E12.5,'' pass/fail = '',A4)') IQ, Q, QMIPR, PASS(I2) + WRITE(6,'('' IQ = '',I5,'' Q2 ='',E12.5,'' Qmax = '', & + & E12.5,'' pass/fail = '',A4)') IQ, Q, QMAPR, PASS(I3) + WRITE(6,'('' '',5X,'' s ='',E12.5,'' Smax = '', & + & E12.5,'' pass/fail = '',A4)') Q/X, RS2CUT, PASS(I4) + WRITE(6,'('' IQ = '',I5,'' Q2 ='',E12.5,'' Qmin_alphas = '', & + & E12.5,'' pass/fail = '',A4)') IQ, Q, QMINAS, PASS(I5) + WRITE(6,'('' '')') + + ENDIF + + RETURN + END + +!DECK ID>, QTHRES. + +! ========================== + SUBROUTINE QTHRES(T34,T45) +! ========================== + +!--- QTHRES: user input of flavour thresholds. +!--- Input : Double precision T34: Q2 .lt. T34 --> f = 3 +!--- Q2 .ge. T34 --> f = 4 +!--- T45: Q2 .lt. T45 --> f = 4 +!--- Q2 .ge. T45 --> f = 5 +!--- Output: THRS34 and THRS45 in +seq,QCGRID. +!--- NB1 : Default THRS34 = -huge, THRS45 = +huge --> f = 4. +!--- NB2 : The array NFMAP(Q2) = 3,4,5 is setup here through a +!--- call to QNSETT and maintained further in the grid +!--- defining routines. + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + CALL QTRACE('QTHRES ',0) + + IF(T34.GE.T45) THEN + IERR = 1 + GOTO 500 + ENDIF + + THRS34 = T34 + THRS45 = T45 + +!--- Fill the flavour map + CALL QNSETT + + RETURN + + 500 CONTINUE + + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r QTHRES ---> STOP'')') + WRITE(6,'( '' ------------------------------------'')') + WRITE(6,'( '' Input Threshold34 :'',E12.5)') T34 + WRITE(6,'( '' Threshold45 :'',E12.5)') T45 + WRITE(6,'(/'' Value of T34 .ge. T45'')') + + CALL QTRACE('QTHRES ',1) + + STOP + + END + +!DECK ID>, QNSETT. + +! ================= + SUBROUTINE QNSETT +! ================= + +!--- Input: THRS34 and THRS45 + grid-definitions, all this +!--- as stored in QCGRID. +!--- Output: integer array NFMAP(IQ) = 3,4,5 +!--- Called by QTHRES (user input of thresholds) and +!--- by all grid definition routines (update of NFMAP). + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + IF(NQ2.LE.0) THEN + DO IQ = 1,MQ2 + NFMAP(IQ) = 4 + ENDDO + RETURN + ENDIF + + DO IQ = 1,NQ2 + NFMAP(IQ) = 4 + IF(Q2TAB(IQ).LT.THRS34) NFMAP(IQ) = 3 + IF(Q2TAB(IQ).GE.THRS45) NFMAP(IQ) = 5 + ENDDO + +!-- Invalidate all evolutions + CALL QNFALS(LEVDONE,MXX*10) + + RETURN + END + +!DECK ID>, QNFMAP. + +! ============================== + SUBROUTINE QNFMAP(OPT,T34,T45) +! ============================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + CHARACTER*(*) OPT + + +!--- Obsolete 17/07/96: use QTHRES instead + + CALL QTHRES(T34,T45) + + RETURN + + END + +!DECK ID>, QNFSET. + +! =========================== + SUBROUTINE QNFSET(IX,IQ,NF) +! =========================== + + WRITE(6,'(/'' QNFSET: this routine is not available'', & + & '' ---> STOP'')') + STOP + + END + +!DECK ID>, QNFNUL. + +! ================= + SUBROUTINE QNFNUL +! ================= + + WRITE(6,'(/'' QNFNUL: this routine is not available'', & + & '' ---> STOP'')') + STOP + + END + +!DECK ID>, NFLGET. + +! =========================== + INTEGER FUNCTION NFLGET(IQ) +! =========================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + CALL QTRACE('NFLGET ',0) + + NFLGET = 0 + IF(IQ.GE.1.AND.IQ.LE.NQ2) THEN + NFLGET = NFMAP(IQ) + ELSE + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r NFLGET ---> STOP'')') + WRITE(6,'( '' ------------------------------------'')') + WRITE(6,'( '' Input IQ :'',I10)') IQ + WRITE(6,'(/'' IQ outside grid boundary'')') + CALL QTRACE('NFLGET ',1) + STOP + ENDIF + + RETURN + END + +!DECK ID>, QPGRID. + +! ====================== + SUBROUTINE QPGRID(LUN) +! ====================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + +!-- Write x-Q2 evolution grid +!-- ------------------------- + + WRITE(LUN,'(/'' QCDNUM x-Q2 evolution grid'')') + WRITE(LUN,'( '' --------------------------'')') + + CALL GRGIVE(N_X,X_MI,X_MA,N_Q,Q_MI,Q_MA) + + WRITE(LUN,'(/'' nx xmin xmax'', & + & '' nq qmin qmax'')') + WRITE(LUN,'(I5,2F10.7,I5,2F10.2)') & + & N_X,X_MI,X_MA,N_Q,Q_MI,Q_MA + WRITE(LUN,'(/'' Xgrid (heavy quarks)'')') + WRITE(LUN,'(5(I4,E12.5))') (I,XHTAB(I),I=1,NXX) + WRITE(LUN,'(/'' Xgrid'')') + WRITE(LUN,'(5(I4,E12.5))') (I,XXTAB(I),I=1,NXX) + WRITE(LUN,'(/'' Qgrid'')') + WRITE(LUN,'(5(I4,E12.5))') (I,Q2TAB(I),I=1,NQ2) + IF(RS2CUT.GE.0.) THEN + RS2C = SQRT(RS2CUT) + ELSE + RS2C = RS2CUT + ENDIF + WRITE(LUN,'(/'' Thresholds and cuts''/ & + & '' Q2 charm .......: '',E12.5/ & + & '' Q2 bottom .......: '',E12.5/ & + & '' Xmin cut .......: '',E12.5/ & + & '' Qmin cut .......: '',E12.5/ & + & '' Qmax cut .......: '',E12.5/ & + & '' Roots cut .......: '',E12.5/ & + & '' Qmin alpha_s ...: '',E12.5/)') & + & THRS34,THRS45,XMICUT,QMICUT,QMACUT,RS2C,QMINAS + + RETURN + END + +!DECK ID>, QDELQ2. + +! ================= + SUBROUTINE QDELQ2 +! ================= + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + +!-- Pre-calculate log distance in Q2 for up and down evolution + + DO 10 IQ = 2,NQ2 + DELUP(IQ) = LOG(Q2TAB(IQ)/Q2TAB(IQ-1)) + 10 END DO + DO 20 IQ = NQ2-1,1,-1 + DELDN(IQ) = LOG(Q2TAB(IQ)/Q2TAB(IQ+1)) + 20 END DO + + LDQ2OK = .TRUE. + + RETURN + END + +!DECK ID>, QFMARK. + +! ====================== + SUBROUTINE QFMARK(X,Q) +! ====================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + CALL QTRACE('QFMARK ',0) + +!-- Mark gridpoints for fast structure function calculation + + IERR = 0 + IF(X.LE.0. .OR. X.GT.1.) THEN + IERR = 1 + GOTO 500 + ENDIF + IF(Q.LE.0.) THEN + IERR = 2 + GOTO 500 + ENDIF + +!-- Mark the evolution grid + + IX = IXFROMX(X) + IQ = IQFROMQ(Q) + IF(IX.EQ.0.OR.IQ.EQ.0) THEN + IERR = 3 + GOTO 500 + ELSEIF(IX.GT.0.AND.IQ.GT.0) THEN + MARKFF(IX,IQ) = 1 + MARKQQ(IQ) = 1 + LMARK = .TRUE. + ELSEIF(IX.LT.0.AND.IQ.GT.0) THEN + MARKFF(-IX,IQ) = 1 + MARKFF(-IX+1,IQ) = 1 + MARKQQ(IQ) = 1 + LMARK = .TRUE. + ELSEIF(IX.GT.0.AND.IQ.LT.0) THEN + MARKFF(IX,-IQ) = 1 + MARKFF(IX,-IQ+1) = 1 + MARKQQ(-IQ) = 1 + MARKQQ(-IQ+1) = 1 + LMARK = .TRUE. + ELSEIF(IX.LT.0.AND.IQ.LT.0) THEN + MARKFF(-IX,-IQ) = 1 + MARKFF(-IX+1,-IQ) = 1 + MARKFF(-IX,-IQ+1) = 1 + MARKFF(-IX+1,-IQ+1) = 1 + MARKQQ(-IQ) = 1 + MARKQQ(-IQ+1) = 1 + LMARK = .TRUE. + ENDIF + +!-- Mark the heavy quark grid + + IX = IHFROMH(X) + IQ = IQFROMQ(Q) + IF(IX.EQ.0.OR.IQ.EQ.0) THEN + IERR = 3 + GOTO 500 + ELSEIF(IX.GT.0.AND.IQ.GT.0) THEN + MARKFH(IX,IQ) = 1 + ELSEIF(IX.LT.0.AND.IQ.GT.0) THEN + MARKFH(-IX,IQ) = 1 + MARKFH(-IX+1,IQ) = 1 + ELSEIF(IX.GT.0.AND.IQ.LT.0) THEN + MARKFH(IX,-IQ) = 1 + MARKFH(IX,-IQ+1) = 1 + ELSEIF(IX.LT.0.AND.IQ.LT.0) THEN + MARKFH(-IX,-IQ) = 1 + MARKFH(-IX+1,-IQ) = 1 + MARKFH(-IX,-IQ+1) = 1 + MARKFH(-IX+1,-IQ+1) = 1 + ENDIF + + RETURN + + 500 CONTINUE + + DO I = 1,30 + DO J = 1,7 + LFFCAL(J,I) = .FALSE. + ENDDO + ENDDO + + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r QFMARK ---> STOP'')') + WRITE(6,'( '' ------------------------------------'')') + WRITE(6,'( '' Input x :'',E12.5)') X + WRITE(6,'( '' Input Q2 :'',E12.5)') Q + IF(IERR.EQ.1) THEN + WRITE(6,'(/'' Value of x outside allowed range [0,1]'')') + ELSEIF(IERR.EQ.2) THEN + WRITE(6,'(/'' Value of Q2 outside allowed range > 0'')') + ELSEIF(IERR.EQ.3) THEN + WRITE(6,'(/'' Value of x and/or Q2 outside grid'')') + IDUM = ICUTXQ(X,Q,1) + ENDIF + + CALL QTRACE('QFMARK ',1) + + STOP + + END + +!DECK ID>, QFMNUL. + +! ================= + SUBROUTINE QFMNUL +! ================= + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + CALL QTRACE('QFMNUL ',0) + +!-- Clear gridpoints for fast structure function calculation + + CALL QNINUL(MARKFF,MXX*MQ2) + CALL QNINUL(MARKQQ,MQ2) + CALL QNINUL(IDFAST,7*30) + NDFAST = 30 + LMARK = .FALSE. + + DO I = 1,30 + DO J = 1,7 + LFFCAL(J,I) = .FALSE. + ENDDO + ENDDO + + RETURN + END + +!DECK ID>, STFCLR. + +! ================= + SUBROUTINE STFCLR +! ================= + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + +!-- Clear memory allocation for STFAST + + CALL QTRACE('STFCLR ',0) + + CALL QNINUL(IDFAST,7*30) + NDFAST = 30 + + DO I = 1,30 + DO J = 1,7 + LFFCAL(J,I) = .FALSE. + ENDDO + ENDDO + + RETURN + END + +!DECK ID>, QNFILW. + +! ================================ + SUBROUTINE QNFILW(IQLIST,NQLIST) +! ================================ + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + LOGICAL LTIME + REAL T_START,T_END,T_SPENT + COMMON/QCTIME/T_START(10),T_END(10),T_SPENT(10),N_CALLS(10), & + &E_CALLS(10),LTIME + COMMON/QCFCNT/IFCNT(-1:1,5) + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + REAL & + &WGTFF1,WGTFG1, & + &WGTGF1,WGTGG1, & + &WGTPP2,WGTPM2,WGTNS2, & + &WGTFF2,WGTFG2, & + &WGTGF2,WGTGG2, & + &WGTC2Q,WGTC2G,YNTC2Q, & + &WGTCLQ,WGTCLG,WGTC3Q + + COMMON/QCWEIT/ & + &WGTFF1(MXX*(MXX+1)/2) ,WGTFG1(MXX*(MXX+1)/2,3:5), & + &WGTGF1(MXX*(MXX+1)/2) ,WGTGG1(MXX*(MXX+1)/2,3:5), & + &WGTPP2(MXX*(MXX+1)/2,3:5),WGTPM2(MXX*(MXX+1)/2,3:5), & + &WGTNS2(MXX*(MXX+1)/2,3:5), & + &WGTFF2(MXX*(MXX+1)/2,3:5),WGTFG2(MXX*(MXX+1)/2,3:5), & + &WGTGF2(MXX*(MXX+1)/2,3:5),WGTGG2(MXX*(MXX+1)/2,3:5), & + &WGTC2Q(MXX*(MXX+1)/2) ,WGTC2G(MXX*(MXX+1)/2,3:5), & + &WGTCLQ(MXX*(MXX+1)/2) ,WGTCLG(MXX*(MXX+1)/2,3:5), & + &WGTC3Q(MXX*(MXX+1)/2) ,YNTC2Q(MXX) + + COMMON/QCWADR/ IWADR(MXX,MXX) + + + DIMENSION IQLIST(*) + + IF(LTIME) CALL TIMEX_LHA(T_START(2)) + + CALL QTRACE('QNFILW ',0) + + IF(NXX.EQ.0.OR.NQ2.EQ.0) THEN + IERR = 1 + GOTO 500 + ENDIF + +!-- Invalidate all evolutions + CALL QNFALS(LEVDONE,MXX*10) + +!-- Setup the adresses + DO IX0 = 1,MXX + DO IX = IX0,MXX + IWADR(IX,IX0) = IWTAD(IX,IX0) + ENDDO + ENDDO + +!-- Now calculate weights + IF(LW1ANA) THEN + DO 30 NF = 3,5 + CALL FILLO1(NF) + 30 CONTINUE + LW1NUM = .FALSE. + LWT1OK = .TRUE. + WRITE(6,'(/'' QNFILW: Calculate LO weights analytically'')') + ENDIF + + I1 = 0 + I2 = 0 + I3 = 0 + IF(LW1NUM) THEN + I1 = 1 + LWT1OK = .TRUE. + WRITE(6,'(/'' QNFILW: Calculate LO weights numerically'')') + ENDIF + IF(LW2NUM) THEN + I2 = 1 + LWT2OK = .TRUE. + WRITE(6,'(/'' QNFILW: Calculate NLO weights'')') + ENDIF + IF(LW2STF) THEN + I3 = 1 + LWTFOK = .TRUE. + WRITE(6,'(/'' QNFILW: Calculate F2 weights'')') + ENDIF + + DO 40 NF = 3,5 + CALL FILLWF(I1,I2,I3,NF) + 40 END DO + + IF(LWF2C.OR.LWF2B.OR.LWFLC.OR.LWFLB) THEN + +!--- Check charm, bottom mass + IF(.NOT.(0..LT.CBMSTF(4) .AND. CBMSTF(4).EQ.CBMSTF(5) .AND. & + & CBMSTF(4).LT.CBMSTF(6) .AND. CBMSTF(6).EQ.CBMSTF(7))) THEN + IERR = 2 + GOTO 500 + ENDIF + + IF(LWF2C) THEN + LWFCOK = .TRUE. + CALL FIL_F2H(4) + WRITE(6,'(/'' QNFILW: Calculate F2c weights'')') + ENDIF + IF(LWF2B) THEN + LWFBOK = .TRUE. + CALL FIL_F2H(6) + WRITE(6,'(/'' QNFILW: Calculate F2b weights'')') + ENDIF + IF(LWFLC) THEN + LWLCOK = .TRUE. + CALL FIL_FLH(5) + WRITE(6,'(/'' QNFILW: Calculate FLc weights'')') + ENDIF + IF(LWFLB) THEN + LWLBOK = .TRUE. + CALL FIL_FLH(7) + WRITE(6,'(/'' QNFILW: Calculate FLb weights'')') + ENDIF + + ENDIF + + WRITE(6,'(/)') + + IF(LTIME) THEN + CALL TIMEX_LHA(T_END(2)) + T_SPENT(2) = T_SPENT(2)+T_END(2)-T_START(2) + N_CALLS(2) = N_CALLS(2)+1 + ENDIF + + RETURN + + 500 CONTINUE + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r QNFILW ---> STOP'')') + WRITE(6,'( '' ------------------------------------'')') + IF(IERR.EQ.1) THEN + WRITE(6,'(/'' No x-Q2 grid available'')') + ENDIF + IF(IERR.EQ.2) THEN + WRITE(6,'( '' Cmass (F2c,FLc) ='',2E12.5)') CBMSTF(4),CBMSTF(5) + WRITE(6,'( '' Bmass (F2b,FLb) ='',2E12.5)') CBMSTF(6),CBMSTF(7) + WRITE(6,'(/'' Masses not in ascending order or not equal'', & + & '' for F2 and FL'')') + ENDIF + + CALL QTRACE('QNFILW ',1) + + STOP + + END + +!DECK ID>, QNGETW. + +! =============================================== + DOUBLE PRECISION FUNCTION QNGETW(OPT,IX0,IX,IQ) +! =============================================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + REAL & + &WGTFF1,WGTFG1, & + &WGTGF1,WGTGG1, & + &WGTPP2,WGTPM2,WGTNS2, & + &WGTFF2,WGTFG2, & + &WGTGF2,WGTGG2, & + &WGTC2Q,WGTC2G,YNTC2Q, & + &WGTCLQ,WGTCLG,WGTC3Q + + COMMON/QCWEIT/ & + &WGTFF1(MXX*(MXX+1)/2) ,WGTFG1(MXX*(MXX+1)/2,3:5), & + &WGTGF1(MXX*(MXX+1)/2) ,WGTGG1(MXX*(MXX+1)/2,3:5), & + &WGTPP2(MXX*(MXX+1)/2,3:5),WGTPM2(MXX*(MXX+1)/2,3:5), & + &WGTNS2(MXX*(MXX+1)/2,3:5), & + &WGTFF2(MXX*(MXX+1)/2,3:5),WGTFG2(MXX*(MXX+1)/2,3:5), & + &WGTGF2(MXX*(MXX+1)/2,3:5),WGTGG2(MXX*(MXX+1)/2,3:5), & + &WGTC2Q(MXX*(MXX+1)/2) ,WGTC2G(MXX*(MXX+1)/2,3:5), & + &WGTCLQ(MXX*(MXX+1)/2) ,WGTCLG(MXX*(MXX+1)/2,3:5), & + &WGTC3Q(MXX*(MXX+1)/2) ,YNTC2Q(MXX) + + COMMON/QCWADR/ IWADR(MXX,MXX) + + + REAL & + &WH_C0KG,WH_C1KG,WH_C1BKG, & + &WH_C1KQ,WH_C1BKQ,WH_D1KQ,WH_D1BKQ + + COMMON/QCHWGT/ & + &WH_C0KG(0:MXX,MQ2,4:7), & + &WH_C1KG(0:MXX,MQ2,4:7),WH_C1BKG(0:MXX,MQ2,4:7), & + &WH_C1KQ(0:MXX,MQ2,4:7),WH_C1BKQ(0:MXX,MQ2,4:7), & + &WH_D1KQ(0:MXX,MQ2,4:7),WH_D1BKQ(0:MXX,MQ2,4:7) + + + CHARACTER*(*) OPT + CHARACTER*8 OPT8 + + CALL QTRACE('QNGETW ',0) + + IERR = 0 + IF(IX0.LE.0.OR.IX0.GT.MXX-1) THEN + IERR = 1 + GOTO 500 + ENDIF + IF(IX.LE.0.OR.IX.GT.MXX-1) THEN + IERR = 1 + GOTO 500 + ENDIF + IF(IQ.LE.0.OR.IQ.GT.MQ2-1) THEN + IERR = 1 + GOTO 500 + ENDIF + + NF = NFMAP(IQ) + IF(NF.LT.3.OR.NF.GT.5) THEN + IERR = 2 + GOTO 500 + ENDIF + + IF(IX.LT.IX0) THEN + QNGETW = 0. + RETURN + ENDIF + + LEN = MIN(LENOCC_LHA(OPT),8) + OPT8(1:LEN) = OPT(1:LEN) + CALL CLTOU_LHA(OPT8) + + IF(OPT8(1:6).EQ.'WGTFF1') THEN + QNGETW = WGTFF1(IWTAD(IX,IX0)) + ELSEIF(OPT8(1:6).EQ.'WGTFG1') THEN + QNGETW = WGTFG1(IWTAD(IX,IX0),NF) + ELSEIF(OPT8(1:6).EQ.'WGTGF1') THEN + QNGETW = WGTGF1(IWTAD(IX,IX0)) + ELSEIF(OPT8(1:6).EQ.'WGTGG1') THEN + QNGETW = WGTGG1(IWTAD(IX,IX0),NF) + ELSEIF(OPT8(1:6).EQ.'WGTPP2') THEN + QNGETW = WGTPP2(IWTAD(IX,IX0),NF) + ELSEIF(OPT8(1:6).EQ.'WGTPM2') THEN + QNGETW = WGTPM2(IWTAD(IX,IX0),NF) + ELSEIF(OPT8(1:6).EQ.'WGTNS2') THEN + QNGETW = WGTNS2(IWTAD(IX,IX0),NF) + ELSEIF(OPT8(1:6).EQ.'WGTFF2') THEN + QNGETW = WGTFF2(IWTAD(IX,IX0),NF) + ELSEIF(OPT8(1:6).EQ.'WGTFG2') THEN + QNGETW = WGTFG2(IWTAD(IX,IX0),NF) + ELSEIF(OPT8(1:6).EQ.'WGTGF2') THEN + QNGETW = WGTGF2(IWTAD(IX,IX0),NF) + ELSEIF(OPT8(1:6).EQ.'WGTGG2') THEN + QNGETW = WGTGG2(IWTAD(IX,IX0),NF) + ELSEIF(OPT8(1:6).EQ.'WGTC2Q') THEN + QNGETW = WGTC2Q(IWTAD(IX,IX0)) + ELSEIF(OPT8(1:6).EQ.'WGTC2G') THEN + QNGETW = WGTC2G(IWTAD(IX,IX0),NF) + ELSEIF(OPT8(1:6).EQ.'WGTCLQ') THEN + QNGETW = WGTCLQ(IWTAD(IX,IX0)) + ELSEIF(OPT8(1:6).EQ.'WGTCLG') THEN + QNGETW = WGTCLG(IWTAD(IX,IX0),NF) + ELSEIF(OPT8(1:6).EQ.'WGTC3Q') THEN + QNGETW = WGTC3Q(IWTAD(IX,IX0)) + ELSEIF(OPT8(1:7).EQ.'WH_C02G') THEN + QNGETW = WH_C0KG(IX-IX0,IQ,4) + ELSEIF(OPT8(1:7).EQ.'WH_C12G') THEN + QNGETW = WH_C1KG(IX-IX0,IQ,4) + ELSEIF(OPT8(1:8).EQ.'WH_C1B2G') THEN + QNGETW = WH_C1BKG(IX-IX0,IQ,4) + ELSEIF(OPT8(1:7).EQ.'WH_C12Q') THEN + QNGETW = WH_C1KQ(IX-IX0,IQ,4) + ELSEIF(OPT8(1:8).EQ.'WH_C1B2Q') THEN + QNGETW = WH_C1BKQ(IX-IX0,IQ,4) + ELSEIF(OPT8(1:7).EQ.'WH_D12Q') THEN + QNGETW = WH_D1KQ(IX-IX0,IQ,4) + ELSEIF(OPT8(1:8).EQ.'WH_D1B2Q') THEN + QNGETW = WH_D1BKQ(IX-IX0,IQ,4) + ELSEIF(OPT8(1:7).EQ.'WH_C0LG') THEN + QNGETW = WH_C0KG(IX-IX0,IQ,5) + ELSEIF(OPT8(1:7).EQ.'WH_C1LG') THEN + QNGETW = WH_C1KG(IX-IX0,IQ,5) + ELSEIF(OPT8(1:8).EQ.'WH_C1BLG') THEN + QNGETW = WH_C1BKG(IX-IX0,IQ,5) + ELSEIF(OPT8(1:7).EQ.'WH_C1LQ') THEN + QNGETW = WH_C1KQ(IX-IX0,IQ,5) + ELSEIF(OPT8(1:8).EQ.'WH_C1BLQ') THEN + QNGETW = WH_C1BKQ(IX-IX0,IQ,5) + ELSEIF(OPT8(1:7).EQ.'WH_D1LQ') THEN + QNGETW = WH_D1KQ(IX-IX0,IQ,5) + ELSEIF(OPT8(1:8).EQ.'WH_D1BLQ') THEN + QNGETW = WH_D1BKQ(IX-IX0,IQ,5) + ELSE + IERR = 3 + GOTO 500 + ENDIF + + RETURN + + 500 CONTINUE + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r QNGETW ---> STOP'')') + WRITE(6,'( '' ------------------------------------'')') + WRITE(6,'( '' Input OPT :'',A)') OPT + WRITE(6,'( '' IX0 :'',I10)') IX0 + WRITE(6,'( '' IX :'',I10)') IX + WRITE(6,'( '' IQ :'',I10)') IQ + IF(IERR.EQ.1) THEN + WRITE(6,'(/'' IX0, IX and/or IQ outside allowed range'')') + ELSEIF(IERR.EQ.2) THEN + WRITE(6,'(/'' NF(IX,IQ) ='',I3,'' outside allowed range'')') NF + ELSEIF(IERR.EQ.3) THEN + WRITE(6,'(/'' Unknown option'')') + ENDIF + + CALL QTRACE('QNGETW ',1) + + STOP + + END + +!DECK ID>, QSTRIP. + +! ================================= + SUBROUTINE QSTRIP(NAMEIN,NAMEOUT) +! ================================= + +!--- Truncate NAMEIN to 5 characters and convert to upper case + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + CHARACTER*(*) NAMEIN + CHARACTER*5 NAMEOUT + + LEN = MIN(LENOCC_LHA(NAMEIN),5) + NAMEOUT = ' ' + NAMEOUT(1:LEN) = NAMEIN(1:LEN) + CALL CLTOU_LHA(NAMEOUT) + + RETURN + END + +!DECK ID>, CHKNAM. + +! ==================================== + SUBROUTINE CHKNAM(ID,NAME,SNAME,NAM) +! ==================================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + CHARACTER*5 PNAM,STFNAM + LOGICAL LNFP + COMMON /QCLNFP/ LNFP(0:30,3:5) + COMMON /QCPNAM/ PNAM(0:30) + COMMON /QCPWGT/ PWGT(0:10,0:30,3:5) + COMMON /QCFNAM/ STFNAM(7) + + + CHARACTER*(*) NAME, SNAME + CHARACTER*5 NAM + + LEN = MIN(LENOCC_LHA(NAME),5) + NAM = ' ' + NAM(1:LEN) = NAME(1:LEN) + CALL CLTOU_LHA(NAM) + + IF(NAM.EQ.' ') THEN + IERR = 1 + GOTO 500 + ENDIF + + IF(NAM.EQ.'FREE ') THEN + PNAM(ID) = NAM + LNFP(ID,3) = .FALSE. + LNFP(ID,4) = .FALSE. + LNFP(ID,5) = .FALSE. + IF(ID.LE.10) THEN + DO JD = 0,30 + PWGT(ID,JD,3) = 0. + PWGT(ID,JD,4) = 0. + PWGT(ID,JD,5) = 0. + ENDDO + ELSE + DO JD = 0,10 + PWGT(JD,ID,3) = 0. + PWGT(JD,ID,4) = 0. + PWGT(JD,ID,5) = 0. + ENDDO + ENDIF + RETURN + ENDIF + + IF(PNAM(ID).NE.'FREE '.AND.PNAM(ID).NE.NAM) THEN + IERR = 2 + GOTO 500 + ENDIF + + DO JD = 0,30 + IF(JD.EQ.ID) EXIT + IF(PNAM(JD).EQ.NAM) THEN + IERR = 3 + GOTO 500 + ENDIF + END DO + + RETURN + + 500 CONTINUE + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r '',A,'' ---> STOP'')') & + & SNAME + WRITE(6,'( '' ------------------------------------'')') + WRITE(6,'( '' Input ID :'',I10)') ID + WRITE(6,'( '' Input NAME :'',A)') NAM + IF(IERR.EQ.1) THEN + WRITE(6,'(/'' Blank name not allowed'')') + ELSEIF(IERR.EQ.2) THEN + WRITE(6,'(/'' ID already booked'')') + ELSEIF(IERR.EQ.3) THEN + WRITE(6,'(/'' NAME already used'')') + ENDIF + + CALL QTRACE('CHKNAM ',1) + + STOP + + END + +!DECK ID>, QNBOOK. + +! ========================== + SUBROUTINE QNBOOK(ID,NAME) +! ========================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + CHARACTER*5 PNAM,STFNAM + LOGICAL LNFP + COMMON /QCLNFP/ LNFP(0:30,3:5) + COMMON /QCPNAM/ PNAM(0:30) + COMMON /QCPWGT/ PWGT(0:10,0:30,3:5) + COMMON /QCFNAM/ STFNAM(7) + + + CHARACTER*(*) NAME + CHARACTER*5 NAM + + CALL QTRACE('QNBOOK ',0) + + CALL CHKNAM(ID,NAME,'QNBOOK',NAM) + + PNAM(ID) = NAM + LNFP(ID,3) = .TRUE. + LNFP(ID,4) = .TRUE. + LNFP(ID,5) = .TRUE. + PWGT(ID,ID,3) = 1. + PWGT(ID,ID,4) = 1. + PWGT(ID,ID,5) = 1. + + RETURN + END + +!DECK ID>, QNLINC. + +! =================================== + SUBROUTINE QNLINC(ID,NAME,NF,WEITS) +! =================================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + CHARACTER*5 PNAM,STFNAM + LOGICAL LNFP + COMMON /QCLNFP/ LNFP(0:30,3:5) + COMMON /QCPNAM/ PNAM(0:30) + COMMON /QCPWGT/ PWGT(0:10,0:30,3:5) + COMMON /QCFNAM/ STFNAM(7) + + + CHARACTER*(*) NAME + CHARACTER*5 NAM + DIMENSION WEITS(10) + + CALL QTRACE('QNLINC ',0) + + IF(ID.LE.10.OR.ID.GE.31) THEN + IERR = 1 + GOTO 500 + ENDIF + + IF(NF.LT.3 .OR.NF.GT.5 ) THEN + IERR = 2 + GOTO 500 + ENDIF + + CALL CHKNAM(ID,NAME,'QNLINC',NAM) + + PNAM(ID) = NAM + LNFP(ID,NF) = .TRUE. + DO 20 I=1,10 + PWGT(I,ID,NF) = WEITS(I) + 20 END DO + + RETURN + + 500 CONTINUE + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r QNLINC ---> STOP'')') + WRITE(6,'( '' ------------------------------------'')') + WRITE(6,'( '' Input ID :'',I0)') ID + WRITE(6,'( '' NAME :'',A)') NAME + WRITE(6,'( '' NF :'',I0)') NF + WRITE(6,'( '' FACTORS(1):'',E12.5)') WEITS(1) + IF(IERR.EQ.1) THEN + WRITE(6,'(/'' ID outside allowed range [11,30]'')') + ELSEIF(IERR.EQ.2) THEN + WRITE(6,'(/'' NF outside allowed range [3,5]'')') + ENDIF + + CALL QTRACE('QNLINC ',1) + + STOP + + END + +!DECK ID>, QNGIVE. + +! =================================== + SUBROUTINE QNGIVE(ID,NF,NAME,WEITS) +! =================================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + CHARACTER*5 PNAM,STFNAM + LOGICAL LNFP + COMMON /QCLNFP/ LNFP(0:30,3:5) + COMMON /QCPNAM/ PNAM(0:30) + COMMON /QCPWGT/ PWGT(0:10,0:30,3:5) + COMMON /QCFNAM/ STFNAM(7) + + + CHARACTER*5 NAME + DIMENSION WEITS(10) + + CALL QTRACE('QNGIVE ',1) + + IF(ID.LT.0.OR.ID.GT.30.OR.NF.LT.3.OR.NF.GT.5) THEN + + NAME = 'NULL ' + DO 10 I=1,10 + WEITS(I) = 0. + 10 CONTINUE + + ELSE + + NAME = PNAM(ID) + DO 15 I=1,10 + WEITS(I) = PWGT(I,ID,NF) + 15 CONTINUE + + ENDIF + + RETURN + END + +!DECK ID>, IDCHEK. + +! ============================= + INTEGER FUNCTION IPDFID(UNAM) +! ============================= + +!--- IPDFID = identifier of memory resident quark distn + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + CHARACTER*(*) UNAM + CHARACTER*5 NAM + + + CHARACTER*5 PNAM,STFNAM + LOGICAL LNFP + COMMON /QCLNFP/ LNFP(0:30,3:5) + COMMON /QCPNAM/ PNAM(0:30) + COMMON /QCPWGT/ PWGT(0:10,0:30,3:5) + COMMON /QCFNAM/ STFNAM(7) + + + CALL QTRACE('IPDFID ',0) + + CALL QSTRIP(UNAM,NAM) + + IF(NAM.EQ.' '.OR.NAM.EQ.'FREE ') THEN + GOTO 500 + ENDIF + + ID = -1 + DO I = 1,10 + IF(NAM.EQ.PNAM(I)) ID = I + ENDDO + + IPDFID = ID + + IF(ID.EQ.-1) THEN + GOTO 500 + ENDIF + + RETURN + + 500 CONTINUE + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r IPDFID ---> STOP'')') + WRITE(6,'( '' ------------------------------------'')') + WRITE(6,'( '' Input NAME :'',A)') UNAM + WRITE(6,'(/'' NAME not booked at all or NAME does not refer''/ & + & '' to a memory resident quark distribution'')') + IF(NAM(1:1).EQ.' ') & + &WRITE(6,'(/'' WARNING: NAME has one or more leading blanks'')') + + CALL QTRACE('IPDFID ',1) + + STOP + END + + +!DECK ID>, IDCHEK. + +! ============================================ + INTEGER FUNCTION IDCHEK(NAM,NF,SRNAME,ISTOP) +! ============================================ + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + CHARACTER*6 SRNAME + CHARACTER*5 NAMLAST,NAM + + + CHARACTER*5 PNAM,STFNAM + LOGICAL LNFP + COMMON /QCLNFP/ LNFP(0:30,3:5) + COMMON /QCPNAM/ PNAM(0:30) + COMMON /QCPWGT/ PWGT(0:10,0:30,3:5) + COMMON /QCFNAM/ STFNAM(7) + + + SAVE IDLAST,NAMLAST + + DATA IDLAST / 0 / + DATA NAMLAST / ' ' / + + IDCHEK = -1 + + IF(NAM.EQ.' '.OR.NAM.EQ.'FREE '.OR. & + & NF.LT.3.OR.NF.GT.5) THEN + IF(ISTOP.EQ.1) THEN + IERR = 1 + GOTO 500 + ENDIF + RETURN + ENDIF + + ID = -1 + IF(NAM.EQ.NAMLAST.AND.LNFP(IDLAST,NF)) THEN + ID = IDLAST + ELSE + DO 10 I = 0,30 + IF(NAM.EQ.PNAM(I).AND.LNFP(I,NF)) ID = I + 10 CONTINUE + IDLAST = ID + NAMLAST = NAM + ENDIF + + IDCHEK = ID + + IF(ID.EQ.-1.AND.ISTOP.EQ.1) THEN + IERR = 2 + GOTO 500 + ENDIF + + RETURN + + 500 CONTINUE + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r '',A,'' ---> STOP'')') & + & SRNAME + WRITE(6,'( '' ------------------------------------'')') + WRITE(6,'( '' Input NAME :'',A)') NAM + WRITE(6,'( '' NF :'',I10)') NF + IF(IERR.EQ.1) THEN + WRITE(6,'(/'' Input name not allowed and/or NF outside'', & + & '' the allowed range [3,5]'')') + ELSEIF(IERR.EQ.2) THEN + WRITE(6,'(/'' NAME not booked at all or, if NAME refers to''/ & + & '' a linear combination, it might not have been''/ & + & '' booked for NF flavours'')') + IF(NAM(1:1).EQ.' ') & + & WRITE(6,'(/'' WARNING: NAME has one or more leading blanks'')') + ENDIF + + CALL QTRACE('IDCHEK ',1) + + STOP + END + +!DECK ID>, QNLIST. + +! ====================== + SUBROUTINE QNLIST(LUN) +! ====================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + CHARACTER*5 NAM + CHARACTER*3 II + + + CHARACTER*5 PNAM,STFNAM + LOGICAL LNFP + COMMON /QCLNFP/ LNFP(0:30,3:5) + COMMON /QCPNAM/ PNAM(0:30) + COMMON /QCPWGT/ PWGT(0:10,0:30,3:5) + COMMON /QCFNAM/ STFNAM(7) + + + WRITE(LUN,'(////)') + WRITE(LUN,'(1X,''+'',13(''-''),''+'',60(''-''),''+'')') + WRITE(LUN,'('' | | W_'',I2, & + & 9('' W_'',I2),'' |'')') (J, J=1,10) + WRITE(LUN,'('' | ID NAME nf | '',A4, & + & 9(2X,A4),'' |'')') (PNAM(J),J=1,10) + WRITE(LUN,'(1X,''+'',13(''-''),''+'',60(''-''),''+'')') + DO I = 0,10 + IF(IDCHEK(PNAM(I),3,' ',0).EQ.-1) EXIT + WRITE(LUN,'('' |'',I3,1X,A5,'' |'',F5.2, & + &9(F6.2),'' |'')') I, PNAM(I),(PWGT(J,I,3),J=1,10) + END DO + WRITE(LUN,'(1X,''+'',13(''-''),''+'',60(''-''),''+'')') + DO 20 I = 11,30 + NAM = PNAM(I) + WRITE(II,'(I3)') I + IF(IDCHEK(PNAM(I),3,' ',0).NE.-1) THEN + WRITE(LUN,'('' |'',A3,1X,A5,'' 3 |'',F5.2, & + & 9(F6.2),'' |'')') II, NAM,(PWGT(J,I,3),J=1,10) + NAM = ' ' + II = ' ' + ENDIF + IF(IDCHEK(PNAM(I),4,' ',0).NE.-1) THEN + WRITE(LUN,'('' |'',A3,1X,A5,'' 4 |'',F5.2, & + & 9(F6.2),'' |'')') II, NAM,(PWGT(J,I,4),J=1,10) + NAM = ' ' + II = ' ' + ENDIF + IF(IDCHEK(PNAM(I),5,' ',0).NE.-1) THEN + WRITE(LUN,'('' |'',A3,1X,A5,'' 5 |'',F5.2, & + & 9(F6.2),'' |'')') II, NAM, (PWGT(J,I,5),J=1,10) + NAM = ' ' + II = ' ' + ENDIF + 20 END DO + WRITE(LUN,'(1X,''+'',13(''-''),''+'',60(''-''),''+'')') + WRITE(LUN,'(////)') + + RETURN + END + +!DECK ID>, QNPSET. +! ================================= + SUBROUTINE QNPSET(UNAM,IX,IQ,VAL) +! ================================= + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + CHARACTER*(*) UNAM + CHARACTER*5 NAME + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + + + CHARACTER*5 PNAM,STFNAM + LOGICAL LNFP + COMMON /QCLNFP/ LNFP(0:30,3:5) + COMMON /QCPNAM/ PNAM(0:30) + COMMON /QCPWGT/ PWGT(0:10,0:30,3:5) + COMMON /QCFNAM/ STFNAM(7) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + CALL QTRACE('QNPSET ',0) + + IF(NXX.EQ.0.OR.NQ2.EQ.0) THEN + IERR = 1 + GOTO 500 + ENDIF + + CALL QSTRIP(UNAM,NAME) + + ID = IDCHEK(NAME,4,'QNPSET',1) + + IF(ID.EQ.-1) RETURN + + IF(IX.LT.1.OR.IX.GT.NXX) THEN + IERR = 2 + GOTO 500 + ENDIF + + IF(IQ.LT.1.OR.IQ.GT.NQ2) THEN + IERR = 2 + GOTO 500 + ENDIF + + IF(ID.LT.0.OR.ID.GT.10) THEN + IERR = 3 + GOTO 500 + ENDIF + +!-- If a different input value, invalidate evolution for this +!-- and all lower x-grid points + IF(VAL.NE.PDFQCD(IX,IQ,ID)) THEN + DO JX = 1,IX + LEVDONE(JX,MAX(ID,1)) = .FALSE. + ENDDO + ENDIF + + PDFQCD(IX,IQ,ID) = VAL + + DO I = 1,30 + DO J = 1,7 + LFFCAL(J,I) = .FALSE. + ENDDO + ENDDO + + RETURN + + 500 CONTINUE + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r QNPSET ---> STOP'')') + WRITE(6,'( '' ------------------------------------'')') + WRITE(6,'( '' Input NAME :'',A)') UNAM + WRITE(6,'( '' IX :'',I10)') IX + WRITE(6,'( '' IQ :'',I10)') IQ + WRITE(6,'( '' Value :'',E12.5)') VAL + IF(IERR.EQ.1) THEN + WRITE(6,'(/'' No x-Q2 grid available'')') + ELSEIF(IERR.EQ.2) THEN + WRITE(6,'(/'' IX and/or IQ outside grid boundary'')') + ELSEIF(IERR.EQ.3) THEN + WRITE(6,'(/'' Apparently you try to assign a value'', & + & '' to a linear combination: no thank you'')') + ENDIF + + CALL QTRACE('QNPSET ',1) + + STOP + + END + +!DECK ID>, QADDSI. + +! ================================= + SUBROUTINE QADDSI(UNAM,IQ,FACTOR) +! ================================= + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + CHARACTER*(*) UNAM + CHARACTER*5 NAME + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + + + CHARACTER*5 PNAM,STFNAM + LOGICAL LNFP + COMMON /QCLNFP/ LNFP(0:30,3:5) + COMMON /QCPNAM/ PNAM(0:30) + COMMON /QCPWGT/ PWGT(0:10,0:30,3:5) + COMMON /QCFNAM/ STFNAM(7) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + CALL QTRACE('QADDSI ',0) + + IF(NXX.EQ.0.OR.NQ2.EQ.0) THEN + IERR = 1 + GOTO 500 + ENDIF + + CALL QSTRIP(UNAM,NAME) + + ID = IDCHEK(NAME,4,'QADDSI',1) + + IF(ID.EQ.-1) RETURN + + IF(ID.EQ.0.OR.ID.EQ.1) THEN + IERR = 2 + GOTO 500 + ENDIF + + IF(IQ.LT.1.OR.IQ.GT.NQ2) THEN + IERR = 3 + GOTO 500 + ENDIF + + IF(ID.LT.0.OR.ID.GT.10) THEN + IERR = 4 + GOTO 500 + ENDIF + + DO IX = 1,NXX +!-- Invalidate evolution of this pdf + LEVDONE(IX,MAX(ID,1)) = .FALSE. + PDFQCD(IX,IQ,ID) = PDFQCD(IX,IQ,ID)+ & + & FACTOR*PDFQCD(IX,IQ,1) + ENDDO + + DO I = 1,30 + DO J = 1,7 + LFFCAL(J,I) = .FALSE. + ENDDO + ENDDO + + RETURN + + 500 CONTINUE + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r QADDSI ---> STOP'')') + WRITE(6,'( '' ------------------------------------'')') + WRITE(6,'( '' Input NAME :'',A)') UNAM + WRITE(6,'( '' IQ :'',I10)') IQ + WRITE(6,'( '' Factor :'',E12.5)') FACTOR + IF(IERR.EQ.1) THEN + WRITE(6,'(/'' No x-Q2 grid available'')') + ELSEIF(IERR.EQ.2) THEN + WRITE(6,'(/'' This routine cannot be used'', & + & '' for singlet or gluon'')') + ELSEIF(IERR.EQ.3) THEN + WRITE(6,'(/'' IX and/or IQ outside grid boundary'')') + ELSEIF(IERR.EQ.4) THEN + WRITE(6,'(/'' Apparently you try to assign a value'', & + & '' to a linear combination: no thank you'')') + ENDIF + + CALL QTRACE('QADDSI ',1) + + STOP + + END + +!DECK ID>, QNPNUL. + +! ======================= + SUBROUTINE QNPNUL(UNAM) +! ======================= + +!--- Set parton distribution 'NAME' to zero. +!--- Called by user. + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + CHARACTER*(*) UNAM + CHARACTER*5 NAME + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + + + CHARACTER*5 PNAM,STFNAM + LOGICAL LNFP + COMMON /QCLNFP/ LNFP(0:30,3:5) + COMMON /QCPNAM/ PNAM(0:30) + COMMON /QCPWGT/ PWGT(0:10,0:30,3:5) + COMMON /QCFNAM/ STFNAM(7) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + CALL QTRACE('QNPNUL ',0) + + CALL QSTRIP(UNAM,NAME) + + ID = IDCHEK(NAME,4,'QNPNUL',1) + + IF(ID.EQ.-1) RETURN + + IF(ID.LT.0.OR.ID.GT.10) THEN + GOTO 500 + ENDIF + + DO IX = 1,MXX + DO IQ = 1,MQ2 + PDFQCD(IX,IQ,ID) = 0. + ENDDO + ENDDO + +!-- Invalidate all evolutions + CALL QNFALS(LEVDONE,MXX*10) + + DO I = 1,30 + DO J = 1,7 + LFFCAL(J,I) = .FALSE. + ENDDO + ENDDO + + RETURN + + 500 CONTINUE + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r QNPNUL ---> STOP'')') + WRITE(6,'( '' ------------------------------------'')') + WRITE(6,'( '' Input NAME :'',A)') UNAM + WRITE(6,'(/'' Apparently you try to clear'', & + & '' a linear combination: no thank you'')') + + CALL QTRACE('QNPNUL ',1) + + STOP + + END + +!DECK ID>, IX1CHK. + +! ============================== + INTEGER FUNCTION IX1CHK(ISTOP) +! ============================== + +!--- Check all pdfs are zero at NXX+1 (x = 1). +!--- IX1CHK = 0 : All ok. +!--- = 1 : Nonzero entry in gluon or singlet. +!--- = 2-10 : Nonzero entry in PDF 2-10. +!--- Called by user. + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + + + CHARACTER*5 PNAM,STFNAM + LOGICAL LNFP + COMMON /QCLNFP/ LNFP(0:30,3:5) + COMMON /QCPNAM/ PNAM(0:30) + COMMON /QCPWGT/ PWGT(0:10,0:30,3:5) + COMMON /QCFNAM/ STFNAM(7) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + CALL QTRACE('IX1CHK ',0) + + IERR = -1 + JQ = 0 + + DO ID = 0,10 + DO IQ = 1,NQ2 + IF(ABS(PDFQCD(NXX+1,IQ,ID)).GT.1.E-11) THEN + IERR = ID + JQ = IQ + ENDIF + ENDDO + ENDDO + + IF(IERR.EQ.-1) THEN + IX1CHK = 0 + RETURN + ENDIF + + IX1CHK = MAX(IERR,1) + IF(ISTOP.EQ.0) RETURN + + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r IX1CHK ---> STOP'')') + WRITE(6,'( '' ------------------------------------'')') + WRITE(6,'( '' Pdf identifier ID :'',I5)') IERR + WRITE(6,'( '' X = 1 gridpoint IX :'',I5)') NXX+1 + WRITE(6,'( '' Q2 gridpoint IQ :'',I5)') JQ + WRITE(6,'(/'' Pdf nonzero at x = 1;''/ & + & '' this should never happen....'')') + + CALL QTRACE('IX1CHK ',1) + + STOP + + END + +!DECK ID>, EVOLSG. + +! ================================ + SUBROUTINE EVOLSG(IQ0,IUQL,IUQH) +! ================================ + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + LOGICAL LTIME + REAL T_START,T_END,T_SPENT + COMMON/QCTIME/T_START(10),T_END(10),T_SPENT(10),N_CALLS(10), & + &E_CALLS(10),LTIME + COMMON/QCFCNT/IFCNT(-1:1,5) + + + IF(LTIME) CALL TIMEX_LHA(T_START(5)) + + CALL QTRACE('EVOLSG ',0) + + IF(NXX.EQ.0.OR.NQ2.EQ.0) THEN + IERR = 1 + GOTO 500 + ENDIF + + IQL = IUQL + IQH = IUQH + + IXL = MAX(ABS(IXFROMX(XMICUT)),1) + IQD = ABS(IQFROMQ(QMICUT)) + IQD = MAX(IQD,ABS(IQFROMQ(QMINAS))) + IQU = ABS(IQFROMQ(QMACUT)) + IF(IQD.NE.0) IQL = MAX(IQD,IQL) + IF(IQU.NE.0) IQH = MIN(IQU+1,IQH) + + IF(IQL.LE.0) IQL = 1 + IF(IQH.LE.0.OR.IQH.GT.NQ2) IQH = NQ2 + IF(IQL.EQ.IQ0.AND.IQH.EQ.IQ0) RETURN + IF(IQL.GE.IQH) THEN + IERR = 2 + GOTO 500 + ENDIF + IF(IQL.LT.1.OR.IQL.GE.NQ2) THEN + IERR = 3 + GOTO 500 + ENDIF + IF(IQH.LE.1.OR.IQH.GT.NQ2) THEN + IERR = 3 + GOTO 500 + ENDIF + IF(IQ0.LT.IQL.OR.IQ0.GT.IQH) THEN + IERR = 4 + GOTO 500 + ENDIF + IF(.NOT.LWT1OK) THEN + IERR = 5 + GOTO 500 + ENDIF + IF(IORD.EQ.2.AND..NOT.LWT2OK) THEN + IERR = 6 + GOTO 500 + ENDIF + + IRUN = 0 + IF(.NOT.LALFOK) THEN + CALL QFILAS('EVOLSG') + IRUN = 1 + ENDIF + IF(.NOT.LDQ2OK) THEN + CALL QDELQ2 + IRUN = 1 + ENDIF + + DO IX = 1,NXX + LE_DONE(IX) = LEVDONE(IX,1) + DO IQ = 1,NQ2 + FGLQCD(IX,IQ) = PDFQCD(IX,IQ,0) + FSIQCD(IX,IQ) = PDFQCD(IX,IQ,1) + ENDDO + ENDDO + + IF(IQ0.NE.IQ0_LAST(1) .OR. & + & IQL.NE.IQL_LAST(1) .OR. & + & IQH.NE.IQH_LAST(1) ) IRUN = 1 + + CALL APSI(IXL,IQ0,IQL,IQH,IRUN,EVL) + + IQ0_LAST(1) = IQ0 + IQL_LAST(1) = IQL + IQH_LAST(1) = IQH + + DO IX = 1,NXX + LEVDONE(IX,1) = LE_DONE(IX) + DO IQ = 1,NQ2 + PDFQCD(IX,IQ,0) = FGLQCD(IX,IQ) + PDFQCD(IX,IQ,1) = FSIQCD(IX,IQ) + ENDDO + ENDDO + + DO I = 1,30 + DO J = 1,7 + LFFCAL(J,I) = .FALSE. + ENDDO + ENDDO + + IF(LTIME) THEN + CALL TIMEX_LHA(T_END(5)) + T_SPENT(5) = T_SPENT(5)+T_END(5)-T_START(5) + N_CALLS(5) = N_CALLS(5)+1 + E_CALLS(5) = E_CALLS(5)+EVL + ENDIF + + RETURN + + 500 CONTINUE + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r EVOLSG ---> STOP'')') + WRITE(6,'( '' ------------------------------------'')') + WRITE(6,'( '' Input IQ0 :'',I5)') IQ0 + WRITE(6,'( '' IQLow :'',I5)') IUQL + WRITE(6,'( '' IQHigh :'',I5)') IUQH + IF(IERR.NE.1) THEN + WRITE(6,'(/'' After cuts IQ0, Q20 :'',I5,E12.5)') IQ0,Q2TAB(IQ0) + WRITE(6,'( '' IQL, Q2L :'',I5,E12.5)') IQL,Q2TAB(IQL) + WRITE(6,'( '' IQH, Q2H :'',I5,E12.5)') IQH,Q2TAB(IQH) + ENDIF + IF(IERR.EQ.1) THEN + WRITE(6,'(/'' No x-Q2 grid available'')') + ELSEIF(IERR.EQ.2) THEN + WRITE(6,'(/'' Value of IQL .ge. IQH'', & + & '' (after applying Q2 cuts, if any)'')') + ELSEIF(IERR.EQ.3) THEN + WRITE(6,'(/'' IQL and/or IQH outside grid boundary'')') + ELSEIF(IERR.EQ.4) THEN + WRITE(6,'(/'' IQ0 outside the range [IQL,IQH]'', & + & '' (after applying Q2 cuts, if any)'')') + ELSEIF(IERR.EQ.5) THEN + WRITE(6,'(/'' No LO weight tables available'', & + & '' (please call s/r QNFILW)'')') + ELSEIF(IERR.EQ.6) THEN + WRITE(6,'(/'' No NLO weight tables available'', & + & '' (please call s/r QNFILW)'')') + ENDIF + + CALL QTRACE('EVOLSG ',1) + + STOP + + END + + +!DECK ID>, APSI. +! ========================================= + SUBROUTINE APSI(IXL,IQ0,IQL,IQH,IRUN,EVL) +! ========================================= + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + REAL & + &WGTFF1,WGTFG1, & + &WGTGF1,WGTGG1, & + &WGTPP2,WGTPM2,WGTNS2, & + &WGTFF2,WGTFG2, & + &WGTGF2,WGTGG2, & + &WGTC2Q,WGTC2G,YNTC2Q, & + &WGTCLQ,WGTCLG,WGTC3Q + + COMMON/QCWEIT/ & + &WGTFF1(MXX*(MXX+1)/2) ,WGTFG1(MXX*(MXX+1)/2,3:5), & + &WGTGF1(MXX*(MXX+1)/2) ,WGTGG1(MXX*(MXX+1)/2,3:5), & + &WGTPP2(MXX*(MXX+1)/2,3:5),WGTPM2(MXX*(MXX+1)/2,3:5), & + &WGTNS2(MXX*(MXX+1)/2,3:5), & + &WGTFF2(MXX*(MXX+1)/2,3:5),WGTFG2(MXX*(MXX+1)/2,3:5), & + &WGTGF2(MXX*(MXX+1)/2,3:5),WGTGG2(MXX*(MXX+1)/2,3:5), & + &WGTC2Q(MXX*(MXX+1)/2) ,WGTC2G(MXX*(MXX+1)/2,3:5), & + &WGTCLQ(MXX*(MXX+1)/2) ,WGTCLG(MXX*(MXX+1)/2,3:5), & + &WGTC3Q(MXX*(MXX+1)/2) ,YNTC2Q(MXX) + + COMMON/QCWADR/ IWADR(MXX,MXX) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + LOGICAL LTIME + REAL T_START,T_END,T_SPENT + COMMON/QCTIME/T_START(10),T_END(10),T_SPENT(10),N_CALLS(10), & + &E_CALLS(10),LTIME + COMMON/QCFCNT/IFCNT(-1:1,5) + + + EVL = 0. + + FSI = FSIQCD(NXX,IQ0) + FGL = FGLQCD(NXX,IQ0) +! ------------------------------------------- + ! + IF(.NOT.LE_DONE(NXX) .OR. IRUN.EQ.1) THEN +! ------------------------------------------- + + NF = NFMAP(IQ0) + + WQQ = ALFAPQ(IQ0) * WGTFF1(IWADR(NXX,NXX)) + & + & ALFA2Q(IQ0) * WGTFF2(IWADR(NXX,NXX),NF) + WQG = ALFAPQ(IQ0) * WGTFG1(IWADR(NXX,NXX),NF) + & + & ALFA2Q(IQ0) * WGTFG2(IWADR(NXX,NXX),NF) + WGQ = ALFAPQ(IQ0) * WGTGF1(IWADR(NXX,NXX)) + & + & ALFA2Q(IQ0) * WGTGF2(IWADR(NXX,NXX),NF) + WGG = ALFAPQ(IQ0) * WGTGG1(IWADR(NXX,NXX),NF) + & + & ALFA2Q(IQ0) * WGTGG2(IWADR(NXX,NXX),NF) + + DSI = WQQ*FSI+WQG*FGL + DGL = WGQ*FSI+WGG*FGL + + FSI0 = FSI + DSI0 = DSI + FGL0 = FGL + DGL0 = DGL + FSIQCD(NXX,IQ0) = FSI + DSIQCD(NXX,IQ0) = DSI + FGLQCD(NXX,IQ0) = FGL + DGGQCD(NXX,IQ0) = DGL + EVL = EVL+1. + + DO 100 IQ = IQ0+1,IQH + DEL = DELUP(IQ) + NF = NFMAP(IQ) + WQQ = ALFAPQ(IQ) * WGTFF1(IWADR(NXX,NXX)) + & + & ALFA2Q(IQ) * WGTFF2(IWADR(NXX,NXX),NF) + WQG = ALFAPQ(IQ) * WGTFG1(IWADR(NXX,NXX),NF) + & + & ALFA2Q(IQ) * WGTFG2(IWADR(NXX,NXX),NF) + WGQ = ALFAPQ(IQ) * WGTGF1(IWADR(NXX,NXX)) + & + & ALFA2Q(IQ) * WGTGF2(IWADR(NXX,NXX),NF) + WGG = ALFAPQ(IQ) * WGTGG1(IWADR(NXX,NXX),NF) + & + & ALFA2Q(IQ) * WGTGG2(IWADR(NXX,NXX),NF) + AAS = 2.*FSI + DSI*DEL + BBS = 2. - WQQ*DEL + AAG = 2.*FGL + DGL*DEL + BBG = 2. - WGG*DEL + FSI = (AAS*BBG+WQG*AAG*DEL) / (BBS*BBG-WQG*WGQ*DEL*DEL) + FGL = (AAG*BBS+WGQ*AAS*DEL) / (BBG*BBS-WGQ*WQG*DEL*DEL) + DSI = WQQ*FSI+WQG*FGL + DGL = WGQ*FSI+WGG*FGL + FSIQCD(NXX,IQ) = FSI + DSIQCD(NXX,IQ) = DSI + FGLQCD(NXX,IQ) = FGL + DGGQCD(NXX,IQ) = DGL + 100 CONTINUE + EVL = EVL+IQH-IQ0 + + FSI = FSI0 + DSI = DSI0 + FGL = FGL0 + DGL = DGL0 + + DO 200 IQ = IQ0-1,IQL,-1 + DEL = DELDN(IQ) + NF = NFMAP(IQ) + WQQ = ALFAPQ(IQ) * WGTFF1(IWADR(NXX,NXX)) + & + & ALFA2Q(IQ) * WGTFF2(IWADR(NXX,NXX),NF) + WQG = ALFAPQ(IQ) * WGTFG1(IWADR(NXX,NXX),NF) + & + & ALFA2Q(IQ) * WGTFG2(IWADR(NXX,NXX),NF) + WGQ = ALFAPQ(IQ) * WGTGF1(IWADR(NXX,NXX)) + & + & ALFA2Q(IQ) * WGTGF2(IWADR(NXX,NXX),NF) + WGG = ALFAPQ(IQ) * WGTGG1(IWADR(NXX,NXX),NF) + & + & ALFA2Q(IQ) * WGTGG2(IWADR(NXX,NXX),NF) + AAS = 2.*FSI + DSI*DEL + BBS = 2. - WQQ*DEL + AAG = 2.*FGL + DGL*DEL + BBG = 2. - WGG*DEL + FSI = (AAS*BBG+WQG*AAG*DEL) / (BBS*BBG-WQG*WGQ*DEL*DEL) + FGL = (AAG*BBS+WGQ*AAS*DEL) / (BBG*BBS-WGQ*WQG*DEL*DEL) + DSI = WQQ*FSI+WQG*FGL + DGL = WGQ*FSI+WGG*FGL + FSIQCD(NXX,IQ) = FSI + DSIQCD(NXX,IQ) = DSI + FGLQCD(NXX,IQ) = FGL + DGGQCD(NXX,IQ) = DGL + 200 CONTINUE + EVL = EVL+IQ0-IQL + +! ------- + ! + ENDIF +! ------- + +! --------------------------- + ! + DO IX0 = NXX-1,IXL,-1 +! --------------------------- + + FSI = FSIQCD(IX0,IQ0) + FGL = FGLQCD(IX0,IQ0) + IF(LE_DONE(IX0) .AND. IRUN.EQ.0) EXIT + ALF = ALFAPQ(IQ0) + AL2 = ALFA2Q(IQ0) + SQQ1 = 0. + SQG1 = 0. + SGQ1 = 0. + SGG1 = 0. + SQQ2 = 0. + SQG2 = 0. + SGQ2 = 0. + SGG2 = 0. + NF = NFMAP(IQ0) + DO 220 IX = NXX,IX0+1,-1 + IADR = IWADR(IX,IX0) + SQQ1 = SQQ1 + WGTFF1(IADR) * FSIQCD(IX,IQ0) + SQQ2 = SQQ2 + WGTFF2(IADR,NF) * FSIQCD(IX,IQ0) + SQG1 = SQG1 + WGTFG1(IADR,NF) * FGLQCD(IX,IQ0) + SQG2 = SQG2 + WGTFG2(IADR,NF) * FGLQCD(IX,IQ0) + SGQ1 = SGQ1 + WGTGF1(IADR) * FSIQCD(IX,IQ0) + SGQ2 = SGQ2 + WGTGF2(IADR,NF) * FSIQCD(IX,IQ0) + SGG1 = SGG1 + WGTGG1(IADR,NF) * FGLQCD(IX,IQ0) + SGG2 = SGG2 + WGTGG2(IADR,NF) * FGLQCD(IX,IQ0) + 220 CONTINUE + IAD = IWADR(IX0,IX0) + SQQ = ALF*SQQ1 + AL2*SQQ2 + SQG = ALF*SQG1 + AL2*SQG2 + SGQ = ALF*SGQ1 + AL2*SGQ2 + SGG = ALF*SGG1 + AL2*SGG2 + WQQ = ALF* WGTFF1(IAD) + AL2*WGTFF2(IAD,NF) + WQG = ALF* WGTFG1(IAD,NF) + AL2*WGTFG2(IAD,NF) + WGQ = ALF* WGTGF1(IAD) + AL2*WGTGF2(IAD,NF) + WGG = ALF* WGTGG1(IAD,NF) + AL2*WGTGG2(IAD,NF) + DSI = WQQ*FSI+SQQ+WQG*FGL+SQG + DGL = WGQ*FSI+SGQ+WGG*FGL+SGG + + FSI0 = FSI + DSI0 = DSI + FGL0 = FGL + DGL0 = DGL + FSIQCD(IX0,IQ0) = FSI + DSIQCD(IX0,IQ0) = DSI + FGLQCD(IX0,IQ0) = FGL + DGGQCD(IX0,IQ0) = DGL + EVL = EVL+NXX-IX0+1 + + DO 250 IQ = IQ0+1,IQH + IF(IFAILC(IX0,IQ).NE.0) GOTO 250 + ALF = ALFAPQ(IQ) + AL2 = ALFA2Q(IQ) + DEL = DELUP(IQ) + SQQ1 = 0. + SQG1 = 0. + SGQ1 = 0. + SGG1 = 0. + SQQ2 = 0. + SQG2 = 0. + SGQ2 = 0. + SGG2 = 0. + NF = NFMAP(IQ) + DO 230 IX = NXX,IX0+1,-1 + IADR = IWADR(IX,IX0) + SQQ1 = SQQ1 + WGTFF1(IADR) * FSIQCD(IX,IQ) + SQQ2 = SQQ2 + WGTFF2(IADR,NF) * FSIQCD(IX,IQ) + SQG1 = SQG1 + WGTFG1(IADR,NF) * FGLQCD(IX,IQ) + SQG2 = SQG2 + WGTFG2(IADR,NF) * FGLQCD(IX,IQ) + SGQ1 = SGQ1 + WGTGF1(IADR) * FSIQCD(IX,IQ) + SGQ2 = SGQ2 + WGTGF2(IADR,NF) * FSIQCD(IX,IQ) + SGG1 = SGG1 + WGTGG1(IADR,NF) * FGLQCD(IX,IQ) + SGG2 = SGG2 + WGTGG2(IADR,NF) * FGLQCD(IX,IQ) + 230 CONTINUE + IAD = IWADR(IX0,IX0) + SQQ = ALF*SQQ1 + AL2*SQQ2 + SQG = ALF*SQG1 + AL2*SQG2 + SGQ = ALF*SGQ1 + AL2*SGQ2 + SGG = ALF*SGG1 + AL2*SGG2 + WQQ = ALF* WGTFF1(IAD) + AL2*WGTFF2(IAD,NF) + WQG = ALF* WGTFG1(IAD,NF) + AL2*WGTFG2(IAD,NF) + WGQ = ALF* WGTGF1(IAD) + AL2*WGTGF2(IAD,NF) + WGG = ALF* WGTGG1(IAD,NF) + AL2*WGTGG2(IAD,NF) + AAS = 2.*FSI + (DSI+SQQ+SQG)*DEL + BBS = 2. - WQQ*DEL + AAG = 2.*FGL + (DGL+SGQ+SGG)*DEL + BBG = 2. - WGG*DEL + FSI = (AAS*BBG+WQG*AAG*DEL) / (BBS*BBG-WQG*WGQ*DEL*DEL) + FGL = (AAG*BBS+WGQ*AAS*DEL) / (BBG*BBS-WGQ*WQG*DEL*DEL) + DSI = WQQ*FSI+SQQ+WQG*FGL+SQG + DGL = WGQ*FSI+SGQ+WGG*FGL+SGG + FSIQCD(IX0,IQ) = FSI + DSIQCD(IX0,IQ) = DSI + FGLQCD(IX0,IQ) = FGL + DGGQCD(IX0,IQ) = DGL + EVL = EVL+NXX-IX0+1 + 250 CONTINUE + + FSI = FSI0 + DSI = DSI0 + FGL = FGL0 + DGL = DGL0 + + DO 270 IQ = IQ0-1,IQL,-1 + ALF = ALFAPQ(IQ) + AL2 = ALFA2Q(IQ) + DEL = DELDN(IQ) + SQQ1 = 0. + SQG1 = 0. + SGQ1 = 0. + SGG1 = 0. + SQQ2 = 0. + SQG2 = 0. + SGQ2 = 0. + SGG2 = 0. + NF = NFMAP(IQ) + DO 260 IX = NXX,IX0+1,-1 + IADR = IWADR(IX,IX0) + SQQ1 = SQQ1 + WGTFF1(IADR) * FSIQCD(IX,IQ) + SQQ2 = SQQ2 + WGTFF2(IADR,NF) * FSIQCD(IX,IQ) + SQG1 = SQG1 + WGTFG1(IADR,NF) * FGLQCD(IX,IQ) + SQG2 = SQG2 + WGTFG2(IADR,NF) * FGLQCD(IX,IQ) + SGQ1 = SGQ1 + WGTGF1(IADR) * FSIQCD(IX,IQ) + SGQ2 = SGQ2 + WGTGF2(IADR,NF) * FSIQCD(IX,IQ) + SGG1 = SGG1 + WGTGG1(IADR,NF) * FGLQCD(IX,IQ) + SGG2 = SGG2 + WGTGG2(IADR,NF) * FGLQCD(IX,IQ) + 260 CONTINUE + IAD = IWADR(IX0,IX0) + SQQ = ALF*SQQ1 + AL2*SQQ2 + SQG = ALF*SQG1 + AL2*SQG2 + SGQ = ALF*SGQ1 + AL2*SGQ2 + SGG = ALF*SGG1 + AL2*SGG2 + WQQ = ALF* WGTFF1(IAD) + AL2*WGTFF2(IAD,NF) + WQG = ALF* WGTFG1(IAD,NF) + AL2*WGTFG2(IAD,NF) + WGQ = ALF* WGTGF1(IAD) + AL2*WGTGF2(IAD,NF) + WGG = ALF* WGTGG1(IAD,NF) + AL2*WGTGG2(IAD,NF) + AAS = 2.*FSI + (DSI+SQQ+SQG)*DEL + BBS = 2. - WQQ*DEL + AAG = 2.*FGL + (DGL+SGQ+SGG)*DEL + BBG = 2. - WGG*DEL + FSI = (AAS*BBG+WQG*AAG*DEL) / (BBS*BBG-WQG*WGQ*DEL*DEL) + FGL = (AAG*BBS+WGQ*AAS*DEL) / (BBG*BBS-WGQ*WQG*DEL*DEL) + DSI = WQQ*FSI+SQQ+WQG*FGL+SQG + DGL = WGQ*FSI+SGQ+WGG*FGL+SGG + FSIQCD(IX0,IQ) = FSI + DSIQCD(IX0,IQ) = DSI + FGLQCD(IX0,IQ) = FGL + DGGQCD(IX0,IQ) = DGL + EVL = EVL+NXX-IX0+1 + 270 CONTINUE + +! ---------- + ! + END DO +! ---------- + + EVL = EVL*2./(NXX*(NXX+1)*NQ2) + + CALL QNTRUE(LE_DONE,NXX) + + RETURN + END + +!DECK ID>, EVOLNM. + +! ===================================== + SUBROUTINE EVOLNM(UNAM,IQ0,IUQL,IUQH) +! ===================================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + CHARACTER*(*) UNAM + CHARACTER*5 NAME + + + CHARACTER*5 PNAM,STFNAM + LOGICAL LNFP + COMMON /QCLNFP/ LNFP(0:30,3:5) + COMMON /QCPNAM/ PNAM(0:30) + COMMON /QCPWGT/ PWGT(0:10,0:30,3:5) + COMMON /QCFNAM/ STFNAM(7) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + REAL & + &WGTFF1,WGTFG1, & + &WGTGF1,WGTGG1, & + &WGTPP2,WGTPM2,WGTNS2, & + &WGTFF2,WGTFG2, & + &WGTGF2,WGTGG2, & + &WGTC2Q,WGTC2G,YNTC2Q, & + &WGTCLQ,WGTCLG,WGTC3Q + + COMMON/QCWEIT/ & + &WGTFF1(MXX*(MXX+1)/2) ,WGTFG1(MXX*(MXX+1)/2,3:5), & + &WGTGF1(MXX*(MXX+1)/2) ,WGTGG1(MXX*(MXX+1)/2,3:5), & + &WGTPP2(MXX*(MXX+1)/2,3:5),WGTPM2(MXX*(MXX+1)/2,3:5), & + &WGTNS2(MXX*(MXX+1)/2,3:5), & + &WGTFF2(MXX*(MXX+1)/2,3:5),WGTFG2(MXX*(MXX+1)/2,3:5), & + &WGTGF2(MXX*(MXX+1)/2,3:5),WGTGG2(MXX*(MXX+1)/2,3:5), & + &WGTC2Q(MXX*(MXX+1)/2) ,WGTC2G(MXX*(MXX+1)/2,3:5), & + &WGTCLQ(MXX*(MXX+1)/2) ,WGTCLG(MXX*(MXX+1)/2,3:5), & + &WGTC3Q(MXX*(MXX+1)/2) ,YNTC2Q(MXX) + + COMMON/QCWADR/ IWADR(MXX,MXX) + + + LOGICAL LTIME + REAL T_START,T_END,T_SPENT + COMMON/QCTIME/T_START(10),T_END(10),T_SPENT(10),N_CALLS(10), & + &E_CALLS(10),LTIME + COMMON/QCFCNT/IFCNT(-1:1,5) + + + IF(LTIME) CALL TIMEX_LHA(T_START(3)) + + CALL QTRACE('EVOLNM ',0) + + IF(NXX.EQ.0.OR.NQ2.EQ.0) THEN + IERR = 1 + GOTO 500 + ENDIF + + IQL = IUQL + IQH = IUQH + + IXL = MAX(ABS(IXFROMX(XMICUT)),1) + IQD = ABS(IQFROMQ(QMICUT)) + IQD = MAX(IQD,ABS(IQFROMQ(QMINAS))) + IQU = ABS(IQFROMQ(QMACUT)) + IF(IQD.NE.0) IQL = MAX(IQD,IQL) + IF(IQU.NE.0) IQH = MIN(IQU+1,IQH) + + IF(IQL.LE.0) IQL = 1 + IF(IQH.LE.0.OR.IQH.GT.NQ2) IQH = NQ2 + IF(IQL.EQ.IQ0.AND.IQH.EQ.IQ0) RETURN + IF(IQL.GE.IQH) THEN + IERR = 2 + GOTO 500 + ENDIF + IF(IQL.LT.1.OR.IQL.GE.NQ2) THEN + IERR = 3 + GOTO 500 + ENDIF + IF(IQH.LE.1.OR.IQH.GT.NQ2) THEN + IERR = 3 + GOTO 500 + ENDIF + IF(IQ0.LT.IQL.OR.IQ0.GT.IQH) THEN + IERR = 4 + GOTO 500 + ENDIF + IF(.NOT.LWT1OK) THEN + IERR = 5 + GOTO 500 + ENDIF + IF(IORD.EQ.2.AND..NOT.LWT2OK) THEN + IERR = 6 + GOTO 500 + ENDIF + + CALL QSTRIP(UNAM,NAME) + + NFMI = 9 + NFMA = 0 + DO 15 IQ = IQL,IQH + NFMI = MIN(NFMI,NFMAP(IQ)) + NFMA = MAX(NFMA,NFMAP(IQ)) + 15 END DO + + DO 16 NF = NFMI,NFMA + ID = IDCHEK(NAME,NF,'EVOLNM',1) + 16 END DO + + IRUN = 0 + IF(LPLUS) THEN + DO 19 NF = 3,5 + DO 18 IX0 = 1,NXX + DO 17 IX = IX0,NXX + WGTNS2(IWADR(IX,IX0),NF) = WGTPM2(IWADR(IX,IX0),NF) + 17 CONTINUE + 18 CONTINUE + 19 CONTINUE + IRUN = 1 + ENDIF + LPLUS = .FALSE. + + IF(.NOT.LALFOK) THEN + CALL QFILAS('EVOLNM') + IRUN = 1 + ENDIF + IF(.NOT.LDQ2OK) THEN + CALL QDELQ2 + IRUN = 1 + ENDIF + + DO IX = 1,NXX + LE_DONE(IX) = LEVDONE(IX,ID) + DO IQ = 1,NQ2 + FNSQCD(IX,IQ) = PDFQCD(IX,IQ,ID) + ENDDO + ENDDO + + IF(IQ0.NE.IQ0_LAST(ID) .OR. & + & IQL.NE.IQL_LAST(ID) .OR. & + & IQH.NE.IQH_LAST(ID) ) IRUN = 1 + + CALL APNS(IXL,IQ0,IQL,IQH,IRUN,EVL) + + IQ0_LAST(ID) = IQ0 + IQL_LAST(ID) = IQL + IQH_LAST(ID) = IQH + + DO IX = 1,NXX + LEVDONE(IX,ID) = LE_DONE(IX) + DO IQ = 1,NQ2 + PDFQCD(IX,IQ,ID) = FNSQCD(IX,IQ) + ENDDO + ENDDO + + DO I = 1,30 + DO J = 1,7 + LFFCAL(J,I) = .FALSE. + ENDDO + ENDDO + + IF(LTIME) THEN + CALL TIMEX_LHA(T_END(3)) + T_SPENT(3) = T_SPENT(3)+T_END(3)-T_START(3) + N_CALLS(3) = N_CALLS(3)+1 + E_CALLS(3) = E_CALLS(3)+EVL + ENDIF + + RETURN + + 500 CONTINUE + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r EVOLNM ---> STOP'')') + WRITE(6,'( '' ------------------------------------'')') + WRITE(6,'( '' Input NAME :'',A)') UNAM + WRITE(6,'( '' IQ0 :'',I5)') IQ0 + WRITE(6,'( '' IQLow :'',I5)') IUQL + WRITE(6,'( '' IQHigh :'',I5)') IUQH + IF(IERR.NE.1) THEN + WRITE(6,'(/'' After cuts IQ0, Q20 :'',I5,E12.5)') IQ0,Q2TAB(IQ0) + WRITE(6,'( '' IQL, Q2L :'',I5,E12.5)') IQL,Q2TAB(IQL) + WRITE(6,'( '' IQH, Q2H :'',I5,E12.5)') IQH,Q2TAB(IQH) + ENDIF + IF(IERR.EQ.1) THEN + WRITE(6,'(/'' No x-Q2 grid available'')') + ELSEIF(IERR.EQ.2) THEN + WRITE(6,'(/'' Value of IQL .ge. IQH'', & + & '' (after applying Q2 cuts, if any)'')') + ELSEIF(IERR.EQ.3) THEN + WRITE(6,'(/'' IQL and/or IQH outside grid boundary'')') + ELSEIF(IERR.EQ.4) THEN + WRITE(6,'(/'' IQ0 outside the range [IQL,IQH]'', & + & '' (after applying Q2 cuts, if any)'')') + ELSEIF(IERR.EQ.5) THEN + WRITE(6,'(/'' No LO weight tables available'', & + & '' (please call s/r QNFILW)'')') + ELSEIF(IERR.EQ.6) THEN + WRITE(6,'(/'' No NLO weight tables available'', & + & '' (please call s/r QNFILW)'')') + ENDIF + + CALL QTRACE('EVOLNM ',1) + + STOP + + END + +!DECK ID>, EVOLNP. + +! ===================================== + SUBROUTINE EVOLNP(UNAM,IQ0,IUQL,IUQH) +! ===================================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + CHARACTER*(*) UNAM + CHARACTER*5 NAME + + + CHARACTER*5 PNAM,STFNAM + LOGICAL LNFP + COMMON /QCLNFP/ LNFP(0:30,3:5) + COMMON /QCPNAM/ PNAM(0:30) + COMMON /QCPWGT/ PWGT(0:10,0:30,3:5) + COMMON /QCFNAM/ STFNAM(7) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + REAL & + &WGTFF1,WGTFG1, & + &WGTGF1,WGTGG1, & + &WGTPP2,WGTPM2,WGTNS2, & + &WGTFF2,WGTFG2, & + &WGTGF2,WGTGG2, & + &WGTC2Q,WGTC2G,YNTC2Q, & + &WGTCLQ,WGTCLG,WGTC3Q + + COMMON/QCWEIT/ & + &WGTFF1(MXX*(MXX+1)/2) ,WGTFG1(MXX*(MXX+1)/2,3:5), & + &WGTGF1(MXX*(MXX+1)/2) ,WGTGG1(MXX*(MXX+1)/2,3:5), & + &WGTPP2(MXX*(MXX+1)/2,3:5),WGTPM2(MXX*(MXX+1)/2,3:5), & + &WGTNS2(MXX*(MXX+1)/2,3:5), & + &WGTFF2(MXX*(MXX+1)/2,3:5),WGTFG2(MXX*(MXX+1)/2,3:5), & + &WGTGF2(MXX*(MXX+1)/2,3:5),WGTGG2(MXX*(MXX+1)/2,3:5), & + &WGTC2Q(MXX*(MXX+1)/2) ,WGTC2G(MXX*(MXX+1)/2,3:5), & + &WGTCLQ(MXX*(MXX+1)/2) ,WGTCLG(MXX*(MXX+1)/2,3:5), & + &WGTC3Q(MXX*(MXX+1)/2) ,YNTC2Q(MXX) + + COMMON/QCWADR/ IWADR(MXX,MXX) + + + LOGICAL LTIME + REAL T_START,T_END,T_SPENT + COMMON/QCTIME/T_START(10),T_END(10),T_SPENT(10),N_CALLS(10), & + &E_CALLS(10),LTIME + COMMON/QCFCNT/IFCNT(-1:1,5) + + + IF(LTIME) CALL TIMEX_LHA(T_START(4)) + + CALL QTRACE('EVOLNP ',0) + + IF(NXX.EQ.0.OR.NQ2.EQ.0) THEN + IERR = 1 + GOTO 500 + ENDIF + + IQL = IUQL + IQH = IUQH + + IXL = MAX(ABS(IXFROMX(XMICUT)),1) + IQD = ABS(IQFROMQ(QMICUT)) + IQD = MAX(IQD,ABS(IQFROMQ(QMINAS))) + IQU = ABS(IQFROMQ(QMACUT)) + IF(IQD.NE.0) IQL = MAX(IQD,IQL) + IF(IQU.NE.0) IQH = MIN(IQU+1,IQH) + + IF(IQL.LE.0) IQL = 1 + IF(IQH.LE.0.OR.IQH.GT.NQ2) IQH = NQ2 + IF(IQL.EQ.IQ0.AND.IQH.EQ.IQ0) RETURN + IF(IQL.GE.IQH) THEN + IERR = 2 + GOTO 500 + ENDIF + IF(IQL.LT.1.OR.IQL.GE.NQ2) THEN + IERR = 3 + GOTO 500 + ENDIF + IF(IQH.LE.1.OR.IQH.GT.NQ2) THEN + IERR = 3 + GOTO 500 + ENDIF + IF(IQ0.LT.IQL.OR.IQ0.GT.IQH) THEN + IERR = 4 + GOTO 500 + ENDIF + IF(.NOT.LWT1OK) THEN + IERR = 5 + GOTO 500 + ENDIF + IF(IORD.EQ.2.AND..NOT.LWT2OK) THEN + IERR = 6 + GOTO 500 + ENDIF + + CALL QSTRIP(UNAM,NAME) + + NFMI = 9 + NFMA = 0 + DO 15 IQ = IQL,IQH + NFMI = MIN(NFMI,NFMAP(IQ)) + NFMA = MAX(NFMA,NFMAP(IQ)) + 15 END DO + + DO 16 NF = NFMI,NFMA + ID = IDCHEK(NAME,NF,'EVOLNP',1) + 16 END DO + + IRUN = 0 + IF(.NOT.LPLUS) THEN + DO 19 NF = 3,5 + DO 18 IX0 = 1,NXX + DO 17 IX = IX0,NXX + WGTNS2(IWADR(IX,IX0),NF) = WGTPP2(IWADR(IX,IX0),NF) + 17 CONTINUE + 18 CONTINUE + 19 CONTINUE + IRUN = 1 + ENDIF + LPLUS = .TRUE. + + IF(.NOT.LALFOK) THEN + CALL QFILAS('EVOLNP') + IRUN = 1 + ENDIF + IF(.NOT.LDQ2OK) THEN + CALL QDELQ2 + IRUN = 1 + ENDIF + + DO 25 IX = 1,NXX + DO 20 IQ = 1,NQ2 + 20 END DO + 25 END DO + + DO IX = 1,NXX + LE_DONE(IX) = LEVDONE(IX,ID) + DO IQ = 1,NQ2 + FNSQCD(IX,IQ) = PDFQCD(IX,IQ,ID) + ENDDO + ENDDO + + IF(IQ0.NE.IQ0_LAST(ID) .OR. & + & IQL.NE.IQL_LAST(ID) .OR. & + & IQH.NE.IQH_LAST(ID) ) IRUN = 1 + + CALL APNS(IXL,IQ0,IQL,IQH,IRUN,EVL) + + IQ0_LAST(ID) = IQ0 + IQL_LAST(ID) = IQL + IQH_LAST(ID) = IQH + + DO IX = 1,NXX + LEVDONE(IX,ID) = LE_DONE(IX) + DO IQ = 1,NQ2 + PDFQCD(IX,IQ,ID) = FNSQCD(IX,IQ) + ENDDO + ENDDO + + DO I = 1,30 + DO J = 1,7 + LFFCAL(J,I) = .FALSE. + ENDDO + ENDDO + + IF(LTIME) THEN + CALL TIMEX_LHA(T_END(4)) + T_SPENT(4) = T_SPENT(4)+T_END(4)-T_START(4) + N_CALLS(4) = N_CALLS(4)+1 + E_CALLS(4) = E_CALLS(4)+EVL + ENDIF + + RETURN + + 500 CONTINUE + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r EVOLNP ---> STOP'')') + WRITE(6,'( '' ------------------------------------'')') + WRITE(6,'( '' Input NAME :'',A)') UNAM + WRITE(6,'( '' IQ0 :'',I5)') IQ0 + WRITE(6,'( '' IQLow :'',I5)') IUQL + WRITE(6,'( '' IQHigh :'',I5)') IUQH + IF(IERR.NE.1) THEN + WRITE(6,'(/'' After cuts IQ0, Q20 :'',I5,E12.5)') IQ0,Q2TAB(IQ0) + WRITE(6,'( '' IQL, Q2L :'',I5,E12.5)') IQL,Q2TAB(IQL) + WRITE(6,'( '' IQH, Q2H :'',I5,E12.5)') IQH,Q2TAB(IQH) + ENDIF + IF(IERR.EQ.1) THEN + WRITE(6,'(/'' No x-Q2 grid available'')') + ELSEIF(IERR.EQ.2) THEN + WRITE(6,'(/'' Value of IQL .ge. IQH'', & + & '' (after applying Q2 cuts, if any)'')') + ELSEIF(IERR.EQ.3) THEN + WRITE(6,'(/'' IQL and/or IQH outside grid boundary'')') + ELSEIF(IERR.EQ.4) THEN + WRITE(6,'(/'' IQ0 outside the range [IQL,IQH]'', & + & '' (after applying Q2 cuts, if any)'')') + ELSEIF(IERR.EQ.5) THEN + WRITE(6,'(/'' No LO weight tables available'', & + & '' (please call s/r QNFILW)'')') + ELSEIF(IERR.EQ.6) THEN + WRITE(6,'(/'' No NLO weight tables available'', & + & '' (please call s/r QNFILW)'')') + ENDIF + + CALL QTRACE('EVOLNP ',1) + + STOP + + END + +!DECK ID>, EVPLUS. + +! ===================================== + SUBROUTINE EVPLUS(UNAM,IQ0,IUQL,IUQH) +! ===================================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + CHARACTER*(*) UNAM + CHARACTER*5 NAME + + + CHARACTER*5 PNAM,STFNAM + LOGICAL LNFP + COMMON /QCLNFP/ LNFP(0:30,3:5) + COMMON /QCPNAM/ PNAM(0:30) + COMMON /QCPWGT/ PWGT(0:10,0:30,3:5) + COMMON /QCFNAM/ STFNAM(7) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + REAL & + &WGTFF1,WGTFG1, & + &WGTGF1,WGTGG1, & + &WGTPP2,WGTPM2,WGTNS2, & + &WGTFF2,WGTFG2, & + &WGTGF2,WGTGG2, & + &WGTC2Q,WGTC2G,YNTC2Q, & + &WGTCLQ,WGTCLG,WGTC3Q + + COMMON/QCWEIT/ & + &WGTFF1(MXX*(MXX+1)/2) ,WGTFG1(MXX*(MXX+1)/2,3:5), & + &WGTGF1(MXX*(MXX+1)/2) ,WGTGG1(MXX*(MXX+1)/2,3:5), & + &WGTPP2(MXX*(MXX+1)/2,3:5),WGTPM2(MXX*(MXX+1)/2,3:5), & + &WGTNS2(MXX*(MXX+1)/2,3:5), & + &WGTFF2(MXX*(MXX+1)/2,3:5),WGTFG2(MXX*(MXX+1)/2,3:5), & + &WGTGF2(MXX*(MXX+1)/2,3:5),WGTGG2(MXX*(MXX+1)/2,3:5), & + &WGTC2Q(MXX*(MXX+1)/2) ,WGTC2G(MXX*(MXX+1)/2,3:5), & + &WGTCLQ(MXX*(MXX+1)/2) ,WGTCLG(MXX*(MXX+1)/2,3:5), & + &WGTC3Q(MXX*(MXX+1)/2) ,YNTC2Q(MXX) + + COMMON/QCWADR/ IWADR(MXX,MXX) + + + LOGICAL LTIME + REAL T_START,T_END,T_SPENT + COMMON/QCTIME/T_START(10),T_END(10),T_SPENT(10),N_CALLS(10), & + &E_CALLS(10),LTIME + COMMON/QCFCNT/IFCNT(-1:1,5) + + + IF(LTIME) CALL TIMEX_LHA(T_START(4)) + + CALL QTRACE('EVPLUS ',0) + + IF(NXX.EQ.0.OR.NQ2.EQ.0) THEN + IERR = 1 + GOTO 500 + ENDIF + + IQL = IUQL + IQH = IUQH + + IXL = MAX(ABS(IXFROMX(XMICUT)),1) + IQD = ABS(IQFROMQ(QMICUT)) + IQD = MAX(IQD,ABS(IQFROMQ(QMINAS))) + IQU = ABS(IQFROMQ(QMACUT)) + IF(IQD.NE.0) IQL = MAX(IQD,IQL) + IF(IQU.NE.0) IQH = MIN(IQU+1,IQH) + + IF(IQL.LE.0) IQL = 1 + IF(IQH.LE.0.OR.IQH.GT.NQ2) IQH = NQ2 + IF(IQL.EQ.IQ0.AND.IQH.EQ.IQ0) RETURN + IF(IQL.GE.IQH) THEN + IERR = 2 + GOTO 500 + ENDIF + IF(IQL.LT.1.OR.IQL.GE.NQ2) THEN + IERR = 3 + GOTO 500 + ENDIF + IF(IQH.LE.1.OR.IQH.GT.NQ2) THEN + IERR = 3 + GOTO 500 + ENDIF + IF(IQ0.LT.IQL.OR.IQ0.GT.IQH) THEN + IERR = 4 + GOTO 500 + ENDIF + IF(NFMAP(IQL).NE.NFMAP(IQH-1)) THEN + IERR = 5 + GOTO 500 + ENDIF + IF(.NOT.LWT1OK) THEN + IERR = 6 + GOTO 500 + ENDIF + IF(IORD.EQ.2.AND..NOT.LWT2OK) THEN + IERR = 7 + GOTO 500 + ENDIF + + CALL QSTRIP(UNAM,NAME) + + NFMI = 9 + NFMA = 0 + DO 15 IQ = IQL,IQH + NFMI = MIN(NFMI,NFMAP(IQ)) + NFMA = MAX(NFMA,NFMAP(IQ)) + 15 END DO + + DO 16 NF = NFMI,NFMA + ID = IDCHEK(NAME,NF,'EVPLUS',1) + 16 END DO + + IRUN = 0 + IF(.NOT.LPLUS) THEN + DO 19 NF = 3,5 + DO 18 IX0 = 1,NXX + DO 17 IX = IX0,NXX + WGTNS2(IWADR(IX,IX0),NF) = WGTPP2(IWADR(IX,IX0),NF) + 17 CONTINUE + 18 CONTINUE + 19 CONTINUE + IRUN = 1 + ENDIF + LPLUS = .TRUE. + + IF(.NOT.LALFOK) THEN + CALL QFILAS('EVPLUS') + IRUN = 1 + ENDIF + IF(.NOT.LDQ2OK) THEN + CALL QDELQ2 + IRUN = 1 + ENDIF + + DO IX = 1,NXX + LE_DONE(IX) = LEVDONE(IX,ID) + DO IQ = 1,NQ2 + FNSQCD(IX,IQ) = PDFQCD(IX,IQ,ID) + ENDDO + ENDDO + + IF(IQ0.NE.IQ0_LAST(ID) .OR. & + & IQL.NE.IQL_LAST(ID) .OR. & + & IQH.NE.IQH_LAST(ID) ) IRUN = 1 + + CALL APNS(IXL,IQ0,IQL,IQH,IRUN,EVL) + + IQ0_LAST(ID) = IQ0 + IQL_LAST(ID) = IQL + IQH_LAST(ID) = IQH + + DO IX = 1,NXX + LEVDONE(IX,ID) = LE_DONE(IX) + DO IQ = 1,NQ2 + PDFQCD(IX,IQ,ID) = FNSQCD(IX,IQ) + ENDDO + ENDDO + + DO I = 1,30 + DO J = 1,7 + LFFCAL(J,I) = .FALSE. + ENDDO + ENDDO + + IF(LTIME) THEN + CALL TIMEX_LHA(T_END(4)) + T_SPENT(4) = T_SPENT(4)+T_END(4)-T_START(4) + N_CALLS(4) = N_CALLS(4)+1 + E_CALLS(4) = E_CALLS(4)+EVL + ENDIF + + RETURN + + 500 CONTINUE + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r EVPLUS ---> STOP'')') + WRITE(6,'( '' ------------------------------------'')') + WRITE(6,'( '' Input NAME :'',A)') UNAM + WRITE(6,'( '' Input IQ0 :'',I10)') IQ0 + WRITE(6,'( '' IQLow :'',I10)') IUQL + WRITE(6,'( '' IQHigh :'',I10)') IUQH + IF(IERR.NE.1) THEN + WRITE(6,'(/'' After cuts IQ0, Q20 :'',I5,E12.5)') IQ0,Q2TAB(IQ0) + WRITE(6,'( '' IQL, Q2L :'',I5,E12.5)') IQL,Q2TAB(IQL) + WRITE(6,'( '' IQH, Q2H :'',I5,E12.5)') IQH,Q2TAB(IQH) + ENDIF + IF(IERR.EQ.1) THEN + WRITE(6,'(/'' No x-Q2 grid available'')') + ELSEIF(IERR.EQ.2) THEN + WRITE(6,'(/'' Value of IQL .ge. IQH'', & + & '' (after applying Q2 cuts, if any)'')') + ELSEIF(IERR.EQ.3) THEN + WRITE(6,'(/'' IQL and/or IQH outside grid boundary'')') + ELSEIF(IERR.EQ.4) THEN + WRITE(6,'(/'' IQ0 outside the range [IQL,IQH]'')') + ELSEIF(IERR.EQ.5) THEN + WRITE(6,'(/'' [IQL,IQH} crosses a flavour threshold'')') + ELSEIF(IERR.EQ.6) THEN + WRITE(6,'(/'' No LO weight tables available'', & + & '' (please call s/r QNFILW)'')') + ELSEIF(IERR.EQ.7) THEN + WRITE(6,'(/'' No NLO weight tables available'', & + & '' (please call s/r QNFILW)'')') + ENDIF + + CALL QTRACE('EVPLUS ',1) + + STOP + + END + +!DECK ID>, APNS. + +! ========================================= + SUBROUTINE APNS(IXL,IQ0,IQL,IQH,IRUN,EVL) +! ========================================= + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + REAL & + &WGTFF1,WGTFG1, & + &WGTGF1,WGTGG1, & + &WGTPP2,WGTPM2,WGTNS2, & + &WGTFF2,WGTFG2, & + &WGTGF2,WGTGG2, & + &WGTC2Q,WGTC2G,YNTC2Q, & + &WGTCLQ,WGTCLG,WGTC3Q + + COMMON/QCWEIT/ & + &WGTFF1(MXX*(MXX+1)/2) ,WGTFG1(MXX*(MXX+1)/2,3:5), & + &WGTGF1(MXX*(MXX+1)/2) ,WGTGG1(MXX*(MXX+1)/2,3:5), & + &WGTPP2(MXX*(MXX+1)/2,3:5),WGTPM2(MXX*(MXX+1)/2,3:5), & + &WGTNS2(MXX*(MXX+1)/2,3:5), & + &WGTFF2(MXX*(MXX+1)/2,3:5),WGTFG2(MXX*(MXX+1)/2,3:5), & + &WGTGF2(MXX*(MXX+1)/2,3:5),WGTGG2(MXX*(MXX+1)/2,3:5), & + &WGTC2Q(MXX*(MXX+1)/2) ,WGTC2G(MXX*(MXX+1)/2,3:5), & + &WGTCLQ(MXX*(MXX+1)/2) ,WGTCLG(MXX*(MXX+1)/2,3:5), & + &WGTC3Q(MXX*(MXX+1)/2) ,YNTC2Q(MXX) + + COMMON/QCWADR/ IWADR(MXX,MXX) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + LOGICAL LTIME + REAL T_START,T_END,T_SPENT + COMMON/QCTIME/T_START(10),T_END(10),T_SPENT(10),N_CALLS(10), & + &E_CALLS(10),LTIME + COMMON/QCFCNT/IFCNT(-1:1,5) + + + EVL = 0. + + FNS = FNSQCD(NXX,IQ0) +! ------------------------------------------- + ! + IF(.NOT.LE_DONE(NXX) .OR. IRUN.EQ.1) THEN +! ------------------------------------------- + + NF = NFMAP(IQ0) + WGT = ALFAPQ(IQ0)*WGTFF1(IWADR(NXX,NXX)) + & + & ALFA2Q(IQ0)*WGTNS2(IWADR(NXX,NXX),NF) + DNS = WGT*FNS + FNS0 = FNS + DNS0 = DNS + FNSQCD(NXX,IQ0) = FNS + DNSQCD(NXX,IQ0) = DNS + EVL = EVL+1. + + DO 100 IQ = IQ0+1,IQH + NF = NFMAP(IQ) + WGT = ALFAPQ(IQ)*WGTFF1(IWADR(NXX,NXX)) + & + & ALFA2Q(IQ)*WGTNS2(IWADR(NXX,NXX),NF) + FNS = ( 2.*FNS + DNS*DELUP(IQ) ) / ( 2. - WGT*DELUP(IQ) ) + DNS = WGT*FNS + FNSQCD(NXX,IQ) = FNS + DNSQCD(NXX,IQ) = DNS + 100 CONTINUE + EVL = EVL+IQH-IQ0 + + FNS = FNS0 + DNS = DNS0 + + DO 200 IQ = IQ0-1,IQL,-1 + NF = NFMAP(IQ) + WGT = ALFAPQ(IQ)*WGTFF1(IWADR(NXX,NXX)) + & + & ALFA2Q(IQ)*WGTNS2(IWADR(NXX,NXX),NF) + FNS = ( 2.*FNS + DNS*DELDN(IQ) ) / ( 2. - WGT*DELDN(IQ) ) + DNS = WGT*FNS + FNSQCD(NXX,IQ) = FNS + DNSQCD(NXX,IQ) = DNS + 200 CONTINUE + EVL = EVL+IQ0-IQL + +! ------- + ! + ENDIF +! ------- + +! --------------------------- + ! + DO IX0 = NXX-1,IXL,-1 +! --------------------------- + + FNS = FNSQCD(IX0,IQ0) + IF(LE_DONE(IX0).AND.IRUN.EQ.0) EXIT + ALFAS = ALFAPQ(IQ0) + ALFA2 = ALFA2Q(IQ0) + SUM = 0. + NF = NFMAP(IQ0) + DO 220 IX = NXX,IX0+1,-1 + WFF1 = WGTFF1(IWADR(IX,IX0)) + WNS2 = WGTNS2(IWADR(IX,IX0),NF) + SUM = SUM + (ALFAS*WFF1+ALFA2*WNS2) * FNSQCD(IX,IQ0) + 220 CONTINUE + WGT = ALFAS*WGTFF1(IWADR(IX0,IX0)) + & + & ALFA2*WGTNS2(IWADR(IX0,IX0),NF) + DNS = WGT*FNS + SUM + + FNS0 = FNS + DNS0 = DNS + FNSQCD(IX0,IQ0) = FNS + DNSQCD(IX0,IQ0) = DNS + EVL = EVL+NXX-IX0+1 + + DO 250 IQ = IQ0+1,IQH + IF(IFAILC(IX0,IQ).NE.0) GOTO 250 + ALFAS = ALFAPQ(IQ) + ALFA2 = ALFA2Q(IQ) + DELIQ = DELUP(IQ) + SUM = 0. + NF = NFMAP(IQ) + DO 230 IX = NXX,IX0+1,-1 + WFF1 = WGTFF1(IWADR(IX,IX0)) + WNS2 = WGTNS2(IWADR(IX,IX0),NF) + SUM = SUM + (ALFAS*WFF1+ALFA2*WNS2) * FNSQCD(IX,IQ) + 230 CONTINUE + WGT = ALFAS*WGTFF1(IWADR(IX0,IX0)) + & + & ALFA2*WGTNS2(IWADR(IX0,IX0),NF) + FNS = ( 2.*FNS + (DNS+SUM)*DELIQ ) / ( 2. - WGT*DELIQ ) + DNS = WGT*FNS + SUM + FNSQCD(IX0,IQ) = FNS + DNSQCD(IX0,IQ) = DNS + EVL = EVL+NXX-IX0+1 + 250 CONTINUE + + FNS = FNS0 + DNS = DNS0 + + DO 270 IQ = IQ0-1,IQL,-1 + ALFAS = ALFAPQ(IQ) + ALFA2 = ALFA2Q(IQ) + DELIQ = DELDN(IQ) + SUM = 0. + NF = NFMAP(IQ) + DO 260 IX = NXX,IX0+1,-1 + WFF1 = WGTFF1(IWADR(IX,IX0)) + WNS2 = WGTNS2(IWADR(IX,IX0),NF) + SUM = SUM + (ALFAS*WFF1+ALFA2*WNS2) * FNSQCD(IX,IQ) + 260 CONTINUE + WGT = ALFAS*WGTFF1(IWADR(IX0,IX0)) + & + & ALFA2*WGTNS2(IWADR(IX0,IX0),NF) + FNS = ( 2.*FNS + (DNS+SUM)*DELIQ ) / ( 2. - WGT*DELIQ ) + DNS = WGT*FNS + SUM + FNSQCD(IX0,IQ) = FNS + DNSQCD(IX0,IQ) = DNS + EVL = EVL+NXX-IX0+1 + 270 CONTINUE + +! ---------- + ! + END DO +! ---------- + + EVL = EVL*2./(NXX*(NXX+1)*NQ2) + + CALL QNTRUE(LE_DONE,NXX) + + RETURN + END + +!DECK ID>, QNPGET. + +! ============================================ + DOUBLE PRECISION FUNCTION QNPGET(NAME,IX,IQ) +! ============================================ + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + CHARACTER*(*) NAME + +!--- Obsolete (21/05/96): use QPDFIJ instead + + QNPGET = QPDFIJ(NAME,IX,IQ,IFL) + + RETURN + END + +!DECK ID>, QPDFIJ. + +! ================================================ + DOUBLE PRECISION FUNCTION QPDFIJ(UNAM,IX,IQ,IFL) +! ================================================ + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +!--- Returns parton distribution 'NAME' at gridpoint IX,IQ +!--- Output IFL = 0 : Inside grid or cuts +!--- -1 : Outside grid or cuts + + CHARACTER*(*) UNAM + CHARACTER*5 NAME + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + + + CHARACTER*5 PNAM,STFNAM + LOGICAL LNFP + COMMON /QCLNFP/ LNFP(0:30,3:5) + COMMON /QCPNAM/ PNAM(0:30) + COMMON /QCPWGT/ PWGT(0:10,0:30,3:5) + COMMON /QCFNAM/ STFNAM(7) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + CALL QTRACE('QPDFIJ ',0) + + QPDFIJ = 0. + IERR = 0 + IFL = 0 + + IF(NXX.EQ.0.OR.NQ2.EQ.0) THEN + IERR = 1 + GOTO 500 + ENDIF + IF(IX.LT.1.OR.IX.GT.MXX-1 .OR. & + & IQ.LT.1.OR.IQ.GT.MQ2-1) THEN + IERR = 2 + IFL = -1 + IF(LIMCK) GOTO 500 + RETURN + ENDIF + IF(IFAILC(IX,IQ).NE.0) THEN + IERR = 2 + IFL = -1 + IF(LIMCK) GOTO 500 + RETURN + ENDIF + + CALL QSTRIP(UNAM,NAME) + + NF = NFMAP(IQ) + ID = IDCHEK(NAME,NF,'QPDFIJ',1) + + IF(ID.EQ.-1) RETURN + + QPDFIJ = GET_PDFIJ(ID,IX,IQ) + + RETURN + + 500 CONTINUE + + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r QPDFIJ ---> STOP'')') + WRITE(6,'( '' ------------------------------------'')') + WRITE(6,'( '' Input NAME : '',A)') UNAM + WRITE(6,'( '' IX : '',I5)') IX + WRITE(6,'( '' IQ : '',I5)') IQ + IF(IERR.EQ.1) THEN + WRITE(6,'(/'' No x-Q2 grid defined'')') + ELSEIF(IERR.EQ.2) THEN + WRITE(6,'(/'' IX and/or IQ outside grid or cuts'')') + IDUM = ICUTIJ(IX,IQ,1) + ENDIF + + CALL QTRACE('QPDFIJ ',1) + + STOP + + END + +!DECK ID>, PARTXQ. + +! =================================== + SUBROUTINE PARTXQ(NAME,X,Q,VAL,IFL) +! =================================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + CHARACTER*(*) NAME + +!--- Obsolete (21/05/96): use QPDFXQ instead + + VAL = QPDFXQ(NAME,X,Q,IFL) + + RETURN + END + +!DECK ID>, QPDFXQ. + +! ============================================== + DOUBLE PRECISION FUNCTION QPDFXQ(UNAM,X,Q,IFL) +! ============================================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +!--- Returns parton distribution 'NAME' at X,Q +!--- Output IFL = 0 : Inside grid +!--- -1 : Outside grid or cuts + + CHARACTER*(*) UNAM + CHARACTER*5 NAME + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + + + CHARACTER*5 PNAM,STFNAM + LOGICAL LNFP + COMMON /QCLNFP/ LNFP(0:30,3:5) + COMMON /QCPNAM/ PNAM(0:30) + COMMON /QCPWGT/ PWGT(0:10,0:30,3:5) + COMMON /QCFNAM/ STFNAM(7) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + CALL QTRACE('QPDFXQ ',0) + + VAL = 0. + IFL = 0 + QPDFXQ = 0. + + IF(NXX.EQ.0.OR.NQ2.EQ.0) THEN + IERR = 1 + IFL = -1 + GOTO 500 + ENDIF + JFL = ICUTXQ(X,Q,0) + IF(JFL.NE.0) THEN + IERR = 2 + IFL = -1 + IF(LIMCK) GOTO 500 + RETURN + ENDIF + + IX = ABS(IXFROMX(X)) + IQ = MIN(ABS(IQFROMQ(Q)),NQ2-1) + + CALL QSTRIP(UNAM,NAME) + + NF = NFMAP(IQ) + ID = IDCHEK(NAME,NF,'QPDFXQ',1) + + IF(.NOT.LDQ2OK) CALL QDELQ2 + + TX = (X-XXTAB(IX))/(XXTAB(IX+1)-XXTAB(IX)) + TQ = LOG(Q/Q2TAB(IQ))/LOG(Q2TAB(IQ+1)/Q2TAB(IQ)) + + QPDFXQ = GET_PDFXQ(ID,IX,IQ,TX,TQ) + + RETURN + + 500 CONTINUE + + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r QPDFXQ ---> STOP'')') + WRITE(6,'( '' ------------------------------------'')') + WRITE(6,'( '' Input NAME : '',A)') UNAM + WRITE(6,'( '' X : '',E12.5)') X + WRITE(6,'( '' Q2 : '',E12.5)') Q + IF(IERR.EQ.1) THEN + WRITE(6,'(/'' No x-Q2 grid defined'')') + ELSEIF(IERR.EQ.2) THEN + WRITE(6,'(/'' X and/or Q2 outside grid or cuts'')') + IDUM = ICUTXQ(X,Q,1) + ENDIF + + CALL QTRACE('QPDFXQ ',1) + + STOP + END + +!DECK ID>, GET_PDFIJ. + +! ============================================= + DOUBLE PRECISION FUNCTION GET_PDFIJ(ID,IX,IQ) +! ============================================= + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +!-- Return parton distribution ID at IX,IQ. +!-- IX should be in the range 1,...NXX. +!-- IQ should be in the range 1,...NQ2. + + + CHARACTER*5 PNAM,STFNAM + LOGICAL LNFP + COMMON /QCLNFP/ LNFP(0:30,3:5) + COMMON /QCPNAM/ PNAM(0:30) + COMMON /QCPWGT/ PWGT(0:10,0:30,3:5) + COMMON /QCFNAM/ STFNAM(7) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + GET_PDFIJ = 0. + + NF = NFMAP(IQ) + + DO I = 0,10 + GET_PDFIJ = GET_PDFIJ + PWGT(I,ID,NF)*PDFQCD(IX,IQ,I) + ENDDO + + RETURN + END + +!DECK ID>, GET_PDFXQ. + +! =================================================== + DOUBLE PRECISION FUNCTION GET_PDFXQ(ID,IX,IQ,TX,TQ) +! =================================================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +!-- Return parton distribution ID at X,Q. +!-- IX gridpoint at or below x; should be in the range 1,...NXX. +!-- IQ gridpoint at or below Q; should be in the range 1,...NQ2-1. + + + CHARACTER*5 PNAM,STFNAM + LOGICAL LNFP + COMMON /QCLNFP/ LNFP(0:30,3:5) + COMMON /QCPNAM/ PNAM(0:30) + COMMON /QCPWGT/ PWGT(0:10,0:30,3:5) + COMMON /QCFNAM/ STFNAM(7) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + F11 = GET_PDFIJ(ID,IX,IQ) + F12 = GET_PDFIJ(ID,IX,IQ+1) + F21 = GET_PDFIJ(ID,IX+1,IQ) + F22 = GET_PDFIJ(ID,IX+1,IQ+1) + F1 = (1.-TQ)*F11 + TQ*F12 + F2 = (1.-TQ)*F21 + TQ*F22 + + GET_PDFXQ = (1.-TX)*F1 + TX*F2 + + RETURN + END + +!DECK ID>, BKFAST. + +! ============================== + SUBROUTINE BKFAST(IDF,ID,IERR) +! ============================== + +!--- Book the NDFMAX arrays available for STFAST storage. +!--- Called by STFAST. +!--- Input : IDF = structure function identifier; +!--- 1 2 3 4 5 6 7 +!--- F2 FL xF3 F2c Flc F2b Flb +!--- ID = parton dist identifier (1-30). +!--- Output : set IDFAST(IDF,ID) = j; the results of +!--- STFAST for the combination IDF,ID are +!--- stored in FSTORE(ix,iq,j). +!--- If j.gt.NDFMAX (no more space) then BKFAST +!--- acts as a do-nothing & sets ierr .ne. 0. + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + IERR = 0 + IF(IDFAST(IDF,ID).EQ.0) THEN + IF(NDFAST.EQ.30+NDFMAX) THEN + IERR = 1 + RETURN + ENDIF + NDFAST = NDFAST + 1 + IDFAST(IDF,ID) = NDFAST + ISTFID(NDFAST) = IDF + IPDFID(NDFAST) = ID + ENDIF + + RETURN + END + +!DECK ID>, STFAST. + +! =========================== + SUBROUTINE STFAST(OPT,UNAM) +! =========================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + CHARACTER*(*) OPT,UNAM + CHARACTER*5 NAME + CHARACTER*5 OPT5 + + + LOGICAL LTIME + REAL T_START,T_END,T_SPENT + COMMON/QCTIME/T_START(10),T_END(10),T_SPENT(10),N_CALLS(10), & + &E_CALLS(10),LTIME + COMMON/QCFCNT/IFCNT(-1:1,5) + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + IF(LTIME) CALL TIMEX_LHA(T_START(6)) + + CALL QTRACE('STFAST ',0) + + IERR = 0 + IF(.NOT.LMARK) THEN + IERR = 1 + GOTO 500 + ENDIF + + CALL QSTRIP(UNAM,NAME) + CALL QSTRIP(OPT ,OPT5) + + JX = 0 + JQ = 0 + XX = 0. + QQ = 0. + IDF = IFCHEK(OPT5,NAME,JX,JQ,XX,QQ,'STFAST',1,ID) + + IF(.NOT.LALFOK) CALL QFILAS('STFAST') + IF(.NOT.LDQ2OK) CALL QDELQ2 + + IF(IDF.GE.1.AND.IDF.LE.7) THEN + CALL BKFAST(IDF,ID,IERR) + IF(IERR.NE.0) THEN + LFFCAL(IDF,ID) = .FALSE. + RETURN + ENDIF + ELSE + IERR = 10 + GOTO 500 + ENDIF + + IF (IDF.EQ.1) THEN + CALL FASTF2(ID) + ELSEIF(IDF.EQ.2) THEN + CALL FASTFL(ID) + ELSEIF(IDF.EQ.3) THEN + CALL FASTF3(ID) + ELSE + CALL FASTFKH(IDF,ID) + ENDIF + + IF(LTIME) THEN + CALL TIMEX_LHA(T_END(6)) + T_SPENT(6) = T_SPENT(6)+T_END(6)-T_START(6) + N_CALLS(6) = N_CALLS(6)+1 + ENDIF + + RETURN + + 500 CONTINUE + + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r STFAST ---> STOP'')') + WRITE(6,'( '' ------------------------------------'')') + WRITE(6,'( '' Input OPT : '',A)') OPT + WRITE(6,'( '' Input NAME : '',A)') UNAM + IF(IERR.EQ.1) THEN + WRITE(6, & + & '(/'' No gridpoints marked for fast calculation''/ & + & '' Please call s/r QFMARK before STFAST'')') + ELSEIF(IERR.EQ.10) THEN + WRITE(6,'(/'' Unknown input option OPT'')') + ENDIF + + CALL QTRACE('STFAST ',1) + + STOP + + END + +!DECK ID>, FASTF2. + +! ===================== + SUBROUTINE FASTF2(ID) +! ===================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + + + CHARACTER*5 PNAM,STFNAM + LOGICAL LNFP + COMMON /QCLNFP/ LNFP(0:30,3:5) + COMMON /QCPNAM/ PNAM(0:30) + COMMON /QCPWGT/ PWGT(0:10,0:30,3:5) + COMMON /QCFNAM/ STFNAM(7) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + REAL & + &WGTFF1,WGTFG1, & + &WGTGF1,WGTGG1, & + &WGTPP2,WGTPM2,WGTNS2, & + &WGTFF2,WGTFG2, & + &WGTGF2,WGTGG2, & + &WGTC2Q,WGTC2G,YNTC2Q, & + &WGTCLQ,WGTCLG,WGTC3Q + + COMMON/QCWEIT/ & + &WGTFF1(MXX*(MXX+1)/2) ,WGTFG1(MXX*(MXX+1)/2,3:5), & + &WGTGF1(MXX*(MXX+1)/2) ,WGTGG1(MXX*(MXX+1)/2,3:5), & + &WGTPP2(MXX*(MXX+1)/2,3:5),WGTPM2(MXX*(MXX+1)/2,3:5), & + &WGTNS2(MXX*(MXX+1)/2,3:5), & + &WGTFF2(MXX*(MXX+1)/2,3:5),WGTFG2(MXX*(MXX+1)/2,3:5), & + &WGTGF2(MXX*(MXX+1)/2,3:5),WGTGG2(MXX*(MXX+1)/2,3:5), & + &WGTC2Q(MXX*(MXX+1)/2) ,WGTC2G(MXX*(MXX+1)/2,3:5), & + &WGTCLQ(MXX*(MXX+1)/2) ,WGTCLG(MXX*(MXX+1)/2,3:5), & + &WGTC3Q(MXX*(MXX+1)/2) ,YNTC2Q(MXX) + + COMMON/QCWADR/ IWADR(MXX,MXX) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + DIMENSION QUARKS(MXX),GLUONS(MXX) + +!-- Get adress where to store F2 + JD = IDFAST(1,ID) + +!-- Loop over all Q2 gridpoints + DO 100 IQ = 1,NQ2 + +!-- Initialise FSTORE and get minimum value of x + IXMIN = 999999 + DO IX = 1,NXX + FSTORE(IX,IQ,JD) = -401. + IF(MARKFF(IX,IQ).EQ.1) IXMIN = MIN(IXMIN,IX) + ENDDO + +!-- Is this Q2 gridpoint marked? + IF(MARKQQ(IQ).NE.1) EXIT + +!-- Get scale and check if inside Q2 gridboundaries + QMU = Q2TAB(IQ)*AAM2L + BBM2L + IMU = MIN(ABS(IQFROMQ(QMU)),NQ2-1) + IF(IMU.EQ.0) EXIT + QR2 = QMU*AAAR2 + BBBR2 + IR2 = MIN(ABS(IQFROMQ(QR2)),NQ2-1) + IF(IR2.EQ.0) EXIT + +!-- Calculate F2 for all marked gridpoints + FACT = LOG(Q2TAB(IQ)/QMU) + NF = NFMAP(IMU) + TX = 0. + TQ = LOG(QMU/Q2TAB(IMU))/LOG(Q2TAB(IMU+1)/Q2TAB(IMU)) + TR = LOG(QR2/Q2TAB(IR2))/LOG(Q2TAB(IR2+1)/Q2TAB(IR2)) + AS = GET_AS(IR2,TR) + DO IX0 = NXX,IXMIN,-1 + GLUONS(IX0) = GET_PDFXQ( 0,IX0,IMU,TX,TQ) + QUARKS(IX0) = GET_PDFXQ(ID,IX0,IMU,TX,TQ) + IF(MARKFF(IX0,IQ).EQ.1) THEN + FFF0 = QUARKS(IX0) + IF(IORD.EQ.1) THEN + FSTORE(IX0,IQ,JD) = FFF0 + ELSE + FF = 0. + DO IX = IX0,NXX + FF = FF + & + & (WGTC2Q(IWADR(IX,IX0))+ & + & WGTFF1(IWADR(IX,IX0))*FACT)*QUARKS(IX) + & + & (WGTC2G(IWADR(IX,IX0),NF)+ & + & WGTFG1(IWADR(IX,IX0),NF)*FACT)* & + & GLUONS(IX)*PWGT(1,ID,NF) + ENDDO + FSTORE(IX0,IQ,JD) = FFF0 + AS*FF + ENDIF + ENDIF + ENDDO + FSTORE(NXX+1,IQ,JD) = 0. + + 100 END DO + +!-- Mark F2 calculated for pdf ID + LFFCAL(1,ID) = .TRUE. + + RETURN + END + +!DECK ID>, FASTFL. + +! ===================== + SUBROUTINE FASTFL(ID) +! ===================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + + + CHARACTER*5 PNAM,STFNAM + LOGICAL LNFP + COMMON /QCLNFP/ LNFP(0:30,3:5) + COMMON /QCPNAM/ PNAM(0:30) + COMMON /QCPWGT/ PWGT(0:10,0:30,3:5) + COMMON /QCFNAM/ STFNAM(7) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + REAL & + &WGTFF1,WGTFG1, & + &WGTGF1,WGTGG1, & + &WGTPP2,WGTPM2,WGTNS2, & + &WGTFF2,WGTFG2, & + &WGTGF2,WGTGG2, & + &WGTC2Q,WGTC2G,YNTC2Q, & + &WGTCLQ,WGTCLG,WGTC3Q + + COMMON/QCWEIT/ & + &WGTFF1(MXX*(MXX+1)/2) ,WGTFG1(MXX*(MXX+1)/2,3:5), & + &WGTGF1(MXX*(MXX+1)/2) ,WGTGG1(MXX*(MXX+1)/2,3:5), & + &WGTPP2(MXX*(MXX+1)/2,3:5),WGTPM2(MXX*(MXX+1)/2,3:5), & + &WGTNS2(MXX*(MXX+1)/2,3:5), & + &WGTFF2(MXX*(MXX+1)/2,3:5),WGTFG2(MXX*(MXX+1)/2,3:5), & + &WGTGF2(MXX*(MXX+1)/2,3:5),WGTGG2(MXX*(MXX+1)/2,3:5), & + &WGTC2Q(MXX*(MXX+1)/2) ,WGTC2G(MXX*(MXX+1)/2,3:5), & + &WGTCLQ(MXX*(MXX+1)/2) ,WGTCLG(MXX*(MXX+1)/2,3:5), & + &WGTC3Q(MXX*(MXX+1)/2) ,YNTC2Q(MXX) + + COMMON/QCWADR/ IWADR(MXX,MXX) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + DIMENSION QUARKS(MXX),GLUONS(MXX) + +!-- Get adress where to store FL + JD = IDFAST(2,ID) + +!-- Loop over all Q2 gridpoints + DO 100 IQ = 1,NQ2 + +!-- Initialise FSTORE and get minimum value of x + IXMIN = 999999 + DO IX = 1,NXX + FSTORE(IX,IQ,JD) = -401. + IF(MARKFF(IX,IQ).EQ.1) IXMIN = MIN(IXMIN,IX) + ENDDO + +!-- Is this Q2 gridpoint marked? + IF(MARKQQ(IQ).NE.1) EXIT + +!-- Get scale and check if inside Q2 gridboundaries + QMU = Q2TAB(IQ)*AAM2L + BBM2L + IMU = MIN(ABS(IQFROMQ(QMU)),NQ2-1) + IF(IMU.EQ.0) EXIT + QR2 = QMU*AAAR2 + BBBR2 + IR2 = MIN(ABS(IQFROMQ(QR2)),NQ2-1) + IF(IR2.EQ.0) EXIT + +!-- Calculate FL for all marked gridpoints + FACT = LOG(Q2TAB(IQ)/QMU)*FL_FAC + NF = NFMAP(IMU) + TX = 0. + TQ = LOG(QMU/Q2TAB(IMU))/LOG(Q2TAB(IMU+1)/Q2TAB(IMU)) + TR = LOG(QR2/Q2TAB(IR2))/LOG(Q2TAB(IR2+1)/Q2TAB(IR2)) + AS = GET_AS(IR2,TR) + DO IX0 = NXX,IXMIN,-1 + GLUONS(IX0) = GET_PDFXQ( 0,IX0,IMU,TX,TQ) + QUARKS(IX0) = GET_PDFXQ(ID,IX0,IMU,TX,TQ) + IF(MARKFF(IX0,IQ).EQ.1) THEN + FFF0 = 0. + IF(IORD.EQ.1) THEN + FSTORE(IX0,IQ,JD) = 0. + ELSE + FF = 0. + DO IX = IX0,NXX + FF = FF + & + & (WGTCLQ(IWADR(IX,IX0))+ & + & WGTFF1(IWADR(IX,IX0))*FACT)*QUARKS(IX) + & + & (WGTCLG(IWADR(IX,IX0),NF)+ & + & WGTFG1(IWADR(IX,IX0),NF)*FACT)* & + & GLUONS(IX)*PWGT(1,ID,NF) + ENDDO + FSTORE(IX0,IQ,JD) = FFF0 + AS*FF + ENDIF + ENDIF + ENDDO + FSTORE(NXX+1,IQ,JD) = 0. + + 100 END DO + +!-- Mark FL calculated for pdf ID + LFFCAL(2,ID) = .TRUE. + + RETURN + END + +!DECK ID>, FASTF3. + +! ===================== + SUBROUTINE FASTF3(ID) +! ===================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + + + CHARACTER*5 PNAM,STFNAM + LOGICAL LNFP + COMMON /QCLNFP/ LNFP(0:30,3:5) + COMMON /QCPNAM/ PNAM(0:30) + COMMON /QCPWGT/ PWGT(0:10,0:30,3:5) + COMMON /QCFNAM/ STFNAM(7) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + REAL & + &WGTFF1,WGTFG1, & + &WGTGF1,WGTGG1, & + &WGTPP2,WGTPM2,WGTNS2, & + &WGTFF2,WGTFG2, & + &WGTGF2,WGTGG2, & + &WGTC2Q,WGTC2G,YNTC2Q, & + &WGTCLQ,WGTCLG,WGTC3Q + + COMMON/QCWEIT/ & + &WGTFF1(MXX*(MXX+1)/2) ,WGTFG1(MXX*(MXX+1)/2,3:5), & + &WGTGF1(MXX*(MXX+1)/2) ,WGTGG1(MXX*(MXX+1)/2,3:5), & + &WGTPP2(MXX*(MXX+1)/2,3:5),WGTPM2(MXX*(MXX+1)/2,3:5), & + &WGTNS2(MXX*(MXX+1)/2,3:5), & + &WGTFF2(MXX*(MXX+1)/2,3:5),WGTFG2(MXX*(MXX+1)/2,3:5), & + &WGTGF2(MXX*(MXX+1)/2,3:5),WGTGG2(MXX*(MXX+1)/2,3:5), & + &WGTC2Q(MXX*(MXX+1)/2) ,WGTC2G(MXX*(MXX+1)/2,3:5), & + &WGTCLQ(MXX*(MXX+1)/2) ,WGTCLG(MXX*(MXX+1)/2,3:5), & + &WGTC3Q(MXX*(MXX+1)/2) ,YNTC2Q(MXX) + + COMMON/QCWADR/ IWADR(MXX,MXX) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + DIMENSION QUARKS(MXX) + +!-- Get adress where to store F3 + JD = IDFAST(3,ID) + +!-- Loop over all Q2 gridpoints + DO 100 IQ = 1,NQ2 + +!-- Initialise FSTORE and get minimum value of x + IXMIN = 999999 + DO IX = 1,NXX + FSTORE(IX,IQ,JD) = -401. + IF(MARKFF(IX,IQ).EQ.1) IXMIN = MIN(IXMIN,IX) + ENDDO + +!-- Is this Q2 gridpoint marked? + IF(MARKQQ(IQ).NE.1) EXIT + +!-- Get scale and check if inside Q2 gridboundaries + QMU = Q2TAB(IQ)*AAM2L + BBM2L + IMU = MIN(ABS(IQFROMQ(QMU)),NQ2-1) + IF(IMU.EQ.0) EXIT + QR2 = QMU*AAAR2 + BBBR2 + IR2 = MIN(ABS(IQFROMQ(QR2)),NQ2-1) + IF(IR2.EQ.0) EXIT + +!-- Calculate F3 for all marked gridpoints + FACT = LOG(Q2TAB(IQ)/QMU) + TX = 0. + TQ = LOG(QMU/Q2TAB(IMU))/LOG(Q2TAB(IMU+1)/Q2TAB(IMU)) + TR = LOG(QR2/Q2TAB(IR2))/LOG(Q2TAB(IR2+1)/Q2TAB(IR2)) + AS = GET_AS(IR2,TR) + DO IX0 = NXX,IXMIN,-1 + QUARKS(IX0) = GET_PDFXQ(ID,IX0,IMU,TX,TQ) + IF(MARKFF(IX0,IQ).EQ.1) THEN + FFF0 = QUARKS(IX0) + IF(IORD.EQ.1) THEN + FSTORE(IX0,IQ,JD) = FFF0 + ELSE + FF = 0. + DO IX = IX0,NXX + FF = FF + & + & (WGTC3Q(IWADR(IX,IX0))+ & + & WGTFF1(IWADR(IX,IX0))*FACT)*QUARKS(IX) + ENDDO + FSTORE(IX0,IQ,JD) = FFF0 + AS*FF + ENDIF + ENDIF + ENDDO + FSTORE(NXX+1,IQ,JD) = 0. + + 100 END DO + +!-- Mark F3 calculated for pdf ID + LFFCAL(3,ID) = .TRUE. + + RETURN + END + +!DECK ID>, FASTFKH. + +! ========================== + SUBROUTINE FASTFKH(IDF,ID) +! ========================== + +!-- IDF = 4,5,6,7 for F2c,FLc,F2b,FLb + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + + + CHARACTER*5 PNAM,STFNAM + LOGICAL LNFP + COMMON /QCLNFP/ LNFP(0:30,3:5) + COMMON /QCPNAM/ PNAM(0:30) + COMMON /QCPWGT/ PWGT(0:10,0:30,3:5) + COMMON /QCFNAM/ STFNAM(7) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + REAL & + &WH_C0KG,WH_C1KG,WH_C1BKG, & + &WH_C1KQ,WH_C1BKQ,WH_D1KQ,WH_D1BKQ + + COMMON/QCHWGT/ & + &WH_C0KG(0:MXX,MQ2,4:7), & + &WH_C1KG(0:MXX,MQ2,4:7),WH_C1BKG(0:MXX,MQ2,4:7), & + &WH_C1KQ(0:MXX,MQ2,4:7),WH_C1BKQ(0:MXX,MQ2,4:7), & + &WH_D1KQ(0:MXX,MQ2,4:7),WH_D1BKQ(0:MXX,MQ2,4:7) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + DIMENSION QU(MXX),GL(MXX),SI(MXX) + +!-- Correct quark mass + QMASS = CBMSTF(IDF) + CCCC = CHARGE(IDF) + +!-- Get adress where to store FKH + JD = IDFAST(IDF,ID) + +!-- FKH in LO + IF(IORD.EQ.1) THEN + + DO 100 IQ = 1,NQ2 + IXMIN = 999999 + DO IX = 1,NXX + FSTORE(IX,IQ,JD) = -401. + IF(MARKFH(IX,IQ).EQ.1) IXMIN = MIN(IXMIN,IX) + ENDDO + IF(MARKQQ(IQ).NE.1) GOTO 100 + QMU = Q2TAB(IQ)*AAM2H + BBM2H + IMU = MIN(ABS(IQFROMQ(QMU)),NQ2-1) + IF(IMU.EQ.0) GOTO 100 + QR2 = QMU*AAAR2 + BBBR2 + IR2 = MIN(ABS(IQFROMQ(QR2)),NQ2-1) + IF(IR2.EQ.0) GOTO 100 + TQ = LOG(QMU/Q2TAB(IMU))/LOG(Q2TAB(IMU+1)/Q2TAB(IMU)) + TR = LOG(QR2/Q2TAB(IR2))/LOG(Q2TAB(IR2+1)/Q2TAB(IR2)) + AS = GET_AS(IR2,TR) + DO IX0 = NXX,IXMIN,-1 + IXL = IHTAB(IX0) + X = XHTAB(IX0) + TX = (X-XXTAB(IXL))/(XXTAB(IXL+1)-XXTAB(IXL)) + GL(IX0) = GET_PDFXQ( 0,IXL,IMU,TX,TQ) + IF(MARKFH(IX0,IQ).EQ.1) THEN + FF = 0. + DO IX = IX0,NXX + FF = FF + & + & WH_C0KG(IX-IX0,IQ,IDF)*GL(IX) + ENDDO + FSTORE(IX0,IQ,JD) = CCCC*AS*FF + ENDIF + ENDDO + FSTORE(NXX+1,IQ,JD) = 0. + 100 CONTINUE + + +!-- FKH in NLO + ELSE + + DO 200 IQ = 1,NQ2 + IXMIN = 999999 + DO IX = 1,NXX + FSTORE(IX,IQ,JD) = -401. + IF(MARKFH(IX,IQ).EQ.1) IXMIN = MIN(IXMIN,IX) + ENDDO + IF(MARKQQ(IQ).NE.1) GOTO 200 + QMU = Q2TAB(IQ)*AAM2H + BBM2H + IMU = MIN(ABS(IQFROMQ(QMU)),NQ2-1) + IF(IMU.EQ.0) GOTO 200 + QR2 = QMU*AAAR2 + BBBR2 + IR2 = MIN(ABS(IQFROMQ(QR2)),NQ2-1) + IF(IR2.EQ.0) GOTO 200 + TQ = LOG(QMU/Q2TAB(IMU))/LOG(Q2TAB(IMU+1)/Q2TAB(IMU)) + TR = LOG(QR2/Q2TAB(IR2))/LOG(Q2TAB(IR2+1)/Q2TAB(IR2)) + AS = GET_AS(IR2,TR) + FACT = LOG(QMU/(QMASS*QMASS)) + DO IX0 = NXX,IXMIN,-1 + IXL = IHTAB(IX0) + X = XHTAB(IX0) + TX = (X-XXTAB(IXL))/(XXTAB(IXL+1)-XXTAB(IXL)) + GL(IX0) = GET_PDFXQ( 0,IXL,IMU,TX,TQ) + SI(IX0) = GET_PDFXQ( 1,IXL,IMU,TX,TQ) + QU(IX0) = GET_PDFXQ(ID,IXL,IMU,TX,TQ) + IF(MARKFH(IX0,IQ).EQ.1) THEN + F1 = 0. + F2 = 0. + F3 = 0. + F4 = 0. + DO IX = IX0,NXX + I = IX-IX0 + F1 = F1 + & + & WH_C0KG(I,IQ,IDF)*GL(IX) + F2 = F2 + & + & (WH_C1KG(I,IQ,IDF)+WH_C1BKG(I,IQ,IDF)*FACT)*GL(IX) + F3 = F3 + & + & (WH_C1KQ(I,IQ,IDF)+WH_C1BKQ(I,IQ,IDF)*FACT)*SI(IX) + F4 = F4 + & + & (WH_D1KQ(I,IQ,IDF)+WH_D1BKQ(I,IQ,IDF)*FACT)*QU(IX) + ENDDO + FSTORE(IX0,IQ,JD) = CCCC * & + & (AS*F1+AS*AS*(F2+F3)) + AS*AS*F4 + ENDIF + ENDDO + FSTORE(NXX+1,IQ,JD) = 0. + 200 CONTINUE + + ENDIF + + LFFCAL(IDF,ID) = .TRUE. + + + RETURN + END + +!DECK ID>, QNFGET. + +! ================================================ + DOUBLE PRECISION FUNCTION QNFGET(OPT,NAME,IX,IQ) +! ================================================ + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + CHARACTER*(*) OPT,NAME + +!--- Obsolete (16/07/96): use QSTFIJ instead + + QNFGET = QSTFIJ(OPT,NAME,IX,IQ,IFL) + + RETURN + END + +!DECK ID>, QSTFIJ. + +! ==================================================== + DOUBLE PRECISION FUNCTION QSTFIJ(OPT,UNAM,IX,IQ,IFL) +! ==================================================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +!--- Returns stf 'OPT' from pdf 'NAME' at gridpoint IX,IQ +!--- IFL = 0 : F2 sucessfully calculated +!--- 1 : Fast calculation +!--- -1 : Scale mu outside grid + + CHARACTER*(*) OPT,UNAM + CHARACTER*5 NAME + CHARACTER*5 OPT5 + + + LOGICAL LTIME + REAL T_START,T_END,T_SPENT + COMMON/QCTIME/T_START(10),T_END(10),T_SPENT(10),N_CALLS(10), & + &E_CALLS(10),LTIME + COMMON/QCFCNT/IFCNT(-1:1,5) + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + + + CHARACTER*5 PNAM,STFNAM + LOGICAL LNFP + COMMON /QCLNFP/ LNFP(0:30,3:5) + COMMON /QCPNAM/ PNAM(0:30) + COMMON /QCPWGT/ PWGT(0:10,0:30,3:5) + COMMON /QCFNAM/ STFNAM(7) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + CALL QTRACE('QSTFIJ ',0) + + CALL QSTRIP(UNAM,NAME) + CALL QSTRIP(OPT ,OPT5) + + QSTFIJ = 0. + IFL = 0 + X = 0. + Q = 0. + IERR = IFCHEK(OPT5,NAME,IX,IQ,X,Q,'QSTFIJ',1,ID) + +!-- Outside grid or cuts? + IF(IERR.EQ.-2) THEN + IFL = -1 + RETURN + ENDIF + + IF(.NOT.LALFOK) CALL QFILAS('QSTFIJ') + IF(.NOT.LDQ2OK) CALL QDELQ2 + + IF(IERR.EQ.1) THEN + QSTFIJ = GET_F2(ID,IX,IQ,IFL) + IFCNT(IFL,1) = IFCNT(IFL,1)+1 + ELSEIF(IERR.EQ.2) THEN + QSTFIJ = GET_FL(ID,IX,IQ,IFL) + IFCNT(IFL,2) = IFCNT(IFL,2)+1 + ELSEIF(IERR.EQ.3) THEN + QSTFIJ = GET_F3(ID,IX,IQ,IFL) + IFCNT(IFL,3) = IFCNT(IFL,3)+1 +!--- Use GETFKH instead of GET_FKH for the heavy quarks since +!--- we have to interpolate on the heavy quark grid. + ELSEIF(IERR.EQ.4) THEN + CALL GETFKH(4,ID,XXTAB(IX),Q2TAB(IQ),QSTFIJ,IFL) + IFCNT(IFL,4) = IFCNT(IFL,4)+1 + ELSEIF(IERR.EQ.5) THEN + CALL GETFKH(5,ID,XXTAB(IX),Q2TAB(IQ),QSTFIJ,IFL) + IFCNT(IFL,5) = IFCNT(IFL,5)+1 + ELSEIF(IERR.EQ.6) THEN + CALL GETFKH(6,ID,XXTAB(IX),Q2TAB(IQ),QSTFIJ,IFL) + IFCNT(IFL,4) = IFCNT(IFL,4)+1 + ELSEIF(IERR.EQ.7) THEN + CALL GETFKH(7,ID,XXTAB(IX),Q2TAB(IQ),QSTFIJ,IFL) + IFCNT(IFL,5) = IFCNT(IFL,5)+1 + ENDIF + + RETURN + + END + +!DECK ID>, STRFXQ. + +! ======================================= + SUBROUTINE STRFXQ(OPT,NAME,X,Q,VAL,IFL) +! ======================================= + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + CHARACTER*(*) OPT,NAME + +!--- Obsolete (16/07/96): use QSTFXQ instead + + VAL = QSTFXQ(OPT,NAME,X,Q,IFL) + + RETURN + END + +!DECK ID>, QSTFXQ. + +! ================================================== + DOUBLE PRECISION FUNCTION QSTFXQ(OPT,UNAM,X,Q,IFL) +! ================================================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + +!--- IFL = 0 : F2 sucessfully calculated +!--- 1 : Fast calculation +!--- -1 : Scale mu outside grid + + CHARACTER*(*) OPT,UNAM + CHARACTER*5 NAME + CHARACTER*5 OPT5 + + + LOGICAL LTIME + REAL T_START,T_END,T_SPENT + COMMON/QCTIME/T_START(10),T_END(10),T_SPENT(10),N_CALLS(10), & + &E_CALLS(10),LTIME + COMMON/QCFCNT/IFCNT(-1:1,5) + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + CALL QTRACE('QSTFXQ ',0) + + CALL QSTRIP(UNAM,NAME) + CALL QSTRIP(OPT ,OPT5) + + QSTFXQ = 0. + IFL = 0 + IERR = IFCHEK(OPT5,NAME,0,0,X,Q,'QSTFXQ',1,ID) + +!-- Outside grid or cuts? + IF(IERR.EQ.-2) THEN + IFL = -1 + RETURN + ENDIF + + IF(.NOT.LALFOK) CALL QFILAS('QSTFXQ') + IF(.NOT.LDQ2OK) CALL QDELQ2 + + IF (IERR.EQ.1) THEN + CALL GETF2(ID,X,Q,STRF,IFL) + IFCNT(IFL,1) = IFCNT(IFL,1)+1 + ELSEIF(IERR.EQ.2) THEN + CALL GETFL(ID,X,Q,STRF,IFL) + IFCNT(IFL,2) = IFCNT(IFL,2)+1 + ELSEIF(IERR.EQ.3) THEN + CALL GETF3(ID,X,Q,STRF,IFL) + IFCNT(IFL,3) = IFCNT(IFL,3)+1 + ELSEIF(IERR.EQ.4) THEN + CALL GETFKH(4,ID,X,Q,STRF,IFL) + IFCNT(IFL,4) = IFCNT(IFL,4)+1 + ELSEIF(IERR.EQ.5) THEN + CALL GETFKH(5,ID,X,Q,STRF,IFL) + IFCNT(IFL,5) = IFCNT(IFL,5)+1 + ELSEIF(IERR.EQ.6) THEN + CALL GETFKH(6,ID,X,Q,STRF,IFL) + IFCNT(IFL,4) = IFCNT(IFL,4)+1 + ELSEIF(IERR.EQ.7) THEN + CALL GETFKH(7,ID,X,Q,STRF,IFL) + IFCNT(IFL,5) = IFCNT(IFL,5)+1 + ENDIF + + QSTFXQ = STRF + + RETURN + + END + +!DECK ID>, IFCHEK. + +! ============================================================ + INTEGER FUNCTION IFCHEK(OPT,NAME,JX,JQ,XX,QQ,SRNAM,ISTOP,ID) +! ============================================================ + +!--- Check for structure function calculation + +!--- IFCHEK = -5: Q2 < 1.5 GeV2 for heavy quark stfs +!--- -4: No weight tables +!--- -3: Input NAME corresponds to gluon +!--- -2: x,Q2,M2,R2 outside grid or cuts +!--- -1: No x,Q2 grid available +!--- 0: Unknown option +!--- 1-7: F2, FL, xF3, F2c, FLc, F2b, FLb + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + CHARACTER*5 OPT + CHARACTER*5 NAME + CHARACTER*6 SRNAM + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + LOGICAL LTIME + REAL T_START,T_END,T_SPENT + COMMON/QCTIME/T_START(10),T_END(10),T_SPENT(10),N_CALLS(10), & + &E_CALLS(10),LTIME + COMMON/QCFCNT/IFCNT(-1:1,5) + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + +!-- Check if valid option + IERR = IDFCHK(OPT) + IF(IERR.EQ.0) GOTO 500 + JJ = IERR + IF(IERR.EQ.6) JJ = 4 + IF(IERR.EQ.7) JJ = 5 + +!-- Check x,Q2 grid available + IF(NXX.EQ.0.OR.NQ2.EQ.0) THEN + IERR = -1 + GOTO 500 + ENDIF + + IF(SRNAM.NE.'STFAST') THEN +!-- -------------------------- + +!-- Get x, Q2 + IF(SRNAM.EQ.'QSTFIJ') THEN + X = XFROMIX(JX) + Q = QFROMIQ(JQ) + ELSE + X = XX + Q = QQ + ENDIF + +!-- Check x,Q2 inside grid + QP = Q + IX = ABS(IXFROMX(X)) + IQ = MIN(ABS(IQFROMQ(Q)),NQ2-1) + IF(IX.EQ.0.OR.IQ.EQ.0) THEN + IFCNT(-1,JJ) = IFCNT(-1,JJ)+1 + IERR = -2 + GOTO 500 + ENDIF + +!-- Check factorisation scale inside grid or cuts + IF(IERR.LE.3) THEN + QM = AAM2L*Q + BBM2L + ELSE + QM = AAM2H*Q + BBM2H + ENDIF + QP = QM + IFLG = ICUTXQ(X,QP,0) + IF(IFLG.NE.0) THEN + IFCNT(-1,JJ) = IFCNT(-1,JJ)+1 + IERR = -2 + GOTO 500 + ENDIF + IM2 = MIN(ABS(IQFROMQ(QM)),NQ2-1) + +!-- Check renormalisation scale inside grid and above Lamba2 + QR = AAAR2*QM + BBBR2 + QP = QR + IR2 = MIN(ABS(IQFROMQ(QR)),NQ2-1) + IF(IR2.EQ.0 .OR. IFLG.GE.10000) THEN + IFCNT(-1,JJ) = IFCNT(-1,JJ)+1 + IERR = -2 + GOTO 500 + ENDIF + +!-- Check if the parton distribution is booked + ID = IDCHEK(NAME,NFMAP(IQ) ,SRNAM,1) + ID = IDCHEK(NAME,NFMAP(IQ+1) ,SRNAM,1) + ID = IDCHEK(NAME,NFMAP(IM2) ,SRNAM,1) + ID = IDCHEK(NAME,NFMAP(IM2+1),SRNAM,1) + ID = IDCHEK(NAME,NFMAP(IR2) ,SRNAM,1) + ID = IDCHEK(NAME,NFMAP(IR2+1),SRNAM,1) + + ELSE +!-- ---- + +!-- Check if the parton distribution is booked + NFMIN = NFMAP(1) + NFMAX = NFMAP(NQ2) + DO NF = NFMIN,NFMAX + ID = IDCHEK(NAME,NF,'STFAST',1) + ENDDO + + ENDIF +!-- ----- + +!-- No structure functions from the gluon + IF(ID.EQ.0) THEN + IERR = -3 + GOTO 500 + ENDIF + +!-- Check if the weight tables are available + IF(IERR.LE.3) THEN + IF(IORD.EQ.2.AND..NOT.LWTFOK) THEN + IERR = -4 + GOTO 500 + ENDIF + ELSEIF(IERR.EQ.4) THEN + IF(.NOT.LWFCOK) THEN + IERR = -4 + GOTO 500 + ENDIF + ELSEIF(IERR.EQ.5) THEN + IF(.NOT.LWLCOK) THEN + IERR = -4 + GOTO 500 + ENDIF + ELSEIF(IERR.EQ.6) THEN + IF(.NOT.LWFBOK) THEN + IERR = -4 + GOTO 500 + ENDIF + ELSEIF(IERR.EQ.7) THEN + IF(.NOT.LWLBOK) THEN + IERR = -4 + GOTO 500 + ENDIF + ENDIF + +!-- Check low Q2 for heavy quarks + IF(SRNAM.NE.'STFAST') THEN + IF(IERR.GE.4) THEN + IF(LCLOWQ.AND.Q.LE.1.5) THEN + IERR = -5 + GOTO 500 + ENDIF + ENDIF + ENDIF + + IFCHEK = IERR + + RETURN + + 500 CONTINUE + + IFCHEK = IERR + +!-- Stop? + IF(ISTOP.EQ.0) RETURN + IF(.NOT.LIMCK.AND.IERR.EQ.-2) RETURN + + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r '',A6,'' ---> STOP'')') & + & SRNAM + WRITE(6,'( '' ------------------------------------'')') + WRITE(6,'( '' Input Opt : '',A)') OPT + WRITE(6,'( '' Name : '',A)') NAME + IF(SRNAM.NE.'STFAST') THEN + IF(SRNAM.EQ.'QSTFIJ') THEN + WRITE(6,'( '' IX : '',I10 )') JX + WRITE(6,'( '' IQ : '',I10 )') JQ + ELSE + WRITE(6,'( '' x : '',E12.5)') XX + WRITE(6,'( '' Q2 : '',E12.5)') QQ + ENDIF + ENDIF + IF(IERR.EQ.0) THEN + WRITE(6,'(/'' Unknown option'')') + ELSEIF(IERR.EQ.-1) THEN + WRITE(6,'(/'' No x-Q2 grid available'')') + ELSEIF(IERR.EQ.-2) THEN + WRITE(6,'(/'' X, Q2 or mu2 outside grid or cuts'')') + IDUM = ICUTXQ(X,QP,1) + ELSEIF(IERR.EQ.-3) THEN + WRITE(6,'(/'' Strf from the gluon, no thank you'')') + ELSEIF(IERR.EQ.-4) THEN + WRITE(6,'(/'' No weight tables available'')') + ELSEIF(IERR.EQ.-5) THEN + WRITE(6,'(/'' Cannot calculate F2h, FLh for Q2 < 1.5 GeV2'')') + ENDIF + + CALL QTRACE('IFCHEK ',1) + + STOP + + END + +!DECK ID>, IDFCHK. + +! ============================= + INTEGER FUNCTION IDFCHK(OPT5) +! ============================= + +!-- Returns 1,2,3,4,5,6,7 for F2,Fl,xF3,F2c,FLc,F2b,FLb. +!-- Returns 0 if no valid OPT is given on input. + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + CHARACTER*5 OPT5 + + IDFCHK = 0 + + IF (OPT5(1:3).EQ.'F2 ') THEN + IDFCHK = 1 + ELSEIF(OPT5(1:3).EQ.'FL ') THEN + IDFCHK = 2 + ELSEIF(OPT5(1:3).EQ.'XF3') THEN + IDFCHK = 3 + ELSEIF(OPT5(1:3).EQ.'F2C') THEN + IDFCHK = 4 + ELSEIF(OPT5(1:3).EQ.'FLC') THEN + IDFCHK = 5 + ELSEIF(OPT5(1:3).EQ.'F2B') THEN + IDFCHK = 6 + ELSEIF(OPT5(1:3).EQ.'FLB') THEN + IDFCHK = 7 + ENDIF + + RETURN + END + +!DECK ID>, GETF2. + +! ================================ + SUBROUTINE GETF2(ID,X,Q,VAL,IFL) +! ================================ + +!--- IFL = 0 : F2 sucessfully calculated +!--- 1 : Fast calculation +!--- -1 : Scale mu outside grid + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + + + CHARACTER*5 PNAM,STFNAM + LOGICAL LNFP + COMMON /QCLNFP/ LNFP(0:30,3:5) + COMMON /QCPNAM/ PNAM(0:30) + COMMON /QCPWGT/ PWGT(0:10,0:30,3:5) + COMMON /QCFNAM/ STFNAM(7) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + REAL & + &WGTFF1,WGTFG1, & + &WGTGF1,WGTGG1, & + &WGTPP2,WGTPM2,WGTNS2, & + &WGTFF2,WGTFG2, & + &WGTGF2,WGTGG2, & + &WGTC2Q,WGTC2G,YNTC2Q, & + &WGTCLQ,WGTCLG,WGTC3Q + + COMMON/QCWEIT/ & + &WGTFF1(MXX*(MXX+1)/2) ,WGTFG1(MXX*(MXX+1)/2,3:5), & + &WGTGF1(MXX*(MXX+1)/2) ,WGTGG1(MXX*(MXX+1)/2,3:5), & + &WGTPP2(MXX*(MXX+1)/2,3:5),WGTPM2(MXX*(MXX+1)/2,3:5), & + &WGTNS2(MXX*(MXX+1)/2,3:5), & + &WGTFF2(MXX*(MXX+1)/2,3:5),WGTFG2(MXX*(MXX+1)/2,3:5), & + &WGTGF2(MXX*(MXX+1)/2,3:5),WGTGG2(MXX*(MXX+1)/2,3:5), & + &WGTC2Q(MXX*(MXX+1)/2) ,WGTC2G(MXX*(MXX+1)/2,3:5), & + &WGTCLQ(MXX*(MXX+1)/2) ,WGTCLG(MXX*(MXX+1)/2,3:5), & + &WGTC3Q(MXX*(MXX+1)/2) ,YNTC2Q(MXX) + + COMMON/QCWADR/ IWADR(MXX,MXX) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + VAL = 0. + JER = 1 + IFL = -1 + IX = IXFROMX(X) + IQ = IQFROMQ(Q) + + IF(IX.GT.0.AND.IQ.GT.0) THEN + VAL = GET_F2(ID,IX,IQ,IERR) + JER = MIN(JER,IERR) + ELSEIF(IX.GT.0.AND.IQ.LT.0.AND.IQ.NE.-NQ2) THEN + IQ = -IQ + VAL1 = GET_F2(ID,IX,IQ,IERR) + JER = MIN(JER,IERR) + VAL2 = GET_F2(ID,IX,IQ+1,IERR) + JER = MIN(JER,IERR) + TQ = LOG(Q/Q2TAB(IQ))/LOG(Q2TAB(IQ+1)/Q2TAB(IQ)) + VAL = (1.-TQ)*VAL1 + TQ*VAL2 + ELSEIF(IX.LT.0.AND.IQ.GT.0) THEN + IX = -IX + VAL1 = GET_F2(ID,IX,IQ,IERR) + JER = MIN(JER,IERR) + VAL2 = GET_F2(ID,IX+1,IQ,IERR) + JER = MIN(JER,IERR) + TX = (X-XXTAB(IX))/(XXTAB(IX+1)-XXTAB(IX)) + VAL = (1.-TX)*VAL1 + TX*VAL2 + ELSEIF(IX.LT.0.AND.IQ.LT.0.AND.IQ.NE.-NQ2) THEN + IX = -IX + IQ = -IQ + VAL1 = GET_F2(ID,IX,IQ,IERR) + JER = MIN(JER,IERR) + VAL2 = GET_F2(ID,IX,IQ+1,IERR) + JER = MIN(JER,IERR) + VAL3 = GET_F2(ID,IX+1,IQ,IERR) + JER = MIN(JER,IERR) + VAL4 = GET_F2(ID,IX+1,IQ+1,IERR) + JER = MIN(JER,IERR) + TQ = LOG(Q/Q2TAB(IQ))/LOG(Q2TAB(IQ+1)/Q2TAB(IQ)) + VAL1 = (1.-TQ)*VAL1 + TQ*VAL2 + VAL2 = (1.-TQ)*VAL3 + TQ*VAL4 + TX = (X-XXTAB(IX))/(XXTAB(IX+1)-XXTAB(IX)) + VAL = (1.-TX)*VAL1 + TX*VAL2 + ELSE + VAL = 0. + JER = -1 + ENDIF + + IFL = JER + + RETURN + END + +!DECK ID>, GET_F2. + +! ================================================ + DOUBLE PRECISION FUNCTION GET_F2(ID,IX0,IQ,IERR) +! ================================================ + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +!-- Input: ID parton distribution identifier +!-- IX0 x gridpoint +!-- Q Q2 value +!-- Output: IERR = 0 F2 successfully calculated +!-- = 1 Fast calculation +!-- = -1 Scale mu outside grid + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + + + CHARACTER*5 PNAM,STFNAM + LOGICAL LNFP + COMMON /QCLNFP/ LNFP(0:30,3:5) + COMMON /QCPNAM/ PNAM(0:30) + COMMON /QCPWGT/ PWGT(0:10,0:30,3:5) + COMMON /QCFNAM/ STFNAM(7) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + REAL & + &WGTFF1,WGTFG1, & + &WGTGF1,WGTGG1, & + &WGTPP2,WGTPM2,WGTNS2, & + &WGTFF2,WGTFG2, & + &WGTGF2,WGTGG2, & + &WGTC2Q,WGTC2G,YNTC2Q, & + &WGTCLQ,WGTCLG,WGTC3Q + + COMMON/QCWEIT/ & + &WGTFF1(MXX*(MXX+1)/2) ,WGTFG1(MXX*(MXX+1)/2,3:5), & + &WGTGF1(MXX*(MXX+1)/2) ,WGTGG1(MXX*(MXX+1)/2,3:5), & + &WGTPP2(MXX*(MXX+1)/2,3:5),WGTPM2(MXX*(MXX+1)/2,3:5), & + &WGTNS2(MXX*(MXX+1)/2,3:5), & + &WGTFF2(MXX*(MXX+1)/2,3:5),WGTFG2(MXX*(MXX+1)/2,3:5), & + &WGTGF2(MXX*(MXX+1)/2,3:5),WGTGG2(MXX*(MXX+1)/2,3:5), & + &WGTC2Q(MXX*(MXX+1)/2) ,WGTC2G(MXX*(MXX+1)/2,3:5), & + &WGTCLQ(MXX*(MXX+1)/2) ,WGTCLG(MXX*(MXX+1)/2,3:5), & + &WGTC3Q(MXX*(MXX+1)/2) ,YNTC2Q(MXX) + + COMMON/QCWADR/ IWADR(MXX,MXX) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + GET_F2 = 0. + + IF(LFFCAL(1,ID)) THEN + IERR = 1 + JD = IDFAST(1,ID) + GET_F2 = FSTORE(IX0,IQ,JD) + IF(GET_F2.GE.-99.) RETURN + ENDIF + + IERR = 0 + QMU = AAM2L*Q2TAB(IQ) + BBM2L + IMU = MIN(ABS(IQFROMQ(QMU)),NQ2-1) + IF(IMU.EQ.0) THEN + IERR = -1 + RETURN + ENDIF + + TX = 0. + TQ = LOG(QMU/Q2TAB(IMU))/LOG(Q2TAB(IMU+1)/Q2TAB(IMU)) + FFF0 = GET_PDFXQ(ID,IX0,IMU,TX,TQ) + + IF(IORD.EQ.1) THEN + GET_F2 = FFF0 + RETURN + ENDIF + + QR2 = QMU*AAAR2 + BBBR2 + IR2 = MIN(ABS(IQFROMQ(QR2)),NQ2-1) + IF(IR2.EQ.0) THEN + IERR = -1 + RETURN + ENDIF + TR = LOG(QR2/Q2TAB(IR2))/LOG(Q2TAB(IR2+1)/Q2TAB(IR2)) + + NF = NFMAP(IMU) + FACT = LOG(Q2TAB(IQ)/QMU) + F2 = 0. + DO IX = IX0,NXX + QU = GET_PDFXQ(ID,IX,IMU,TX,TQ) + GL = GET_PDFXQ( 0,IX,IMU,TX,TQ) + F2 = F2 + & + & (WGTC2Q(IWADR(IX,IX0))+ & + & WGTFF1(IWADR(IX,IX0))*FACT)*QU + & + & (WGTC2G(IWADR(IX,IX0),NF)+ & + & WGTFG1(IWADR(IX,IX0),NF)*FACT)*GL*PWGT(1,ID,NF) + ENDDO + GET_F2 = FFF0 + GET_AS(IR2,TR)*F2 + + RETURN + END + +!DECK ID>, GETFL. + +! ================================ + SUBROUTINE GETFL(ID,X,Q,VAL,IFL) +! ================================ + + +!--- IFL = 0 : F2 sucessfully calculated +!--- 1 : Fast calculation +!--- -1 : Scale mu outside grid + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + + + CHARACTER*5 PNAM,STFNAM + LOGICAL LNFP + COMMON /QCLNFP/ LNFP(0:30,3:5) + COMMON /QCPNAM/ PNAM(0:30) + COMMON /QCPWGT/ PWGT(0:10,0:30,3:5) + COMMON /QCFNAM/ STFNAM(7) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + REAL & + &WGTFF1,WGTFG1, & + &WGTGF1,WGTGG1, & + &WGTPP2,WGTPM2,WGTNS2, & + &WGTFF2,WGTFG2, & + &WGTGF2,WGTGG2, & + &WGTC2Q,WGTC2G,YNTC2Q, & + &WGTCLQ,WGTCLG,WGTC3Q + + COMMON/QCWEIT/ & + &WGTFF1(MXX*(MXX+1)/2) ,WGTFG1(MXX*(MXX+1)/2,3:5), & + &WGTGF1(MXX*(MXX+1)/2) ,WGTGG1(MXX*(MXX+1)/2,3:5), & + &WGTPP2(MXX*(MXX+1)/2,3:5),WGTPM2(MXX*(MXX+1)/2,3:5), & + &WGTNS2(MXX*(MXX+1)/2,3:5), & + &WGTFF2(MXX*(MXX+1)/2,3:5),WGTFG2(MXX*(MXX+1)/2,3:5), & + &WGTGF2(MXX*(MXX+1)/2,3:5),WGTGG2(MXX*(MXX+1)/2,3:5), & + &WGTC2Q(MXX*(MXX+1)/2) ,WGTC2G(MXX*(MXX+1)/2,3:5), & + &WGTCLQ(MXX*(MXX+1)/2) ,WGTCLG(MXX*(MXX+1)/2,3:5), & + &WGTC3Q(MXX*(MXX+1)/2) ,YNTC2Q(MXX) + + COMMON/QCWADR/ IWADR(MXX,MXX) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + VAL = 0. + JER = 1 + IFL = -1 + IX = IXFROMX(X) + IQ = IQFROMQ(Q) + + IF(IX.GT.0.AND.IQ.GT.0) THEN + VAL = GET_FL(ID,IX,IQ,IERR) + JER = MIN(JER,IERR) + ELSEIF(IX.GT.0.AND.IQ.LT.0.AND.IQ.NE.-NQ2) THEN + IQ = -IQ + VAL1 = GET_FL(ID,IX,IQ,IERR) + JER = MIN(JER,IERR) + VAL2 = GET_FL(ID,IX,IQ+1,IERR) + JER = MIN(JER,IERR) + TQ = LOG(Q/Q2TAB(IQ))/LOG(Q2TAB(IQ+1)/Q2TAB(IQ)) + VAL = (1.-TQ)*VAL1 + TQ*VAL2 + ELSEIF(IX.LT.0.AND.IQ.GT.0) THEN + IX = -IX + VAL1 = GET_FL(ID,IX,IQ,IERR) + JER = MIN(JER,IERR) + VAL2 = GET_FL(ID,IX+1,IQ,IERR) + JER = MIN(JER,IERR) + TX = (X-XXTAB(IX))/(XXTAB(IX+1)-XXTAB(IX)) + VAL = (1.-TX)*VAL1 + TX*VAL2 + ELSEIF(IX.LT.0.AND.IQ.LT.0.AND.IQ.NE.-NQ2) THEN + IX = -IX + IQ = -IQ + VAL1 = GET_FL(ID,IX,IQ,IERR) + JER = MIN(JER,IERR) + VAL2 = GET_FL(ID,IX,IQ+1,IERR) + JER = MIN(JER,IERR) + VAL3 = GET_FL(ID,IX+1,IQ,IERR) + JER = MIN(JER,IERR) + VAL4 = GET_FL(ID,IX+1,IQ+1,IERR) + JER = MIN(JER,IERR) + TQ = LOG(Q/Q2TAB(IQ))/LOG(Q2TAB(IQ+1)/Q2TAB(IQ)) + VAL1 = (1.-TQ)*VAL1 + TQ*VAL2 + VAL2 = (1.-TQ)*VAL3 + TQ*VAL4 + TX = (X-XXTAB(IX))/(XXTAB(IX+1)-XXTAB(IX)) + VAL = (1.-TX)*VAL1 + TX*VAL2 + ELSE + VAL = 0. + JER = -1 + ENDIF + + IFL = JER + + RETURN + END + +!DECK ID>, GET_FL. + +! ================================================ + DOUBLE PRECISION FUNCTION GET_FL(ID,IX0,IQ,IERR) +! ================================================ + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +!-- Input: ID parton distribution identifier +!-- IX0 x gridpoint +!-- Q Q2 value +!-- Output: IERR = 0 FL successfully calculated +!-- = 1 Fast calculation +!-- = -1 Scale mu outside grid + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + + + CHARACTER*5 PNAM,STFNAM + LOGICAL LNFP + COMMON /QCLNFP/ LNFP(0:30,3:5) + COMMON /QCPNAM/ PNAM(0:30) + COMMON /QCPWGT/ PWGT(0:10,0:30,3:5) + COMMON /QCFNAM/ STFNAM(7) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + REAL & + &WGTFF1,WGTFG1, & + &WGTGF1,WGTGG1, & + &WGTPP2,WGTPM2,WGTNS2, & + &WGTFF2,WGTFG2, & + &WGTGF2,WGTGG2, & + &WGTC2Q,WGTC2G,YNTC2Q, & + &WGTCLQ,WGTCLG,WGTC3Q + + COMMON/QCWEIT/ & + &WGTFF1(MXX*(MXX+1)/2) ,WGTFG1(MXX*(MXX+1)/2,3:5), & + &WGTGF1(MXX*(MXX+1)/2) ,WGTGG1(MXX*(MXX+1)/2,3:5), & + &WGTPP2(MXX*(MXX+1)/2,3:5),WGTPM2(MXX*(MXX+1)/2,3:5), & + &WGTNS2(MXX*(MXX+1)/2,3:5), & + &WGTFF2(MXX*(MXX+1)/2,3:5),WGTFG2(MXX*(MXX+1)/2,3:5), & + &WGTGF2(MXX*(MXX+1)/2,3:5),WGTGG2(MXX*(MXX+1)/2,3:5), & + &WGTC2Q(MXX*(MXX+1)/2) ,WGTC2G(MXX*(MXX+1)/2,3:5), & + &WGTCLQ(MXX*(MXX+1)/2) ,WGTCLG(MXX*(MXX+1)/2,3:5), & + &WGTC3Q(MXX*(MXX+1)/2) ,YNTC2Q(MXX) + + COMMON/QCWADR/ IWADR(MXX,MXX) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + GET_FL = 0. + + IF(LFFCAL(2,ID)) THEN + IERR = 1 + JD = IDFAST(2,ID) + GET_FL = FSTORE(IX0,IQ,JD) + IF(GET_FL.GE.-99.) RETURN + ENDIF + + IERR = 0 + + IF(IORD.EQ.1) THEN + GET_FL = 0. + RETURN + ENDIF + + QMU = AAM2L*Q2TAB(IQ) + BBM2L + IMU = MIN(ABS(IQFROMQ(QMU)),NQ2-1) + IF(IMU.EQ.0) THEN + IERR = -1 + RETURN + ENDIF + + QR2 = QMU*AAAR2 + BBBR2 + IR2 = MIN(ABS(IQFROMQ(QR2)),NQ2-1) + IF(IR2.EQ.0) THEN + IERR = -1 + RETURN + ENDIF + + TX = 0. + TQ = LOG(QMU/Q2TAB(IMU))/LOG(Q2TAB(IMU+1)/Q2TAB(IMU)) + TR = LOG(QR2/Q2TAB(IR2))/LOG(Q2TAB(IR2+1)/Q2TAB(IR2)) + + NF = NFMAP(IMU) + FACT = LOG(Q2TAB(IQ)/QMU)*FL_FAC + FL = 0. + DO IX = IX0,NXX + QU = GET_PDFXQ(ID,IX,IMU,TX,TQ) + GL = GET_PDFXQ( 0,IX,IMU,TX,TQ) + FL = FL + & + & (WGTCLQ(IWADR(IX,IX0))+ & + & WGTFF1(IWADR(IX,IX0))*FACT)*QU + & + & (WGTCLG(IWADR(IX,IX0),NF)+ & + & WGTFG1(IWADR(IX,IX0),NF)*FACT)*GL*PWGT(1,ID,NF) + ENDDO + GET_FL = GET_AS(IR2,TR)*FL + + RETURN + END + +!DECK ID>, GETF3. + +! ================================ + SUBROUTINE GETF3(ID,X,Q,VAL,IFL) +! ================================ + + +!--- IFL = 0 : F2 sucessfully calculated +!--- 1 : Fast calculation +!--- -1 : Scale mu outside grid + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + + + CHARACTER*5 PNAM,STFNAM + LOGICAL LNFP + COMMON /QCLNFP/ LNFP(0:30,3:5) + COMMON /QCPNAM/ PNAM(0:30) + COMMON /QCPWGT/ PWGT(0:10,0:30,3:5) + COMMON /QCFNAM/ STFNAM(7) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + REAL & + &WGTFF1,WGTFG1, & + &WGTGF1,WGTGG1, & + &WGTPP2,WGTPM2,WGTNS2, & + &WGTFF2,WGTFG2, & + &WGTGF2,WGTGG2, & + &WGTC2Q,WGTC2G,YNTC2Q, & + &WGTCLQ,WGTCLG,WGTC3Q + + COMMON/QCWEIT/ & + &WGTFF1(MXX*(MXX+1)/2) ,WGTFG1(MXX*(MXX+1)/2,3:5), & + &WGTGF1(MXX*(MXX+1)/2) ,WGTGG1(MXX*(MXX+1)/2,3:5), & + &WGTPP2(MXX*(MXX+1)/2,3:5),WGTPM2(MXX*(MXX+1)/2,3:5), & + &WGTNS2(MXX*(MXX+1)/2,3:5), & + &WGTFF2(MXX*(MXX+1)/2,3:5),WGTFG2(MXX*(MXX+1)/2,3:5), & + &WGTGF2(MXX*(MXX+1)/2,3:5),WGTGG2(MXX*(MXX+1)/2,3:5), & + &WGTC2Q(MXX*(MXX+1)/2) ,WGTC2G(MXX*(MXX+1)/2,3:5), & + &WGTCLQ(MXX*(MXX+1)/2) ,WGTCLG(MXX*(MXX+1)/2,3:5), & + &WGTC3Q(MXX*(MXX+1)/2) ,YNTC2Q(MXX) + + COMMON/QCWADR/ IWADR(MXX,MXX) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + VAL = 0. + JER = 1 + IFL = -1 + IX = IXFROMX(X) + IQ = IQFROMQ(Q) + + IF(IX.GT.0.AND.IQ.GT.0) THEN + VAL = GET_F3(ID,IX,IQ,IERR) + JER = MIN(JER,IERR) + ELSEIF(IX.GT.0.AND.IQ.LT.0.AND.IQ.NE.-NQ2) THEN + IQ = -IQ + VAL1 = GET_F3(ID,IX,IQ,IERR) + JER = MIN(JER,IERR) + VAL2 = GET_F3(ID,IX,IQ+1,IERR) + JER = MIN(JER,IERR) + TQ = LOG(Q/Q2TAB(IQ))/LOG(Q2TAB(IQ+1)/Q2TAB(IQ)) + VAL = (1.-TQ)*VAL1 + TQ*VAL2 + ELSEIF(IX.LT.0.AND.IQ.GT.0) THEN + IX = -IX + VAL1 = GET_F3(ID,IX,IQ,IERR) + JER = MIN(JER,IERR) + VAL2 = GET_F3(ID,IX+1,IQ,IERR) + JER = MIN(JER,IERR) + TX = (X-XXTAB(IX))/(XXTAB(IX+1)-XXTAB(IX)) + VAL = (1.-TX)*VAL1 + TX*VAL2 + ELSEIF(IX.LT.0.AND.IQ.LT.0.AND.IQ.NE.-NQ2) THEN + IX = -IX + IQ = -IQ + VAL1 = GET_F3(ID,IX,IQ,IERR) + JER = MIN(JER,IERR) + VAL2 = GET_F3(ID,IX,IQ+1,IERR) + JER = MIN(JER,IERR) + VAL3 = GET_F3(ID,IX+1,IQ,IERR) + JER = MIN(JER,IERR) + VAL4 = GET_F3(ID,IX+1,IQ+1,IERR) + JER = MIN(JER,IERR) + TQ = LOG(Q/Q2TAB(IQ))/LOG(Q2TAB(IQ+1)/Q2TAB(IQ)) + VAL1 = (1.-TQ)*VAL1 + TQ*VAL2 + VAL2 = (1.-TQ)*VAL3 + TQ*VAL4 + TX = (X-XXTAB(IX))/(XXTAB(IX+1)-XXTAB(IX)) + VAL = (1.-TX)*VAL1 + TX*VAL2 + ELSE + VAL = 0. + JER = -1 + ENDIF + + IFL = JER + + RETURN + END + +!DECK ID>, GET_F3. + +! ================================================ + DOUBLE PRECISION FUNCTION GET_F3(ID,IX0,IQ,IERR) +! ================================================ + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +!-- Input: ID parton distribution identifier +!-- IX0 x gridpoint +!-- Q Q2 value +!-- Output: IERR = 0 F3 successfully calculated +!-- = 1 Fast calculation +!-- = -1 Scale mu outside grid + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + + + CHARACTER*5 PNAM,STFNAM + LOGICAL LNFP + COMMON /QCLNFP/ LNFP(0:30,3:5) + COMMON /QCPNAM/ PNAM(0:30) + COMMON /QCPWGT/ PWGT(0:10,0:30,3:5) + COMMON /QCFNAM/ STFNAM(7) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + REAL & + &WGTFF1,WGTFG1, & + &WGTGF1,WGTGG1, & + &WGTPP2,WGTPM2,WGTNS2, & + &WGTFF2,WGTFG2, & + &WGTGF2,WGTGG2, & + &WGTC2Q,WGTC2G,YNTC2Q, & + &WGTCLQ,WGTCLG,WGTC3Q + + COMMON/QCWEIT/ & + &WGTFF1(MXX*(MXX+1)/2) ,WGTFG1(MXX*(MXX+1)/2,3:5), & + &WGTGF1(MXX*(MXX+1)/2) ,WGTGG1(MXX*(MXX+1)/2,3:5), & + &WGTPP2(MXX*(MXX+1)/2,3:5),WGTPM2(MXX*(MXX+1)/2,3:5), & + &WGTNS2(MXX*(MXX+1)/2,3:5), & + &WGTFF2(MXX*(MXX+1)/2,3:5),WGTFG2(MXX*(MXX+1)/2,3:5), & + &WGTGF2(MXX*(MXX+1)/2,3:5),WGTGG2(MXX*(MXX+1)/2,3:5), & + &WGTC2Q(MXX*(MXX+1)/2) ,WGTC2G(MXX*(MXX+1)/2,3:5), & + &WGTCLQ(MXX*(MXX+1)/2) ,WGTCLG(MXX*(MXX+1)/2,3:5), & + &WGTC3Q(MXX*(MXX+1)/2) ,YNTC2Q(MXX) + + COMMON/QCWADR/ IWADR(MXX,MXX) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + GET_F3 = 0. + + IF(LFFCAL(3,ID)) THEN + IERR = 1 + JD = IDFAST(3,ID) + GET_F3 = FSTORE(IX0,IQ,JD) + IF(GET_F3.GE.-99.) RETURN + ENDIF + + IERR = 0 + + QMU = AAM2L*Q2TAB(IQ) + BBM2L + IMU = MIN(ABS(IQFROMQ(QMU)),NQ2-1) + IF(IMU.EQ.0) THEN + IERR = -1 + RETURN + ENDIF + + TX = 0. + TQ = LOG(QMU/Q2TAB(IMU))/LOG(Q2TAB(IMU+1)/Q2TAB(IMU)) + FFF0 = GET_PDFXQ(ID,IX0,IMU,TX,TQ) + + IF(IORD.EQ.1) THEN + GET_F3 = FFF0 + RETURN + ENDIF + + QR2 = QMU*AAAR2 + BBBR2 + IR2 = MIN(ABS(IQFROMQ(QR2)),NQ2-1) + IF(IR2.EQ.0) THEN + IERR = -1 + RETURN + ENDIF + TR = LOG(QR2/Q2TAB(IR2))/LOG(Q2TAB(IR2+1)/Q2TAB(IR2)) + + F3 = 0. + FACT = LOG(Q2TAB(IQ)/QMU) + DO IX = IX0,NXX + QU = GET_PDFXQ(ID,IX,IMU,TX,TQ) + F3 = F3 + & + & (WGTC3Q(IWADR(IX,IX0))+ & + & WGTFF1(IWADR(IX,IX0))*FACT)*QU + ENDDO + GET_F3 = FFF0 + GET_AS(IR2,TR)*F3 + + RETURN + END + +!DECK ID>, GETFKH. + +! ===================================== + SUBROUTINE GETFKH(IDF,ID,X,Q,VAL,IFL) +! ===================================== + +!--- Input : IDF = 4,5,6,7 for F2c,FLc,F2b,Flb +!--- ID = parton distribution identifier +!--- X = x value +!--- Q = Q2 value + +!--- Output: VAL = heavy quark structure function +!--- IFL = 0 : F2 sucessfully calculated +!--- 1 : Fast calculation +!--- -1 : Scale mu outside grid + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + + + CHARACTER*5 PNAM,STFNAM + LOGICAL LNFP + COMMON /QCLNFP/ LNFP(0:30,3:5) + COMMON /QCPNAM/ PNAM(0:30) + COMMON /QCPWGT/ PWGT(0:10,0:30,3:5) + COMMON /QCFNAM/ STFNAM(7) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + REAL & + &WGTFF1,WGTFG1, & + &WGTGF1,WGTGG1, & + &WGTPP2,WGTPM2,WGTNS2, & + &WGTFF2,WGTFG2, & + &WGTGF2,WGTGG2, & + &WGTC2Q,WGTC2G,YNTC2Q, & + &WGTCLQ,WGTCLG,WGTC3Q + + COMMON/QCWEIT/ & + &WGTFF1(MXX*(MXX+1)/2) ,WGTFG1(MXX*(MXX+1)/2,3:5), & + &WGTGF1(MXX*(MXX+1)/2) ,WGTGG1(MXX*(MXX+1)/2,3:5), & + &WGTPP2(MXX*(MXX+1)/2,3:5),WGTPM2(MXX*(MXX+1)/2,3:5), & + &WGTNS2(MXX*(MXX+1)/2,3:5), & + &WGTFF2(MXX*(MXX+1)/2,3:5),WGTFG2(MXX*(MXX+1)/2,3:5), & + &WGTGF2(MXX*(MXX+1)/2,3:5),WGTGG2(MXX*(MXX+1)/2,3:5), & + &WGTC2Q(MXX*(MXX+1)/2) ,WGTC2G(MXX*(MXX+1)/2,3:5), & + &WGTCLQ(MXX*(MXX+1)/2) ,WGTCLG(MXX*(MXX+1)/2,3:5), & + &WGTC3Q(MXX*(MXX+1)/2) ,YNTC2Q(MXX) + + COMMON/QCWADR/ IWADR(MXX,MXX) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + VAL = 0. + IFL = -1 + + JER = 1 + IX = IHFROMH(X) + IQ = IQFROMQ(Q) + + IF(IX.GT.0.AND.IQ.GT.0) THEN + VAL = GET_FKH(IDF,ID,IX,IQ,IERR) + JER = MIN(JER,IERR) + ELSEIF(IX.GT.0.AND.IQ.LT.0.AND.IQ.NE.-NQ2) THEN + IQ = -IQ + VAL1 = GET_FKH(IDF,ID,IX,IQ,IERR) + JER = MIN(JER,IERR) + VAL2 = GET_FKH(IDF,ID,IX,IQ+1,IERR) + JER = MIN(JER,IERR) + TQ = LOG(Q/Q2TAB(IQ))/LOG(Q2TAB(IQ+1)/Q2TAB(IQ)) + VAL = (1.-TQ)*VAL1 + TQ*VAL2 + ELSEIF(IX.LT.0.AND.IQ.GT.0) THEN + IX = -IX + VAL1 = GET_FKH(IDF,ID,IX,IQ,IERR) + JER = MIN(JER,IERR) + VAL2 = GET_FKH(IDF,ID,IX+1,IQ,IERR) + JER = MIN(JER,IERR) + TX = (X-XHTAB(IX))/(XHTAB(IX+1)-XHTAB(IX)) + VAL = (1.-TX)*VAL1 + TX*VAL2 + ELSEIF(IX.LT.0.AND.IQ.LT.0.AND.IQ.NE.-NQ2) THEN + IX = -IX + IQ = -IQ + VAL1 = GET_FKH(IDF,ID,IX,IQ,IERR) + JER = MIN(JER,IERR) + VAL2 = GET_FKH(IDF,ID,IX,IQ+1,IERR) + JER = MIN(JER,IERR) + VAL3 = GET_FKH(IDF,ID,IX+1,IQ,IERR) + JER = MIN(JER,IERR) + VAL4 = GET_FKH(IDF,ID,IX+1,IQ+1,IERR) + JER = MIN(JER,IERR) + TQ = LOG(Q/Q2TAB(IQ))/LOG(Q2TAB(IQ+1)/Q2TAB(IQ)) + VAL1 = (1.-TQ)*VAL1 + TQ*VAL2 + VAL2 = (1.-TQ)*VAL3 + TQ*VAL4 + TX = (X-XHTAB(IX))/(XHTAB(IX+1)-XHTAB(IX)) + VAL = (1.-TX)*VAL1 + TX*VAL2 + ELSE + VAL = 0. + JER = -1 + ENDIF + + IFL = JER + + + RETURN + END + +!DECK ID>, FILLWF. + +! ==================================== + SUBROUTINE FILLWF(IO1,IO2,IF2,NFLAV) +! ==================================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + REAL & + &WGTFF1,WGTFG1, & + &WGTGF1,WGTGG1, & + &WGTPP2,WGTPM2,WGTNS2, & + &WGTFF2,WGTFG2, & + &WGTGF2,WGTGG2, & + &WGTC2Q,WGTC2G,YNTC2Q, & + &WGTCLQ,WGTCLG,WGTC3Q + + COMMON/QCWEIT/ & + &WGTFF1(MXX*(MXX+1)/2) ,WGTFG1(MXX*(MXX+1)/2,3:5), & + &WGTGF1(MXX*(MXX+1)/2) ,WGTGG1(MXX*(MXX+1)/2,3:5), & + &WGTPP2(MXX*(MXX+1)/2,3:5),WGTPM2(MXX*(MXX+1)/2,3:5), & + &WGTNS2(MXX*(MXX+1)/2,3:5), & + &WGTFF2(MXX*(MXX+1)/2,3:5),WGTFG2(MXX*(MXX+1)/2,3:5), & + &WGTGF2(MXX*(MXX+1)/2,3:5),WGTGG2(MXX*(MXX+1)/2,3:5), & + &WGTC2Q(MXX*(MXX+1)/2) ,WGTC2G(MXX*(MXX+1)/2,3:5), & + &WGTCLQ(MXX*(MXX+1)/2) ,WGTCLG(MXX*(MXX+1)/2,3:5), & + &WGTC3Q(MXX*(MXX+1)/2) ,YNTC2Q(MXX) + + COMMON/QCWADR/ IWADR(MXX,MXX) + + + EXTERNAL C2Q, C2QX0, C2G, CLQ, CLG, D3Q + EXTERNAL PQGLO, PGQLO, PQQLO, PQQX0, PGGLO, PGGX0 + EXTERNAL PP1SFUN, PP1SX0, PM1SFUN, PM1SX0 + EXTERNAL FF1SFUN, FF1SX0, GF1SFUN, XP1TFUN + EXTERNAL GG1SFUN, GG1SX0, FG1SFUN, XG1TFUN + + COMMON /QCWGTC/ YWGT,QPCG,QMASS,EGAUSS,NF + + EGAUSS = 0.0001 + NF = NFLAV + + CWFGG = 6.*(11./12.-NF/18.) - 6. + + DO 90 IX0 = 1,NXX + + X0 = XXTAB(IX0) + + YNTC2Q(IX0) = DGAUSS_LHA(C2Q,0.D0,X0,EGAUSS) + + SI = X0/XXTAB(IX0) + SP = X0/XXTAB(IX0+1) + + IF(IO1.NE.0) THEN + CALL S1FUNC(PQGLO ,SP,SI,S1PQG) + WGTFG1(IWADR(IX0,IX0),NF) = S1PQG + CALL S1FUNC(PGQLO ,SP,SI,S1PGQ) + WGTGF1(IWADR(IX0,IX0)) = S1PGQ + CALL S1FUNC(PQQX0 ,SP,SI,S1PQQ) + WGTFF1(IWADR(IX0,IX0)) = S1PQQ+2.+(8./3.)*LOG(1.-SP) + CALL S1FUNC(PGGX0 ,SP,SI,S1PGG) + WGTGG1(IWADR(IX0,IX0),NF) = S1PGG+6.*LOG(1.-SP)+CWFGG + ENDIF + + IF(IO2.NE.0) THEN + TERM1 = DGAUSS_LHA(PM1SFUN,0.D0,SP,EGAUSS) + TERM2 = DGAUSS_LHA(XP1TFUN,0.D0,SP,EGAUSS) + TERM3 = DGAUSS_LHA(XG1TFUN,0.D0,SP,EGAUSS) + CALL S1FUNC(PP1SX0 ,SP,SI,S1NS2) + WGTPP2(IWADR(IX0,IX0),NF) = S1NS2 - TERM1 + WGTNS2(IWADR(IX0,IX0),NF) = S1NS2 - TERM1 + LPLUS = .TRUE. + CALL S1FUNC(PM1SX0 ,SP,SI,S1F32) + WGTPM2(IWADR(IX0,IX0),NF) = S1F32 - TERM1 + CALL S1FUNC(FF1SX0 ,SP,SI,S1FF2) + WGTFF2(IWADR(IX0,IX0),NF) = S1FF2 - TERM2 + CALL S1FUNC(GF1SFUN,SP,SI,S1FG2) + WGTFG2(IWADR(IX0,IX0),NF) = S1FG2 + CALL S1FUNC(GG1SX0 ,SP,SI,S1GG2) + WGTGG2(IWADR(IX0,IX0),NF) = S1GG2 - TERM3 + CALL S1FUNC(FG1SFUN,SP,SI,S1GF2) + WGTGF2(IWADR(IX0,IX0),NF) = S1GF2 + ENDIF + + IF(IF2.NE.0) THEN + TERM = DGAUSS_LHA(C2Q,0.D0,SP,EGAUSS) + CALL S1FUNC(C2QX0 ,SP,SI,S1C2Q) + WGTC2Q(IWADR(IX0,IX0)) = S1C2Q - TERM + CALL S1FUNC(C2G ,SP,SI,S1C2G) + WGTC2G(IWADR(IX0,IX0),NF) = S1C2G + CALL S1FUNC(CLQ ,SP,SI,S1CLQ) + WGTCLQ(IWADR(IX0,IX0)) = S1CLQ + CALL S1FUNC(CLG ,SP,SI,S1CLG) + WGTCLG(IWADR(IX0,IX0),NF) = S1CLG + CALL S1FUNC(D3Q ,SP,SI,S1D3Q) + WGTC3Q(IWADR(IX0,IX0)) = S1C2Q - TERM - S1D3Q + ENDIF + + DO 80 IX = IX0+1,NXX + + SI = X0/XXTAB(IX) + SP = X0/XXTAB(IX+1) + SM = X0/XXTAB(IX-1) + + IF(IO1.NE.0) THEN + CALL S1FUNC(PQGLO ,SP,SI,S1PQG) + CALL S2FUNC(PQGLO ,SI,SM,S2PQG) + WGTFG1(IWADR(IX,IX0),NF) = (S1PQG-S2PQG) + CALL S1FUNC(PGQLO ,SP,SI,S1PGQ) + CALL S2FUNC(PGQLO ,SI,SM,S2PGQ) + WGTGF1(IWADR(IX,IX0)) = S1PGQ-S2PGQ + CALL S1FUNC(PQQLO ,SP,SI,S1PQQ) + CALL S2FUNC(PQQLO ,SI,SM,S2PQQ) + WGTFF1(IWADR(IX,IX0)) = S1PQQ-S2PQQ + CALL S1FUNC(PGGLO ,SP,SI,S1PGG) + CALL S2FUNC(PGGLO ,SI,SM,S2PGG) + WGTGG1(IWADR(IX,IX0),NF) = S1PGG-S2PGG + ENDIF + + IF(IO2.NE.0) THEN + CALL S1FUNC(PP1SFUN,SP,SI,S1NS2) + CALL S2FUNC(PP1SFUN,SI,SM,S2NS2) + WGTPP2(IWADR(IX,IX0),NF) = S1NS2-S2NS2 + WGTNS2(IWADR(IX,IX0),NF) = S1NS2-S2NS2 + CALL S1FUNC(PM1SFUN,SP,SI,S1F32) + CALL S2FUNC(PM1SFUN,SI,SM,S2F32) + WGTPM2(IWADR(IX,IX0),NF) = S1F32-S2F32 + CALL S1FUNC(FF1SFUN,SP,SI,S1FF2) + CALL S2FUNC(FF1SFUN,SI,SM,S2FF2) + WGTFF2(IWADR(IX,IX0),NF) = S1FF2-S2FF2 + CALL S1FUNC(GF1SFUN,SP,SI,S1FG2) + CALL S2FUNC(GF1SFUN,SI,SM,S2FG2) + WGTFG2(IWADR(IX,IX0),NF) = S1FG2-S2FG2 + CALL S1FUNC(GG1SFUN,SP,SI,S1GG2) + CALL S2FUNC(GG1SFUN,SI,SM,S2GG2) + WGTGG2(IWADR(IX,IX0),NF) = S1GG2-S2GG2 + CALL S1FUNC(FG1SFUN,SP,SI,S1GF2) + CALL S2FUNC(FG1SFUN,SI,SM,S2GF2) + WGTGF2(IWADR(IX,IX0),NF) = S1GF2-S2GF2 + ENDIF + + IF(IF2.NE.0) THEN + CALL S1FUNC(C2Q ,SP,SI,S1C2Q) + CALL S2FUNC(C2Q ,SI,SM,S2C2Q) + WGTC2Q(IWADR(IX,IX0)) = S1C2Q-S2C2Q + CALL S1FUNC(C2G ,SP,SI,S1C2G) + CALL S2FUNC(C2G ,SI,SM,S2C2G) + WGTC2G(IWADR(IX,IX0),NF) = S1C2G-S2C2G + CALL S1FUNC(CLQ ,SP,SI,S1CLQ) + CALL S2FUNC(CLQ ,SI,SM,S2CLQ) + WGTCLQ(IWADR(IX,IX0)) = S1CLQ-S2CLQ + CALL S1FUNC(CLG ,SP,SI,S1CLG) + CALL S2FUNC(CLG ,SI,SM,S2CLG) + WGTCLG(IWADR(IX,IX0),NF) = S1CLG-S2CLG + CALL S1FUNC(D3Q ,SP,SI,S1D3Q) + CALL S2FUNC(D3Q ,SI,SM,S2D3Q) + WGTC3Q(IWADR(IX,IX0)) = S1C2Q-S2C2Q-S1D3Q+S2D3Q + ENDIF + + 80 CONTINUE + + 90 END DO + + YWGT = 0. + + RETURN + END + +!DECK ID>, IWTADR. + + INTEGER FUNCTION IWTADR(I,J,K) + +!--- Upper diagonal storage: I .ge. J (!) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + IWTADR = 1 + (J-1)*(MXX+1) - & + & (J*(J-1))/2 + (I-J) + (K-1)*(MXX*(MXX+1))/2 + + RETURN + END + +!DECK ID>, IWTAD. + + INTEGER FUNCTION IWTAD(I,J) + +!--- Upper diagonal storage: I .ge. J (!) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + IWTAD = 1 + (J-1)*(MXX+1) - (J*(J-1))/2 + (I-J) + + RETURN + END + +!DECK ID>, S1FUNC. + +! ================================ + SUBROUTINE S1FUNC(FUN,U,V,S1FUN) +! ================================ + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + EXTERNAL FUN + + COMMON /QCWGTC/ YWGT,QPCG,QMASS,EGAUSS,NF + + YWGT = U + S1FUN = DGAUSS_LHA(FUN,U,V,EGAUSS)*V/(V-U) + + YWGT = 0. + + RETURN + END + +!DECK ID>, S2FUNC. + +! ================================ + SUBROUTINE S2FUNC(FUN,U,V,S2FUN) +! ================================ + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + EXTERNAL FUN + + COMMON /QCWGTC/ YWGT,QPCG,QMASS,EGAUSS,NF + + YWGT = V + S2FUN = DGAUSS_LHA(FUN,U,V,EGAUSS)*U/(V-U) + + YWGT = 0. + + RETURN + END + +!DECK ID>, FILLO1. + +! ===================== + SUBROUTINE FILLO1(NF) +! ===================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +!----- | F | | WGTFF WGTFG | | F | +!----- d/dLnQ2 | | = | | | | +!----- | G | | WGTGF WGTGG | | G | + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + REAL & + &WGTFF1,WGTFG1, & + &WGTGF1,WGTGG1, & + &WGTPP2,WGTPM2,WGTNS2, & + &WGTFF2,WGTFG2, & + &WGTGF2,WGTGG2, & + &WGTC2Q,WGTC2G,YNTC2Q, & + &WGTCLQ,WGTCLG,WGTC3Q + + COMMON/QCWEIT/ & + &WGTFF1(MXX*(MXX+1)/2) ,WGTFG1(MXX*(MXX+1)/2,3:5), & + &WGTGF1(MXX*(MXX+1)/2) ,WGTGG1(MXX*(MXX+1)/2,3:5), & + &WGTPP2(MXX*(MXX+1)/2,3:5),WGTPM2(MXX*(MXX+1)/2,3:5), & + &WGTNS2(MXX*(MXX+1)/2,3:5), & + &WGTFF2(MXX*(MXX+1)/2,3:5),WGTFG2(MXX*(MXX+1)/2,3:5), & + &WGTGF2(MXX*(MXX+1)/2,3:5),WGTGG2(MXX*(MXX+1)/2,3:5), & + &WGTC2Q(MXX*(MXX+1)/2) ,WGTC2G(MXX*(MXX+1)/2,3:5), & + &WGTCLQ(MXX*(MXX+1)/2) ,WGTCLG(MXX*(MXX+1)/2,3:5), & + &WGTC3Q(MXX*(MXX+1)/2) ,YNTC2Q(MXX) + + COMMON/QCWADR/ IWADR(MXX,MXX) + + + DO 100 IX0=1,NXX + X0 = XXTAB(IX0) + + DO 100 IXI=IX0,NXX + SI = X0 / XXTAB(IXI) + SP = X0 / XXTAB(IXI+1) + IF(IXI.EQ.IX0) THEN + SSP = LOG(SP) / (1.-SP) + WPQQV = SP + 4.*LOG(1.-SP)+ 2.*SP*SSP + WPQGV = 3. - (1.-SP)**2 + 3.*SP*SSP + WPGQV = - 7. - SP - 4.*(1.+SP)*SSP + WPGGV = - 12.5 - NF/3. + 6.*LOG(1.-SP) + (1.-SP)**2 & + & - 6.*(1.+SP)*SSP + ELSEIF(IXI.EQ.IX0+1) THEN + SSI = LOG(SI) / (1.-SI) + WPQQV = SP-1. + SQQ(SI,SP) - 2.*SSI + WPQGV = (SP-1.)*(2.-SI-SP) - 3.*SP*LOG(SP/SI)/(SP-SI) - 3.*SSI + WPGQV = 1.-SP + 4.*(SP+1.)*LOG(SP/SI)/(SP-SI) + 8.*SSI + WPGGV = (1.-SP)*(2.-SI-SP) + 6.*SGG(SI,SP) + 12.*SSI + ELSE + SM = X0 / XXTAB(IXI-1) + WPQQV = SP-SM + SQQ(SI,SP) - SQQ(SI,SM) + WPQGV = (SP-SM)*(3.-SM-SI-SP) - 3.*SP*LOG(SP/SI)/(SP-SI) & + & + 3.*SM*LOG(SM/SI)/(SM-SI) + WPGQV = SM-SP + 4.*(SP+1.)*LOG(SP/SI)/(SP-SI) & + & - 4.*(SM+1.)*LOG(SM/SI)/(SM-SI) + WPGGV = (SM-SP)*(3.-SM-SI-SP) + 6.*( SGG(SI,SP) - SGG(SI,SM) ) + ENDIF + + WGTFF1(IWADR(IXI,IX0)) = 2./3. * SI * WPQQV + + WGTFG1(IWADR(IXI,IX0),NF) = 1./6. * SI * WPQGV * 2.*NF + + WGTGF1(IWADR(IXI,IX0)) = 2./3. * SI * WPGQV + + WGTGG1(IWADR(IXI,IX0),NF) = SI * WPGGV + + 100 CONTINUE + + RETURN + END + +!DECK ID>, SQQ. + +! ================================== + DOUBLE PRECISION FUNCTION SQQ(X,Y) +! ================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + SQQ = 2./(Y-X) * ( 2.*(Y-1.)*LOG((1.-Y)/(1.-X)) - Y*LOG(Y/X) ) + + RETURN + END + +!DECK ID>, SGG. + +! ================================== + DOUBLE PRECISION FUNCTION SGG(X,Y) +! ================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + SGG = ( (1.+Y)*LOG(Y/X) - (1.-Y)*LOG((1.-Y)/(1.-X)) ) / (Y-X) + + RETURN + END + +!DECK ID>, QNSPLF. + +! =============================================== + DOUBLE PRECISION FUNCTION QNSPLF(OPT,X,Q,NFLAV) +! =============================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + CHARACTER*(*) OPT + CHARACTER*10 OPT1 + + COMMON /QCWGTC/ YWGT,QPGC,QMASS,EGAUSS,NF + + DATA OPT1 /' '/ + + YWGT = 0. + NF = NFLAV + QNSPLF = 0. + QPCG = Q + CALL QNRGET('CMASS',QMASS) + + LEN = LENOCC_LHA(OPT) + IF(LEN.GT.10 .OR. LEN.LE.0) GOTO 550 +!-- Avoid changing input parameter + OPT1(1:LEN) = OPT(1:LEN) + CALL CLTOU_LHA(OPT1) + + IF (LEN.GE.4.AND.OPT1(1:4).EQ.'PFF1') THEN + IF(X.GE.1..OR.X.LT.0.) RETURN + QNSPLF = PQQLO(X) + ELSEIF(LEN.GE.4.AND.OPT1(1:4).EQ.'PFG1') THEN + IF(NF.LE.0) GOTO 500 + IF(X.GT.1..OR.X.LT.0.) RETURN + QNSPLF = PQGLO(X) + ELSEIF(LEN.GE.4.AND.OPT1(1:4).EQ.'PGF1') THEN + IF(X.GT.1..OR.X.LT.0.) RETURN + QNSPLF = PGQLO(X) + ELSEIF(LEN.GE.4.AND.OPT1(1:4).EQ.'PGG1') THEN + IF(X.GE.1..OR.X.LT.0.) RETURN + QNSPLF = PGGLO(X) + ELSEIF(LEN.GE.4.AND.OPT1(1:4).EQ.'PPL2') THEN + IF(NF.LE.0) GOTO 500 + IF(X.GE.1..OR.X.LT.0.) RETURN + QNSPLF = PP1SFUN(X) + ELSEIF(LEN.GE.4.AND.OPT1(1:4).EQ.'PMI2') THEN + IF(NF.LE.0) GOTO 500 + IF(X.GE.1..OR.X.LT.0.) RETURN + QNSPLF = PM1SFUN(X) + ELSEIF(LEN.GE.4.AND.OPT1(1:4).EQ.'PFF2') THEN + IF(NF.LE.0) GOTO 500 + IF(X.GE.1..OR.X.LT.0.) RETURN + QNSPLF = FF1SFUN(X) + ELSEIF(LEN.GE.4.AND.OPT1(1:4).EQ.'PFG2') THEN + IF(NF.LE.0) GOTO 500 + IF(X.GE.1..OR.X.LT.0.) RETURN + QNSPLF = FG1SFUN(X) + ELSEIF(LEN.GE.4.AND.OPT1(1:4).EQ.'PGF2') THEN + IF(NF.LE.0) GOTO 500 + IF(X.GE.1..OR.X.LT.0.) RETURN + QNSPLF = GF1SFUN(X) + ELSEIF(LEN.GE.4.AND.OPT1(1:4).EQ.'PGG2') THEN + IF(NF.LE.0) GOTO 500 + IF(X.GE.1..OR.X.LT.0.) RETURN + QNSPLF = GG1SFUN(X) + ELSEIF(LEN.GE.3.AND.OPT1(1:3).EQ.'C1Q') THEN + IF(X.GE.1..OR.X.LT.0.) RETURN + QNSPLF = C2Q(X)-CLQ(X) + ELSEIF(LEN.GE.3.AND.OPT1(1:3).EQ.'C1G') THEN + IF(NF.LE.0) GOTO 500 + IF(X.GE.1..OR.X.LT.0.) RETURN + QNSPLF = C2G(X)-CLG(X) + ELSEIF(LEN.GE.3.AND.OPT1(1:3).EQ.'C2Q') THEN + IF(X.GE.1..OR.X.LT.0.) RETURN + QNSPLF = C2Q(X) + ELSEIF(LEN.GE.3.AND.OPT1(1:3).EQ.'C2G') THEN + IF(NF.LE.0) GOTO 500 + IF(X.GE.1..OR.X.LT.0.) RETURN + QNSPLF = C2G(X) + ELSEIF(LEN.GE.3.AND.OPT1(1:3).EQ.'CLQ') THEN + IF(X.GE.1..OR.X.LT.0.) RETURN + QNSPLF = CLQ(X) + ELSEIF(LEN.GE.3.AND.OPT1(1:3).EQ.'CLG') THEN + IF(NF.LE.0) GOTO 500 + IF(X.GE.1..OR.X.LT.0.) RETURN + QNSPLF = CLG(X) + ELSEIF(LEN.GE.3.AND.OPT1(1:3).EQ.'C3Q') THEN + IF(X.GE.1..OR.X.LT.0.) RETURN + QNSPLF = C2Q(X)-D3Q(X) + ELSEIF(LEN.GE.4.AND.OPT1(1:4).EQ.'C02G') THEN + IF(X.GE.1..OR.X.LT.0.) RETURN + QNSPLF = X*C02G_FUN(X) + ELSEIF(LEN.GE.4.AND.OPT1(1:4).EQ.'C12G') THEN + IF(X.GE.1..OR.X.LT.0.) RETURN + QNSPLF = X*C12G_FUN(X) + ELSEIF(LEN.GE.5.AND.OPT1(1:5).EQ.'C1B2G') THEN + IF(X.GE.1..OR.X.LT.0.) RETURN + QNSPLF = X*C1B2G_FUN(X) + ELSEIF(LEN.GE.4.AND.OPT1(1:4).EQ.'C12Q') THEN + IF(X.GE.1..OR.X.LT.0.) RETURN + QNSPLF = X*C12Q_FUN(X) + ELSEIF(LEN.GE.5.AND.OPT1(1:5).EQ.'C1B2Q') THEN + IF(X.GE.1..OR.X.LT.0.) RETURN + QNSPLF = X*C1B2Q_FUN(X) + ELSEIF(LEN.GE.4.AND.OPT1(1:4).EQ.'D12Q') THEN + IF(X.GE.1..OR.X.LT.0.) RETURN + QNSPLF = X*D12Q_FUN(X) + ELSEIF(LEN.GE.5.AND.OPT1(1:5).EQ.'D1B2Q') THEN + IF(X.GE.1..OR.X.LT.0.) RETURN + QNSPLF = X*D1B2Q_FUN(X) + ELSE + GOTO 550 + ENDIF + + RETURN + + 500 CONTINUE + WRITE(6,'('' QNSPLF: NF not allowed'',I10, & + & '' ---> STOP'')') NF + STOP + + 550 CONTINUE + WRITE(6,'('' QNSPLF: undefined option '',A, & + & '' ---> STOP'')') OPT + STOP + + END + +!DECK ID>, PQGLO. + +! ================================== + DOUBLE PRECISION FUNCTION PQGLO(X) +! ================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + COMMON /QCWGTC/ YWGT,QPGC,QMASS,EGAUSS,NF + + PQG = NF * ( X*X + (1.-X)*(1.-X) ) + + PQGLO = (X-YWGT)*PQG/X + + RETURN + END + +!DECK ID>, PGQLO. + +! ================================== + DOUBLE PRECISION FUNCTION PGQLO(X) +! ================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + COMMON /QCWGTC/ YWGT,QPGC,QMASS,EGAUSS,NF + + PGQ = 4. * ( 1. + (1.-X)*(1.-X) ) / ( 3.*X ) + + PGQLO = (X-YWGT)*PGQ/X + + RETURN + END + +!DECK ID>, PQQLO. +! +! ================================== + DOUBLE PRECISION FUNCTION PQQLO(X) +! ================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) +! + COMMON /QCWGTC/ YWGT,QPGC,QMASS,EGAUSS,NF +! + PQQ = (4./3.) * ( 1. + X*X ) / (1.-X) +! + PQQLO = (X-YWGT)*PQQ/X +! + RETURN + END + +!DECK ID>, PQQX0. +! +! ================================== + DOUBLE PRECISION FUNCTION PQQX0(X) +! ================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) +! + COMMON /QCWGTC/ YWGT,QPGC,QMASS,EGAUSS,NF +! + PQQX0 = (4./3.) * ( (X-YWGT)*(1.+X*X)/X - 2.*(1.-YWGT) ) / (1.-X) +! + RETURN + END + +!DECK ID>, PGGLO. +! +! ================================== + DOUBLE PRECISION FUNCTION PGGLO(X) +! ================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) +! + COMMON /QCWGTC/ YWGT,QPGC,QMASS,EGAUSS,NF +! + PGG = 6. * ( X/(1.-X) + (1.-X)/X + X*(1.-X) ) +! + PGGLO = (X-YWGT)*PGG/X +! + RETURN + END + +!DECK ID>, PGGX0. +! +! ================================== + DOUBLE PRECISION FUNCTION PGGX0(X) +! ================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) +! + COMMON /QCWGTC/ YWGT,QPGC,QMASS,EGAUSS,NF +! + PGGX0 = 6. * (X-YWGT) * ( (1.-X)/(X*X) + 1. - X ) +! + RETURN + END + +!DECK ID>, PP1SFUN. +! +! ==================================== + DOUBLE PRECISION FUNCTION PP1SFUN(X) +! ==================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) +! + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + +! + COMMON /QCWGTC/ YWGT,QPGC,QMASS,EGAUSS,NF +! + CX2 = X**2 + C1PX = 1.+X + C1MX = 1.-X + CLX = LOG(X) + CLX2 = CLX**2 + CL1MX = LOG(C1MX) + CL1PX = LOG(C1PX) + CPFFX = (1.+CX2) / C1MX + CPFFMX = (1.+CX2) / C1PX + CS3X = -DDILOG_LHA(-X) + CS2X = .5*(CLX2-CPI2S3) + 2.*(CS3X-CLX*CL1PX) +! + AAA = - CPFFX*2.*CLX*CL1MX - (2.*X+3./C1MX)*CLX - .5*C1PX*CLX2 & + & - 5.*C1MX + BBB = CPFFX*(.5*CLX2+C11S6*CLX+CPIA) + C1PX*CLX + C20S3*C1MX + CCC = - CPFFX*C2S3*(C5S3+CLX) - C4S3*C1MX +! + PQQ = C16S9*AAA + 4.*BBB + C2S3*NF*CCC + PQQB = - C4S9 * ( CPFFMX*CS2X + C1PX*CLX + 2.*C1MX ) +! + PP1S = PQQ + PQQB + PP1SFUN = (X-YWGT)*PP1S/X +! + RETURN + END + +!DECK ID>, PP1SX0. +! +! =================================== + DOUBLE PRECISION FUNCTION PP1SX0(X) +! =================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) +! + COMMON /QCWGTC/ YWGT,QPGC,QMASS,EGAUSS,NF +! + YREM = YWGT + YWGT = 0. + PPLUS = PP1SFUN(X) + PMINU = PM1SFUN(X) + YWGT = YREM + PP1SX0 = (X-YWGT)*PPLUS/X - (1.-YWGT)*PMINU +! + RETURN + END + +!DECK ID>, PM1SFUN. +! +! ==================================== + DOUBLE PRECISION FUNCTION PM1SFUN(X) +! ==================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) +! + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + +! + COMMON /QCWGTC/ YWGT,QPGC,QMASS,EGAUSS,NF +! + CX2 = X**2 + C1PX = 1.+X + C1MX = 1.-X + CLX = LOG(X) + CLX2 = CLX**2 + CL1MX = LOG(C1MX) + CL1PX = LOG(C1PX) + CPFFX = (1.+CX2) / C1MX + CPFFMX = (1.+CX2) / C1PX + CS3X = -DDILOG_LHA(-X) + CS2X = .5*(CLX2-CPI2S3) + 2.*(CS3X-CLX*CL1PX) +! + AAA = - CPFFX*2.*CLX*CL1MX - (2.*X+3./C1MX)*CLX - .5*C1PX*CLX2 & + & - 5.*C1MX + BBB = CPFFX*(.5*CLX2+C11S6*CLX+CPIA) + C1PX*CLX + C20S3*C1MX + CCC = - CPFFX*C2S3*(C5S3+CLX) - C4S3*C1MX +! + PQQ = C16S9*AAA + 4.*BBB + C2S3*NF*CCC + PQQB = - C4S9 * ( CPFFMX*CS2X + C1PX*CLX + 2.*C1MX ) +! + PM1S = PQQ - PQQB + PM1SFUN = (X-YWGT)*PM1S/X +! + RETURN + END + +!DECK ID>, PM1SX0. +! +! =================================== + DOUBLE PRECISION FUNCTION PM1SX0(X) +! =================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) +! + COMMON /QCWGTC/ YWGT,QPGC,QMASS,EGAUSS,NF +! + YREM = YWGT + YWGT = 0. + PMINU = PM1SFUN(X) + YWGT = YREM + PM1SX0 = (X-YWGT)*PMINU/X - (1.-YWGT)*PMINU +! + RETURN + END + +!DECK ID>, FF1SFUN. +! +! ==================================== + DOUBLE PRECISION FUNCTION FF1SFUN(X) +! ==================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) +! + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + +! + COMMON /QCWGTC/ YWGT,QPGC,QMASS,EGAUSS,NF +! + CX2 = X**2 + C1PX = 1.+X + C1MX = 1.-X + CLX = LOG(X) + CLX2 = CLX**2 + CL1MX = LOG(C1MX) + CL1PX = LOG(C1PX) + CPFFX = (1.+CX2) / C1MX + CPFFMX = (1.+CX2) / C1PX + CS3X = -DDILOG_LHA(-X) + CS2X = .5*(CLX2-CPI2S3) + 2.*(CS3X-CLX*CL1PX) +! + AAA = - CPFFX*CLX*(1.5+2.*CL1MX) + 2.*CPFFMX*CS2X & + & - 1. + X + (.5-1.5*X)*CLX - .5*C1PX*CLX2 + BBB = CPFFX*(C11S6*CLX+.5*CLX2+CPIA) - CPFFMX*CS2X & + & + C14S3*C1MX + CCC = - CPFFX*(C10S9+C2S3*CLX) + C40S9/X - 2.*C1PX*CLX2 & + & - C16S3 + C40S3*X + (10.*X+C16S3*CX2+2.)*CLX & + & - C112S9*CX2 +! + FF1S = C16S9*AAA + 4.*BBB + C2S3*NF*CCC + FF1SFUN = (X-YWGT)*FF1S/X +! + RETURN + END + +!DECK ID>, FF1SX0. +! +! =================================== + DOUBLE PRECISION FUNCTION FF1SX0(X) +! =================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) +! + COMMON /QCWGTC/ YWGT,QPGC,QMASS,EGAUSS,NF +! + YREM = YWGT + YWGT = 0. + FF1S = FF1SFUN(X) + XP1T = XP1TFUN(X) + YWGT = YREM + FF1SX0 = (X-YWGT)*FF1S/X - (1.-YWGT)*XP1T +! + RETURN + END + +!DECK ID>, GF1SFUN. +! +! ==================================== + DOUBLE PRECISION FUNCTION GF1SFUN(X) +! ==================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) +! + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + +! + COMMON /QCWGTC/ YWGT,QPGC,QMASS,EGAUSS,NF +! + CX2 = X**2 + C1PX = 1.+X + C1MX = 1.-X + CLX = LOG(X) + CLX2 = CLX**2 + CL1MX = LOG(C1MX) + CL1PX = LOG(C1PX) + CL1MX2 = CL1MX**2 + CPGFX = CX2 + C1MX**2 + CPGFMX = CX2 + C1PX**2 + CS3X = -DDILOG_LHA(-X) + CS2X = .5*(CLX2-CPI2S3) + 2.*(CS3X-CLX*CL1PX) +! + AAA = 4. - 9.*X + (4.*X-1.)*CLX + (2.*X-1.)*CLX2 & + & + 4.*CL1MX & + & + (2.*CLX-2.*CLX*CL1MX+CLX2-2.*CL1MX+CL1MX2+CPIE) & + & * 2. * CPGFX + DDD = C182S9 + C14S9*X + C40S9/X + (C136S3*X-C38S3)*CLX & + & - 4.*CL1MX - (2.+8.*X)*CLX2 + 2.*CS2X*CPGFMX & + & + (C44S3*CLX-CLX2-2.*CL1MX2+4.*CL1MX+CPIF) * CPGFX +! + GF1S = C2S3*NF*AAA + 1.5*NF*DDD + GF1SFUN = (X-YWGT)*GF1S/X +! + RETURN + END + +!DECK ID>, XP1TFUN. +! +! ==================================== + DOUBLE PRECISION FUNCTION XP1TFUN(X) +! ==================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) +! + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + +! + COMMON /QCWGTC/ YWGT,QPGC,QMASS,EGAUSS,NF +! + CX2 = X**2 + C1PX = 1.+X + C1MX = 1.-X + CLX = LOG(X) + CLX2 = CLX**2 + CL1MX = LOG(C1MX) + CL1PX = LOG(C1PX) + CL1MX2 = CL1MX**2 + CPFFX = (1.+CX2) / C1MX + CPFFMX = (1.+CX2) / C1PX + CPFGX = (1.+C1MX**2) / X + CPFGMX = - (1.+C1PX**2) / X + CS1X = -DDILOG_LHA(1.D0-X) + CS3X = -DDILOG_LHA(-X) + CS2X = .5*(CLX2-CPI2S3) + 2.*(CS3X-CLX*CL1PX) +! + AAA = CPFFX*(1.5*CLX-2.*CLX2+2.*CLX*CL1MX) + 2.*CPFFMX*CS2X & + & - 1. + X + (-1.5+.5*X)*CLX + .5*C1PX*CLX2 + BBB = CPFFX*(C11S6*CLX+.5*CLX2+CPIA) - CPFFMX*CS2X & + & + C14S3*C1MX + CCC = - CPFFX*(C2S3*CLX+C10S9) & + & - C52S3 + C28S3*X + C112S9*CX2 - C40S9/X & + & - (10.+18.*X+C16S3*CX2)*CLX + 2.*C1PX*CLX2 + PFF1T = C16S9*AAA + 4.*BBB + C2S3*NF*CCC +! + AAA = -.5 + 4.5*X + (-8.+.5*X)*CLX + 2.*X*CL1MX & + & + (1.-.5*X)*CLX2 & + & + (CL1MX2+4.*CLX*CL1MX-8.*CS1X-CPIB) * CPFGX + BBB = C62S9 - C35S18*X - C44S9*CX2 & + & + (2.+12.*X+C8S3*CX2) * CLX & + & - 2.*X*CL1MX - (4.+X)*CLX2 + CPFGMX*CS2X & + & + ( - 2.*CLX*CL1MX - 3.*CLX - 1.5*CLX2 & + & - CL1MX2 + 8.*CS1X + CPIC ) * CPFGX + PFG1T = C16S9*AAA + 4.*BBB +! + XP1T = X * ( PFF1T + PFG1T ) + XP1TFUN = (X-YWGT)*XP1T/X +! + RETURN + END + +!DECK ID>, GG1SFUN. +! +! ==================================== + DOUBLE PRECISION FUNCTION GG1SFUN(X) +! ==================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) +! + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + +! + COMMON /QCWGTC/ YWGT,QPGC,QMASS,EGAUSS,NF +! + CX2 = X**2 + C1PX = 1.+X + C1MX = 1.-X + CLX = LOG(X) + CLX2 = CLX**2 + CL1MX = LOG(C1MX) + CL1PX = LOG(C1PX) + CL1MX2 = CL1MX**2 + CS3X = -DDILOG_LHA(-X) + CS2X = .5*(CLX2-CPI2S3) + 2.*(CS3X-CLX*CL1PX) +! + CPGG = 1./C1MX + 1./X -2. + X - CX2 + CMPGG = 1./C1PX - 1./X -2. - X - CX2 +! +! AAA = -16.+ 8.*X+ C20S3*CX2 + C4S3/X + (-6.-10.*X)*CLX + + AAA = -16.+ 8.*X+ C20S3*CX2 + C4S3/X + (-6.-10.*X)*CLX & + & -2.*C1PX*CLX2 + BBB = 2.* C1MX + 26./9.*(CX2-1./X) - C4S3*C1PX*CLX - & + & 20./9.*CPGG + CCC = 27./2.*C1MX + 67./9.*(CX2-1./X)+(-25./3.+11./3.*x- & + & 44./3.*CX2)*CLX+4.*C1PX*CLX2+(67./9.-4.*CLX*CL1MX + & + & CLX2-CPI2S3)*CPGG + 2.*CMPGG*CS2X +! + GG1S = C2S3*NF*AAA + 1.5*NF*BBB + 9.* CCC + GG1SFUN = (X-YWGT)*GG1S/X +! + RETURN + END + +!DECK ID>, GG1SX0. +! +! =================================== + DOUBLE PRECISION FUNCTION GG1SX0(X) +! =================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) +! + COMMON /QCWGTC/ YWGT,QPGC,QMASS,EGAUSS,NF +! + YREM = YWGT + YWGT = 0. + GG1S = GG1SFUN(X) + XG1T = XG1TFUN(X) + YWGT = YREM + GG1SX0 = (X-YWGT)*GG1S/X - (1.-YWGT)*XG1T +! + RETURN + END + +!DECK ID>, FG1SFUN. +! +! ==================================== + DOUBLE PRECISION FUNCTION FG1SFUN(X) +! ==================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) +! + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + +! + COMMON /QCWGTC/ YWGT,QPGC,QMASS,EGAUSS,NF +! + CX2 = X**2 + C1PX = 1.+X + C1MX = 1.-X + CLX = LOG(X) + CLX2 = CLX**2 + CL1MX = LOG(C1MX) + CL1PX = LOG(C1PX) + CL1MX2 = CL1MX**2 + CPFGX = (1.+C1MX**2) / X + CPFGMX = - (1.+C1PX**2) / X + CS3X = -DDILOG_LHA(-X) + CS2X = .5*(CLX2-CPI2S3) + 2.*(CS3X-CLX*CL1PX) +! + AAA = -5./2.- 7./2.*X+(2.+7./2.*X)*CLX+(-1.+0.5*X)*CLX2 & + & -2.*X*CL1MX+ (-3.*CL1MX-CL1MX2)*CPFGX + BBB = 28./9.+65./18.*X+44./9.*CX2+(-12.-5.*X-8./3.*CX2)*CLX+ & + & (4.+X)*CLX2+2.*X*CL1MX+ (-2.*CLX*CL1MX+0.5*CLX2+ & + & 11./3.*CL1MX+CL1MX2-0.5*CPI2S3+0.5)*CPFGX+CPFGMX*CS2X + CCC = -C4S3*X- (20./9.+C4S3*CL1MX)*CPFGX +! + FG1S = C16S9*AAA+4.*BBB+2./3.*NF*CCC + FG1SFUN = (X-YWGT)*FG1S/X +! + RETURN + END + +!DECK ID>, XG1TFUN. +! +! ==================================== + DOUBLE PRECISION FUNCTION XG1TFUN(X) +! ==================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) +! + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + +! + COMMON /QCWGTC/ YWGT,QPGC,QMASS,EGAUSS,NF +! + CX2 = X**2 + C1PX = 1.+X + C1MX = 1.-X + CLX = LOG(X) + CLX2 = CLX**2 + CL1MX = LOG(C1MX) + CL1PX = LOG(C1PX) + CL1MX2 = CL1MX**2 + CPGFX = CX2 + C1MX**2 + CPGFMX = CX2 + C1PX**2 + CS1X = -DDILOG_LHA(1.D0-X) + CS3X = -DDILOG_LHA(-X) + CS2X = .5*(CLX2-CPI2S3) + 2.*(CS3X-CLX*CL1PX) +! + CPGG = 1./C1MX + 1./X -2. + X - CX2 + CMPGG = 1./C1PX - 1./X -2. - X - CX2 +! + AAA = -4.+12.*x-164./9.*CX2+92./9./X+(10.+14.*X+C16S3*CX2+ & + & C16S3/X)*CLX + 2.*C1PX*CLX2 + BBB = 2.-2.*X+26./9.*(CX2-1./X)-C4S3*C1PX*CLX- & + & (20./9.+8./3.*CLX)*CPGG + CCC = 27./2.*(C1MX)+67./9.*(CX2-1./X)+(11./3.-25./3.*X- & + & 44./3./X)*CLX -4.*(C1PX) * CLX2 + (4.*CLX*CL1MX - & + & 3.*CLX2+22./3.*CLX-CPI2S3+67./9.)*CPGG+ & + & 2.*CMPGG*CS2X + PGG1T = 2./3.*NF*AAA+3./2.*NF*BBB+9.*CCC +! + AAA = -8./3.-(16./9.+8./3.*CLX+8./3.*CL1MX)*CPGFX + BBB = -2.+3.*X+(-7.+8.*X)*CLX-4.*CL1MX + (1.-2.*X)*CLX2 & + & +(-4.*CLX*CL1MX-2.*CLX2-2.*CL1MX+2.*CLX-2.*CL1MX2 & + & +16.*CS1X+ 2.*PI*PI - 10.)*CPGFX + CCC = -152./9.+166./9.*X-40./9./X+ (-C4S3-76./3.*X)*CLX+ & + & 4.*CL1MX + (2.+8.*X)*CLX2+ (8.*CLX*CL1MX-CLX2- & + & C4S3*CLX+10./3.*CL1MX+2.*CL1MX2-16.*CS1X-7.*CPI2S3+ & + & 178./9.)*CPGFX+2.*CPGFMX*CS2X + PGF1T = (0.5*NF)**2*AAA+2./3.*NF*BBB+3./2.*NF*CCC +! + XG1T = X * ( PGG1T + PGF1T ) + XG1TFUN = (X-YWGT)*XG1T/X +! + RETURN + END + +!DECK ID>, C2Q. + +! ================================ + DOUBLE PRECISION FUNCTION C2Q(X) +! ================================ + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + + + COMMON /QCWGTC/ YWGT,QPGC,QMASS,EGAUSS,NF + + C1MX = 1.-X + C2Q = 3. + C5S3*X + (C4S3*LOG(C1MX/X)-1.) * (1.+X**2) / C1MX + C2Q = (X-YWGT)*C2Q/X + + RETURN + END + +!DECK ID>, C2QX0. + + +! ================================== + DOUBLE PRECISION FUNCTION C2QX0(X) +! ================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + + + COMMON /QCWGTC/ YWGT,QPGC,QMASS,EGAUSS,NF + + C1MX = 1.-X + C2Q = 3. + C5S3*X + (C4S3*LOG(C1MX/X)-1.) * (1.+X**2) / C1MX + + C2QX0 = ((X-YWGT)/X+YWGT-1.)*C2Q + + RETURN + END + +!DECK ID>, C2G. + +! ================================ + DOUBLE PRECISION FUNCTION C2G(X) +! ================================ + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + COMMON /QCWGTC/ YWGT,QPGC,QMASS,EGAUSS,NF + + C1MX = 1. - X + C2G = -.5 + 4.*X*C1MX + .5 * (X**2+C1MX**2) * LOG(C1MX/X) + C2G = 2.*NF*(X-YWGT)*C2G/X + + RETURN + END + +!DECK ID>, CLQ. + +! ================================ + DOUBLE PRECISION FUNCTION CLQ(X) +! ================================ + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + + + COMMON /QCWGTC/ YWGT,QPGC,QMASS,EGAUSS,NF + + CLQ = C8S3*X + CLQ = (X-YWGT)*CLQ/X + + RETURN + END + +!DECK ID>, CLG. + +! ================================ + DOUBLE PRECISION FUNCTION CLG(X) +! ================================ + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + + + COMMON /QCWGTC/ YWGT,QPGC,QMASS,EGAUSS,NF + + CLG = NF*4.*X*(1.-X) + CLG = (X-YWGT)*CLG/X + + RETURN + END + +!DECK ID>, D3Q. + +! ================================ + DOUBLE PRECISION FUNCTION D3Q(X) +! ================================ + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + + +!-- C3Q = C2Q - D3Q + + COMMON /QCWGTC/ YWGT,QPGC,QMASS,EGAUSS,NF + + D3Q = C4S3*(1.+X) +!-- Fixed this bug in QCDNUM16.11 17-01-98 +! D3Q = (X-YWGT)*C3Q/X + D3Q = (X-YWGT)*D3Q/X + + RETURN + END + +!DECK ID>, PCGFUN. + +! =================================== + DOUBLE PRECISION FUNCTION PCGFUN(X) +! =================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +!-- Pcg (heavy quark) splitting function taken from +!-- Glueck, Hoffmann and Reya, Z. Phys. C13(1982)119 eq. (2.6). +!-- Notice that if YWGT is set to zero, PCGFUN(X) returns Pcg(x). +!-- Q2 and the quark mass are passed through the common block +!-- /QCWGTC/ as QPCG and QMASS respectively. + + COMMON /QCWGTC/ YWGT,QPCG,QMASS,EGAUSS,NF + + FACTOR = QMASS*QMASS/QPCG + PCG = 0. + IF(X.LT.(1./(1.+4.*FACTOR))) THEN + U = 1.-X + V = SQRT(1.-4.*FACTOR*X/(1.-X)) + PCG = (1./V)*(0.5-X*U+FACTOR*X*(3.-4.*X)/U & + & -16.*FACTOR*FACTOR*X*X) - & + & (2.*FACTOR*X*(1.-3.*X)-8.*FACTOR*FACTOR*X*X) & + & *LOG((1.+V)/(1.-V)) + ENDIF + PCGFUN = (X-YWGT)*PCG/X + + RETURN + END + +!DECK ID>, QASTOL. + +! ============================== + SUBROUTINE LFROMA(AS,Q2,QL,NF) +! ============================== + +!--- Calculate Lambda^(nf) given alpha_s(Q^2) + + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r LFROMA ---> STOP'')') + WRITE(6,'( '' ------------------------------------'')') + WRITE(6,'(/'' This s/r is not available...... '')') + + STOP + END + + +!DECK ID>, AFROML. + +! ============================== + SUBROUTINE AFROML(QL,NF,AS,Q2) +! ============================== + +!--- Calculate alpha_s(Q^2) given Lambda^(nf) + + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r AFROML ---> STOP'')') + WRITE(6,'( '' ------------------------------------'')') + WRITE(6,'(/'' This s/r is not available...... '')') + + STOP + END + +!DECK ID>, QNALFA. + +! ===================================== + DOUBLE PRECISION FUNCTION QNALFA(QQ2) +! ===================================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + IF(LBMARK) THEN +! fix for rgr + call rgras(qnalfa,qq2) +! print *,' 1 rgras called and NF is ',nf +! F = 4. +! QCDL = 0.250 +! QNALFA = QNALAM(F,QQ2,QCDL,IORD) + ELSEIF(LASOLD) THEN + QNALFA = A0TOA1_OLD(QQ2,Q0ALFA,ALPHA0,IORD,NF,IERR) + ELSE + QNALFA = A0TOA1(QQ2,Q0ALFA,ALPHA0,IORD,NF,IERR) + ENDIF + + RETURN + END + +!DECK ID>, QALFAS. + +! =================================================== + DOUBLE PRECISION FUNCTION QALFAS(QQ2,QLAMB,NF,IERR) +! =================================================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + IF(LBMARK) THEN +! fix for rgr alphas +! print *,' 2 rgras called and NF is ' + call rgras(qalfas,qq2) + QLAMB = SQRT(Q_LAMB2(QQ2,QALFAS,NF,IORD)) +! F = 4. +! QCDL = 0.250 +! QALFAS = QNALAM(F,QQ2,QCDL,IORD) +! NF = F +! QLAMB = 0. + ELSEIF(LASOLD) THEN + QALFAS = A0TOA1_OLD(QQ2,Q0ALFA,ALPHA0,IORD,NF,IERR) + QLAMB = SQRT(Q_LAMB2(QQ2,QALFAS,NF,IORD)) + IF(IERR.NE.0) QLAMB = 0. + ELSE + QALFAS = A0TOA1(QQ2,Q0ALFA,ALPHA0,IORD,NF,IERR) + QLAMB = SQRT(Q_LAMB2(QQ2,QALFAS,NF,IORD)) + IF(IERR.NE.0) QLAMB = 0. + ENDIF + + RETURN + END + +!DECK ID>, QFILAS. + +! ======================== + SUBROUTINE QFILAS(SRNAM) +! ======================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + CHARACTER*6 SRNAM + +!-- Check quark masses + IF(.NOT.(0.LE.UDSCBT(1) .AND. UDSCBT(1).LE.UDSCBT(2) .AND. & + & UDSCBT(2).LE.UDSCBT(3) .AND. UDSCBT(3).LT.UDSCBT(4) .AND. & + & UDSCBT(4).LT.UDSCBT(5) .AND. UDSCBT(5).LT.UDSCBT(6))) THEN + IERR = 1 + GOTO 500 + ENDIF + + IF(LBMARK) THEN +!-- This is a fix to put in the RGR alphas + DO IQ = 1,NQ2 + +!-- Alphas at the renormalistion scale + QQ2 = Q2TAB(IQ)*AAAR2 + BBBR2 +! print *,' 3 rgras called and iord is ',iord + call rgras(ALF,QQ2) +! print *,nf,iord,alf,qq2 + BET0 = 11.-2*NF/3. + ALFASQ(IQ) = ALF + ALFAPQ(IQ) = ALF/(2.*PI) + ALFA2Q(IQ) = 0. + IF(IORD.GE.2) THEN + ALFA2Q(IQ) = ALFAPQ(IQ)*ALFAPQ(IQ) + FACT = LOG(QQ2/Q2TAB(IQ))*BET0*0.5 + ALFAPQ(IQ) = ALFAPQ(IQ)*(1.+FACT*ALFAPQ(IQ)) + ENDIF + + ENDDO + + +!C-- Alphas for benchmark tests (HERA workshop) +! +! F = 4. +! QCDL = 0.250 +! +! DO IQ = 1,NQ2 +! +!C-- Alphas at the renormalistion scale +! QQ2 = Q2TAB(IQ)*AAAR2 + BBBR2 +! ALFASQ(IQ) = QNALAM(F,QQ2,QCDL,IORD) +! BET0 = 11.-2.*F/3. +! ALFAPQ(IQ) = ALFASQ(IQ) /(2.*PI) +! ALFA2Q(IQ) = 0. +! IEALFA(IQ) = 0 +! IF(IORD.GE.2) THEN +! ALFA2Q(IQ) = ALFAPQ(IQ)*ALFAPQ(IQ) +! FACT = LOG(QQ2/Q2TAB(IQ))*BET0*0.5 +! ALFAPQ(IQ) = ALFAPQ(IQ)*(1.+FACT*ALFAPQ(IQ)) +! ENDIF +! +! ENDDO + + ELSEIF(LASOLD) THEN + +!-- Alphas from old routine (for backwards compatibility) + + DO IQ = 1,NQ2 + +!-- Alphas at the renormalistion scale + QQ2 = Q2TAB(IQ)*AAAR2 + BBBR2 + ALFASQ(IQ) = A0TOA1_OLD(QQ2,Q0ALFA,ALPHA0,IORD,NF,IERR) + BET0 = 11.-2*NF/3. + IEALFA(IQ) = IERR + ALFAPQ(IQ) = ALFASQ(IQ) /(2.*PI) + ALFA2Q(IQ) = 0. + IF(IORD.GE.2) THEN + ALFA2Q(IQ) = ALFAPQ(IQ)*ALFAPQ(IQ) + FACT = LOG(QQ2/Q2TAB(IQ))*BET0*0.5 + ALFAPQ(IQ) = ALFAPQ(IQ)*(1.+FACT*ALFAPQ(IQ)) + ENDIF + + ENDDO + + ELSE + +!-- This is the alphas to be used + + DO IQ = 1,NQ2 + +!-- Alphas at the renormalistion scale + QQ2 = Q2TAB(IQ)*AAAR2 + BBBR2 + ALF = A0TOA1(QQ2,Q0ALFA,ALPHA0,IORD,NF,IERR) +! print *,iord,nf,qq2,alf + BET0 = 11.-2*NF/3. + IEALFA(IQ) = IERR + ALFASQ(IQ) = ALF + ALFAPQ(IQ) = ALF/(2.*PI) + ALFA2Q(IQ) = 0. + IF(IORD.GE.2) THEN + ALFA2Q(IQ) = ALFAPQ(IQ)*ALFAPQ(IQ) + FACT = LOG(QQ2/Q2TAB(IQ))*BET0*0.5 + ALFAPQ(IQ) = ALFAPQ(IQ)*(1.+FACT*ALFAPQ(IQ)) + ENDIF + + ENDDO + + ENDIF + + LALFOK = .TRUE. +!-- Invalidate all evolutions + CALL QNFALS(LEVDONE,MXX*10) + +!-- Find lowest Q2 for which alpha_s is calculated + QMINAS = Q2TAB(NQ2) + DO IQ = NQ2,1,-1 + IF(IEALFA(IQ).EQ.0) QMINAS = Q2TAB(IQ) + ENDDO + + RETURN + + 500 CONTINUE + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r '',A,'' ---> STOP'')') & + & SRNAM + WRITE(6,'( '' ------------------------------------'')') + WRITE(6,'( '' Umass :'',E12.5)') UDSCBT(1) + WRITE(6,'( '' Dmass :'',E12.5)') UDSCBT(2) + WRITE(6,'( '' Smass :'',E12.5)') UDSCBT(3) + WRITE(6,'( '' Cmass :'',E12.5)') UDSCBT(4) + WRITE(6,'( '' Bmass :'',E12.5)') UDSCBT(5) + WRITE(6,'( '' Tmass :'',E12.5)') UDSCBT(6) + IF(IERR.EQ.1) THEN + WRITE(6,'(/'' Quark masses not in ascending order'')') + ENDIF + + CALL QTRACE('QFILAS ',1) + + STOP + + END + +!DECK ID>, GET_AS. + +! ======================================= + DOUBLE PRECISION FUNCTION GET_AS(IQ,TQ) +! ======================================= + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +!-- Interpolation of alpha_s table: returns alpha_s/(2pi) +!-- Input IQ must be in the range 1,...,NQ2-1 + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + GET_AS = ((1.-TQ)*ALFASQ(IQ)+TQ*ALFASQ(IQ+1))/(2.*PI) + + RETURN + END + +!DECK ID>, QNALAM. + +! ================================================= + DOUBLE PRECISION FUNCTION QNALAM (F,Q2,QCDL,IORD) +! ================================================= + + IMPLICIT DOUBLE PRECISION (A - Z) + INTEGER IORD + + DATA PI / 3.14159265359 / + +!--- Calculation of alpha strong (Q**2) in NLO : +!--- F = number of flavours +!--- Q2 = Q**2 in GeV**2 +!--- QCDL = Lambda(MSbar) in GeV + + B0 = 11.D0 - 2.D0/3.D0 * F + B0S = B0 * B0 + B1 = 102.D0 - 38.D0/3.D0 * F + LAM2 = QCDL * QCDL + LQ2 = DLOG (Q2/LAM2) + QNALAM = 1.D0/(B0 * LQ2) + IF(IORD.GE.2) QNALAM = QNALAM - 1.D0/(B0 * LQ2) * & + & (B1/B0S * DLOG(LQ2)/LQ2) + QNALAM = QNALAM*4.D0*PI + + RETURN + END + +!DECK ID>, A0TOA1. + +! =========================================================== + DOUBLE PRECISION FUNCTION A0TOA1(QSU,QS0,AS0,IORD,NFF,IERR) +! =========================================================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + QS1 = QSU + + QMU0 = SQRT(QS0) + QMU1 = SQRT(QS1) + + DO 10 I=1,6 + IF(QMU0.GE.UDSCBT(I)) NF0 = I + IF(QMU1.GE.UDSCBT(I)) NF1 = I + 10 END DO + + IF(NF1.LT.NF0) THEN + IST = -1 + JST = 0 + ELSE + IST = 1 + JST = 1 + ENDIF + + ALFA0 = AS0 + Q00 = QS0 + + DO 50 NF = NF0,NF1,IST + + IF(NF.NE.NF1) THEN + Q21 = UDSCBT(NF+JST)*UDSCBT(NF+JST) + ELSE + Q21 = QS1 + ENDIF + ALFA1 = ALPHAR(Q21,Q00,ALFA0,NF,IORD,JERR) + ALFA0 = ALFA1 + Q00 = Q21 + + 50 END DO + + A0TOA1 = ALFA0 + NFF = NF1 + IERR = JERR + + RETURN + END + +! =============================================================== + DOUBLE PRECISION FUNCTION A0TOA1_OLD(QSU,QS0,AS0,IORD,NFF,IERR) +! =============================================================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + QS1 = QSU + + QMU0 = SQRT(QS0) + QMU1 = SQRT(QS1) + + DO 10 I=1,6 + IF(QMU0.GE.UDSCBT(I)) NF0 = I + IF(QMU1.GE.UDSCBT(I)) NF1 = I + 10 END DO + + IF(NF1.LT.NF0) THEN + IST = -1 + JST = 0 + ELSE + IST = 1 + JST = 1 + ENDIF + + ALFA0 = AS0 + Q00 = QS0 + + DO 50 NF = NF0,NF1,IST + + IF(NF.NE.NF1) THEN + Q21 = UDSCBT(NF+JST)*UDSCBT(NF+JST) + ELSE + Q21 = QS1 + ENDIF + ALFA0 = ALPHAR_OLD(Q21,Q00,ALFA0,NF,IORD,JERR) + Q00 = Q21 + + 50 END DO + + A0TOA1_OLD = ALFA0 + NFF = NF1 + IERR = JERR + + RETURN + END + +!DECK ID>, ALPHAR. + +! ========================================================== + DOUBLE PRECISION FUNCTION ALPHAR(QSQ,QS0,AS0,NF,IORD,IERR) +! ========================================================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +!-- ALPHAS FROM RGE GIVEN AS0 AT QS0 + + DATA PI / 3.14159265359 / + + BET0 = 11.-2*NF/3. + BET1 = 102.-38*NF/3. + B0 = BET0/(4.*PI) + B1 = BET1/(4.*PI*BET0) + IERR = 0 + + TERM0 = 1./AS0+B0*LOG(QSQ/QS0) + IF(TERM0.LE.0.) THEN + ALPHAR = 100. + IERR = 1 + RETURN + ENDIF + ALFA0 = 1./TERM0 + IF(IORD.EQ.1) THEN + ALPHAR = ALFA0 + RETURN + ENDIF + 20 CONTINUE + ARG = (1./ALFA0+B1)/(1./AS0+B1) + IF(ARG.LE.0.) THEN + ALPHAR = 100. + IERR = 1 + RETURN + ELSE + TERM = TERM0+B1*LOG(ARG) + IF(TERM.LE.0) THEN + ALPHAR = 100. + IERR = 1 + RETURN + ELSE + ALFA1 = 1./TERM + ENDIF + ENDIF + IF(ABS(ALFA1-ALFA0).GT.1.E-6) THEN + ALFA0 = ALFA1 + GOTO 20 + ENDIF + + ALPHAR = ALFA1 + + RETURN + END + +! ============================================================== + DOUBLE PRECISION FUNCTION ALPHAR_OLD(QSQ,QS0,AS0,NF,IORD,IERR) +! ============================================================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +!-----MARCHIANO: ALPHAS FROM RGE GIVEN AS0 AT QS0 +!-----This routine uses an incorrect truncation --> +!-----alpha_s is about 0.4% too low. + + DATA PI / 3.1415927 / + + QMU = SQRT(QSQ) + QM0 = SQRT(QS0) + + B3 = -(11.-2.*NF/3.)/(2.*PI) + B33 = -(51.-19.*NF/3.)/(4.*PI*PI) + B333 = -(2857.-5033.*NF/9.+325.*NF*NF/27.)/(64.*PI*PI*PI) + IERR = 0 + + TERM0 = 1./AS0-B3*LOG(QMU/QM0) + ALFA0 = 1./TERM0 + IF(IORD.EQ.1) THEN + ALPHAR_OLD = ALFA0 + RETURN + ENDIF + 20 CONTINUE + TERM = TERM0-B33*LOG(ALFA0/AS0)/B3 + IF(IORD.EQ.3) TERM = TERM-(B333*B3-B33*B33)*(ALFA0-AS0)/(B3*B3) + ALFA1 = 1./TERM + IF(ABS(ALFA1-ALFA0).GT.1.E-6) THEN + ALFA0 = ALFA1 + GOTO 20 + ENDIF + + ALPHAR_OLD = ALFA1 + + RETURN + END + +!DECK ID>, Q_LAMB2. + +! ================================================== + DOUBLE PRECISION FUNCTION Q_LAMB2(QS0,AS0,NF,IORD) +! ================================================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +!-- Calculate lambda**2 given AS0 at QS0 + + DATA PI / 3.14159265359 / + + BET0 = 11.-2*NF/3. + BET1 = 102.-38*NF/3. + AS = AS0/(4.*PI) + + Q_LAMB2 = QS0*EXP(-1./(BET0*AS)) + + IF(IORD.EQ.1) RETURN + + ARG = 1. + BET0/(BET1*AS) + POW = BET1/(BET0*BET0) + Q_LAMB2 = Q_LAMB2*ARG**POW + + RETURN + END + +!DECK ID>, QHEAVY. + +! Heavy quark structure functions. +! Heavy quark coefficient functions up to NLO are taken from the code +! of S. Riemersma. For reference, see S. Riemersma, J. Smith and +! W.L. van Neerven, Phys. Lett. B347(1995)143. + +!DECK ID>, GET_FKH. + +! ===================================================== + DOUBLE PRECISION FUNCTION GET_FKH(IDF,ID,IX0,IQ,IERR) +! ===================================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +!-- Input: IDF = 4,5,6,7 for F2c,Flc,F2b,Flb +!-- Input: ID parton distribution identifier +!-- IX0 x gridpoint of heavy quark grid +!-- IQ Q2 gridpoint +!-- Output: IERR = 0 FKH successfully calculated +!-- = 1 Fast calculation +!-- = -1 Scale mu outside grid + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + + + CHARACTER*5 PNAM,STFNAM + LOGICAL LNFP + COMMON /QCLNFP/ LNFP(0:30,3:5) + COMMON /QCPNAM/ PNAM(0:30) + COMMON /QCPWGT/ PWGT(0:10,0:30,3:5) + COMMON /QCFNAM/ STFNAM(7) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + REAL & + &WH_C0KG,WH_C1KG,WH_C1BKG, & + &WH_C1KQ,WH_C1BKQ,WH_D1KQ,WH_D1BKQ + + COMMON/QCHWGT/ & + &WH_C0KG(0:MXX,MQ2,4:7), & + &WH_C1KG(0:MXX,MQ2,4:7),WH_C1BKG(0:MXX,MQ2,4:7), & + &WH_C1KQ(0:MXX,MQ2,4:7),WH_C1BKQ(0:MXX,MQ2,4:7), & + &WH_D1KQ(0:MXX,MQ2,4:7),WH_D1BKQ(0:MXX,MQ2,4:7) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + +!-- Correct quark mass + QMASS = CBMSTF(IDF) + CCCC = CHARGE(IDF) + + GET_FKH = 0. + + IF(LFFCAL(IDF,ID)) THEN + IERR = 1 + JD = IDFAST(IDF,ID) + GET_FKH = FSTORE(IX0,IQ,JD) + IF(GET_FKH.GE.-99.) RETURN + ENDIF + + QMU = Q2TAB(IQ)*AAM2H + BBM2H + IMU = MIN(ABS(IQFROMQ(QMU)),NQ2-1) + IF(IMU.EQ.0) THEN + IERR = -1 + RETURN + ENDIF + QR2 = QMU*AAAR2 + BBBR2 + IR2 = MIN(ABS(IQFROMQ(QR2)),NQ2-1) + IF(IR2.EQ.0) THEN + IERR = -1 + RETURN + ENDIF + + IERR = 0 + TQ = LOG(QMU/Q2TAB(IMU))/LOG(Q2TAB(IMU+1)/Q2TAB(IMU)) + TR = LOG(QR2/Q2TAB(IR2))/LOG(Q2TAB(IR2+1)/Q2TAB(IR2)) + + IF(IORD.EQ.1) THEN + + FF = 0. + DO IX = IX0,NXX + IXL = IHTAB(IX) + X = XHTAB(IX) + TX = (X-XXTAB(IXL))/(XXTAB(IXL+1)-XXTAB(IXL)) + GL = GET_PDFXQ(0,IXL,IMU,TX,TQ) + FF = FF + WH_C0KG(IX-IX0,IQ,IDF)*GL + ENDDO + GET_FKH = CCCC * GET_AS(IR2,TR) * FF + + ELSE + + AS = GET_AS(IR2,TR) + F1 = 0. + F2 = 0. + F3 = 0. + F4 = 0. + FACT = LOG(QMU/(QMASS*QMASS)) + DO IX = IX0,NXX + IXL = IHTAB(IX) + X = XHTAB(IX) + TX = (X-XXTAB(IXL))/(XXTAB(IXL+1)-XXTAB(IXL)) + GL = GET_PDFXQ( 0,IXL,IMU,TX,TQ) + SI = GET_PDFXQ( 1,IXL,IMU,TX,TQ) + QU = GET_PDFXQ(ID,IXL,IMU,TX,TQ) + I = IX-IX0 + F1 = F1 + WH_C0KG(I,IQ,IDF)*GL + F2 = F2 + (WH_C1KG(I,IQ,IDF)+WH_C1BKG(I,IQ,IDF)*FACT)*GL + F3 = F3 + (WH_C1KQ(I,IQ,IDF)+WH_C1BKQ(I,IQ,IDF)*FACT)*SI + F4 = F4 + (WH_D1KQ(I,IQ,IDF)+WH_D1BKQ(I,IQ,IDF)*FACT)*QU + ENDDO + GET_FKH = CCCC * (AS*F1+AS*AS*(F2+F3)) + AS*AS*F4 + ENDIF + + RETURN + END + +!DECK ID>, FIL_F2H. + +! ======================= + SUBROUTINE FIL_F2H(IDF) +! ======================= + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + EXTERNAL C02G_FUN, C12G_FUN, C1B2G_FUN + EXTERNAL C12Q_FUN, C1B2Q_FUN + EXTERNAL D12Q_FUN, D1B2Q_FUN + + COMMON /QCWGTC/ YWGT,QPCG,QMASS,EGAUSS,NF + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + REAL & + &WH_C0KG,WH_C1KG,WH_C1BKG, & + &WH_C1KQ,WH_C1BKQ,WH_D1KQ,WH_D1BKQ + + COMMON/QCHWGT/ & + &WH_C0KG(0:MXX,MQ2,4:7), & + &WH_C1KG(0:MXX,MQ2,4:7),WH_C1BKG(0:MXX,MQ2,4:7), & + &WH_C1KQ(0:MXX,MQ2,4:7),WH_C1BKQ(0:MXX,MQ2,4:7), & + &WH_D1KQ(0:MXX,MQ2,4:7),WH_D1BKQ(0:MXX,MQ2,4:7) + + + QMASS = CBMSTF(IDF) + + EGAUSS = 0.001 + + DO 400 IQ = 1,NQ2 + + QPCG = Q2TAB(IQ) + APCG = 1.+4.*QMASS*QMASS/QPCG + + IX0 = 1 + X0 = XHTAB(IX0) + +! WRITE(6,'('' Calculate F2H weights for IX ='',I4)') IX0 + + DO 200 IX = IX0,NXX + + XI = XHTAB(IX) + XIP1 = XHTAB(IX+1) + IF(IX.GT.IX0) XIM1 = XHTAB(IX-1) + IF(XIP1.LE.X0*APCG) GOTO 200 + XI = MAX(XI,X0*APCG) + SIP1 = X0/XIP1 + SI = X0/XI + + CALL S1FUNC(C02G_FUN,SIP1,SI,S1FUN) + IF(IX.EQ.IX0) THEN + WH_C0KG(IX-IX0,IQ,IDF) = S1FUN + ELSE + SIM1 = X0/XIM1 + CALL S2FUNC(C02G_FUN,SI,SIM1,S2FUN) + WH_C0KG(IX-IX0,IQ,IDF) = S1FUN-S2FUN + ENDIF + + CALL S1FUNC(C12G_FUN,SIP1,SI,S1FUN) + IF(IX.EQ.IX0) THEN + WH_C1KG(IX-IX0,IQ,IDF) = S1FUN + ELSE + SIM1 = X0/XIM1 + CALL S2FUNC(C12G_FUN,SI,SIM1,S2FUN) + WH_C1KG(IX-IX0,IQ,IDF) = S1FUN-S2FUN + ENDIF + + CALL S1FUNC(C1B2G_FUN,SIP1,SI,S1FUN) + IF(IX.EQ.IX0) THEN + WH_C1BKG(IX-IX0,IQ,IDF) = S1FUN + ELSE + SIM1 = X0/XIM1 + CALL S2FUNC(C1B2G_FUN,SI,SIM1,S2FUN) + WH_C1BKG(IX-IX0,IQ,IDF) = S1FUN-S2FUN + ENDIF + + CALL S1FUNC(C12Q_FUN,SIP1,SI,S1FUN) + IF(IX.EQ.IX0) THEN + WH_C1KQ(IX-IX0,IQ,IDF) = S1FUN + ELSE + SIM1 = X0/XIM1 + CALL S2FUNC(C12Q_FUN,SI,SIM1,S2FUN) + WH_C1KQ(IX-IX0,IQ,IDF) = S1FUN-S2FUN + ENDIF + + CALL S1FUNC(C1B2Q_FUN,SIP1,SI,S1FUN) + IF(IX.EQ.IX0) THEN + WH_C1BKQ(IX-IX0,IQ,IDF) = S1FUN + ELSE + SIM1 = X0/XIM1 + CALL S2FUNC(C1B2Q_FUN,SI,SIM1,S2FUN) + WH_C1BKQ(IX-IX0,IQ,IDF) = S1FUN-S2FUN + ENDIF + + CALL S1FUNC(D12Q_FUN,SIP1,SI,S1FUN) + IF(IX.EQ.IX0) THEN + WH_D1KQ(IX-IX0,IQ,IDF) = S1FUN + ELSE + SIM1 = X0/XIM1 + CALL S2FUNC(D12Q_FUN,SI,SIM1,S2FUN) + WH_D1KQ(IX-IX0,IQ,IDF) = S1FUN-S2FUN + ENDIF + + CALL S1FUNC(D1B2Q_FUN,SIP1,SI,S1FUN) + IF(IX.EQ.IX0) THEN + WH_D1BKQ(IX-IX0,IQ,IDF) = S1FUN + ELSE + SIM1 = X0/XIM1 + CALL S2FUNC(D1B2Q_FUN,SI,SIM1,S2FUN) + WH_D1BKQ(IX-IX0,IQ,IDF) = S1FUN-S2FUN + ENDIF + + 200 CONTINUE + + 400 END DO + + RETURN + END + +!DECK ID>, C02G_FUN. + +! ===================================== + DOUBLE PRECISION FUNCTION C02G_FUN(X) +! ===================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + COMMON /QCWGTC/ YWGT,QPCG,QMASS,EGAUSS,NF + + DATA PI /3.14159265359/ + + FACTOR = QMASS*QMASS/QPCG + C02G = 0. + IF(X.LT.(1./(1.+4.*FACTOR))) THEN + XI = 1./FACTOR + ETA = XI * (1.-X)/(4.*X) - 1. + C02G = (C0_LG(ETA,XI)+C0_TG(ETA,XI)) * XI / (2.*PI) + ENDIF + C02G_FUN = (X-YWGT)*C02G/(X*X) + + RETURN + END + +!DECK ID>, C12G_FUN. + +! ===================================== + DOUBLE PRECISION FUNCTION C12G_FUN(X) +! ===================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + COMMON /QCWGTC/ YWGT,QPCG,QMASS,EGAUSS,NF + + FACTOR = QMASS*QMASS/QPCG + C12G = 0. + IF(X.LT.(1./(1.+4.*FACTOR))) THEN + XI = 1./FACTOR + ETA = XI * (1.-X)/(4.*X) - 1. + BET = SQRT(ETA/(1.+ETA)) + RHO = 1./(1.+ETA) + C12G = CATF * (H1_ALG(ETA,XI)+H1_ATG(ETA,XI)) + & + & CFTF * (H1_FLG(ETA,XI)+H1_FTG(ETA,XI)) + & + & CATF * BET * (GFUN_L(ETA,XI)+GFUN_T(ETA,XI)) + & + & CATF * RHO * (EFUN_LA(ETA,XI)+EFUN_TA(ETA,XI)) + & + & CFTF * RHO * (EFUN_LF(ETA,XI)+EFUN_TF(ETA,XI)) + C12G = C12G*4.*PI/FACTOR + ENDIF + C12G_FUN = (X-YWGT)*C12G/(X*X) + + RETURN + END + +!DECK ID>, C1B2G_FUN. + +! ====================================== + DOUBLE PRECISION FUNCTION C1B2G_FUN(X) +! ====================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + COMMON /QCWGTC/ YWGT,QPCG,QMASS,EGAUSS,NF + + FACTOR = QMASS*QMASS/QPCG + C1B2G = 0. + IF(X.LT.(1./(1.+4.*FACTOR))) THEN + XI = 1./FACTOR + ETA = XI * (1.-X)/(4.*X) - 1. + BET = SQRT(ETA/(1.+ETA)) + RHO = 1./(1.+ETA) + C1B2G = CATF * (H1BAR_LG(ETA,XI)+H1BAR_TG(ETA,XI)) + & + & CATF * BET * (GBAR_L(ETA,XI)+GBAR_T(ETA,XI)) + & + & CATF * RHO * (EBAR_LA(ETA,XI)+EBAR_TA(ETA,XI)) + C1B2G = C1B2G*4.*PI/FACTOR + ENDIF + C1B2G_FUN = (X-YWGT)*C1B2G/(X*X) + + RETURN + END + +!DECK ID>, C12Q_FUN. + +! ===================================== + DOUBLE PRECISION FUNCTION C12Q_FUN(X) +! ===================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + COMMON /QCWGTC/ YWGT,QPCG,QMASS,EGAUSS,NF + + FACTOR = QMASS*QMASS/QPCG + C12Q = 0. + IF(X.LT.(1./(1.+4.*FACTOR))) THEN + XI = 1./FACTOR + ETA = XI * (1.-X)/(4.*X) - 1. + BET = SQRT(ETA/(1.+ETA)) + BET3 = BET*BET*BET + RHO = 1./(1.+ETA) + C12Q = CFTF * (H1_HLQ(ETA,XI)+H1_HTQ(ETA,XI)) + & + & CFTF * BET3 * (GFUN_L(ETA,XI)+GFUN_T(ETA,XI)) + C12Q = C12Q*4.*PI/FACTOR + ENDIF + C12Q_FUN = (X-YWGT)*C12Q/(X*X) + + RETURN + END + +!DECK ID>, C1B2Q_FUN. + +! ====================================== + DOUBLE PRECISION FUNCTION C1B2Q_FUN(X) +! ====================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + COMMON /QCWGTC/ YWGT,QPCG,QMASS,EGAUSS,NF + + FACTOR = QMASS*QMASS/QPCG + C1B2Q = 0. + IF(X.LT.(1./(1.+4.*FACTOR))) THEN + XI = 1./FACTOR + ETA = XI * (1.-X)/(4.*X) - 1. + BET = SQRT(ETA/(1.+ETA)) + BET3 = BET*BET*BET + RHO = 1./(1.+ETA) + C1B2Q = CFTF * (H1BAR_HLQ(ETA,XI)+H1BAR_HTQ(ETA,XI)) + & + & CFTF * BET3 * (GBAR_L(ETA,XI)+GBAR_T(ETA,XI)) + C1B2Q = C1B2Q*4.*PI/FACTOR + ENDIF + C1B2Q_FUN = (X-YWGT)*C1B2Q/(X*X) + + RETURN + END + +!DECK ID>, D12Q_FUN. + +! ===================================== + DOUBLE PRECISION FUNCTION D12Q_FUN(X) +! ===================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + COMMON /QCWGTC/ YWGT,QPCG,QMASS,EGAUSS,NF + + FACTOR = QMASS*QMASS/QPCG + D12Q = 0. + IF(X.LT.(1./(1.+4.*FACTOR))) THEN + XI = 1./FACTOR + ETA = XI * (1.-X)/(4.*X) - 1. + IF(QPCG.LE.1.5) THEN + D12Q = CFTF * (H1F_LLQ(ETA,XI)+H1F_LTQ(ETA,XI)) + ELSE + D12Q = CFTF * (H1_LLQ(ETA,XI)+H1_LTQ(ETA,XI)) + ENDIF + D12Q = D12Q*4.*PI/FACTOR + ENDIF + D12Q_FUN = (X-YWGT)*D12Q/(X*X) + + RETURN + END + +!DECK ID>, D1B2Q_FUN. + +! ====================================== + DOUBLE PRECISION FUNCTION D1B2Q_FUN(X) +! ====================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + COMMON /QCWGTC/ YWGT,QPCG,QMASS,EGAUSS,NF + + FACTOR = QMASS*QMASS/QPCG + D1B2Q = 0. + IF(X.LT.(1./(1.+4.*FACTOR))) THEN + XI = 1./FACTOR + ETA = XI * (1.-X)/(4.*X) - 1. + IF(QPCG.LE.1.5) THEN + D1B2Q = CFTF * H1BAR_LTQ(ETA,XI) + ELSE + D1B2Q = 0. + ENDIF + D1B2Q = D1B2Q*4.*PI/FACTOR + ENDIF + D1B2Q_FUN = (X-YWGT)*D1B2Q/(X*X) + + RETURN + END + +!DECK ID>, FIL_FLH. + +! ======================= + SUBROUTINE FIL_FLH(IDF) +! ======================= + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + EXTERNAL C0LG_FUN, C1LG_FUN, C1BLG_FUN + EXTERNAL C1LQ_FUN, C1BLQ_FUN + EXTERNAL D1LQ_FUN, D1BLQ_FUN + + COMMON /QCWGTC/ YWGT,QPCG,QMASS,EGAUSS,NF + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + REAL & + &WH_C0KG,WH_C1KG,WH_C1BKG, & + &WH_C1KQ,WH_C1BKQ,WH_D1KQ,WH_D1BKQ + + COMMON/QCHWGT/ & + &WH_C0KG(0:MXX,MQ2,4:7), & + &WH_C1KG(0:MXX,MQ2,4:7),WH_C1BKG(0:MXX,MQ2,4:7), & + &WH_C1KQ(0:MXX,MQ2,4:7),WH_C1BKQ(0:MXX,MQ2,4:7), & + &WH_D1KQ(0:MXX,MQ2,4:7),WH_D1BKQ(0:MXX,MQ2,4:7) + + + QMASS = CBMSTF(IDF) + + EGAUSS = 0.001 + + DO 400 IQ = 1,NQ2 + + QPCG = Q2TAB(IQ) + APCG = 1.+4.*QMASS*QMASS/QPCG + + IX0 = 1 + X0 = XHTAB(IX0) + +! WRITE(6,'('' Calculate FLH weights for IX ='',I4)') IX0 + + DO 200 IX = IX0,NXX + + XI = XHTAB(IX) + XIP1 = XHTAB(IX+1) + IF(IX.GT.IX0) XIM1 = XHTAB(IX-1) + IF(XIP1.LE.X0*APCG) GOTO 200 + XI = MAX(XI,X0*APCG) + SIP1 = X0/XIP1 + SI = X0/XI + + CALL S1FUNC(C0LG_FUN,SIP1,SI,S1FUN) + IF(IX.EQ.IX0) THEN + WH_C0KG(IX-IX0,IQ,IDF) = S1FUN + ELSE + SIM1 = X0/XIM1 + CALL S2FUNC(C0LG_FUN,SI,SIM1,S2FUN) + WH_C0KG(IX-IX0,IQ,IDF) = S1FUN-S2FUN + ENDIF + + CALL S1FUNC(C1LG_FUN,SIP1,SI,S1FUN) + IF(IX.EQ.IX0) THEN + WH_C1KG(IX-IX0,IQ,IDF) = S1FUN + ELSE + SIM1 = X0/XIM1 + CALL S2FUNC(C1LG_FUN,SI,SIM1,S2FUN) + WH_C1KG(IX-IX0,IQ,IDF) = S1FUN-S2FUN + ENDIF + + CALL S1FUNC(C1BLG_FUN,SIP1,SI,S1FUN) + IF(IX.EQ.IX0) THEN + WH_C1BKG(IX-IX0,IQ,IDF) = S1FUN + ELSE + SIM1 = X0/XIM1 + CALL S2FUNC(C1BLG_FUN,SI,SIM1,S2FUN) + WH_C1BKG(IX-IX0,IQ,IDF) = S1FUN-S2FUN + ENDIF + + CALL S1FUNC(C1LQ_FUN,SIP1,SI,S1FUN) + IF(IX.EQ.IX0) THEN + WH_C1KQ(IX-IX0,IQ,IDF) = S1FUN + ELSE + SIM1 = X0/XIM1 + CALL S2FUNC(C1LQ_FUN,SI,SIM1,S2FUN) + WH_C1KQ(IX-IX0,IQ,IDF) = S1FUN-S2FUN + ENDIF + + CALL S1FUNC(C1BLQ_FUN,SIP1,SI,S1FUN) + IF(IX.EQ.IX0) THEN + WH_C1BKQ(IX-IX0,IQ,IDF) = S1FUN + ELSE + SIM1 = X0/XIM1 + CALL S2FUNC(C1BLQ_FUN,SI,SIM1,S2FUN) + WH_C1BKQ(IX-IX0,IQ,IDF) = S1FUN-S2FUN + ENDIF + + CALL S1FUNC(D1LQ_FUN,SIP1,SI,S1FUN) + IF(IX.EQ.IX0) THEN + WH_D1KQ(IX-IX0,IQ,IDF) = S1FUN + ELSE + SIM1 = X0/XIM1 + CALL S2FUNC(D1LQ_FUN,SI,SIM1,S2FUN) + WH_D1KQ(IX-IX0,IQ,IDF) = S1FUN-S2FUN + ENDIF + +! CALL S1FUNC(D1BLQ_FUN,SIP1,SI,S1FUN) +! IF(IX.EQ.IX0) THEN +! WH_D1BKQ(IX-IX0,IQ,IDF) = S1FUN +! ELSE +! SIM1 = X0/XIM1 +! CALL S2FUNC(D1BLQ_FUN,SI,SIM1,S2FUN) +! WH_D1BKQ(IX-IX0,IQ,IDF) = S1FUN-S2FUN +! ENDIF + WH_D1BKQ(IX-IX0,IQ,IDF) = 0. + + 200 CONTINUE + + 400 END DO + + RETURN + END + +!DECK ID>, C0LG_FUN. + +! ===================================== + DOUBLE PRECISION FUNCTION C0LG_FUN(X) +! ===================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + COMMON /QCWGTC/ YWGT,QPCG,QMASS,EGAUSS,NF + + DATA PI /3.14159265359/ + + FACTOR = QMASS*QMASS/QPCG + C0LG = 0. + IF(X.LT.(1./(1.+4.*FACTOR))) THEN + XI = 1./FACTOR + ETA = XI * (1.-X)/(4.*X) - 1. + C0LG = C0_LG(ETA,XI) * XI / (2.*PI) + ENDIF + C0LG_FUN = (X-YWGT)*C0LG/(X*X) + + RETURN + END + +!DECK ID>, C1LG_FUN. + +! ===================================== + DOUBLE PRECISION FUNCTION C1LG_FUN(X) +! ===================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + COMMON /QCWGTC/ YWGT,QPCG,QMASS,EGAUSS,NF + + FACTOR = QMASS*QMASS/QPCG + C1LG = 0. + IF(X.LT.(1./(1.+4.*FACTOR))) THEN + XI = 1./FACTOR + ETA = XI * (1.-X)/(4.*X) - 1. + BET = SQRT(ETA/(1.+ETA)) + RHO = 1./(1.+ETA) + C1LG = CATF * H1_ALG(ETA,XI) + & + & CFTF * H1_FLG(ETA,XI) + & + & CATF * BET * GFUN_L(ETA,XI) + & + & CATF * RHO * EFUN_LA(ETA,XI) + & + & CFTF * RHO * EFUN_LF(ETA,XI) + C1LG = C1LG*4.*PI/FACTOR + ENDIF + C1LG_FUN = (X-YWGT)*C1LG/(X*X) + + RETURN + END + +!DECK ID>, C1BLG_FUN. + +! ====================================== + DOUBLE PRECISION FUNCTION C1BLG_FUN(X) +! ====================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + COMMON /QCWGTC/ YWGT,QPCG,QMASS,EGAUSS,NF + + FACTOR = QMASS*QMASS/QPCG + C1BLG = 0. + IF(X.LT.(1./(1.+4.*FACTOR))) THEN + XI = 1./FACTOR + ETA = XI * (1.-X)/(4.*X) - 1. + BET = SQRT(ETA/(1.+ETA)) + RHO = 1./(1.+ETA) + C1BLG = CATF * H1BAR_LG(ETA,XI) + & + & CATF * BET * GBAR_L(ETA,XI) + & + & CATF * RHO * EBAR_LA(ETA,XI) + C1BLG = C1BLG*4.*PI/FACTOR + ENDIF + C1BLG_FUN = (X-YWGT)*C1BLG/(X*X) + + RETURN + END + +!DECK ID>, C1LQ_FUN. + +! ===================================== + DOUBLE PRECISION FUNCTION C1LQ_FUN(X) +! ===================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + COMMON /QCWGTC/ YWGT,QPCG,QMASS,EGAUSS,NF + + FACTOR = QMASS*QMASS/QPCG + C1LQ = 0. + IF(X.LT.(1./(1.+4.*FACTOR))) THEN + XI = 1./FACTOR + ETA = XI * (1.-X)/(4.*X) - 1. + BET = SQRT(ETA/(1.+ETA)) + BET3 = BET*BET*BET + RHO = 1./(1.+ETA) + C1LQ = CFTF * H1_HLQ(ETA,XI) + & + & CFTF * BET3 * GFUN_L(ETA,XI) + C1LQ = C1LQ*4.*PI/FACTOR + ENDIF + C1LQ_FUN = (X-YWGT)*C1LQ/(X*X) + + RETURN + END + +!DECK ID>, C1BLQ_FUN. + +! ====================================== + DOUBLE PRECISION FUNCTION C1BLQ_FUN(X) +! ====================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + COMMON /QCWGTC/ YWGT,QPCG,QMASS,EGAUSS,NF + + FACTOR = QMASS*QMASS/QPCG + C1BLQ = 0. + IF(X.LT.(1./(1.+4.*FACTOR))) THEN + XI = 1./FACTOR + ETA = XI * (1.-X)/(4.*X) - 1. + BET = SQRT(ETA/(1.+ETA)) + BET3 = BET*BET*BET + RHO = 1./(1.+ETA) + C1BLQ = CFTF * H1BAR_HLQ(ETA,XI) + & + & CFTF * BET3 * GBAR_L(ETA,XI) + C1BLQ = C1BLQ*4.*PI/FACTOR + ENDIF + C1BLQ_FUN = (X-YWGT)*C1BLQ/(X*X) + + RETURN + END + +!DECK ID>, D1LQ_FUN. + +! ===================================== + DOUBLE PRECISION FUNCTION D1LQ_FUN(X) +! ===================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + COMMON /QCWGTC/ YWGT,QPCG,QMASS,EGAUSS,NF + + FACTOR = QMASS*QMASS/QPCG + D1LQ = 0. + IF(X.LT.(1./(1.+4.*FACTOR))) THEN + XI = 1./FACTOR + ETA = XI * (1.-X)/(4.*X) - 1. + IF(QPCG.LE.1.5) THEN + D1LQ = CFTF * H1F_LLQ(ETA,XI) + ELSE + D1LQ = CFTF * H1_LLQ(ETA,XI) + ENDIF + D1LQ = D1LQ*4.*PI/FACTOR + ENDIF + D1LQ_FUN = (X-YWGT)*D1LQ/(X*X) + + RETURN + END + +!DECK ID>, D1BLQ_FUN. + +! ====================================== + DOUBLE PRECISION FUNCTION D1BLQ_FUN(X) +! ====================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + COMMON /QCWGTC/ YWGT,QPCG,QMASS,EGAUSS,NF + + D1BLQ_FUN = 0. + + RETURN + END + +!DECK ID>, BORN. + +! This gives the Born coefficients +! For QCD take tf = 1d0/2d0, for QED take tf = 1d0. +! eta = (s - 4d0*m2)/4d0/m2, s is the gamma* gluon (gamma) CM Energy +! xi = Q^2/m2 + +! ======================================= + double precision function C0_Lg(eta,xi) +! ======================================= + +! Longitudinal coefficient function: PL B347(1995)143 eq. (7). +! This function is called born_l in the original code. + + implicit none + double precision eta, xi, pi, tf +! common/group/ca, cf, tf + parameter(tf = 0.5d0) + parameter(pi = 3.14159265359d0) + + C0_Lg = 0.5d0*pi*tf*xi*(1.d0 + eta + 0.25d0*xi)**(-3.d0)* & + & (2.d0*dsqrt(eta*(1.d0 + eta)) - & + & dlog((dsqrt(1.d0 + eta) + dsqrt(eta))/ & + & (dsqrt(1.d0 + eta) - dsqrt(eta)))) + + return + END + +! ======================================= + double precision function C0_Tg(eta,xi) +! ======================================= + +! Transverse coefficient function: PL B347(1995)143 eq. (8). +! This function is called born_t in the original code. + + implicit none + double precision eta, xi, pi, tf +! common/group/ca, cf, tf + parameter(tf = 0.5d0) + parameter(pi = 3.14159265359d0) + + C0_Tg = 0.5d0*pi*tf*(1.d0 + eta + 0.25d0*xi)**(-3)* & + & (-2.d0*((1.d0 + eta - 0.25d0*xi)**2 + eta + 1.d0)* & + & dsqrt(eta/(1.d0 + eta)) + (2.d0*(1.d0 + eta)**2 + & + & 0.125d0*xi**2 + 2.d0*eta + 1.d0)* & + & dlog((dsqrt(1.d0 + eta) + dsqrt(eta))/ & + & (dsqrt(1.d0 + eta) - dsqrt(eta)))) + + return + END + +!DECK ID>, ASYMP. + +! These are the functions that give the asymptotic dependence of the +! coefficient functions with the appropriate factors. xi = mq2/m2 (Q^2/m +! If xi is small, the regular routines have convergence +! problems and we take the limit. (not anymore after code update 03/06/9 + +! ========================================== + double precision function Gfun_L(dummy,xi) +! ========================================== + +! Longitudinal: equation (19) in PLB347 (1995) 143 - 151 +! This function is called asymp_l in the original code. + + implicit none + double precision xilast, store + double precision dummy + double precision xi, pi, term1 + double precision fii, fjj +! double precision fii_lim, fjj_lim + parameter (pi = 3.14159265359d0) + + save xilast, store + + data xilast, store /0.D0, 0.D0/ + + if(xi.eq.xilast) then + Gfun_L = store + return + endif + +! term1 = 1.d0/(1.d0 + 0.25d0*xi) + +! if (xi .le. 1.d-1) then +! Gfun_L = 1.d0/6.d0/pi*(-4.d0/3.d0*term1 + +! + (1.d0 - 1.d0/6.d0*term1)*fjj_lim(xi) - +! + 2.d0* (-1.d0/3.d0 + xi/15.d0 - xi**2/70.d0) + +! + 0.25d0*term1*fii_lim(xi) - +! + 3.d0* (1.d0/3.d0 - xi/10.d0 + 11.d0*xi**2/420.d0)) +! else +! Gfun_L = 1.d0/6.d0/pi*(4.d0/xi - 4.d0/3.d0*term1 +! + + (1.d0 - 2.d0/xi - 1.d0/6.d0*term1)*fjj(xi) +! + - (3.d0/xi + 0.25d0*term1)*fii(xi)) +! endif + + term1 = 1.d0/(1.d0 + 0.25d0*xi) + + Gfun_L = 1.d0/6.d0/pi*(4.d0/xi - 4.d0/3.d0*term1 & + & + (1.d0 - 2.d0/xi - 1.d0/6.d0*term1)*fjj(xi) & + & - (3.d0/xi + 0.25d0*term1)*fii(xi)) + + xilast = xi + store = Gfun_L + + return + END + +! ========================================== + double precision function Gfun_T(dummy,xi) +! ========================================== + +! Transverse: equation (20) in PLB347 (1995) 143 - 151 +! This function is called asymp_t in the original code. + + implicit none + double precision xilast, store + double precision dummy + double precision xi, pi, term1 + double precision fii, fjj +! double precision fii_lim, fjj_lim + parameter (pi = 3.14159265359d0) + + save xilast, store + + data xilast, store /0.D0, 0.D0/ + + if(xi.eq.xilast) then + Gfun_T = store + return + endif + +! term1 = 1.d0/(1.d0 + 0.25d0*xi) + +! if (xi .le. 1.d-1) then +! Gfun_T = 1.d0/6.d0/pi*(4.d0/3.d0*term1 + (7.d0/6.d0 + +! + 1.d0/6.d0*term1)*fjj_lim(xi) + 1/3.d0* +! + (-1.d0/3.d0 + xi/15.d0 - xi**2/70.d0) + +! + (1.d0 + 0.25d0*term1)*fii_lim(xi) + 2.d0* +! + (1.d0/3.d0 - xi/10.d0 + 11.d0*xi**2/420.d0)) +! else +! Gfun_T = 1.d0/6.d0/pi*(-2.d0/3.d0/xi + 4.d0/3.d0*term1 +! + + (7.d0/6.d0 + 1.d0/3.d0/xi + 1.d0/6.d0*term1)*fjj(xi) +! + + (1.d0 + 2.d0/xi + 0.25d0*term1)*fii(xi)) +! endif + + term1 = 1.d0/(1.d0 + 0.25d0*xi) + + Gfun_t = 1.d0/6.d0/pi*(-2.d0/3.d0/xi + 4.d0/3.d0*term1 & + & + (7.d0/6.d0 + 1.d0/3.d0/xi + 1.d0/6.d0*term1)*fjj(xi) & + & + (1.d0 + 2.d0/xi + 0.25d0*term1)*fii(xi)) + + xilast = xi + store = Gfun_T + + return + END + +! ========================================== + double precision function Gbar_L(dummy,xi) +! ========================================== + +! Longitudinal mass factorization: (21) in PLB347 (1995) 143 - 151 +! This function is called asympbar_l in the original code. + + implicit none + double precision xilast, store + double precision dummy + double precision xi, pi, term1 + double precision fjj +! double precision fjj_lim + parameter (pi = 3.14159265359d0) + + save xilast, store + + data xilast, store /0.D0, 0.D0/ + + if(xi.eq.xilast) then + Gbar_L = store + return + endif + +! term1 = 1.d0/(1.d0 + 0.25d0*xi) + +! if (xi .le. 1.d-1) then +! Gbar_L = 1.d0/6.d0/pi*(0.5d0*term1 + +! + 0.25d0*term1*fjj_lim(xi) + +! + 3.d0* (-1.d0/3.d0 + xi/15.d0 - xi**2/70.d0)) +! else +! Gbar_L = 1.d0/6.d0/pi*(-6.d0/xi + 0.5d0*term1 +! + + (3.d0/xi + 0.25d0*term1)*fjj(xi)) +! endif + + term1 = 1.d0/(1.d0 + 0.25d0*xi) + + Gbar_L = 1.d0/6.d0/pi*(-6.d0/xi + 0.5d0*term1 & + & + (3.d0/xi + 0.25d0*term1)*fjj(xi)) + + xilast = xi + store = Gbar_L + + return + END + +! ========================================== + double precision function Gbar_T(dummy,xi) +! ========================================== + +! transverse mass factorization: (22) in PLB347 (1995) 143 - 151 +! This function is called asympbar_t in the original code. + + implicit none + double precision xilast, store + double precision dummy + double precision xi, pi, term1 + double precision fjj +! double precision fjj_lim + parameter (pi = 3.14159265359d0) + + save xilast, store + + data xilast, store /0.D0, 0.D0/ + + if(xi.eq.xilast) then + Gbar_T = store + return + endif + +! term1 = 1.d0/(1.d0 + 0.25d0*xi) + +! if (xi .le. 1.d-1) then +! Gbar_T = 1.d0/6.d0/pi*(-.5d0*term1 - +! + (1.d0 + 0.25d0*term1)*fjj_lim(xi) - +! + 2.d0* (-1.d0/3.d0 + xi/15.d0 - xi**2/70.d0)) +! else +! Gbar_T = 1.d0/6.d0/pi*(4.d0/xi - 0.5d0*term1 +! + - (1.d0 + 2.d0/xi + 0.25d0*term1)*fjj(xi)) +! endif + + term1 = 1.d0/(1.d0 + 0.25d0*xi) + + Gbar_T = 1.d0/6.d0/pi*(4.d0/xi - 0.5d0*term1 & + & - (1.d0 + 2.d0/xi + 0.25d0*term1)*fjj(xi)) + + xilast = xi + store = Gbar_T + + return + END + +! ================================= + double precision function fii(xi) +! ================================= + +! Equation (24) in PLB347 (1995) 143 - 151 + + implicit none + double precision pi, term1, term2, xi, di_log + parameter (pi = 3.14159265359d0) + + term1 = dsqrt(xi) + term2 = dsqrt(4.d0 + xi) + fii = 4.d0/term1/term2*(-pi*pi/6.d0 & + & - 0.5d0*(dlog((term2 + term1)/(term2 - term1)))**2 & + & + (dlog(0.5d0*(1.d0 - term1/term2)))**2 & + & + 2.d0*di_log(0.5d0*(1.d0 - term1/term2))) + + return + END + +! ================================= + double precision function fjj(xi) +! ================================= + +! Equation (23) in PLB347 (1995) 143 - 151 + + implicit none + double precision pi, xi, term1, term2 + parameter (pi = 3.14159265359d0) + + term1 = dsqrt(xi) + term2 = dsqrt(4.d0 + xi) + fjj = 4.d0/term1/term2*dlog((term2 + term1)/(term2 - term1)) + + return + END + +! ===================================== + double precision function fii_lim(xi) +! ===================================== + +! this gives fii(xi) in the limit that xi -> 0 up to xi**2 + + implicit none + double precision xi + + fii_lim = xi/3.d0 - xi**2/10.d0 + + return + END + +! ===================================== + double precision function fjj_lim(xi) +! ===================================== + +! this gives fjj(xi) in the limit that xi -> 0 up to xi**2 + + implicit none + double precision xi + + fjj_lim = 2.d0 - xi/3.d0 + xi**2/15.d0 + + return + END + +! =================================== + double precision function di_log(x) +! =================================== + +! Equation (25) in PLB347 (1995) 143 - 151 + + implicit double precision (a-z) + dimension b(8) + integer ncall + data ncall/0/,pi6/1.644934066848226d+00/,een,vier/1.d+00,.25d+00/ + + ncall = 0 + if(ncall.eq.0)goto 2 + 1 if(x.lt.0)goto 3 + if(x.gt.0.5)goto 4 + z=-dlog(1.-x) + 7 z2=z*z + di_log=z*(z2*(z2*(z2*(z2*(z2*(z2*(z2*b(8)+b(7))+b(6)) & + & +b(5))+b(4))+b(3))+b(2))+een)-z2*vier + if(x.gt.een)di_log=-di_log-.5*u*u+2.*pi6 + return + 2 b(1)=een + b(2)=een/36. + b(3)=-een/3600. + b(4)=een/211680. + b(5)=-een/(30.*362880.d+00) + b(6)=5./(66.*39916800.d+00) + b(7)=-691./(2730.*39916800.d+00*156.) + b(8)=een/(39916800.d+00*28080.) + ncall=1 + goto 1 + 3 if(x.gt.-een)goto 5 + y=een/(een-x) + z=-dlog(een-y) + z2=z*z + u=dlog(y) + di_log=z*(z2*(z2*(z2*(z2*(z2*(z2*(z2*b(8)+b(7))+b(6)) & + & +b(5))+b(4))+b(3))+b(2))+een)-z2*vier-u*(z+.5*u)-pi6 + return + 4 if(x.ge.een)goto 10 + y=een-x + z=-dlog(x) + 6 u=dlog(y) + z2=z*z + di_log=-z*(z2*(z2*(z2*(z2*(z2*(z2*(z2*b(8)+b(7))+b(6)) & + & +b(5))+b(4))+b(3))+b(2))+een-u)+z2*vier+pi6 + if(x.gt.een)di_log=-di_log-.5*z*z+pi6*2. + return + 5 y=een/(een-x) + z=-dlog(y) + z2=z*z + di_log=-z*(z2*(z2*(z2*(z2*(z2*(z2*(z2*b(8)+b(7))+b(6)) & + & +b(5))+b(4))+b(3))+b(2))+een)-z2*vier + return + 10 if(x.eq.een)goto 20 + xx=1./x + if(x.gt.2.)goto 11 + z=dlog(x) + y=1.-xx + goto 6 + 11 u=dlog(x) + z=-dlog(1.-xx) + goto 7 + 20 di_log=pi6 + + return + END + +!DECK ID>, THRESH. + +! These are the functions that give the threshold dependence of the +! coefficient functions with the appropriate factors. +! eta = (W^2 - 4d0*m2)/4d0/m2 where W is the CM energy of the +! gamma* parton system. xi = mq2/m2 (Q^2/m2) + +! ========================================= + double precision function Efun_LF(eta,xi) +! ========================================= + +! Longitudinal CF group structure: eq (13) in PLB347 (195) 143 - 151 +! This function is called threshf_l in the original code. + + implicit none + double precision pi, eta, xi, beta, term1 + parameter (pi = 3.14159265359d0) + + beta = dsqrt(eta/(1.d0 + eta)) + term1 = 1.d0/(1.d0 + 0.25d0*xi) + Efun_LF = 1.d0/6.d0/pi*xi*term1**3*beta*beta*pi*pi/2.d0 + + return + END + +! ========================================= + double precision function Efun_TF(eta,xi) +! ========================================= + +! Transverse CF group structure: eq (14) in PLB347 (195) 143 - 151 +! This function is called threshf_t in the original code. + + implicit none + double precision pi, eta, xi, beta, term1 + parameter (pi = 3.14159265359d0) + + beta = dsqrt(eta/(1.d0 + eta)) + term1 = 1.d0/(1.d0 + 0.25d0*xi) + Efun_TF = 0.25d0/pi*term1*pi*pi/2.d0 + + return + END + +! ========================================= + double precision function Efun_LA(eta,xi) +! ========================================= + +! Longitudinal CA group structure: eq (15) in PLB347 (195) 143 - 151 +! This function is called thresha_l in the original code. + + implicit none + double precision pi, eta, xi, beta, term1 + parameter (pi = 3.14159265359d0) + + beta = dsqrt(eta/(1.d0 + eta)) + term1 = 1.d0/(1.d0 + 0.25d0*xi) + Efun_LA = 1.d0/6.d0/pi*xi*term1**3*beta**2* & + & (beta*(dlog(8.d0*beta*beta))**2 & + & - 5.d0*beta*dlog(8.d0*beta*beta) - 0.25d0*pi*pi) + + return + END + +! ========================================= + double precision function Efun_TA(eta,xi) +! ========================================= + +! Transverse CA group structure: eq (16) in PLB347 (195) 143 - 151 +! This function is called thresha_t in the original code. + implicit none + double precision pi, eta, xi, beta, term1 + parameter (pi = 3.14159265359d0) + + beta = dsqrt(eta/(1.d0 + eta)) + term1 = 1.d0/(1.d0 + 0.25d0*xi) + Efun_TA = 0.25d0/pi*term1*(beta*(dlog(8.d0*beta*beta))**2 & + & - 5.d0*beta*dlog(8.d0*beta*beta) - 0.25d0*pi*pi) + + return + END + +! ========================================= + double precision function Ebar_LA(eta,xi) +! ========================================= + +! Longitudinal CA group structure for the mass factorization piece: +! equation (17) in PLB347 (195) 143 - 151 +! This function is called threshbar_l in the original code. + + implicit none + double precision pi, eta, xi, beta, term1 + parameter (pi = 3.14159265359d0) + + beta = dsqrt(eta/(1.d0 + eta)) + term1 = 1.d0/(1.d0 + 0.25d0*xi) + Ebar_LA = 1.d0/6.d0/pi*xi*term1**3*beta**3* & + & (-dlog(4.d0*beta*beta)) + + return + END + +! ========================================= + double precision function Ebar_TA(eta,xi) +! ========================================= + +! Transverse CA group structure for the mass factorization piece: +! equation (18) in PLB347 (195) 143 - 151 +! This function is called threshbar_t in the original code. + + implicit none + double precision pi, eta, xi, beta, term1 + parameter (pi = 3.14159265359d0) + + beta = dsqrt(eta/(1.d0 + eta)) + term1 = 1.d0/(1.d0 + 0.25d0*xi) + Ebar_TA = 0.25d0/pi*term1*beta*(-dlog(4.d0*beta*beta)) + + return + END + +!DECK ID>, LOCATE. + +! =========================== + Subroutine Locate(xx,n,x,j) +! =========================== +! routine taken out of Numerical Recipes + + Integer j,n + Double Precision x,xx(n) + Integer jl,ju,jm + + jl = 0 + ju = n+1 + 10 If (ju - jl .gt. 1) then + jm = (ju + jl)/2 + If ((xx(n) .gt. xx(1)) .eqv. (x .gt. xx(jm))) then + jl = jm + else + ju = jm + endif + goto 10 + endif + j = jl + + return + END + +!DECK ID>, GCORRT. + +! ======================================== + double precision function h1_ATg(eta,xi) +! ======================================== + +! eq (9) in PLB347 (1995) 143 - 151 for the transverse piece +! MSbar scheme +! This routine is called subctca in the original code. +! Called sctca in updated code (03/06/96). + + implicit none + integer neta, nxi + parameter (neta = 73, nxi = 49) + double precision calcpts(neta, nxi), dlaeta(neta), dlaxi(nxi) + double precision eta, xi, dleta, dlxi + double precision pxi, peta, f(-1:1), delxi, deleta + integer j, ieta, ixi + + data (calcpts(j, 1), j = 1,neta) /0.4323D-03, 0.5138D-03, & + & 0.6270D-03, 0.7996D-03, 0.9331D-03, 0.1128D-02, 0.1413D-02, & + & 0.1683D-02, 0.2046D-02, 0.2457D-02, 0.2961D-02, 0.3609D-02, & + & 0.4386D-02, 0.5294D-02, 0.6434D-02, 0.7763D-02, 0.9365D-02, & + & 0.1136D-01, 0.1370D-01, 0.1657D-01, 0.2004D-01, 0.2424D-01, & + & 0.2932D-01, 0.3548D-01, 0.4293D-01, 0.5192D-01, 0.6267D-01, & + & 0.7534D-01, 0.8988D-01, 0.1058D+00, 0.1217D+00, 0.1351D+00, & + & 0.1421D+00, 0.1379D+00, 0.1184D+00, 0.8306D-01, 0.3588D-01, & + & -.1530D-01, -.6227D-01, -.9944D-01, -.1244D+00, -.1372D+00, & + & -.1396D+00, -.1341D+00, -.1233D+00, -.1096D+00, -.9476D-01, & + & -.8013D-01, -.6655D-01, -.5451D-01, -.4402D-01, -.3519D-01, & + & -.2786D-01, -.2194D-01, -.1711D-01, -.1324D-01, -.1021D-01, & + & -.7860D-02, -.6008D-02, -.4529D-02, -.3433D-02, -.2592D-02, & + & -.1943D-02, -.1488D-02, -.1096D-02, -.8350D-03, -.6387D-03, & + & -.4413D-03, -.3097D-03, -.2442D-03, -.1783D-03, -.1122D-03, & + & -.1126D-03/ + + data (calcpts(j, 2), j = 1,neta) /0.4112D-03, 0.5596D-03, & + & 0.6731D-03, 0.7794D-03, 0.9800D-03, 0.1176D-02, 0.1394D-02, & + & 0.1665D-02, 0.2028D-02, 0.2507D-02, 0.3011D-02, 0.3593D-02, & + & 0.4371D-02, 0.5280D-02, 0.6421D-02, 0.7751D-02, 0.9354D-02, & + & 0.1135D-01, 0.1370D-01, 0.1656D-01, 0.2004D-01, 0.2424D-01, & + & 0.2932D-01, 0.3547D-01, 0.4293D-01, 0.5191D-01, 0.6265D-01, & + & 0.7532D-01, 0.8986D-01, 0.1057D+00, 0.1217D+00, 0.1351D+00, & + & 0.1421D+00, 0.1379D+00, 0.1184D+00, 0.8304D-01, 0.3587D-01, & + & -.1531D-01, -.6227D-01, -.9945D-01, -.1244D+00, -.1372D+00, & + & -.1396D+00, -.1341D+00, -.1233D+00, -.1096D+00, -.9475D-01, & + & -.8011D-01, -.6660D-01, -.5450D-01, -.4401D-01, -.3518D-01, & + & -.2791D-01, -.2193D-01, -.1710D-01, -.1329D-01, -.1019D-01, & + & -.7845D-02, -.5992D-02, -.4581D-02, -.3485D-02, -.2577D-02, & + & -.1927D-02, -.1473D-02, -.1081D-02, -.8195D-03, -.6233D-03, & + & -.4258D-03, -.3609D-03, -.2288D-03, -.1629D-03, -.1634D-03, & + & -.9715D-04/ + + data (calcpts(j, 3), j = 1,neta) /0.4469D-03, 0.5291D-03, & + & 0.6430D-03, 0.8165D-03, 0.9509D-03, 0.1147D-02, 0.1366D-02, & + & 0.1705D-02, 0.2069D-02, 0.2482D-02, 0.2987D-02, 0.3637D-02, & + & 0.4350D-02, 0.5326D-02, 0.6402D-02, 0.7734D-02, 0.9338D-02, & + & 0.1133D-01, 0.1370D-01, 0.1656D-01, 0.2003D-01, 0.2423D-01, & + & 0.2931D-01, 0.3547D-01, 0.4292D-01, 0.5190D-01, 0.6264D-01, & + & 0.7531D-01, 0.8984D-01, 0.1057D+00, 0.1216D+00, 0.1351D+00, & + & 0.1420D+00, 0.1378D+00, 0.1184D+00, 0.8300D-01, 0.3585D-01, & + & -.1532D-01, -.6227D-01, -.9944D-01, -.1244D+00, -.1372D+00, & + & -.1396D+00, -.1341D+00, -.1233D+00, -.1095D+00, -.9473D-01, & + & -.8016D-01, -.6658D-01, -.5447D-01, -.4405D-01, -.3522D-01, & + & -.2789D-01, -.2190D-01, -.1708D-01, -.1326D-01, -.1024D-01, & + & -.7822D-02, -.5970D-02, -.4558D-02, -.3462D-02, -.2621D-02, & + & -.1972D-02, -.1450D-02, -.1125D-02, -.7969D-03, -.6007D-03, & + & -.4699D-03, -.3383D-03, -.2728D-03, -.2069D-03, -.1408D-03, & + & -.7452D-04/ + + data (calcpts(j, 4), j = 1,neta) /0.4681D-03, 0.5509D-03, & + & 0.6654D-03, 0.7730D-03, 0.9749D-03, 0.1172D-02, 0.1392D-02, & + & 0.1665D-02, 0.2031D-02, 0.2445D-02, 0.3018D-02, 0.3603D-02, & + & 0.4384D-02, 0.5296D-02, 0.6441D-02, 0.7775D-02, 0.9382D-02, & + & 0.1131D-01, 0.1370D-01, 0.1656D-01, 0.2003D-01, 0.2422D-01, & + & 0.2930D-01, 0.3546D-01, 0.4290D-01, 0.5188D-01, 0.6262D-01, & + & 0.7528D-01, 0.8980D-01, 0.1057D+00, 0.1216D+00, 0.1350D+00, & + & 0.1420D+00, 0.1378D+00, 0.1183D+00, 0.8296D-01, 0.3582D-01, & + & -.1534D-01, -.6228D-01, -.9945D-01, -.1244D+00, -.1372D+00, & + & -.1396D+00, -.1341D+00, -.1233D+00, -.1096D+00, -.9477D-01, & + & -.8013D-01, -.6655D-01, -.5451D-01, -.4402D-01, -.3519D-01, & + & -.2786D-01, -.2194D-01, -.1711D-01, -.1323D-01, -.1020D-01, & + & -.7856D-02, -.6003D-02, -.4525D-02, -.3429D-02, -.2588D-02, & + & -.1938D-02, -.1483D-02, -.1092D-02, -.8303D-03, -.6341D-03, & + & -.4366D-03, -.3050D-03, -.2395D-03, -.1737D-03, -.1076D-03, & + & -.1079D-03/ + + data (calcpts(j, 5), j = 1,neta) /0.4681D-03, 0.5517D-03, & + & 0.6672D-03, 0.7759D-03, 0.9790D-03, 0.1178D-02, 0.1399D-02, & + & 0.1674D-02, 0.2041D-02, 0.2457D-02, 0.2967D-02, 0.3621D-02, & + & 0.4405D-02, 0.5319D-02, 0.6400D-02, 0.7738D-02, 0.9348D-02, & + & 0.1135D-01, 0.1369D-01, 0.1655D-01, 0.2002D-01, 0.2421D-01, & + & 0.2928D-01, 0.3544D-01, 0.4288D-01, 0.5185D-01, 0.6259D-01, & + & 0.7523D-01, 0.8975D-01, 0.1056D+00, 0.1215D+00, 0.1349D+00, & + & 0.1419D+00, 0.1377D+00, 0.1182D+00, 0.8289D-01, 0.3577D-01, & + & -.1536D-01, -.6229D-01, -.9945D-01, -.1244D+00, -.1371D+00, & + & -.1396D+00, -.1341D+00, -.1233D+00, -.1095D+00, -.9472D-01, & + & -.8015D-01, -.6657D-01, -.5446D-01, -.4404D-01, -.3521D-01, & + & -.2788D-01, -.2189D-01, -.1713D-01, -.1325D-01, -.1022D-01, & + & -.7874D-02, -.6021D-02, -.4543D-02, -.3447D-02, -.2605D-02, & + & -.1956D-02, -.1501D-02, -.1109D-02, -.8482D-03, -.5853D-03, & + & -.4545D-03, -.3229D-03, -.2574D-03, -.1916D-03, -.1254D-03, & + & -.1258D-03/ + + data (calcpts(j, 6), j = 1,neta) /0.4370D-03, 0.5219D-03, & + & 0.6388D-03, 0.8157D-03, 0.9540D-03, 0.1155D-02, 0.1379D-02, & + & 0.1656D-02, 0.2026D-02, 0.2445D-02, 0.2957D-02, 0.3615D-02, & + & 0.4403D-02, 0.5255D-02, 0.6408D-02, 0.7750D-02, 0.9365D-02, & + & 0.1130D-01, 0.1368D-01, 0.1653D-01, 0.2000D-01, 0.2419D-01, & + & 0.2926D-01, 0.3541D-01, 0.4285D-01, 0.5181D-01, 0.6253D-01, & + & 0.7518D-01, 0.8967D-01, 0.1055D+00, 0.1214D+00, 0.1348D+00, & + & 0.1418D+00, 0.1375D+00, 0.1181D+00, 0.8279D-01, 0.3571D-01, & + & -.1540D-01, -.6231D-01, -.9945D-01, -.1244D+00, -.1371D+00, & + & -.1396D+00, -.1341D+00, -.1233D+00, -.1096D+00, -.9473D-01, & + & -.8015D-01, -.6657D-01, -.5446D-01, -.4403D-01, -.3520D-01, & + & -.2787D-01, -.2188D-01, -.1712D-01, -.1324D-01, -.1022D-01, & + & -.7869D-02, -.6016D-02, -.4538D-02, -.3442D-02, -.2601D-02, & + & -.1951D-02, -.1496D-02, -.1105D-02, -.8434D-03, -.5804D-03, & + & -.4497D-03, -.3181D-03, -.2526D-03, -.1867D-03, -.1206D-03, & + & -.1210D-03/ + + data (calcpts(j, 7), j = 1,neta) /0.4271D-03, 0.5137D-03, & + & 0.6327D-03, 0.8119D-03, 0.9528D-03, 0.1156D-02, 0.1384D-02, & + & 0.1664D-02, 0.2038D-02, 0.2462D-02, 0.2979D-02, 0.3643D-02, & + & 0.4369D-02, 0.5295D-02, 0.6387D-02, 0.7736D-02, 0.9359D-02, & + & 0.1131D-01, 0.1367D-01, 0.1652D-01, 0.1998D-01, 0.2417D-01, & + & 0.2923D-01, 0.3537D-01, 0.4280D-01, 0.5175D-01, 0.6246D-01, & + & 0.7509D-01, 0.8956D-01, 0.1054D+00, 0.1212D+00, 0.1346D+00, & + & 0.1415D+00, 0.1373D+00, 0.1179D+00, 0.8265D-01, 0.3561D-01, & + & -.1546D-01, -.6233D-01, -.9945D-01, -.1243D+00, -.1371D+00, & + & -.1395D+00, -.1341D+00, -.1233D+00, -.1095D+00, -.9470D-01, & + & -.8012D-01, -.6654D-01, -.5449D-01, -.4400D-01, -.3517D-01, & + & -.2790D-01, -.2191D-01, -.1709D-01, -.1327D-01, -.1025D-01, & + & -.7831D-02, -.5978D-02, -.4566D-02, -.3470D-02, -.2629D-02, & + & -.1980D-02, -.1458D-02, -.1066D-02, -.8051D-03, -.6089D-03, & + & -.4781D-03, -.3465D-03, -.6143D-03, -.1485D-03, -.1490D-03, & + & -.8274D-04/ + + data (calcpts(j, 8), j = 1,neta) /0.4171D-03, 0.5064D-03, & + & 0.6284D-03, 0.8110D-03, 0.9558D-03, 0.1164D-02, 0.1396D-02, & + & 0.1682D-02, 0.2062D-02, 0.2492D-02, 0.2950D-02, 0.3621D-02, & + & 0.4356D-02, 0.5291D-02, 0.6392D-02, 0.7752D-02, 0.9319D-02, & + & 0.1128D-01, 0.1365D-01, 0.1650D-01, 0.1995D-01, 0.2413D-01, & + & 0.2919D-01, 0.3531D-01, 0.4273D-01, 0.5167D-01, 0.6235D-01, & + & 0.7495D-01, 0.8940D-01, 0.1052D+00, 0.1210D+00, 0.1343D+00, & + & 0.1413D+00, 0.1370D+00, 0.1177D+00, 0.8245D-01, 0.3546D-01, & + & -.1554D-01, -.6236D-01, -.9945D-01, -.1243D+00, -.1371D+00, & + & -.1395D+00, -.1340D+00, -.1232D+00, -.1095D+00, -.9470D-01, & + & -.8011D-01, -.6653D-01, -.5448D-01, -.4398D-01, -.3522D-01, & + & -.2788D-01, -.2189D-01, -.1707D-01, -.1325D-01, -.1023D-01, & + & -.7811D-02, -.6025D-02, -.4546D-02, -.3450D-02, -.2609D-02, & + & -.1959D-02, -.1438D-02, -.1113D-02, -.7847D-03, -.5884D-03, & + & -.4576D-03, -.3260D-03, -.2605D-03, -.1947D-03, -.1285D-03, & + & -.1289D-03/ + + data (calcpts(j, 9), j = 1,neta) /0.4435D-03, 0.5367D-03, & + & 0.6631D-03, 0.7841D-03, 0.9344D-03, 0.1148D-02, 0.1388D-02, & + & 0.1681D-02, 0.2003D-02, 0.2443D-02, 0.2978D-02, 0.3594D-02, & + & 0.4342D-02, 0.5289D-02, 0.6406D-02, 0.7714D-02, 0.9296D-02, & + & 0.1127D-01, 0.1362D-01, 0.1646D-01, 0.1991D-01, 0.2407D-01, & + & 0.2912D-01, 0.3524D-01, 0.4263D-01, 0.5155D-01, 0.6220D-01, & + & 0.7476D-01, 0.8916D-01, 0.1049D+00, 0.1206D+00, 0.1339D+00, & + & 0.1408D+00, 0.1366D+00, 0.1173D+00, 0.8214D-01, 0.3525D-01, & + & -.1566D-01, -.6242D-01, -.9946D-01, -.1243D+00, -.1371D+00, & + & -.1395D+00, -.1340D+00, -.1232D+00, -.1095D+00, -.9470D-01, & + & -.8011D-01, -.6651D-01, -.5446D-01, -.4403D-01, -.3520D-01, & + & -.2786D-01, -.2194D-01, -.1711D-01, -.1323D-01, -.1020D-01, & + & -.7853D-02, -.6000D-02, -.4521D-02, -.3425D-02, -.2584D-02, & + & -.1934D-02, -.1480D-02, -.1088D-02, -.8263D-03, -.6301D-03, & + & -.4326D-03, -.3010D-03, -.2355D-03, -.1696D-03, -.1035D-03, & + & -.1039D-03/ + + data (calcpts(j,10), j = 1,neta) /0.4611D-03, 0.4933D-03, & + & 0.6262D-03, 0.7544D-03, 0.9129D-03, 0.1136D-02, 0.1386D-02, & + & 0.1691D-02, 0.2025D-02, 0.2479D-02, 0.2963D-02, 0.3595D-02, & + & 0.4361D-02, 0.5262D-02, 0.6332D-02, 0.7662D-02, 0.9268D-02, & + & 0.1120D-01, 0.1357D-01, 0.1641D-01, 0.1984D-01, 0.2399D-01, & + & 0.2902D-01, 0.3512D-01, 0.4249D-01, 0.5136D-01, 0.6198D-01, & + & 0.7448D-01, 0.8881D-01, 0.1045D+00, 0.1201D+00, 0.1333D+00, & + & 0.1402D+00, 0.1360D+00, 0.1167D+00, 0.8169D-01, 0.3495D-01, & + & -.1584D-01, -.6249D-01, -.9946D-01, -.1243D+00, -.1370D+00, & + & -.1394D+00, -.1339D+00, -.1231D+00, -.1095D+00, -.9468D-01, & + & -.8007D-01, -.6653D-01, -.5441D-01, -.4398D-01, -.3521D-01, & + & -.2787D-01, -.2188D-01, -.1711D-01, -.1323D-01, -.1021D-01, & + & -.7857D-02, -.6004D-02, -.4525D-02, -.3429D-02, -.2588D-02, & + & -.1938D-02, -.1483D-02, -.1091D-02, -.8300D-03, -.6337D-03, & + & -.4363D-03, -.3047D-03, -.2392D-03, -.1733D-03, -.1072D-03, & + & -.1076D-03/ + + data (calcpts(j,11), j = 1,neta) /0.4058D-03, 0.5130D-03, & + & 0.6553D-03, 0.7941D-03, 0.9646D-03, 0.1135D-02, 0.1399D-02, & + & 0.1654D-02, 0.2007D-02, 0.2415D-02, 0.2921D-02, 0.3578D-02, & + & 0.4303D-02, 0.5233D-02, 0.6333D-02, 0.7629D-02, 0.9268D-02, & + & 0.1117D-01, 0.1351D-01, 0.1632D-01, 0.1975D-01, 0.2388D-01, & + & 0.2888D-01, 0.3494D-01, 0.4227D-01, 0.5110D-01, 0.6164D-01, & + & 0.7406D-01, 0.8831D-01, 0.1038D+00, 0.1194D+00, 0.1325D+00, & + & 0.1393D+00, 0.1350D+00, 0.1159D+00, 0.8103D-01, 0.3450D-01, & + & -.1609D-01, -.6259D-01, -.9947D-01, -.1242D+00, -.1369D+00, & + & -.1393D+00, -.1339D+00, -.1231D+00, -.1094D+00, -.9458D-01, & + & -.8003D-01, -.6648D-01, -.5441D-01, -.4397D-01, -.3513D-01, & + & -.2786D-01, -.2187D-01, -.1710D-01, -.1322D-01, -.1019D-01, & + & -.7843D-02, -.5989D-02, -.4577D-02, -.3481D-02, -.2572D-02, & + & -.1990D-02, -.1468D-02, -.1076D-02, -.8148D-03, -.6185D-03, & + & -.4210D-03, -.3561D-03, -.2239D-03, -.1580D-03, -.1586D-03, & + & -.9227D-04/ + + data (calcpts(j,12), j = 1,neta) /0.4531D-03, 0.5058D-03, & + & 0.6618D-03, 0.7494D-03, 0.9372D-03, 0.1127D-02, 0.1346D-02, & + & 0.1625D-02, 0.2005D-02, 0.2442D-02, 0.2914D-02, 0.3540D-02, & + & 0.4304D-02, 0.5208D-02, 0.6287D-02, 0.7563D-02, 0.9184D-02, & + & 0.1107D-01, 0.1341D-01, 0.1621D-01, 0.1961D-01, 0.2371D-01, & + & 0.2867D-01, 0.3469D-01, 0.4195D-01, 0.5071D-01, 0.6116D-01, & + & 0.7347D-01, 0.8757D-01, 0.1029D+00, 0.1183D+00, 0.1313D+00, & + & 0.1379D+00, 0.1337D+00, 0.1147D+00, 0.8008D-01, 0.3385D-01, & + & -.1646D-01, -.6275D-01, -.9949D-01, -.1242D+00, -.1368D+00, & + & -.1392D+00, -.1337D+00, -.1230D+00, -.1093D+00, -.9456D-01, & + & -.7998D-01, -.6642D-01, -.5441D-01, -.4396D-01, -.3518D-01, & + & -.2783D-01, -.2190D-01, -.1707D-01, -.1325D-01, -.1022D-01, & + & -.7808D-02, -.5954D-02, -.4542D-02, -.3445D-02, -.2604D-02, & + & -.1954D-02, -.1499D-02, -.1107D-02, -.8456D-03, -.5826D-03, & + & -.4518D-03, -.3202D-03, -.2547D-03, -.1888D-03, -.1227D-03, & + & -.1231D-03/ + + data (calcpts(j,13), j = 1,neta) /0.4062D-03, 0.5431D-03, & + & 0.6522D-03, 0.7622D-03, 0.9086D-03, 0.1126D-02, 0.1377D-02, & + & 0.1625D-02, 0.1977D-02, 0.2390D-02, 0.2910D-02, 0.3520D-02, & + & 0.4273D-02, 0.5104D-02, 0.6247D-02, 0.7524D-02, 0.9082D-02, & + & 0.1098D-01, 0.1327D-01, 0.1605D-01, 0.1941D-01, 0.2347D-01, & + & 0.2837D-01, 0.3432D-01, 0.4151D-01, 0.5015D-01, 0.6047D-01, & + & 0.7261D-01, 0.8651D-01, 0.1017D+00, 0.1168D+00, 0.1295D+00, & + & 0.1360D+00, 0.1318D+00, 0.1130D+00, 0.7871D-01, 0.3290D-01, & + & -.1700D-01, -.6298D-01, -.9950D-01, -.1241D+00, -.1367D+00, & + & -.1390D+00, -.1336D+00, -.1228D+00, -.1092D+00, -.9446D-01, & + & -.7991D-01, -.6638D-01, -.5436D-01, -.4389D-01, -.3511D-01, & + & -.2782D-01, -.2189D-01, -.1705D-01, -.1324D-01, -.1021D-01, & + & -.7855D-02, -.6000D-02, -.4521D-02, -.3424D-02, -.2582D-02, & + & -.1932D-02, -.1477D-02, -.1085D-02, -.8239D-03, -.6275D-03, & + & -.4300D-03, -.3650D-03, -.2329D-03, -.1670D-03, -.1009D-03, & + & -.1012D-03/ + + data (calcpts(j,14), j = 1,neta) /0.4179D-03, 0.5134D-03, & + & 0.5844D-03, 0.7266D-03, 0.9092D-03, 0.1101D-02, 0.1331D-02, & + & 0.1629D-02, 0.1970D-02, 0.2379D-02, 0.2833D-02, 0.3451D-02, & + & 0.4151D-02, 0.5069D-02, 0.6103D-02, 0.7411D-02, 0.8938D-02, & + & 0.1082D-01, 0.1308D-01, 0.1581D-01, 0.1912D-01, 0.2311D-01, & + & 0.2795D-01, 0.3380D-01, 0.4086D-01, 0.4935D-01, 0.5947D-01, & + & 0.7138D-01, 0.8499D-01, 0.9979D-01, 0.1146D+00, 0.1270D+00, & + & 0.1333D+00, 0.1290D+00, 0.1105D+00, 0.7672D-01, 0.3154D-01, & + & -.1778D-01, -.6329D-01, -.9952D-01, -.1239D+00, -.1364D+00, & + & -.1388D+00, -.1333D+00, -.1226D+00, -.1090D+00, -.9429D-01, & + & -.7975D-01, -.6632D-01, -.5426D-01, -.4385D-01, -.3505D-01, & + & -.2783D-01, -.2182D-01, -.1705D-01, -.1323D-01, -.1020D-01, & + & -.7844D-02, -.5988D-02, -.4575D-02, -.3478D-02, -.2569D-02, & + & -.1986D-02, -.1464D-02, -.1072D-02, -.8103D-03, -.6139D-03, & + & -.4831D-03, -.3514D-03, -.2192D-03, -.1533D-03, -.1539D-03, & + & -.8758D-04/ + + data (calcpts(j,15), j = 1,neta) /0.3832D-03, 0.5148D-03, & + & 0.6265D-03, 0.7480D-03, 0.9156D-03, 0.1099D-02, 0.1326D-02, & + & 0.1563D-02, 0.1918D-02, 0.2281D-02, 0.2765D-02, 0.3356D-02, & + & 0.4104D-02, 0.4945D-02, 0.5978D-02, 0.7226D-02, 0.8765D-02, & + & 0.1059D-01, 0.1280D-01, 0.1547D-01, 0.1871D-01, 0.2261D-01, & + & 0.2733D-01, 0.3305D-01, 0.3994D-01, 0.4821D-01, 0.5807D-01, & + & 0.6963D-01, 0.8283D-01, 0.9717D-01, 0.1114D+00, 0.1234D+00, & + & 0.1294D+00, 0.1251D+00, 0.1069D+00, 0.7389D-01, 0.2959D-01, & + & -.1888D-01, -.6375D-01, -.9952D-01, -.1236D+00, -.1361D+00, & + & -.1384D+00, -.1330D+00, -.1223D+00, -.1087D+00, -.9407D-01, & + & -.7959D-01, -.6617D-01, -.5415D-01, -.4378D-01, -.3503D-01, & + & -.2772D-01, -.2184D-01, -.1700D-01, -.1317D-01, -.1021D-01, & + & -.7786D-02, -.5996D-02, -.4515D-02, -.3418D-02, -.2575D-02, & + & -.1925D-02, -.1470D-02, -.1077D-02, -.8160D-03, -.6195D-03, & + & -.4219D-03, -.3569D-03, -.2247D-03, -.1588D-03, -.1594D-03, & + & -.9305D-04/ + + data (calcpts(j,16), j = 1,neta) /0.3814D-03, 0.4972D-03, & + & 0.5997D-03, 0.7195D-03, 0.8268D-03, 0.1025D-02, 0.1277D-02, & + & 0.1550D-02, 0.1884D-02, 0.2238D-02, 0.2726D-02, 0.3265D-02, & + & 0.3976D-02, 0.4791D-02, 0.5810D-02, 0.7055D-02, 0.8466D-02, & + & 0.1027D-01, 0.1241D-01, 0.1500D-01, 0.1813D-01, 0.2191D-01, & + & 0.2647D-01, 0.3199D-01, 0.3864D-01, 0.4661D-01, 0.5610D-01, & + & 0.6719D-01, 0.7983D-01, 0.9351D-01, 0.1071D+00, 0.1184D+00, & + & 0.1239D+00, 0.1197D+00, 0.1020D+00, 0.6990D-01, 0.2683D-01, & + & -.2045D-01, -.6437D-01, -.9952D-01, -.1233D+00, -.1355D+00, & + & -.1378D+00, -.1324D+00, -.1218D+00, -.1083D+00, -.9371D-01, & + & -.7932D-01, -.6596D-01, -.5402D-01, -.4368D-01, -.3491D-01, & + & -.2772D-01, -.2176D-01, -.1698D-01, -.1321D-01, -.1018D-01, & + & -.7819D-02, -.5961D-02, -.4545D-02, -.3447D-02, -.2604D-02, & + & -.1953D-02, -.1431D-02, -.1105D-02, -.8437D-03, -.5805D-03, & + & -.4495D-03, -.3178D-03, -.2523D-03, -.1863D-03, -.1202D-03, & + & -.1205D-03/ + + data (calcpts(j,17), j = 1,neta) /0.3666D-03, 0.4863D-03, & + & 0.5352D-03, 0.6784D-03, 0.8203D-03, 0.9984D-03, 0.1178D-02, & + & 0.1458D-02, 0.1748D-02, 0.2142D-02, 0.2619D-02, 0.3166D-02, & + & 0.3768D-02, 0.4559D-02, 0.5569D-02, 0.6687D-02, 0.8117D-02, & + & 0.9818D-02, 0.1186D-01, 0.1434D-01, 0.1733D-01, 0.2093D-01, & + & 0.2528D-01, 0.3053D-01, 0.3685D-01, 0.4441D-01, 0.5339D-01, & + & 0.6385D-01, 0.7572D-01, 0.8853D-01, 0.1012D+00, 0.1116D+00, & + & 0.1165D+00, 0.1122D+00, 0.9512D-01, 0.6438D-01, 0.2300D-01, & + & -.2262D-01, -.6522D-01, -.9947D-01, -.1227D+00, -.1347D+00, & + & -.1370D+00, -.1316D+00, -.1211D+00, -.1077D+00, -.9331D-01, & + & -.7897D-01, -.6564D-01, -.5376D-01, -.4350D-01, -.3483D-01, & + & -.2762D-01, -.2171D-01, -.1692D-01, -.1315D-01, -.1017D-01, & + & -.7809D-02, -.5949D-02, -.4532D-02, -.3432D-02, -.2588D-02, & + & -.1938D-02, -.1482D-02, -.1089D-02, -.8271D-03, -.6305D-03, & + & -.4328D-03, -.3010D-03, -.2354D-03, -.1695D-03, -.1033D-03, & + & -.1037D-03/ + + data (calcpts(j,18), j = 1,neta) /0.3296D-03, 0.4115D-03, & + & 0.5016D-03, 0.6332D-03, 0.7788D-03, 0.9104D-03, 0.1128D-02, & + & 0.1399D-02, 0.1634D-02, 0.1996D-02, 0.2463D-02, 0.2957D-02, & + & 0.3596D-02, 0.4314D-02, 0.5208D-02, 0.6295D-02, 0.7644D-02, & + & 0.9209D-02, 0.1113D-01, 0.1344D-01, 0.1625D-01, 0.1962D-01, & + & 0.2368D-01, 0.2858D-01, 0.3446D-01, 0.4148D-01, 0.4977D-01, & + & 0.5941D-01, 0.7029D-01, 0.8195D-01, 0.9335D-01, 0.1026D+00, & + & 0.1068D+00, 0.1023D+00, 0.8599D-01, 0.5694D-01, 0.1780D-01, & + & -.2557D-01, -.6633D-01, -.9933D-01, -.1218D+00, -.1335D+00, & + & -.1357D+00, -.1305D+00, -.1201D+00, -.1069D+00, -.9263D-01, & + & -.7842D-01, -.6529D-01, -.5351D-01, -.4325D-01, -.3460D-01, & + & -.2749D-01, -.2163D-01, -.1689D-01, -.1311D-01, -.1012D-01, & + & -.7758D-02, -.5895D-02, -.4542D-02, -.3441D-02, -.2596D-02, & + & -.1945D-02, -.1488D-02, -.1095D-02, -.8333D-03, -.6366D-03, & + & -.4388D-03, -.3069D-03, -.2413D-03, -.1753D-03, -.1091D-03, & + & -.1095D-03/ + + data (calcpts(j,19), j = 1,neta) /0.2951D-03, 0.3689D-03, & + & 0.4670D-03, 0.5583D-03, 0.6835D-03, 0.8831D-03, 0.1059D-02, & + & 0.1247D-02, 0.1494D-02, 0.1828D-02, 0.2232D-02, 0.2694D-02, & + & 0.3265D-02, 0.3947D-02, 0.4766D-02, 0.5738D-02, 0.6961D-02, & + & 0.8415D-02, 0.1017D-01, 0.1228D-01, 0.1484D-01, 0.1791D-01, & + & 0.2160D-01, 0.2605D-01, 0.3136D-01, 0.3769D-01, 0.4513D-01, & + & 0.5373D-01, 0.6336D-01, 0.7359D-01, 0.8345D-01, 0.9125D-01, & + & 0.9436D-01, 0.8964D-01, 0.7425D-01, 0.4728D-01, 0.1099D-01, & + & -.2944D-01, -.6772D-01, -.9898D-01, -.1205D+00, -.1318D+00, & + & -.1339D+00, -.1288D+00, -.1187D+00, -.1057D+00, -.9161D-01, & + & -.7767D-01, -.6468D-01, -.5304D-01, -.4296D-01, -.3438D-01, & + & -.2730D-01, -.2148D-01, -.1678D-01, -.1305D-01, -.1006D-01, & + & -.7689D-02, -.5888D-02, -.4466D-02, -.3430D-02, -.2584D-02, & + & -.1931D-02, -.1474D-02, -.1081D-02, -.8188D-03, -.6218D-03, & + & -.4239D-03, -.3586D-03, -.2263D-03, -.1602D-03, -.1607D-03, & + & -.9433D-04/ + + data (calcpts(j,20), j = 1,neta) /0.2649D-03, 0.3628D-03, & + & 0.4389D-03, 0.5311D-03, 0.6156D-03, 0.7351D-03, 0.9273D-03, & + & 0.1098D-02, 0.1360D-02, 0.1614D-02, 0.1975D-02, 0.2366D-02, & + & 0.2840D-02, 0.3463D-02, 0.4193D-02, 0.5110D-02, 0.6146D-02, & + & 0.7424D-02, 0.8974D-02, 0.1083D-01, 0.1308D-01, 0.1578D-01, & + & 0.1902D-01, 0.2290D-01, 0.2754D-01, 0.3302D-01, 0.3944D-01, & + & 0.4679D-01, 0.5495D-01, 0.6349D-01, 0.7155D-01, 0.7762D-01, & + & 0.7945D-01, 0.7436D-01, 0.5992D-01, 0.3533D-01, 0.2460D-02, & + & -.3427D-01, -.6935D-01, -.9831D-01, -.1185D+00, -.1292D+00, & + & -.1312D+00, -.1263D+00, -.1166D+00, -.1040D+00, -.9026D-01, & + & -.7664D-01, -.6388D-01, -.5242D-01, -.4250D-01, -.3404D-01, & + & -.2704D-01, -.2125D-01, -.1666D-01, -.1292D-01, -.9981D-02, & + & -.7669D-02, -.5863D-02, -.4437D-02, -.3399D-02, -.2551D-02, & + & -.1897D-02, -.1440D-02, -.1046D-02, -.7831D-03, -.5859D-03, & + & -.4545D-03, -.3224D-03, -.2566D-03, -.1906D-03, -.1243D-03, & + & -.1246D-03/ + + data (calcpts(j,21), j = 1,neta) /0.2746D-03, 0.2937D-03, & + & 0.3818D-03, 0.4467D-03, 0.5340D-03, 0.6221D-03, 0.7518D-03, & + & 0.9649D-03, 0.1110D-02, 0.1358D-02, 0.1692D-02, 0.2035D-02, & + & 0.2442D-02, 0.2911D-02, 0.3557D-02, 0.4292D-02, 0.5185D-02, & + & 0.6263D-02, 0.7562D-02, 0.9125D-02, 0.1101D-01, 0.1327D-01, & + & 0.1598D-01, 0.1921D-01, 0.2306D-01, 0.2759D-01, 0.3285D-01, & + & 0.3881D-01, 0.4535D-01, 0.5204D-01, 0.5812D-01, 0.6231D-01, & + & 0.6271D-01, 0.5712D-01, 0.4360D-01, 0.2153D-01, -.7528D-02, & + & -.3993D-01, -.7107D-01, -.9708D-01, -.1155D+00, -.1254D+00, & + & -.1274D+00, -.1229D+00, -.1137D+00, -.1016D+00, -.8842D-01, & + & -.7514D-01, -.6277D-01, -.5157D-01, -.4185D-01, -.3357D-01, & + & -.2671D-01, -.2101D-01, -.1646D-01, -.1276D-01, -.9880D-02, & + & -.7626D-02, -.5813D-02, -.4450D-02, -.3342D-02, -.2559D-02, & + & -.1904D-02, -.1445D-02, -.1051D-02, -.7878D-03, -.5903D-03, & + & -.4587D-03, -.3265D-03, -.2606D-03, -.1945D-03, -.1282D-03, & + & -.1284D-03/ + + data (calcpts(j,22), j = 1,neta) /0.2248D-03, 0.2547D-03, & + & 0.3143D-03, 0.3815D-03, 0.4381D-03, 0.5321D-03, 0.6410D-03, & + & 0.7432D-03, 0.8898D-03, 0.1121D-02, 0.1291D-02, 0.1588D-02, & + & 0.1936D-02, 0.2333D-02, 0.2822D-02, 0.3406D-02, 0.4113D-02, & + & 0.4971D-02, 0.5996D-02, 0.7237D-02, 0.8724D-02, 0.1050D-01, & + & 0.1263D-01, 0.1517D-01, 0.1817D-01, 0.2168D-01, 0.2572D-01, & + & 0.3025D-01, 0.3511D-01, 0.3993D-01, 0.4403D-01, 0.4633D-01, & + & 0.4529D-01, 0.3915D-01, 0.2645D-01, 0.6839D-02, -.1830D-01, & + & -.4602D-01, -.7264D-01, -.9510D-01, -.1113D+00, -.1203D+00, & + & -.1222D+00, -.1182D+00, -.1097D+00, -.9839D-01, -.8586D-01, & + & -.7318D-01, -.6123D-01, -.5042D-01, -.4101D-01, -.3296D-01, & + & -.2623D-01, -.2068D-01, -.1623D-01, -.1258D-01, -.9749D-02, & + & -.7485D-02, -.5732D-02, -.4364D-02, -.3319D-02, -.2534D-02, & + & -.1877D-02, -.1418D-02, -.1089D-02, -.8255D-03, -.6277D-03, & + & -.4292D-03, -.2969D-03, -.2309D-03, -.1647D-03, -.1650D-03, & + & -.9859D-04/ + + data (calcpts(j,23), j = 1,neta) /0.1575D-03, 0.1414D-03, & + & 0.1837D-03, 0.2659D-03, 0.3061D-03, 0.3553D-03, 0.4615D-03, & + & 0.5397D-03, 0.6435D-03, 0.7975D-03, 0.9631D-03, 0.1172D-02, & + & 0.1414D-02, 0.1714D-02, 0.2071D-02, 0.2500D-02, 0.3019D-02, & + & 0.3651D-02, 0.4404D-02, 0.5304D-02, 0.6396D-02, 0.7693D-02, & + & 0.9237D-02, 0.1107D-01, 0.1323D-01, 0.1573D-01, 0.1859D-01, & + & 0.2172D-01, 0.2499D-01, 0.2807D-01, 0.3035D-01, 0.3096D-01, & + & 0.2865D-01, 0.2205D-01, 0.1012D-01, -.7229D-02, -.2869D-01, & + & -.5179D-01, -.7370D-01, -.9219D-01, -.1057D+00, -.1135D+00, & + & -.1154D+00, -.1120D+00, -.1044D+00, -.9415D-01, -.8249D-01, & + & -.7063D-01, -.5927D-01, -.4896D-01, -.3987D-01, -.3211D-01, & + & -.2564D-01, -.2024D-01, -.1589D-01, -.1234D-01, -.9563D-02, & + & -.7355D-02, -.5661D-02, -.4288D-02, -.3306D-02, -.2452D-02, & + & -.1861D-02, -.1400D-02, -.1070D-02, -.8064D-03, -.6082D-03, & + & -.4095D-03, -.3437D-03, -.2109D-03, -.1447D-03, -.1449D-03, & + & -.7844D-04/ + + data (calcpts(j,24), j = 1,neta) /0.9565D-04, 0.1144D-03, & + & 0.1394D-03, 0.1691D-03, 0.2046D-03, 0.2465D-03, 0.2996D-03, & + & 0.3624D-03, 0.4374D-03, 0.5335D-03, 0.6405D-03, 0.7778D-03, & + & 0.9370D-03, 0.1136D-02, 0.1376D-02, 0.1657D-02, 0.2002D-02, & + & 0.2416D-02, 0.2906D-02, 0.3499D-02, 0.4216D-02, 0.5063D-02, & + & 0.6065D-02, 0.7252D-02, 0.8636D-02, 0.1023D-01, 0.1200D-01, & + & 0.1390D-01, 0.1578D-01, 0.1735D-01, 0.1812D-01, 0.1736D-01, & + & 0.1409D-01, 0.7257D-02, -.3859D-02, -.1916D-01, -.3737D-01, & + & -.5634D-01, -.7382D-01, -.8828D-01, -.9890D-01, -.1052D+00, & + & -.1070D+00, -.1043D+00, -.9787D-01, -.8882D-01, -.7832D-01, & + & -.6740D-01, -.5686D-01, -.4712D-01, -.3854D-01, -.3114D-01, & + & -.2486D-01, -.1968D-01, -.1550D-01, -.1206D-01, -.9400D-02, & + & -.7247D-02, -.5546D-02, -.4235D-02, -.3250D-02, -.2460D-02, & + & -.1867D-02, -.1405D-02, -.1008D-02, -.8105D-03, -.6120D-03, & + & -.4130D-03, -.3470D-03, -.2141D-03, -.1478D-03, -.1480D-03, & + & -.8150D-04/ + + data (calcpts(j,25), j = 1,neta) /0.4989D-04, 0.6372D-04, & + & 0.7586D-04, 0.9470D-04, 0.1172D-03, 0.1402D-03, 0.1717D-03, & + & 0.2067D-03, 0.2498D-03, 0.3003D-03, 0.3632D-03, 0.4391D-03, & + & 0.5342D-03, 0.6391D-03, 0.7736D-03, 0.9330D-03, 0.1122D-02, & + & 0.1355D-02, 0.1626D-02, 0.1957D-02, 0.2347D-02, 0.2812D-02, & + & 0.3356D-02, 0.3994D-02, 0.4725D-02, 0.5546D-02, 0.6430D-02, & + & 0.7312D-02, 0.8061D-02, 0.8431D-02, 0.8039D-02, 0.6292D-02, & + & 0.2426D-02, -.4343D-02, -.1454D-01, -.2794D-01, -.4336D-01, & + & -.5888D-01, -.7259D-01, -.8343D-01, -.9112D-01, -.9571D-01, & + & -.9709D-01, -.9512D-01, -.9001D-01, -.8241D-01, -.7327D-01, & + & -.6351D-01, -.5389D-01, -.4489D-01, -.3690D-01, -.2994D-01, & + & -.2399D-01, -.1903D-01, -.1502D-01, -.1176D-01, -.9151D-02, & + & -.7055D-02, -.5414D-02, -.4165D-02, -.3177D-02, -.2385D-02, & + & -.1790D-02, -.1394D-02, -.9966D-03, -.7984D-03, -.5996D-03, & + & -.4004D-03, -.3342D-03, -.2013D-03, -.2015D-03, -.1350D-03, & + & -.6850D-04/ + + data (calcpts(j,26), j = 1,neta) /0.1907D-04, 0.1918D-04, & + & 0.2593D-04, 0.3718D-04, 0.4555D-04, 0.5013D-04, 0.6176D-04, & + & 0.7818D-04, 0.9929D-04, 0.1208D-03, 0.1428D-03, 0.1736D-03, & + & 0.2073D-03, 0.2545D-03, 0.3059D-03, 0.3685D-03, 0.4413D-03, & + & 0.5237D-03, 0.6323D-03, 0.7488D-03, 0.8974D-03, 0.1060D-02, & + & 0.1249D-02, 0.1461D-02, 0.1691D-02, 0.1922D-02, 0.2125D-02, & + & 0.2235D-02, 0.2139D-02, 0.1643D-02, 0.4357D-03, -.1939D-02, & + & -.6063D-02, -.1252D-01, -.2168D-01, -.3329D-01, -.4632D-01, & + & -.5906D-01, -.6983D-01, -.7774D-01, -.8286D-01, -.8565D-01, & + & -.8639D-01, -.8491D-01, -.8106D-01, -.7502D-01, -.6742D-01, & + & -.5900D-01, -.5047D-01, -.4236D-01, -.3498D-01, -.2847D-01, & + & -.2293D-01, -.1833D-01, -.1449D-01, -.1135D-01, -.8859D-02, & + & -.6821D-02, -.5307D-02, -.4054D-02, -.3063D-02, -.2336D-02, & + & -.1740D-02, -.1343D-02, -.1012D-02, -.7464D-03, -.5473D-03, & + & -.4146D-03, -.2817D-03, -.2153D-03, -.1489D-03, -.1490D-03, & + & -.8244D-04/ + + data (calcpts(j,27), j = 1,neta) /0.2006D-05, 0.2856D-05, & + & 0.1167D-05, 0.3743D-05, 0.5087D-05, -.4811D-06, 0.1882D-06, & + & 0.3604D-06, 0.1543D-05, -.4601D-05, -.3152D-05, -.4930D-05, & + & -.8063D-05, -.1520D-04, -.1737D-04, -.2860D-04, -.4090D-04, & + & -.5485D-04, -.6813D-04, -.9724D-04, -.1257D-03, -.1702D-03, & + & -.2322D-03, -.3168D-03, -.4380D-03, -.6165D-03, -.8839D-03, & + & -.1301D-02, -.1962D-02, -.3024D-02, -.4730D-02, -.7424D-02, & + & -.1154D-01, -.1752D-01, -.2560D-01, -.3554D-01, -.4649D-01, & + & -.5701D-01, -.6561D-01, -.7144D-01, -.7456D-01, -.7573D-01, & + & -.7560D-01, -.7426D-01, -.7142D-01, -.6691D-01, -.6092D-01, & + & -.5396D-01, -.4665D-01, -.3949D-01, -.3285D-01, -.2693D-01, & + & -.2181D-01, -.1747D-01, -.1388D-01, -.1092D-01, -.8556D-02, & + & -.6645D-02, -.5126D-02, -.3936D-02, -.3010D-02, -.2281D-02, & + & -.1751D-02, -.1286D-02, -.1021D-02, -.7556D-03, -.5563D-03, & + & -.4235D-03, -.2904D-03, -.2240D-03, -.1575D-03, -.1576D-03, & + & -.9097D-04/ + + data (calcpts(j,28), j = 1,neta) /-.1237D-04, -.1446D-04, & + & -.1884D-04, -.2362D-04, -.3282D-04, -.3729D-04, -.4875D-04, & + & -.5886D-04, -.7149D-04, -.8621D-04, -.1070D-03, -.1237D-03, & + & -.1536D-03, -.1859D-03, -.2326D-03, -.2819D-03, -.3422D-03, & + & -.4187D-03, -.5150D-03, -.6270D-03, -.7669D-03, -.9413D-03, & + & -.1158D-02, -.1426D-02, -.1763D-02, -.2192D-02, -.2745D-02, & + & -.3476D-02, -.4466D-02, -.5839D-02, -.7781D-02, -.1055D-01, & + & -.1448D-01, -.1986D-01, -.2687D-01, -.3531D-01, -.4447D-01, & + & -.5320D-01, -.6021D-01, -.6468D-01, -.6654D-01, -.6648D-01, & + & -.6542D-01, -.6384D-01, -.6161D-01, -.5836D-01, -.5391D-01, & + & -.4846D-01, -.4244D-01, -.3633D-01, -.3050D-01, -.2519D-01, & + & -.2053D-01, -.1653D-01, -.1318D-01, -.1042D-01, -.8179D-02, & + & -.6375D-02, -.4933D-02, -.3800D-02, -.2919D-02, -.2222D-02, & + & -.1691D-02, -.1279D-02, -.9605D-03, -.7213D-03, -.5418D-03, & + & -.4088D-03, -.3024D-03, -.2292D-03, -.1693D-03, -.1227D-03, & + & -.9611D-04/ + + data (calcpts(j,29), j = 1,neta) /-.2297D-04, -.2752D-04, & + & -.3754D-04, -.4311D-04, -.5382D-04, -.5937D-04, -.7678D-04, & + & -.8971D-04, -.1077D-03, -.1287D-03, -.1558D-03, -.1915D-03, & + & -.2322D-03, -.2801D-03, -.3415D-03, -.4181D-03, -.5071D-03, & + & -.6130D-03, -.7460D-03, -.9078D-03, -.1104D-02, -.1346D-02, & + & -.1642D-02, -.2004D-02, -.2451D-02, -.3006D-02, -.3698D-02, & + & -.4577D-02, -.5709D-02, -.7193D-02, -.9172D-02, -.1184D-01, & + & -.1544D-01, -.2018D-01, -.2618D-01, -.3327D-01, -.4091D-01, & + & -.4818D-01, -.5404D-01, -.5768D-01, -.5890D-01, -.5817D-01, & + & -.5640D-01, -.5434D-01, -.5225D-01, -.4982D-01, -.4667D-01, & + & -.4265D-01, -.3795D-01, -.3293D-01, -.2797D-01, -.2331D-01, & + & -.1914D-01, -.1551D-01, -.1244D-01, -.9882D-02, -.7787D-02, & + & -.6085D-02, -.4727D-02, -.3652D-02, -.2803D-02, -.2145D-02, & + & -.1627D-02, -.1235D-02, -.9289D-03, -.6028D-03, -.5232D-03, & + & -.3901D-03, -.2903D-03, -.2171D-03, -.1572D-03, -.1172D-03, & + & -.8393D-04/ + + data (calcpts(j,30), j = 1,neta) /-.2720D-04, -.2861D-04, & + & -.3471D-04, -.4794D-04, -.5707D-04, -.6429D-04, -.7893D-04, & + & -.9699D-04, -.1206D-03, -.1465D-03, -.1769D-03, -.2139D-03, & + & -.2600D-03, -.3148D-03, -.3814D-03, -.4633D-03, -.5624D-03, & + & -.6828D-03, -.8292D-03, -.1008D-02, -.1224D-02, -.1489D-02, & + & -.1811D-02, -.2204D-02, -.2684D-02, -.3275D-02, -.4004D-02, & + & -.4911D-02, -.6053D-02, -.7509D-02, -.9389D-02, -.1184D-01, & + & -.1503D-01, -.1911D-01, -.2418D-01, -.3008D-01, -.3642D-01, & + & -.4249D-01, -.4745D-01, -.5062D-01, -.5165D-01, -.5077D-01, & + & -.4867D-01, -.4620D-01, -.4390D-01, -.4181D-01, -.3953D-01, & + & -.3672D-01, -.3327D-01, -.2936D-01, -.2529D-01, -.2133D-01, & + & -.1768D-01, -.1444D-01, -.1165D-01, -.9313D-02, -.7372D-02, & + & -.5788D-02, -.4514D-02, -.3498D-02, -.2694D-02, -.2069D-02, & + & -.1577D-02, -.1198D-02, -.9051D-03, -.6122D-03, -.5125D-03, & + & -.3860D-03, -.2861D-03, -.2129D-03, -.1596D-03, -.1197D-03, & + & -.8635D-04/ + + data (calcpts(j,31), j = 1,neta) /-.2258D-04, -.3019D-04, & + & -.3714D-04, -.4516D-04, -.5510D-04, -.6652D-04, -.8066D-04, & + & -.9812D-04, -.1185D-03, -.1435D-03, -.1744D-03, -.2112D-03, & + & -.2566D-03, -.3107D-03, -.3767D-03, -.4573D-03, -.5548D-03, & + & -.6731D-03, -.8174D-03, -.9925D-03, -.1204D-02, -.1462D-02, & + & -.1777D-02, -.2159D-02, -.2625D-02, -.3194D-02, -.3891D-02, & + & -.4753D-02, -.5822D-02, -.7163D-02, -.8859D-02, -.1102D-01, & + & -.1377D-01, -.1723D-01, -.2144D-01, -.2631D-01, -.3153D-01, & + & -.3657D-01, -.4081D-01, -.4365D-01, -.4473D-01, -.4408D-01, & + & -.4210D-01, -.3948D-01, -.3692D-01, -.3476D-01, -.3289D-01, & + & -.3091D-01, -.2852D-01, -.2566D-01, -.2249D-01, -.1924D-01, & + & -.1614D-01, -.1332D-01, -.1083D-01, -.8710D-02, -.6933D-02, & + & -.5472D-02, -.4283D-02, -.3333D-02, -.2582D-02, -.1983D-02, & + & -.1517D-02, -.1158D-02, -.8784D-03, -.6120D-03, -.4989D-03, & + & -.3724D-03, -.2791D-03, -.2059D-03, -.1526D-03, -.1126D-03, & + & -.8596D-04/ + + data (calcpts(j,32), j = 1,neta) /-.2433D-04, -.2931D-04, & + & -.3516D-04, -.4244D-04, -.5156D-04, -.6163D-04, -.7470D-04, & + & -.9082D-04, -.1098D-03, -.1328D-03, -.1611D-03, -.1946D-03, & + & -.2361D-03, -.2861D-03, -.3465D-03, -.4206D-03, -.5098D-03, & + & -.6182D-03, -.7499D-03, -.9101D-03, -.1103D-02, -.1340D-02, & + & -.1626D-02, -.1974D-02, -.2397D-02, -.2912D-02, -.3542D-02, & + & -.4314D-02, -.5266D-02, -.6446D-02, -.7921D-02, -.9772D-02, & + & -.1209D-01, -.1496D-01, -.1841D-01, -.2238D-01, -.2663D-01, & + & -.3079D-01, -.3438D-01, -.3695D-01, -.3815D-01, -.3789D-01, & + & -.3633D-01, -.3394D-01, -.3131D-01, -.2897D-01, -.2711D-01, & + & -.2553D-01, -.2389D-01, -.2192D-01, -.1961D-01, -.1709D-01, & + & -.1455D-01, -.1214D-01, -.9967D-02, -.8077D-02, -.6471D-02, & + & -.5135D-02, -.4045D-02, -.3161D-02, -.2449D-02, -.1896D-02, & + & -.1457D-02, -.1111D-02, -.8444D-03, -.6046D-03, -.4781D-03, & + & -.3582D-03, -.2716D-03, -.1983D-03, -.1450D-03, -.1117D-03, & + & -.7837D-04/ + + data (calcpts(j,33), j = 1,neta) /-.1992D-04, -.2417D-04, & + & -.2929D-04, -.3614D-04, -.4347D-04, -.5343D-04, -.6432D-04, & + & -.7849D-04, -.9477D-04, -.1151D-03, -.1399D-03, -.1700D-03, & + & -.2059D-03, -.2498D-03, -.3031D-03, -.3675D-03, -.4459D-03, & + & -.5409D-03, -.6558D-03, -.7954D-03, -.9646D-03, -.1171D-02, & + & -.1420D-02, -.1723D-02, -.2091D-02, -.2539D-02, -.3083D-02, & + & -.3749D-02, -.4566D-02, -.5572D-02, -.6817D-02, -.8362D-02, & + & -.1027D-01, -.1262D-01, -.1541D-01, -.1860D-01, -.2204D-01, & + & -.2544D-01, -.2845D-01, -.3073D-01, -.3201D-01, -.3213D-01, & + & -.3112D-01, -.2920D-01, -.2681D-01, -.2443D-01, -.2244D-01, & + & -.2090D-01, -.1963D-01, -.1830D-01, -.1671D-01, -.1488D-01, & + & -.1290D-01, -.1093D-01, -.9078D-02, -.7432D-02, -.6003D-02, & + & -.4793D-02, -.3795D-02, -.2984D-02, -.2325D-02, -.1805D-02, & + & -.1393D-02, -.1066D-02, -.8131D-03, -.5933D-03, -.4667D-03, & + & -.3535D-03, -.2668D-03, -.2002D-03, -.1469D-03, -.1136D-03, & + & -.8026D-04/ + + data (calcpts(j,34), j = 1,neta) /-.1712D-04, -.2071D-04, & + & -.2527D-04, -.3077D-04, -.3773D-04, -.4540D-04, -.5514D-04, & + & -.6700D-04, -.8094D-04, -.9790D-04, -.1186D-03, -.1438D-03, & + & -.1749D-03, -.2115D-03, -.2566D-03, -.3113D-03, -.3772D-03, & + & -.4571D-03, -.5546D-03, -.6724D-03, -.8150D-03, -.9890D-03, & + & -.1199D-02, -.1454D-02, -.1765D-02, -.2141D-02, -.2598D-02, & + & -.3156D-02, -.3838D-02, -.4672D-02, -.5699D-02, -.6963D-02, & + & -.8515D-02, -.1040D-01, -.1263D-01, -.1518D-01, -.1792D-01, & + & -.2066D-01, -.2314D-01, -.2513D-01, -.2639D-01, -.2679D-01, & + & -.2629D-01, -.2496D-01, -.2303D-01, -.2086D-01, -.1882D-01, & + & -.1719D-01, -.1597D-01, -.1496D-01, -.1390D-01, -.1265D-01, & + & -.1121D-01, -.9674D-02, -.8164D-02, -.6756D-02, -.5513D-02, & + & -.4435D-02, -.3537D-02, -.2791D-02, -.2192D-02, -.1706D-02, & + & -.1319D-02, -.1013D-02, -.7732D-03, -.5733D-03, -.4467D-03, & + & -.3401D-03, -.2535D-03, -.1935D-03, -.1402D-03, -.1068D-03, & + & -.8018D-04/ + + data (calcpts(j,35), j = 1,neta) /-.1442D-04, -.1761D-04, & + & -.2114D-04, -.2543D-04, -.3088D-04, -.3788D-04, -.4561D-04, & + & -.5524D-04, -.6656D-04, -.8093D-04, -.9821D-04, -.1189D-03, & + & -.1444D-03, -.1747D-03, -.2120D-03, -.2566D-03, -.3108D-03, & + & -.3768D-03, -.4572D-03, -.5540D-03, -.6717D-03, -.8145D-03, & + & -.9876D-03, -.1197D-02, -.1452D-02, -.1761D-02, -.2136D-02, & + & -.2592D-02, -.3149D-02, -.3828D-02, -.4659D-02, -.5676D-02, & + & -.6916D-02, -.8412D-02, -.1018D-01, -.1218D-01, -.1435D-01, & + & -.1653D-01, -.1855D-01, -.2023D-01, -.2142D-01, -.2198D-01, & + & -.2186D-01, -.2106D-01, -.1968D-01, -.1791D-01, -.1604D-01, & + & -.1436D-01, -.1306D-01, -.1210D-01, -.1132D-01, -.1049D-01, & + & -.9515D-02, -.8398D-02, -.7220D-02, -.6068D-02, -.5007D-02, & + & -.4069D-02, -.3270D-02, -.2598D-02, -.2052D-02, -.1605D-02, & + & -.1246D-02, -.9591D-03, -.7326D-03, -.5526D-03, -.4260D-03, & + & -.3261D-03, -.2461D-03, -.1861D-03, -.1395D-03, -.1061D-03, & + & -.7946D-04/ + + data (calcpts(j,36), j = 1,neta) /-.1137D-04, -.1382D-04, & + & -.1702D-04, -.2062D-04, -.2489D-04, -.3011D-04, -.3664D-04, & + & -.4486D-04, -.5375D-04, -.6514D-04, -.7944D-04, -.9638D-04, & + & -.1165D-03, -.1415D-03, -.1711D-03, -.2073D-03, -.2513D-03, & + & -.3046D-03, -.3692D-03, -.4476D-03, -.5425D-03, -.6577D-03, & + & -.7973D-03, -.9666D-03, -.1172D-02, -.1421D-02, -.1723D-02, & + & -.2090D-02, -.2536D-02, -.3079D-02, -.3741D-02, -.4548D-02, & + & -.5527D-02, -.6701D-02, -.8081D-02, -.9647D-02, -.1134D-01, & + & -.1306D-01, -.1468D-01, -.1608D-01, -.1713D-01, -.1775D-01, & + & -.1788D-01, -.1748D-01, -.1660D-01, -.1530D-01, -.1377D-01, & + & -.1222D-01, -.1087D-01, -.9851D-02, -.9116D-02, -.8513D-02, & + & -.7875D-02, -.7120D-02, -.6263D-02, -.5366D-02, -.4494D-02, & + & -.3697D-02, -.2997D-02, -.2401D-02, -.1913D-02, -.1499D-02, & + & -.1166D-02, -.9065D-03, -.6999D-03, -.5266D-03, -.4067D-03, & + & -.3067D-03, -.2334D-03, -.1734D-03, -.1334D-03, -.1001D-03, & + & -.7340D-04/ + + data (calcpts(j,37), j = 1,neta) /-.9350D-05, -.1113D-04, & + & -.1370D-04, -.1661D-04, -.2005D-04, -.2421D-04, -.2924D-04, & + & -.3544D-04, -.4294D-04, -.5203D-04, -.6306D-04, -.7640D-04, & + & -.9263D-04, -.1122D-03, -.1360D-03, -.1649D-03, -.1998D-03, & + & -.2422D-03, -.2935D-03, -.3558D-03, -.4312D-03, -.5227D-03, & + & -.6336D-03, -.7680D-03, -.9309D-03, -.1128D-02, -.1368D-02, & + & -.1658D-02, -.2011D-02, -.2439D-02, -.2961D-02, -.3593D-02, & + & -.4358D-02, -.5271D-02, -.6341D-02, -.7553D-02, -.8865D-02, & + & -.1021D-01, -.1149D-01, -.1263D-01, -.1353D-01, -.1413D-01, & + & -.1439D-01, -.1427D-01, -.1377D-01, -.1291D-01, -.1178D-01, & + & -.1050D-01, -.9244D-02, -.8180D-02, -.7389D-02, -.6829D-02, & + & -.6369D-02, -.5881D-02, -.5303D-02, -.4651D-02, -.3971D-02, & + & -.3316D-02, -.2720D-02, -.2199D-02, -.1758D-02, -.1392D-02, & + & -.1095D-02, -.8512D-03, -.6606D-03, -.5066D-03, -.3886D-03, & + & -.2953D-03, -.2240D-03, -.1693D-03, -.1273D-03, -.9535D-04, & + & -.7135D-04/ + + data (calcpts(j,38), j = 1,neta) /-.7323D-05, -.8879D-05, & + & -.1071D-04, -.1298D-04, -.1574D-04, -.1902D-04, -.2306D-04, & + & -.2791D-04, -.3375D-04, -.4091D-04, -.4954D-04, -.6005D-04, & + & -.7274D-04, -.8814D-04, -.1067D-03, -.1294D-03, -.1568D-03, & + & -.1900D-03, -.2303D-03, -.2792D-03, -.3383D-03, -.4100D-03, & + & -.4970D-03, -.6023D-03, -.7300D-03, -.8847D-03, -.1072D-02, & + & -.1299D-02, -.1575D-02, -.1909D-02, -.2315D-02, -.2806D-02, & + & -.3397D-02, -.4101D-02, -.4924D-02, -.5855D-02, -.6865D-02, & + & -.7905D-02, -.8912D-02, -.9819D-02, -.1057D-01, -.1111D-01, & + & -.1141D-01, -.1146D-01, -.1122D-01, -.1071D-01, -.9941D-02, & + & -.8985D-02, -.7943D-02, -.6946D-02, -.6119D-02, -.5514D-02, & + & -.5091D-02, -.4743D-02, -.4372D-02, -.3933D-02, -.3439D-02, & + & -.2928D-02, -.2438D-02, -.1994D-02, -.1609D-02, -.1283D-02, & + & -.1016D-02, -.7942D-03, -.6176D-03, -.4770D-03, -.3677D-03, & + & -.2804D-03, -.2130D-03, -.1610D-03, -.1217D-03, -.9104D-04, & + & -.6771D-04/ + + data (calcpts(j,39), j = 1,neta) /-.5564D-05, -.6759D-05, & + & -.8192D-05, -.9970D-05, -.1212D-04, -.1469D-04, -.1779D-04, & + & -.2157D-04, -.2609D-04, -.3166D-04, -.3838D-04, -.4656D-04, & + & -.5639D-04, -.6835D-04, -.8283D-04, -.1004D-03, -.1217D-03, & + & -.1475D-03, -.1787D-03, -.2167D-03, -.2625D-03, -.3182D-03, & + & -.3856D-03, -.4674D-03, -.5663D-03, -.6863D-03, -.8314D-03, & + & -.1007D-02, -.1221D-02, -.1479D-02, -.1792D-02, -.2170D-02, & + & -.2623D-02, -.3162D-02, -.3790D-02, -.4501D-02, -.5273D-02, & + & -.6072D-02, -.6852D-02, -.7568D-02, -.8177D-02, -.8646D-02, & + & -.8952D-02, -.9074D-02, -.9000D-02, -.8723D-02, -.8246D-02, & + & -.7592D-02, -.6807D-02, -.5974D-02, -.5194D-02, -.4557D-02, & + & -.4098D-02, -.3780D-02, -.3519D-02, -.3239D-02, -.2907D-02, & + & -.2535D-02, -.2153D-02, -.1788D-02, -.1457D-02, -.1175D-02, & + & -.9354D-03, -.7381D-03, -.5775D-03, -.4488D-03, -.3468D-03, & + & -.2662D-03, -.2035D-03, -.1549D-03, -.1169D-03, -.8820D-04, & + & -.6620D-04/ + + data (calcpts(j,40), j = 1,neta) /-.4321D-05, -.5241D-05, & + & -.6319D-05, -.7696D-05, -.9306D-05, -.1129D-04, -.1367D-04, & + & -.1662D-04, -.2009D-04, -.2435D-04, -.2952D-04, -.3579D-04, & + & -.4337D-04, -.5257D-04, -.6371D-04, -.7722D-04, -.9360D-04, & + & -.1134D-03, -.1374D-03, -.1666D-03, -.2019D-03, -.2446D-03, & + & -.2965D-03, -.3593D-03, -.4353D-03, -.5274D-03, -.6389D-03, & + & -.7739D-03, -.9375D-03, -.1135D-02, -.1374D-02, -.1663D-02, & + & -.2009D-02, -.2418D-02, -.2895D-02, -.3434D-02, -.4020D-02, & + & -.4630D-02, -.5230D-02, -.5788D-02, -.6274D-02, -.6666D-02, & + & -.6944D-02, -.7097D-02, -.7115D-02, -.6989D-02, -.6715D-02, & + & -.6298D-02, -.5755D-02, -.5125D-02, -.4469D-02, -.3865D-02, & + & -.3379D-02, -.3033D-02, -.2795D-02, -.2600D-02, -.2389D-02, & + & -.2140D-02, -.1862D-02, -.1578D-02, -.1307D-02, -.1065D-02, & + & -.8552D-03, -.6799D-03, -.5353D-03, -.4180D-03, -.3246D-03, & + & -.2506D-03, -.1920D-03, -.1466D-03, -.1113D-03, -.8399D-04, & + & -.6332D-04/ + + data (calcpts(j,41), j = 1,neta) /-.3334D-05, -.4055D-05, & + & -.4852D-05, -.5910D-05, -.7143D-05, -.8672D-05, -.1049D-04, & + & -.1268D-04, -.1537D-04, -.1864D-04, -.2260D-04, -.2733D-04, & + & -.3314D-04, -.4016D-04, -.4862D-04, -.5896D-04, -.7144D-04, & + & -.8655D-04, -.1049D-03, -.1271D-03, -.1540D-03, -.1866D-03, & + & -.2261D-03, -.2740D-03, -.3319D-03, -.4022D-03, -.4871D-03, & + & -.5900D-03, -.7145D-03, -.8649D-03, -.1047D-02, -.1265D-02, & + & -.1527D-02, -.1837D-02, -.2196D-02, -.2603D-02, -.3046D-02, & + & -.3508D-02, -.3966D-02, -.4397D-02, -.4780D-02, -.5098D-02, & + & -.5339D-02, -.5494D-02, -.5555D-02, -.5518D-02, -.5376D-02, & + & -.5128D-02, -.4777D-02, -.4337D-02, -.3838D-02, -.3328D-02, & + & -.2864D-02, -.2496D-02, -.2236D-02, -.2060D-02, -.1915D-02, & + & -.1757D-02, -.1571D-02, -.1364D-02, -.1157D-02, -.9529D-03, & + & -.7742D-03, -.6209D-03, -.4923D-03, -.3869D-03, -.3023D-03, & + & -.2343D-03, -.1803D-03, -.1383D-03, -.1050D-03, -.7963D-04, & + & -.6029D-04/ + + data (calcpts(j,42), j = 1,neta) /-.2479D-05, -.3065D-05, & + & -.3689D-05, -.4454D-05, -.5396D-05, -.6551D-05, -.7966D-05, & + & -.9624D-05, -.1164D-04, -.1409D-04, -.1709D-04, -.2071D-04, & + & -.2511D-04, -.3044D-04, -.3685D-04, -.4467D-04, -.5412D-04, & + & -.6560D-04, -.7945D-04, -.9630D-04, -.1166D-03, -.1413D-03, & + & -.1713D-03, -.2076D-03, -.2514D-03, -.3046D-03, -.3689D-03, & + & -.4468D-03, -.5409D-03, -.6546D-03, -.7917D-03, -.9566D-03, & + & -.1154D-02, -.1386D-02, -.1657D-02, -.1962D-02, -.2295D-02, & + & -.2644D-02, -.2991D-02, -.3321D-02, -.3618D-02, -.3872D-02, & + & -.4073D-02, -.4215D-02, -.4293D-02, -.4303D-02, -.4241D-02, & + & -.4104D-02, -.3890D-02, -.3602D-02, -.3251D-02, -.2861D-02, & + & -.2468D-02, -.2115D-02, -.1837D-02, -.1644D-02, -.1513D-02, & + & -.1406D-02, -.1289D-02, -.1150D-02, -.9963D-03, -.8400D-03, & + & -.6934D-03, -.5621D-03, -.4501D-03, -.3568D-03, -.2801D-03, & + & -.2181D-03, -.1688D-03, -.1301D-03, -.9944D-04, -.7544D-04, & + & -.5744D-04/ + + data (calcpts(j,43), j = 1,neta) /-.1859D-05, -.2269D-05, & + & -.2779D-05, -.3347D-05, -.4064D-05, -.4958D-05, -.5995D-05, & + & -.7236D-05, -.8771D-05, -.1062D-04, -.1288D-04, -.1560D-04, & + & -.1890D-04, -.2290D-04, -.2775D-04, -.3363D-04, -.4075D-04, & + & -.4937D-04, -.5983D-04, -.7250D-04, -.8785D-04, -.1064D-03, & + & -.1290D-03, -.1563D-03, -.1893D-03, -.2293D-03, -.2777D-03, & + & -.3363D-03, -.4070D-03, -.4925D-03, -.5955D-03, -.7191D-03, & + & -.8667D-03, -.1041D-02, -.1243D-02, -.1471D-02, -.1720D-02, & + & -.1982D-02, -.2244D-02, -.2495D-02, -.2724D-02, -.2923D-02, & + & -.3086D-02, -.3209D-02, -.3288D-02, -.3321D-02, -.3304D-02, & + & -.3235D-02, -.3111D-02, -.2932D-02, -.2702D-02, -.2426D-02, & + & -.2125D-02, -.1824D-02, -.1557D-02, -.1349D-02, -.1205D-02, & + & -.1109D-02, -.1029D-02, -.9423D-03, -.8397D-03, -.7260D-03, & + & -.6111D-03, -.5032D-03, -.4074D-03, -.3254D-03, -.2574D-03, & + & -.2021D-03, -.1574D-03, -.1214D-03, -.9342D-04, -.7142D-04, & + & -.5409D-04/ + + data (calcpts(j,44), j = 1,neta) /-.1425D-05, -.1723D-05, & + & -.2083D-05, -.2524D-05, -.3056D-05, -.3699D-05, -.4481D-05, & + & -.5430D-05, -.6576D-05, -.7963D-05, -.9650D-05, -.1169D-04, & + & -.1416D-04, -.1716D-04, -.2079D-04, -.2519D-04, -.3052D-04, & + & -.3698D-04, -.4482D-04, -.5431D-04, -.6579D-04, -.7972D-04, & + & -.9660D-04, -.1170D-03, -.1417D-03, -.1717D-03, -.2079D-03, & + & -.2518D-03, -.3047D-03, -.3686D-03, -.4455D-03, -.5378D-03, & + & -.6479D-03, -.7776D-03, -.9280D-03, -.1098D-02, -.1284D-02, & + & -.1479D-02, -.1676D-02, -.1865D-02, -.2041D-02, -.2195D-02, & + & -.2325D-02, -.2428D-02, -.2499D-02, -.2539D-02, -.2546D-02, & + & -.2517D-02, -.2450D-02, -.2345D-02, -.2200D-02, -.2016D-02, & + & -.1803D-02, -.1571D-02, -.1344D-02, -.1143D-02, -.9871D-03, & + & -.8809D-03, -.8099D-03, -.7514D-03, -.6872D-03, -.6114D-03, & + & -.5277D-03, -.4433D-03, -.3645D-03, -.2946D-03, -.2351D-03, & + & -.1856D-03, -.1456D-03, -.1129D-03, -.8693D-04, -.6693D-04, & + & -.5093D-04/ + + data (calcpts(j,45), j = 1,neta) /-.1047D-05, -.1275D-05, & + & -.1544D-05, -.1873D-05, -.2268D-05, -.2748D-05, -.3332D-05, & + & -.4036D-05, -.4893D-05, -.5928D-05, -.7185D-05, -.8710D-05, & + & -.1055D-04, -.1279D-04, -.1549D-04, -.1877D-04, -.2276D-04, & + & -.2757D-04, -.3341D-04, -.4049D-04, -.4905D-04, -.5944D-04, & + & -.7201D-04, -.8724D-04, -.1057D-03, -.1280D-03, -.1550D-03, & + & -.1876D-03, -.2271D-03, -.2746D-03, -.3319D-03, -.4005D-03, & + & -.4822D-03, -.5785D-03, -.6900D-03, -.8160D-03, -.9539D-03, & + & -.1099D-02, -.1246D-02, -.1389D-02, -.1522D-02, -.1641D-02, & + & -.1743D-02, -.1826D-02, -.1887D-02, -.1928D-02, -.1945D-02, & + & -.1938D-02, -.1906D-02, -.1846D-02, -.1758D-02, -.1642D-02, & + & -.1499D-02, -.1335D-02, -.1159D-02, -.9869D-03, -.8364D-03, & + & -.7209D-03, -.6425D-03, -.5904D-03, -.5475D-03, -.5002D-03, & + & -.4444D-03, -.3830D-03, -.3212D-03, -.2637D-03, -.2128D-03, & + & -.1696D-03, -.1338D-03, -.1049D-03, -.8132D-04, -.6279D-04, & + & -.4812D-04/ + + data (calcpts(j,46), j = 1,neta) /-.7797D-06, -.9460D-06, & + & -.1149D-05, -.1390D-05, -.1685D-05, -.2043D-05, -.2478D-05, & + & -.3000D-05, -.3631D-05, -.4402D-05, -.5337D-05, -.6469D-05, & + & -.7835D-05, -.9494D-05, -.1150D-04, -.1394D-04, -.1689D-04, & + & -.2047D-04, -.2480D-04, -.3005D-04, -.3641D-04, -.4411D-04, & + & -.5345D-04, -.6475D-04, -.7843D-04, -.9499D-04, -.1150D-03, & + & -.1392D-03, -.1685D-03, -.2037D-03, -.2461D-03, -.2970D-03, & + & -.3574D-03, -.4286D-03, -.5110D-03, -.6042D-03, -.7062D-03, & + & -.8140D-03, -.9235D-03, -.1030D-02, -.1131D-02, -.1222D-02, & + & -.1300D-02, -.1366D-02, -.1417D-02, -.1454D-02, -.1474D-02, & + & -.1479D-02, -.1466D-02, -.1434D-02, -.1383D-02, -.1313D-02, & + & -.1221D-02, -.1110D-02, -.9850D-03, -.8519D-03, -.7227D-03, & + & -.6105D-03, -.5250D-03, -.4674D-03, -.4293D-03, -.3978D-03, & + & -.3632D-03, -.3223D-03, -.2773D-03, -.2321D-03, -.1902D-03, & + & -.1533D-03, -.1220D-03, -.9633D-04, -.7513D-04, -.5833D-04, & + & -.4486D-04/ + + data (calcpts(j,47), j = 1,neta) /-.5812D-06, -.7041D-06, & + & -.8530D-06, -.1034D-05, -.1247D-05, -.1512D-05, -.1830D-05, & + & -.2218D-05, -.2692D-05, -.3258D-05, -.3949D-05, -.4785D-05, & + & -.5798D-05, -.7020D-05, -.8509D-05, -.1031D-04, -.1249D-04, & + & -.1514D-04, -.1834D-04, -.2222D-04, -.2692D-04, -.3261D-04, & + & -.3952D-04, -.4787D-04, -.5798D-04, -.7023D-04, -.8502D-04, & + & -.1029D-03, -.1245D-03, -.1505D-03, -.1819D-03, -.2193D-03, & + & -.2639D-03, -.3164D-03, -.3771D-03, -.4458D-03, -.5210D-03, & + & -.6007D-03, -.6818D-03, -.7614D-03, -.8367D-03, -.9054D-03, & + & -.9658D-03, -.1018D-02, -.1059D-02, -.1090D-02, -.1111D-02, & + & -.1120D-02, -.1118D-02, -.1102D-02, -.1074D-02, -.1032D-02, & + & -.9757D-03, -.9045D-03, -.8198D-03, -.7246D-03, -.6244D-03, & + & -.5279D-03, -.4446D-03, -.3815D-03, -.3393D-03, -.3115D-03, & + & -.2885D-03, -.2631D-03, -.2332D-03, -.2003D-03, -.1675D-03, & + & -.1370D-03, -.1103D-03, -.8765D-04, -.6899D-04, -.5385D-04, & + & -.4165D-04/ + + data (calcpts(j,48), j = 1,neta) /-.4289D-06, -.5178D-06, & + & -.6274D-06, -.7621D-06, -.9198D-06, -.1112D-05, -.1351D-05, & + & -.1637D-05, -.1984D-05, -.2400D-05, -.2909D-05, -.3527D-05, & + & -.4273D-05, -.5175D-05, -.6268D-05, -.7597D-05, -.9203D-05, & + & -.1115D-04, -.1351D-04, -.1637D-04, -.1983D-04, -.2403D-04, & + & -.2912D-04, -.3527D-04, -.4272D-04, -.5174D-04, -.6264D-04, & + & -.7582D-04, -.9172D-04, -.1109D-03, -.1339D-03, -.1615D-03, & + & -.1943D-03, -.2329D-03, -.2775D-03, -.3278D-03, -.3832D-03, & + & -.4419D-03, -.5019D-03, -.5609D-03, -.6172D-03, -.6690D-03, & + & -.7152D-03, -.7550D-03, -.7880D-03, -.8138D-03, -.8322D-03, & + & -.8427D-03, -.8453D-03, -.8395D-03, -.8249D-03, -.8008D-03, & + & -.7669D-03, -.7226D-03, -.6678D-03, -.6033D-03, -.5315D-03, & + & -.4565D-03, -.3860D-03, -.3231D-03, -.2767D-03, -.2458D-03, & + & -.2256D-03, -.2088D-03, -.1903D-03, -.1684D-03, -.1445D-03, & + & -.1206D-03, -.9858D-04, -.7925D-04, -.6292D-04, -.4952D-04, & + & -.3852D-04/ + + data (calcpts(j,49), j = 1,neta) /-.3130D-06, -.3793D-06, & + & -.4580D-06, -.5590D-06, -.6787D-06, -.8204D-06, -.9885D-06, & + & -.1201D-05, -.1456D-05, -.1761D-05, -.2137D-05, -.2588D-05, & + & -.3137D-05, -.3800D-05, -.4604D-05, -.5579D-05, -.6762D-05, & + & -.8190D-05, -.9926D-05, -.1203D-04, -.1457D-04, -.1765D-04, & + & -.2138D-04, -.2590D-04, -.3137D-04, -.3800D-04, -.4600D-04, & + & -.5567D-04, -.6735D-04, -.8141D-04, -.9832D-04, -.1185D-03, & + & -.1426D-03, -.1708D-03, -.2035D-03, -.2405D-03, -.2811D-03, & + & -.3241D-03, -.3683D-03, -.4121D-03, -.4539D-03, -.4927D-03, & + & -.5276D-03, -.5582D-03, -.5840D-03, -.6048D-03, -.6204D-03, & + & -.6307D-03, -.6355D-03, -.6346D-03, -.6277D-03, -.6146D-03, & + & -.5947D-03, -.5677D-03, -.5333D-03, -.4915D-03, -.4427D-03, & + & -.3888D-03, -.3330D-03, -.2798D-03, -.2343D-03, -.2003D-03, & + & -.1778D-03, -.1630D-03, -.1509D-03, -.1374D-03, -.1215D-03, & + & -.1041D-03, -.8673D-04, -.7079D-04, -.5686D-04, -.4513D-04, & + & -.3539D-04/ + + data (dlaeta(j), j = 1,neta) / & + & -6d0, -5.83333333d0, -5.66666667d0, -5.5d0, -5.33333333d0, & + & -5.16666667d0, -5d0, -4.83333333d0, -4.66666667d0, -4.5d0, & + & -4.33333333d0, -4.16666667d0, -4d0, -3.83333333d0, & + & -3.66666667d0, -3.5d0, -3.33333333d0, -3.16666667d0, -3d0, & + & -2.83333333d0, -2.66666667d0, -2.5d0, -2.33333333d0, & + & -2.16666667d0, -2d0, -1.83333333d0, -1.66666667d0, -1.5d0, & + & -1.33333333d0, -1.16666667d0, -1d0, -0.83333333d0, -0.66666667d0,& + & -0.5d0, -0.33333333d0, -0.16666667d0, 0d0, 0.16666667d0, & + & 0.33333333d0, 0.5d0, 0.66666667d0, 0.83333333d0, 1d0, & + & 1.16666667d0, 1.33333333d0, 1.5d0, 1.66666667d0, 1.83333333d0, & + & 2d0, 2.16666667d0, 2.33333333d0, 2.5d0, 2.66666667d0, & + & 2.83333333d0, 3d0, 3.16666667d0, 3.33333333d0, 3.5d0, & + & 3.66666667d0, 3.83333333d0, 4d0, 4.16666667d0, 4.33333333d0, & + & 4.5d0, 4.66666667d0, 4.83333333d0, 5d0, 5.16666667d0, & + & 5.33333333d0, 5.5d0, 5.66666667d0, 5.83333333d0, 6d0/ + + data (dlaxi(j), j = 1,nxi) / & + & -3d0, -2.83333333d0, -2.66666667d0, -2.5d0, -2.33333333d0, & + & -2.16666667d0, -2d0, -1.83333333d0, -1.66666667d0, -1.5d0, & + & -1.33333333d0, -1.16666667d0, -1d0, -0.83333333d0, -0.66666667d0,& + & -0.5d0, -0.33333333d0, -0.16666667d0, 0d0, 0.16666667d0, & + & 0.33333333d0, 0.5d0, 0.66666667d0, 0.83333333d0, 1d0, & + & 1.16666667d0, 1.33333333d0, 1.5d0, 1.66666667d0, 1.83333333d0, & + & 2d0, 2.16666667d0, 2.33333333d0, 2.5d0, 2.66666667d0, & + & 2.83333333d0, 3d0, 3.16666667d0, 3.33333333d0, 3.5d0, & + & 3.66666667d0, 3.83333333d0, 4d0, 4.16666667d0, 4.33333333d0, & + & 4.5d0, 4.66666667d0, 4.83333333d0, 5d0/ + + dleta = dlog10(eta) + dlxi = dlog10(xi) + if (dlxi .le. dlaxi(1)) dlxi = dlaxi(1) + if (dlxi .ge. dlaxi(nxi)) dlxi = dlaxi(nxi) + if (dleta .ge. dlaeta(neta)) dleta = dlaeta(neta) + if (dleta .le. dlaeta(1)) dleta = dlaeta(1) + call locate(dlaeta,neta, dleta, ieta) + call locate(dlaxi, nxi, dlxi, ixi) +! interpolating between the appropriate points + delxi = 1d0/6d0 + deleta = 1d0/6d0 +! lagrange 3-pt. + if (ixi .le. 2) ixi = 2 + if (ixi .ge. 48) ixi = 48 + if (ieta .le. 2) ieta = 2 + if (ieta .ge. 72) ieta = 72 + pxi = (dlxi - dlaxi(ixi))/delxi + f(-1) = pxi*(pxi-1d0)/2d0*calcpts(ieta-1,ixi-1) + & + & (1d0 - pxi**2)*calcpts(ieta-1,ixi) + & + & pxi*(pxi+1d0)/2d0*calcpts(ieta-1,ixi+1) + f(0) = pxi*(pxi-1d0)/2d0*calcpts(ieta,ixi-1) + & + & (1d0 - pxi**2)*calcpts(ieta,ixi) + & + & pxi*(pxi+1d0)/2d0*calcpts(ieta,ixi+1) + f(1) = pxi*(pxi-1d0)/2d0*calcpts(ieta+1,ixi-1) + & + & (1d0 - pxi**2)*calcpts(ieta+1,ixi) + & + & pxi*(pxi+1d0)/2d0*calcpts(ieta+1,ixi+1) + peta = (dleta - dlaeta(ieta))/deleta + h1_ATg = peta*(peta-1d0)/2d0*f(-1) + & + & (1d0 - peta**2)*f(0) + & + & peta*(peta+1d0)/2d0*f(1) +!MB + + peta*(peta+1d0)/2d0*f(1) + return + END + +! ======================================== + double precision function h1_FTg(eta,xi) +! ======================================== + +! eq (10) in PLB347 (1995) 143 - 151 for the transverse piece +! MSbar scheme +! This routine is called subctcf in the original code. +! Called sctcf in updated code (03/06/96). + + implicit none + integer neta, nxi + parameter (neta = 73, nxi = 49) + double precision calcpts(neta, nxi), dlaeta(neta), dlaxi(nxi) + double precision eta, xi, dleta, dlxi + double precision pxi, peta, f(-1:1), delxi, deleta + integer j, ieta, ixi + data (calcpts(j, 1), j = 1,neta) /-.2005D-03, -.2004D-03, & + & -.3501D-03, -.3497D-03, -.4991D-03, -.4983D-03, -.6470D-03, & + & -.7952D-03, -.9425D-03, -.1089D-02, -.1383D-02, -.1524D-02, & + & -.1962D-02, -.2243D-02, -.2666D-02, -.3227D-02, -.3769D-02, & + & -.4434D-02, -.5209D-02, -.6075D-02, -.7007D-02, -.7963D-02, & + & -.8887D-02, -.9694D-02, -.1011D-01, -.1027D-01, -.9623D-02, & + & -.7967D-02, -.4835D-02, -.5091D-03, 0.5340D-02, 0.1151D-01, & + & 0.1643D-01, 0.1747D-01, 0.1237D-01, 0.7897D-03, -.1390D-01, & + & -.2616D-01, -.3083D-01, -.2674D-01, -.1655D-01, -.4410D-02, & + & 0.6429D-02, 0.1431D-01, 0.1894D-01, 0.2087D-01, 0.2082D-01, & + & 0.1952D-01, 0.1755D-01, 0.1527D-01, 0.1299D-01, 0.1083D-01, & + & 0.8899D-02, 0.7217D-02, 0.5789D-02, 0.4600D-02, 0.3625D-02, & + & 0.2837D-02, 0.2204D-02, 0.1703D-02, 0.1309D-02, 0.1001D-02, & + & 0.7622D-03, 0.5780D-03, 0.4364D-03, 0.3286D-03, 0.2464D-03, & + & 0.1844D-03, 0.1375D-03, 0.1022D-03, 0.7583D-04, 0.5611D-04, & + & 0.4143D-04/ + + data (calcpts(j, 2), j = 1,neta) /-.1546D-03, -.3044D-03, & + & -.3042D-03, -.3038D-03, -.4532D-03, -.4523D-03, -.6011D-03, & + & -.7493D-03, -.8966D-03, -.1043D-02, -.1337D-02, -.1628D-02, & + & -.1916D-02, -.2347D-02, -.2770D-02, -.3181D-02, -.3873D-02, & + & -.4538D-02, -.5313D-02, -.6180D-02, -.6961D-02, -.7918D-02, & + & -.8841D-02, -.9649D-02, -.1022D-01, -.1023D-01, -.9578D-02, & + & -.7923D-02, -.4941D-02, -.4661D-03, 0.5382D-02, 0.1155D-01, & + & 0.1647D-01, 0.1750D-01, 0.1240D-01, 0.8170D-03, -.1388D-01, & + & -.2616D-01, -.3083D-01, -.2673D-01, -.1655D-01, -.4404D-02, & + & 0.6433D-02, 0.1429D-01, 0.1894D-01, 0.2086D-01, 0.2082D-01, & + & 0.1952D-01, 0.1755D-01, 0.1527D-01, 0.1298D-01, 0.1083D-01, & + & 0.8899D-02, 0.7217D-02, 0.5789D-02, 0.4600D-02, 0.3625D-02, & + & 0.2837D-02, 0.2204D-02, 0.1703D-02, 0.1309D-02, 0.1001D-02, & + & 0.7622D-03, 0.5780D-03, 0.4364D-03, 0.3286D-03, 0.2464D-03, & + & 0.1844D-03, 0.1375D-03, 0.1022D-03, 0.7583D-04, 0.5611D-04, & + & 0.4143D-04/ + + data (calcpts(j, 3), j = 1,neta) /-.2373D-03, -.2372D-03, & + & -.2369D-03, -.3865D-03, -.3859D-03, -.5351D-03, -.6838D-03, & + & -.6820D-03, -.9793D-03, -.1125D-02, -.1270D-02, -.1561D-02, & + & -.1848D-02, -.2280D-02, -.2703D-02, -.3264D-02, -.3806D-02, & + & -.4471D-02, -.5246D-02, -.6112D-02, -.7044D-02, -.8001D-02, & + & -.8924D-02, -.9582D-02, -.1015D-01, -.1016D-01, -.9512D-02, & + & -.7858D-02, -.4877D-02, -.4031D-03, 0.5293D-02, 0.1145D-01, & + & 0.1637D-01, 0.1755D-01, 0.1244D-01, 0.8570D-03, -.1399D-01, & + & -.2615D-01, -.3083D-01, -.2673D-01, -.1656D-01, -.4395D-02, & + & 0.6424D-02, 0.1430D-01, 0.1893D-01, 0.2086D-01, 0.2082D-01, & + & 0.1952D-01, 0.1755D-01, 0.1527D-01, 0.1299D-01, 0.1083D-01, & + & 0.8899D-02, 0.7217D-02, 0.5789D-02, 0.4600D-02, 0.3625D-02, & + & 0.2837D-02, 0.2204D-02, 0.1703D-02, 0.1309D-02, 0.1001D-02, & + & 0.7622D-03, 0.5778D-03, 0.4364D-03, 0.3286D-03, 0.2464D-03, & + & 0.1844D-03, 0.1375D-03, 0.1022D-03, 0.7583D-04, 0.5611D-04, & + & 0.4143D-04/ + + data (calcpts(j, 4), j = 1,neta) /-.1385D-03, -.2883D-03, & + & -.2881D-03, -.2877D-03, -.4371D-03, -.5862D-03, -.5850D-03, & + & -.7331D-03, -.8804D-03, -.1026D-02, -.1321D-02, -.1612D-02, & + & -.1900D-02, -.2331D-02, -.2754D-02, -.3165D-02, -.3857D-02, & + & -.4522D-02, -.5297D-02, -.6164D-02, -.6946D-02, -.7902D-02, & + & -.8826D-02, -.9634D-02, -.1020D-01, -.1021D-01, -.9565D-02, & + & -.7912D-02, -.4932D-02, -.4606D-03, 0.5233D-02, 0.1154D-01, & + & 0.1645D-01, 0.1748D-01, 0.1236D-01, 0.7658D-03, -.1394D-01, & + & -.2615D-01, -.3082D-01, -.2673D-01, -.1655D-01, -.4398D-02, & + & 0.6433D-02, 0.1429D-01, 0.1894D-01, 0.2087D-01, 0.2083D-01, & + & 0.1952D-01, 0.1753D-01, 0.1527D-01, 0.1298D-01, 0.1083D-01, & + & 0.8899D-02, 0.7216D-02, 0.5790D-02, 0.4600D-02, 0.3625D-02, & + & 0.2837D-02, 0.2204D-02, 0.1703D-02, 0.1309D-02, 0.1001D-02, & + & 0.7622D-03, 0.5778D-03, 0.4364D-03, 0.3286D-03, 0.2464D-03, & + & 0.1844D-03, 0.1375D-03, 0.1022D-03, 0.7582D-04, 0.5611D-04, & + & 0.4143D-04/ + + data (calcpts(j, 5), j = 1,neta) /-.1435D-03, -.2933D-03, & + & -.2930D-03, -.2926D-03, -.4421D-03, -.5912D-03, -.5900D-03, & + & -.7381D-03, -.8854D-03, -.1031D-02, -.1326D-02, -.1617D-02, & + & -.1905D-02, -.2336D-02, -.2759D-02, -.3170D-02, -.3862D-02, & + & -.4527D-02, -.5302D-02, -.6169D-02, -.6951D-02, -.7908D-02, & + & -.8831D-02, -.9640D-02, -.1021D-01, -.1022D-01, -.9573D-02, & + & -.7921D-02, -.4944D-02, -.4749D-03, 0.5215D-02, 0.1152D-01, & + & 0.1642D-01, 0.1744D-01, 0.1231D-01, 0.8520D-03, -.1402D-01, & + & -.2614D-01, -.3081D-01, -.2671D-01, -.1654D-01, -.4394D-02, & + & 0.6431D-02, 0.1430D-01, 0.1893D-01, 0.2087D-01, 0.2083D-01, & + & 0.1953D-01, 0.1754D-01, 0.1527D-01, 0.1298D-01, 0.1083D-01, & + & 0.8898D-02, 0.7216D-02, 0.5788D-02, 0.4600D-02, 0.3625D-02, & + & 0.2835D-02, 0.2205D-02, 0.1703D-02, 0.1309D-02, 0.1001D-02, & + & 0.7621D-03, 0.5778D-03, 0.4365D-03, 0.3286D-03, 0.2464D-03, & + & 0.1844D-03, 0.1374D-03, 0.1022D-03, 0.7582D-04, 0.5611D-04, & + & 0.4143D-04/ + + data (calcpts(j, 6), j = 1,neta) /-.2310D-03, -.2308D-03, & + & -.2305D-03, -.3801D-03, -.3795D-03, -.5287D-03, -.6774D-03, & + & -.8256D-03, -.9729D-03, -.1119D-02, -.1263D-02, -.1555D-02, & + & -.1842D-02, -.2274D-02, -.2697D-02, -.3257D-02, -.3799D-02, & + & -.4464D-02, -.5240D-02, -.6107D-02, -.7039D-02, -.7996D-02, & + & -.8920D-02, -.9579D-02, -.1015D-01, -.1016D-01, -.9515D-02, & + & -.7865D-02, -.4891D-02, -.5759D-03, 0.5258D-02, 0.1140D-01, & + & 0.1630D-01, 0.1745D-01, 0.1231D-01, 0.8284D-03, -.1392D-01, & + & -.2614D-01, -.3080D-01, -.2671D-01, -.1653D-01, -.4397D-02, & + & 0.6421D-02, 0.1430D-01, 0.1894D-01, 0.2086D-01, 0.2082D-01, & + & 0.1953D-01, 0.1754D-01, 0.1527D-01, 0.1298D-01, 0.1083D-01, & + & 0.8897D-02, 0.7216D-02, 0.5788D-02, 0.4599D-02, 0.3625D-02, & + & 0.2836D-02, 0.2205D-02, 0.1703D-02, 0.1309D-02, 0.1001D-02, & + & 0.7621D-03, 0.5779D-03, 0.4365D-03, 0.3284D-03, 0.2464D-03, & + & 0.1844D-03, 0.1374D-03, 0.1022D-03, 0.7582D-04, 0.5611D-04, & + & 0.4143D-04/ + + data (calcpts(j, 7), j = 1,neta) /-.2194D-03, -.2192D-03, & + & -.2189D-03, -.3685D-03, -.3680D-03, -.5171D-03, -.6659D-03, & + & -.8140D-03, -.9613D-03, -.1107D-02, -.1252D-02, -.1543D-02, & + & -.1831D-02, -.2262D-02, -.2685D-02, -.3246D-02, -.3788D-02, & + & -.4453D-02, -.5228D-02, -.6096D-02, -.7028D-02, -.7985D-02, & + & -.8910D-02, -.9569D-02, -.1014D-01, -.1030D-01, -.9660D-02, & + & -.7863D-02, -.5043D-02, -.5842D-03, 0.5241D-02, 0.1137D-01, & + & 0.1625D-01, 0.1739D-01, 0.1222D-01, 0.7137D-03, -.1391D-01, & + & -.2612D-01, -.3079D-01, -.2669D-01, -.1652D-01, -.4402D-02, & + & 0.6419D-02, 0.1429D-01, 0.1892D-01, 0.2086D-01, 0.2081D-01, & + & 0.1952D-01, 0.1754D-01, 0.1527D-01, 0.1298D-01, 0.1083D-01, & + & 0.8896D-02, 0.7215D-02, 0.5787D-02, 0.4599D-02, 0.3625D-02, & + & 0.2836D-02, 0.2205D-02, 0.1704D-02, 0.1309D-02, 0.1001D-02, & + & 0.7621D-03, 0.5779D-03, 0.4365D-03, 0.3285D-03, 0.2464D-03, & + & 0.1842D-03, 0.1374D-03, 0.1022D-03, 0.7582D-04, 0.5611D-04, & + & 0.4143D-04/ + + data (calcpts(j, 8), j = 1,neta) /-.2128D-03, -.2126D-03, & + & -.3623D-03, -.3619D-03, -.3613D-03, -.5105D-03, -.6592D-03, & + & -.8074D-03, -.9547D-03, -.1101D-02, -.1245D-02, -.1536D-02, & + & -.1824D-02, -.2256D-02, -.2679D-02, -.3239D-02, -.3782D-02, & + & -.4447D-02, -.5222D-02, -.6090D-02, -.7022D-02, -.7980D-02, & + & -.8905D-02, -.9566D-02, -.1014D-01, -.1030D-01, -.9663D-02, & + & -.8021D-02, -.5056D-02, -.6067D-03, 0.5056D-02, 0.1132D-01, & + & 0.1618D-01, 0.1713D-01, 0.1223D-01, 0.6853D-03, -.1398D-01, & + & -.2611D-01, -.3077D-01, -.2667D-01, -.1652D-01, -.4388D-02, & + & 0.6431D-02, 0.1429D-01, 0.1893D-01, 0.2086D-01, 0.2082D-01, & + & 0.1951D-01, 0.1753D-01, 0.1526D-01, 0.1298D-01, 0.1083D-01, & + & 0.8895D-02, 0.7215D-02, 0.5788D-02, 0.4598D-02, 0.3624D-02, & + & 0.2836D-02, 0.2203D-02, 0.1704D-02, 0.1309D-02, 0.1001D-02, & + & 0.7620D-03, 0.5779D-03, 0.4365D-03, 0.3285D-03, 0.2464D-03, & + & 0.1842D-03, 0.1374D-03, 0.1022D-03, 0.7582D-04, 0.5611D-04, & + & 0.4143D-04/ + + data (calcpts(j, 9), j = 1,neta) /-.1453D-03, -.2952D-03, & + & -.2949D-03, -.2945D-03, -.4439D-03, -.4431D-03, -.5918D-03, & + & -.7400D-03, -.8873D-03, -.1033D-02, -.1328D-02, -.1619D-02, & + & -.1907D-02, -.2188D-02, -.2762D-02, -.3172D-02, -.3864D-02, & + & -.4530D-02, -.5306D-02, -.6023D-02, -.6956D-02, -.7915D-02, & + & -.8841D-02, -.9653D-02, -.1023D-01, -.1024D-01, -.9610D-02, & + & -.7974D-02, -.5019D-02, -.7318D-03, 0.4913D-02, 0.1115D-01, & + & 0.1598D-01, 0.1704D-01, 0.1209D-01, 0.6323D-03, -.1395D-01, & + & -.2608D-01, -.3072D-01, -.2665D-01, -.1649D-01, -.4378D-02, & + & 0.6416D-02, 0.1428D-01, 0.1891D-01, 0.2085D-01, 0.2080D-01, & + & 0.1950D-01, 0.1752D-01, 0.1527D-01, 0.1298D-01, 0.1083D-01, & + & 0.8894D-02, 0.7213D-02, 0.5787D-02, 0.4599D-02, 0.3624D-02, & + & 0.2835D-02, 0.2203D-02, 0.1702D-02, 0.1309D-02, 0.1001D-02, & + & 0.7620D-03, 0.5777D-03, 0.4363D-03, 0.3285D-03, 0.2464D-03, & + & 0.1842D-03, 0.1374D-03, 0.1022D-03, 0.7581D-04, 0.5611D-04, & + & 0.4143D-04/ + + data (calcpts(j,10), j = 1,neta) /-.2188D-03, -.2186D-03, & + & -.2183D-03, -.3679D-03, -.3673D-03, -.5165D-03, -.6652D-03, & + & -.8134D-03, -.9608D-03, -.1107D-02, -.1251D-02, -.1543D-02, & + & -.1830D-02, -.2262D-02, -.2685D-02, -.3246D-02, -.3788D-02, & + & -.4454D-02, -.5230D-02, -.6098D-02, -.7032D-02, -.7841D-02, & + & -.8769D-02, -.9583D-02, -.1016D-01, -.1018D-01, -.9704D-02, & + & -.8077D-02, -.5135D-02, -.8675D-03, 0.4751D-02, 0.1096D-01, & + & 0.1573D-01, 0.1673D-01, 0.1185D-01, 0.4632D-03, -.1406D-01, & + & -.2606D-01, -.3067D-01, -.2659D-01, -.1647D-01, -.4373D-02, & + & 0.6415D-02, 0.1427D-01, 0.1891D-01, 0.2083D-01, 0.2079D-01, & + & 0.1950D-01, 0.1752D-01, 0.1526D-01, 0.1297D-01, 0.1082D-01, & + & 0.8891D-02, 0.7211D-02, 0.5785D-02, 0.4598D-02, 0.3623D-02, & + & 0.2835D-02, 0.2204D-02, 0.1702D-02, 0.1308D-02, 0.1001D-02, & + & 0.7619D-03, 0.5776D-03, 0.4364D-03, 0.3285D-03, 0.2463D-03, & + & 0.1842D-03, 0.1374D-03, 0.1022D-03, 0.7581D-04, 0.5610D-04, & + & 0.4142D-04/ + + data (calcpts(j,11), j = 1,neta) /-.1437D-03, -.2935D-03, & + & -.2933D-03, -.2929D-03, -.4423D-03, -.4414D-03, -.5902D-03, & + & -.7384D-03, -.8857D-03, -.1032D-02, -.1326D-02, -.1618D-02, & + & -.1905D-02, -.2187D-02, -.2610D-02, -.3171D-02, -.3714D-02, & + & -.4380D-02, -.5156D-02, -.6025D-02, -.6960D-02, -.7920D-02, & + & -.8850D-02, -.9667D-02, -.1010D-01, -.1028D-01, -.9659D-02, & + & -.8046D-02, -.5273D-02, -.1033D-02, 0.4546D-02, 0.1055D-01, & + & 0.1540D-01, 0.1646D-01, 0.1163D-01, 0.4108D-03, -.1410D-01, & + & -.2601D-01, -.3059D-01, -.2652D-01, -.1642D-01, -.4356D-02, & + & 0.6410D-02, 0.1426D-01, 0.1888D-01, 0.2081D-01, 0.2078D-01, & + & 0.1949D-01, 0.1752D-01, 0.1525D-01, 0.1297D-01, 0.1082D-01, & + & 0.8887D-02, 0.7209D-02, 0.5783D-02, 0.4596D-02, 0.3622D-02, & + & 0.2834D-02, 0.2202D-02, 0.1703D-02, 0.1308D-02, 0.1000D-02, & + & 0.7617D-03, 0.5775D-03, 0.4362D-03, 0.3284D-03, 0.2463D-03, & + & 0.1843D-03, 0.1374D-03, 0.1022D-03, 0.7580D-04, 0.5609D-04, & + & 0.4142D-04/ + + data (calcpts(j,12), j = 1,neta) /-.1721D-03, -.1719D-03, & + & -.3216D-03, -.3212D-03, -.4707D-03, -.4698D-03, -.6186D-03, & + & -.7668D-03, -.9141D-03, -.1060D-02, -.1355D-02, -.1496D-02, & + & -.1934D-02, -.2216D-02, -.2639D-02, -.3200D-02, -.3743D-02, & + & -.4410D-02, -.5187D-02, -.6056D-02, -.6993D-02, -.7805D-02, & + & -.8738D-02, -.9560D-02, -.1015D-01, -.1019D-01, -.9731D-02, & + & -.8137D-02, -.5394D-02, -.1194D-02, 0.4180D-02, 0.1010D-01, & + & 0.1486D-01, 0.1594D-01, 0.1109D-01, 0.1429D-03, -.1411D-01, & + & -.2595D-01, -.3047D-01, -.2643D-01, -.1637D-01, -.4346D-02, & + & 0.6403D-02, 0.1424D-01, 0.1885D-01, 0.2079D-01, 0.2076D-01, & + & 0.1946D-01, 0.1749D-01, 0.1524D-01, 0.1296D-01, 0.1081D-01, & + & 0.8882D-02, 0.7204D-02, 0.5779D-02, 0.4593D-02, 0.3620D-02, & + & 0.2833D-02, 0.2201D-02, 0.1701D-02, 0.1308D-02, 0.1000D-02, & + & 0.7615D-03, 0.5774D-03, 0.4361D-03, 0.3282D-03, 0.2463D-03, & + & 0.1841D-03, 0.1373D-03, 0.1021D-03, 0.7577D-04, 0.5607D-04, & + & 0.4140D-04/ + + data (calcpts(j,13), j = 1,neta) /-.1707D-03, -.1705D-03, & + & -.3202D-03, -.3198D-03, -.4693D-03, -.4684D-03, -.6172D-03, & + & -.7654D-03, -.9128D-03, -.1059D-02, -.1353D-02, -.1495D-02, & + & -.1783D-02, -.2215D-02, -.2639D-02, -.3200D-02, -.3743D-02, & + & -.4410D-02, -.5188D-02, -.5909D-02, -.6848D-02, -.7813D-02, & + & -.8751D-02, -.9579D-02, -.1018D-01, -.1023D-01, -.9793D-02, & + & -.8378D-02, -.5676D-02, -.1534D-02, 0.3758D-02, 0.9572D-02, & + & 0.1418D-01, 0.1522D-01, 0.1059D-01, -.1719D-03, -.1426D-01, & + & -.2585D-01, -.3032D-01, -.2629D-01, -.1629D-01, -.4321D-02, & + & 0.6391D-02, 0.1421D-01, 0.1882D-01, 0.2075D-01, 0.2072D-01, & + & 0.1943D-01, 0.1748D-01, 0.1521D-01, 0.1294D-01, 0.1080D-01, & + & 0.8874D-02, 0.7198D-02, 0.5775D-02, 0.4590D-02, 0.3617D-02, & + & 0.2831D-02, 0.2200D-02, 0.1700D-02, 0.1307D-02, 0.9996D-03, & + & 0.7612D-03, 0.5771D-03, 0.4359D-03, 0.3281D-03, 0.2462D-03, & + & 0.1841D-03, 0.1373D-03, 0.1021D-03, 0.7575D-04, 0.5606D-04, & + & 0.4139D-04/ + + data (calcpts(j,14), j = 1,neta) /-.1968D-03, -.1967D-03, & + & -.3464D-03, -.3460D-03, -.3455D-03, -.4946D-03, -.6434D-03, & + & -.7917D-03, -.9391D-03, -.1085D-02, -.1230D-02, -.1521D-02, & + & -.1809D-02, -.2242D-02, -.2666D-02, -.3077D-02, -.3621D-02, & + & -.4289D-02, -.5069D-02, -.5942D-02, -.6883D-02, -.7703D-02, & + & -.8647D-02, -.9484D-02, -.1010D-01, -.1032D-01, -.9760D-02, & + & -.8537D-02, -.5893D-02, -.1986D-02, 0.3039D-02, 0.8692D-02, & + & 0.1309D-01, 0.1430D-01, 0.9794D-02, -.7502D-03, -.1435D-01, & + & -.2570D-01, -.3009D-01, -.2609D-01, -.1617D-01, -.4278D-02, & + & 0.6379D-02, 0.1415D-01, 0.1876D-01, 0.2070D-01, 0.2068D-01, & + & 0.1941D-01, 0.1744D-01, 0.1520D-01, 0.1292D-01, 0.1078D-01, & + & 0.8862D-02, 0.7189D-02, 0.5769D-02, 0.4586D-02, 0.3615D-02, & + & 0.2828D-02, 0.2198D-02, 0.1699D-02, 0.1306D-02, 0.9988D-03, & + & 0.7606D-03, 0.5768D-03, 0.4357D-03, 0.3279D-03, 0.2461D-03, & + & 0.1840D-03, 0.1372D-03, 0.1021D-03, 0.7573D-04, 0.5604D-04, & + & 0.4138D-04/ + + data (calcpts(j,15), j = 1,neta) /-.1824D-03, -.1823D-03, & + & -.3320D-03, -.3316D-03, -.4811D-03, -.4803D-03, -.6291D-03, & + & -.7773D-03, -.9248D-03, -.1071D-02, -.1216D-02, -.1507D-02, & + & -.1796D-02, -.2228D-02, -.2503D-02, -.3065D-02, -.3610D-02, & + & -.4279D-02, -.5061D-02, -.5787D-02, -.6732D-02, -.7708D-02, & + & -.8511D-02, -.9361D-02, -.9993D-02, -.1024D-01, -.9876D-02, & + & -.8711D-02, -.6303D-02, -.2665D-02, 0.2193D-02, 0.7467D-02, & + & 0.1186D-01, 0.1284D-01, 0.8604D-02, -.1434D-02, -.1442D-01, & + & -.2550D-01, -.2975D-01, -.2580D-01, -.1602D-01, -.4239D-02, & + & 0.6339D-02, 0.1408D-01, 0.1867D-01, 0.2062D-01, 0.2060D-01, & + & 0.1933D-01, 0.1739D-01, 0.1515D-01, 0.1289D-01, 0.1076D-01, & + & 0.8844D-02, 0.7176D-02, 0.5758D-02, 0.4578D-02, 0.3609D-02, & + & 0.2824D-02, 0.2195D-02, 0.1697D-02, 0.1304D-02, 0.9978D-03, & + & 0.7599D-03, 0.5762D-03, 0.4354D-03, 0.3277D-03, 0.2459D-03, & + & 0.1839D-03, 0.1371D-03, 0.1020D-03, 0.7567D-04, 0.5600D-04, & + & 0.4136D-04/ + + data (calcpts(j,16), j = 1,neta) /-.1800D-03, -.1799D-03, & + & -.3296D-03, -.3292D-03, -.3287D-03, -.4779D-03, -.6267D-03, & + & -.6250D-03, -.7725D-03, -.1069D-02, -.1213D-02, -.1506D-02, & + & -.1794D-02, -.2077D-02, -.2502D-02, -.2915D-02, -.3612D-02, & + & -.4133D-02, -.4917D-02, -.5647D-02, -.6598D-02, -.7583D-02, & + & -.8399D-02, -.9268D-02, -.9927D-02, -.1022D-01, -.1006D-01, & + & -.8976D-02, -.6836D-02, -.3517D-02, 0.9542D-03, 0.5906D-02, & + & 0.1002D-01, 0.1105D-01, 0.7198D-02, -.2258D-02, -.1472D-01, & + & -.2521D-01, -.2927D-01, -.2542D-01, -.1580D-01, -.4190D-02, & + & 0.6275D-02, 0.1396D-01, 0.1855D-01, 0.2048D-01, 0.2050D-01, & + & 0.1925D-01, 0.1732D-01, 0.1510D-01, 0.1285D-01, 0.1073D-01, & + & 0.8819D-02, 0.7157D-02, 0.5744D-02, 0.4567D-02, 0.3601D-02, & + & 0.2819D-02, 0.2191D-02, 0.1694D-02, 0.1302D-02, 0.9963D-03, & + & 0.7588D-03, 0.5754D-03, 0.4348D-03, 0.3272D-03, 0.2455D-03, & + & 0.1837D-03, 0.1370D-03, 0.1019D-03, 0.7560D-04, 0.5596D-04, & + & 0.4132D-04/ + + data (calcpts(j,17), j = 1,neta) /-.1148D-03, -.2646D-03, & + & -.2644D-03, -.2640D-03, -.4135D-03, -.4127D-03, -.5616D-03, & + & -.7100D-03, -.8576D-03, -.1004D-02, -.1149D-02, -.1441D-02, & + & -.1730D-02, -.2013D-02, -.2439D-02, -.2854D-02, -.3402D-02, & + & -.4076D-02, -.4714D-02, -.5599D-02, -.6409D-02, -.7256D-02, & + & -.8239D-02, -.9134D-02, -.9831D-02, -.1017D-01, -.1010D-01, & + & -.9280D-02, -.7456D-02, -.4522D-02, -.5274D-03, 0.3977D-02, & + & 0.7644D-02, 0.8816D-02, 0.5388D-02, -.3332D-02, -.1483D-01, & + & -.2478D-01, -.2863D-01, -.2489D-01, -.1552D-01, -.4146D-02, & + & 0.6172D-02, 0.1378D-01, 0.1835D-01, 0.2029D-01, 0.2033D-01, & + & 0.1912D-01, 0.1722D-01, 0.1502D-01, 0.1278D-01, 0.1068D-01, & + & 0.8782D-02, 0.7130D-02, 0.5725D-02, 0.4553D-02, 0.3590D-02, & + & 0.2811D-02, 0.2186D-02, 0.1690D-02, 0.1299D-02, 0.9941D-03, & + & 0.7572D-03, 0.5743D-03, 0.4340D-03, 0.3268D-03, 0.2452D-03, & + & 0.1835D-03, 0.1368D-03, 0.1018D-03, 0.7550D-04, 0.5588D-04, & + & 0.4127D-04/ + + data (calcpts(j,18), j = 1,neta) /-.1467D-03, -.1465D-03, & + & -.2963D-03, -.2960D-03, -.2955D-03, -.4447D-03, -.5937D-03, & + & -.5921D-03, -.7398D-03, -.8864D-03, -.1181D-02, -.1324D-02, & + & -.1613D-02, -.1898D-02, -.2325D-02, -.2741D-02, -.3291D-02, & + & -.3819D-02, -.4462D-02, -.5205D-02, -.6176D-02, -.7039D-02, & + & -.7897D-02, -.8826D-02, -.9575D-02, -.9992D-02, -.1002D-01, & + & -.9512D-02, -.8062D-02, -.5594D-02, -.2193D-02, 0.1706D-02, & + & 0.5020D-02, 0.6064D-02, 0.3033D-02, -.4576D-02, -.1507D-01, & + & -.2416D-01, -.2776D-01, -.2419D-01, -.1519D-01, -.4142D-02, & + & 0.5976D-02, 0.1351D-01, 0.1805D-01, 0.2003D-01, 0.2009D-01, & + & 0.1892D-01, 0.1705D-01, 0.1489D-01, 0.1269D-01, 0.1061D-01, & + & 0.8730D-02, 0.7091D-02, 0.5696D-02, 0.4531D-02, 0.3575D-02, & + & 0.2799D-02, 0.2178D-02, 0.1683D-02, 0.1295D-02, 0.9910D-03, & + & 0.7550D-03, 0.5727D-03, 0.4329D-03, 0.3260D-03, 0.2446D-03, & + & 0.1830D-03, 0.1365D-03, 0.1016D-03, 0.7536D-04, 0.5579D-04, & + & 0.4120D-04/ + + data (calcpts(j,19), j = 1,neta) /-.2090D-03, -.2088D-03, & + & -.2086D-03, -.2083D-03, -.3578D-03, -.3571D-03, -.5061D-03, & + & -.6547D-03, -.6525D-03, -.7993D-03, -.1095D-02, -.1238D-02, & + & -.1528D-02, -.1813D-02, -.2092D-02, -.2510D-02, -.3064D-02, & + & -.3595D-02, -.4245D-02, -.4999D-02, -.5684D-02, -.6569D-02, & + & -.7458D-02, -.8283D-02, -.9099D-02, -.9764D-02, -.9935D-02, & + & -.9630D-02, -.8473D-02, -.6571D-02, -.3899D-02, -.6442D-03, & + & 0.2218D-02, 0.3113D-02, 0.6896D-03, -.5955D-02, -.1509D-01, & + & -.2328D-01, -.2662D-01, -.2333D-01, -.1482D-01, -.4195D-02, & + & 0.5655D-02, 0.1305D-01, 0.1759D-01, 0.1960D-01, 0.1974D-01, & + & 0.1863D-01, 0.1682D-01, 0.1472D-01, 0.1256D-01, 0.1051D-01, & + & 0.8655D-02, 0.7035D-02, 0.5655D-02, 0.4501D-02, 0.3553D-02, & + & 0.2784D-02, 0.2166D-02, 0.1676D-02, 0.1289D-02, 0.9868D-03, & + & 0.7519D-03, 0.5706D-03, 0.4312D-03, 0.3248D-03, 0.2438D-03, & + & 0.1824D-03, 0.1361D-03, 0.1013D-03, 0.7515D-04, 0.5564D-04, & + & 0.4110D-04/ + + data (calcpts(j,20), j = 1,neta) /-.1704D-03, -.1703D-03, & + & -.1701D-03, -.1698D-03, -.3194D-03, -.3188D-03, -.4679D-03, & + & -.4665D-03, -.6145D-03, -.7616D-03, -.9074D-03, -.1051D-02, & + & -.1342D-02, -.1629D-02, -.1909D-02, -.2330D-02, -.2737D-02, & + & -.3275D-02, -.3784D-02, -.4550D-02, -.5253D-02, -.6015D-02, & + & -.6793D-02, -.7677D-02, -.8426D-02, -.9065D-02, -.9413D-02, & + & -.9366D-02, -.8727D-02, -.7347D-02, -.5105D-02, -.2548D-02, & + & -.2590D-03, 0.4423D-03, -.1496D-02, -.6912D-02, -.1477D-01, & + & -.2202D-01, -.2513D-01, -.2227D-01, -.1444D-01, -.4398D-02, & + & 0.5099D-02, 0.1237D-01, 0.1690D-01, 0.1899D-01, 0.1922D-01, & + & 0.1822D-01, 0.1651D-01, 0.1447D-01, 0.1237D-01, 0.1037D-01, & + & 0.8549D-02, 0.6956D-02, 0.5596D-02, 0.4459D-02, 0.3522D-02, & + & 0.2761D-02, 0.2149D-02, 0.1663D-02, 0.1280D-02, 0.9806D-03, & + & 0.7475D-03, 0.5674D-03, 0.4290D-03, 0.3232D-03, 0.2427D-03, & + & 0.1816D-03, 0.1355D-03, 0.1009D-03, 0.7488D-04, 0.5544D-04, & + & 0.4096D-04/ + + data (calcpts(j,21), j = 1,neta) /-.9777D-04, -.9765D-04, & + & -.2475D-03, -.2472D-03, -.2468D-03, -.3963D-03, -.3955D-03, & + & -.5443D-03, -.5425D-03, -.6900D-03, -.8362D-03, -.9806D-03, & + & -.1272D-02, -.1411D-02, -.1693D-02, -.2117D-02, -.2380D-02, & + & -.2924D-02, -.3443D-02, -.3924D-02, -.4649D-02, -.5293D-02, & + & -.6119D-02, -.6921D-02, -.7621D-02, -.8255D-02, -.8666D-02, & + & -.8774D-02, -.8275D-02, -.7367D-02, -.5844D-02, -.3874D-02, & + & -.1962D-02, -.1328D-02, -.2876D-02, -.7216D-02, -.1382D-01, & + & -.2019D-01, -.2324D-01, -.2102D-01, -.1410D-01, -.4830D-02, & + & 0.4201D-02, 0.1132D-01, 0.1589D-01, 0.1810D-01, 0.1848D-01, & + & 0.1764D-01, 0.1604D-01, 0.1411D-01, 0.1210D-01, 0.1017D-01, & + & 0.8402D-02, 0.6848D-02, 0.5517D-02, 0.4401D-02, 0.3480D-02, & + & 0.2730D-02, 0.2128D-02, 0.1649D-02, 0.1269D-02, 0.9725D-03, & + & 0.7418D-03, 0.5633D-03, 0.4261D-03, 0.3212D-03, 0.2412D-03, & + & 0.1805D-03, 0.1348D-03, 0.1003D-03, 0.7450D-04, 0.5519D-04, & + & 0.4077D-04/ + + data (calcpts(j,22), j = 1,neta) /-.1735D-03, -.1734D-03, & + & -.1732D-03, -.1730D-03, -.1727D-03, -.3222D-03, -.3215D-03, & + & -.4705D-03, -.4690D-03, -.6168D-03, -.7635D-03, -.9088D-03, & + & -.1052D-02, -.1192D-02, -.1476D-02, -.1754D-02, -.2022D-02, & + & -.2424D-02, -.2805D-02, -.3302D-02, -.3902D-02, -.4582D-02, & + & -.5160D-02, -.5890D-02, -.6402D-02, -.7051D-02, -.7399D-02, & + & -.7551D-02, -.7244D-02, -.6584D-02, -.5435D-02, -.3748D-02, & + & -.2404D-02, -.1634D-02, -.2806D-02, -.6324D-02, -.1186D-01, & + & -.1759D-01, -.2080D-01, -.1952D-01, -.1382D-01, -.5557D-02, & + & 0.2891D-02, 0.9818D-02, 0.1445D-01, 0.1684D-01, 0.1745D-01, & + & 0.1682D-01, 0.1542D-01, 0.1364D-01, 0.1175D-01, 0.9902D-02, & + & 0.8205D-02, 0.6703D-02, 0.5412D-02, 0.4324D-02, 0.3423D-02, & + & 0.2689D-02, 0.2099D-02, 0.1627D-02, 0.1254D-02, 0.9617D-03, & + & 0.7340D-03, 0.5578D-03, 0.4222D-03, 0.3184D-03, 0.2392D-03, & + & 0.1791D-03, 0.1338D-03, 0.9964D-04, 0.7402D-04, 0.5483D-04, & + & 0.4054D-04/ + + data (calcpts(j,23), j = 1,neta) /-.1129D-03, -.1128D-03, & + & -.1127D-03, -.1125D-03, -.1122D-03, -.2618D-03, -.2612D-03, & + & -.2604D-03, -.4091D-03, -.4073D-03, -.5546D-03, -.7007D-03, & + & -.8449D-03, -.9864D-03, -.1124D-02, -.1406D-02, -.1679D-02, & + & -.1939D-02, -.2331D-02, -.2697D-02, -.3172D-02, -.3590D-02, & + & -.4073D-02, -.4583D-02, -.5063D-02, -.5583D-02, -.5880D-02, & + & -.5942D-02, -.5700D-02, -.5019D-02, -.3989D-02, -.2646D-02, & + & -.1380D-02, -.6668D-03, -.1348D-02, -.4099D-02, -.8787D-02, & + & -.1408D-01, -.1771D-01, -.1766D-01, -.1350D-01, -.6539D-02, & + & 0.1131D-02, 0.7788D-02, 0.1250D-01, 0.1516D-01, 0.1607D-01, & + & 0.1573D-01, 0.1458D-01, 0.1301D-01, 0.1127D-01, 0.9550D-02, & + & 0.7946D-02, 0.6514D-02, 0.5274D-02, 0.4223D-02, 0.3352D-02, & + & 0.2638D-02, 0.2061D-02, 0.1599D-02, 0.1235D-02, 0.9479D-03, & + & 0.7242D-03, 0.5508D-03, 0.4171D-03, 0.3147D-03, 0.2367D-03, & + & 0.1774D-03, 0.1326D-03, 0.9877D-04, 0.7339D-04, 0.5439D-04, & + & 0.4023D-04/ + + data (calcpts(j,24), j = 1,neta) /-.6910D-04, -.6903D-04, & + & -.9893D-04, -.1138D-03, -.1286D-03, -.1583D-03, -.2028D-03, & + & -.2471D-03, -.2911D-03, -.3496D-03, -.4225D-03, -.5093D-03, & + & -.6097D-03, -.7229D-03, -.8780D-03, -.1043D-02, -.1247D-02, & + & -.1470D-02, -.1739D-02, -.2031D-02, -.2367D-02, -.2716D-02, & + & -.3103D-02, -.3481D-02, -.3821D-02, -.4103D-02, -.4266D-02, & + & -.4227D-02, -.3915D-02, -.3268D-02, -.2253D-02, -.9436D-03, & + & 0.4012D-03, 0.1290D-02, 0.1046D-02, -.9929D-03, -.4925D-02, & + & -.9856D-02, -.1397D-01, -.1528D-01, -.1294D-01, -.7601D-02, & + & -.9618D-03, 0.5278D-02, 0.1004D-01, 0.1299D-01, 0.1429D-01, & + & 0.1432D-01, 0.1350D-01, 0.1220D-01, 0.1067D-01, 0.9105D-02, & + & 0.7620D-02, 0.6276D-02, 0.5100D-02, 0.4098D-02, 0.3261D-02, & + & 0.2573D-02, 0.2015D-02, 0.1566D-02, 0.1211D-02, 0.9308D-03, & + & 0.7119D-03, 0.5422D-03, 0.4110D-03, 0.3105D-03, 0.2336D-03, & + & 0.1753D-03, 0.1310D-03, 0.9769D-04, 0.7262D-04, 0.5386D-04, & + & 0.3984D-04/ + + data (calcpts(j,25), j = 1,neta) /-.4463D-04, -.5957D-04, & + & -.7450D-04, -.8938D-04, -.1042D-03, -.1190D-03, -.1486D-03, & + & -.1781D-03, -.2073D-03, -.2512D-03, -.3095D-03, -.3671D-03, & + & -.4385D-03, -.5383D-03, -.6356D-03, -.7593D-03, -.8927D-03, & + & -.1063D-02, -.1253D-02, -.1455D-02, -.1694D-02, -.1941D-02, & + & -.2196D-02, -.2435D-02, -.2639D-02, -.2786D-02, -.2809D-02, & + & -.2651D-02, -.2252D-02, -.1543D-02, -.5098D-03, 0.8178D-03, & + & 0.2215D-02, 0.3330D-02, 0.3531D-02, 0.2191D-02, -.9599D-03, & + & -.5427D-02, -.9834D-02, -.1238D-01, -.1187D-01, -.8389D-02, & + & -.3088D-02, 0.2501D-02, 0.7192D-02, 0.1042D-01, 0.1214D-01, & + & 0.1261D-01, 0.1219D-01, 0.1120D-01, 0.9929D-02, 0.8561D-02, & + & 0.7221D-02, 0.5986D-02, 0.4890D-02, 0.3947D-02, 0.3152D-02, & + & 0.2494D-02, 0.1957D-02, 0.1526D-02, 0.1182D-02, 0.9102D-03, & + & 0.6974D-03, 0.5317D-03, 0.4036D-03, 0.3053D-03, 0.2299D-03, & + & 0.1726D-03, 0.1292D-03, 0.9638D-04, 0.7171D-04, 0.5322D-04, & + & 0.3940D-04/ + + data (calcpts(j,26), j = 1,neta) /-.2966D-04, -.2962D-04, & + & -.4456D-04, -.4447D-04, -.5935D-04, -.7417D-04, -.8890D-04, & + & -.1185D-03, -.1329D-03, -.1621D-03, -.2058D-03, -.2490D-03, & + & -.3063D-03, -.3624D-03, -.4316D-03, -.5132D-03, -.6057D-03, & + & -.7225D-03, -.8457D-03, -.9865D-03, -.1139D-02, -.1295D-02, & + & -.1441D-02, -.1591D-02, -.1687D-02, -.1708D-02, -.1632D-02, & + & -.1397D-02, -.9495D-03, -.2161D-03, 0.8048D-03, 0.2109D-02, & + & 0.3533D-02, 0.4767D-02, 0.5314D-02, 0.4615D-02, 0.2265D-02, & + & -.1537D-02, -.5856D-02, -.9181D-02, -.1023D-01, -.8583D-02, & + & -.4844D-02, -.1984D-03, 0.4188D-02, 0.7570D-02, 0.9685D-02, & + & 0.1062D-01, 0.1064D-01, 0.1003D-01, 0.9054D-02, 0.7917D-02, & + & 0.6752D-02, 0.5644D-02, 0.4644D-02, 0.3768D-02, 0.3024D-02, & + & 0.2402D-02, 0.1891D-02, 0.1479D-02, 0.1148D-02, 0.8863D-03, & + & 0.6802D-03, 0.5196D-03, 0.3951D-03, 0.2992D-03, 0.2257D-03, & + & 0.1695D-03, 0.1270D-03, 0.9488D-04, 0.7065D-04, 0.5247D-04, & + & 0.3887D-04/ + + data (calcpts(j,27), j = 1,neta) /-.3332D-04, -.3329D-04, & + & -.4825D-04, -.4819D-04, -.6309D-04, -.6296D-04, -.7777D-04, & + & -.9248D-04, -.1071D-03, -.1364D-03, -.1505D-03, -.1792D-03, & + & -.2222D-03, -.2494D-03, -.3051D-03, -.3589D-03, -.4248D-03, & + & -.4865D-03, -.5719D-03, -.6482D-03, -.7412D-03, -.8295D-03, & + & -.9192D-03, -.9822D-03, -.9994D-03, -.9586D-03, -.8365D-03, & + & -.5633D-03, -.9504D-04, 0.5896D-03, 0.1553D-02, 0.2755D-02, & + & 0.4087D-02, 0.5337D-02, 0.6085D-02, 0.5854D-02, 0.4228D-02, & + & 0.1195D-02, -.2655D-02, -.6188D-02, -.8228D-02, -.8095D-02, & + & -.5908D-02, -.2429D-02, 0.1368D-02, 0.4683D-02, 0.7072D-02, & + & 0.8434D-02, 0.8900D-02, 0.8695D-02, 0.8056D-02, 0.7179D-02, & + & 0.6213D-02, 0.5253D-02, 0.4361D-02, 0.3564D-02, 0.2877D-02, & + & 0.2297D-02, 0.1817D-02, 0.1425D-02, 0.1110D-02, 0.8591D-03, & + & 0.6609D-03, 0.5058D-03, 0.3854D-03, 0.2922D-03, 0.2208D-03, & + & 0.1661D-03, 0.1246D-03, 0.9317D-04, 0.6945D-04, 0.5163D-04, & + & 0.3828D-04/ + + data (calcpts(j,28), j = 1,neta) /-.1367D-04, -.1365D-04, & + & -.2862D-04, -.2858D-04, -.2851D-04, -.4342D-04, -.4328D-04, & + & -.5807D-04, -.7277D-04, -.7232D-04, -.1017D-03, -.1157D-03, & + & -.1293D-03, -.1572D-03, -.1842D-03, -.2248D-03, -.2633D-03, & + & -.2987D-03, -.3447D-03, -.3991D-03, -.4439D-03, -.4897D-03, & + & -.5300D-03, -.5403D-03, -.5221D-03, -.4407D-03, -.2989D-03, & + & -.2706D-04, 0.3975D-03, 0.1014D-02, 0.1850D-02, 0.2886D-02, & + & 0.4067D-02, 0.5210D-02, 0.6002D-02, 0.6036D-02, 0.4981D-02, & + & 0.2682D-02, -.5298D-03, -.3840D-02, -.6280D-02, -.7128D-02, & + & -.6212D-02, -.3917D-02, -.9303D-03, 0.2049D-02, 0.4500D-02, & + & 0.6172D-02, 0.7042D-02, 0.7241D-02, 0.6951D-02, 0.6357D-02, & + & 0.5610D-02, 0.4815D-02, 0.4043D-02, 0.3336D-02, 0.2713D-02, & + & 0.2179D-02, 0.1734D-02, 0.1365D-02, 0.1067D-02, 0.8287D-03, & + & 0.6394D-03, 0.4906D-03, 0.3745D-03, 0.2845D-03, 0.2153D-03, & + & 0.1623D-03, 0.1219D-03, 0.9126D-04, 0.6811D-04, 0.5068D-04, & + & 0.3761D-04/ + + data (calcpts(j,29), j = 1,neta) /0.8002D-06, -.1419D-04, & + & -.1416D-04, -.1413D-04, -.1409D-04, -.1402D-04, -.2892D-04, & + & -.2877D-04, -.2856D-04, -.4325D-04, -.5778D-04, -.5711D-04, & + & -.7112D-04, -.8466D-04, -.1125D-03, -.1244D-03, -.1498D-03, & + & -.1730D-03, -.1931D-03, -.2236D-03, -.2473D-03, -.2610D-03, & + & -.2753D-03, -.2534D-03, -.2158D-03, -.1335D-03, 0.2768D-04, & + & 0.2657D-03, 0.6328D-03, 0.1148D-02, 0.1843D-02, 0.2699D-02, & + & 0.3677D-02, 0.4635D-02, 0.5363D-02, 0.5530D-02, 0.4838D-02, & + & 0.3127D-02, 0.5668D-03, -.2303D-02, -.4731D-02, -.6054D-02, & + & -.5981D-02, -.4655D-02, -.2514D-02, -.7367D-04, 0.2202D-02, & + & 0.3995D-02, 0.5164D-02, 0.5717D-02, 0.5769D-02, 0.5467D-02, & + & 0.4952D-02, 0.4334D-02, 0.3695D-02, 0.3085D-02, 0.2533D-02, & + & 0.2051D-02, 0.1640D-02, 0.1300D-02, 0.1021D-02, 0.7954D-03, & + & 0.6157D-03, 0.4738D-03, 0.3626D-03, 0.2761D-03, 0.2094D-03, & + & 0.1580D-03, 0.1189D-03, 0.8917D-04, 0.6664D-04, 0.4965D-04, & + & 0.3688D-04/ + + data (calcpts(j,30), j = 1,neta) /0.2726D-05, -.1226D-04, & + & -.1225D-04, -.1223D-04, -.1219D-04, -.1215D-04, -.1208D-04, & + & -.1198D-04, -.2683D-04, -.2661D-04, -.2628D-04, -.4081D-04, & + & -.4012D-04, -.5410D-04, -.6761D-04, -.6541D-04, -.7719D-04, & + & -.1025D-03, -.1105D-03, -.1154D-03, -.1305D-03, -.1237D-03, & + & -.1217D-03, -.8993D-04, -.5168D-04, 0.3277D-04, 0.1769D-03, & + & 0.3852D-03, 0.6838D-03, 0.1107D-02, 0.1652D-02, 0.2325D-02, & + & 0.3112D-02, 0.3884D-02, 0.4477D-02, 0.4672D-02, 0.4216D-02, & + & 0.2951D-02, 0.9433D-03, -.1449D-02, -.3665D-02, -.5139D-02, & + & -.5535D-02, -.4866D-02, -.3416D-02, -.1555D-02, 0.3704D-03, & + & 0.2080D-02, 0.3384D-02, 0.4200D-02, 0.4549D-02, 0.4527D-02, & + & 0.4248D-02, 0.3816D-02, 0.3319D-02, 0.2814D-02, 0.2337D-02, & + & 0.1910D-02, 0.1540D-02, 0.1228D-02, 0.9698D-03, 0.7593D-03, & + & 0.5900D-03, 0.4556D-03, 0.3496D-03, 0.2670D-03, 0.2029D-03, & + & 0.1536D-03, 0.1157D-03, 0.8690D-04, 0.6504D-04, 0.4852D-04, & + & 0.3610D-04/ + + data (calcpts(j,31), j = 1,neta) /0.1204D-05, 0.1211D-05, & + & 0.1222D-05, 0.1237D-05, 0.1259D-05, -.1371D-04, -.1366D-04, & + & -.1359D-04, -.1349D-04, -.1333D-04, -.1311D-04, -.1278D-04, & + & -.2730D-04, -.2659D-04, -.2556D-04, -.3904D-04, -.3680D-04, & + & -.4853D-04, -.4372D-04, -.5167D-04, -.5635D-04, -.4120D-04, & + & -.3402D-04, -.1605D-05, 0.4573D-04, 0.1297D-03, 0.2447D-03, & + & 0.4041D-03, 0.6562D-03, 0.9796D-03, 0.1404D-02, 0.1920D-02, & + & 0.2519D-02, 0.3115D-02, 0.3590D-02, 0.3764D-02, 0.3443D-02, & + & 0.2495D-02, 0.9307D-03, -.1023D-02, -.2965D-02, -.4429D-02, & + & -.5075D-02, -.4820D-02, -.3847D-02, -.2457D-02, -.9175D-03, & + & 0.5657D-03, 0.1835D-02, 0.2778D-02, 0.3347D-02, 0.3567D-02, & + & 0.3512D-02, 0.3267D-02, 0.2916D-02, 0.2522D-02, 0.2127D-02, & + & 0.1761D-02, 0.1433D-02, 0.1152D-02, 0.9153D-03, 0.7205D-03, & + & 0.5625D-03, 0.4360D-03, 0.3358D-03, 0.2572D-03, 0.1960D-03, & + & 0.1486D-03, 0.1123D-03, 0.8446D-04, 0.6331D-04, 0.4732D-04, & + & 0.3525D-04/ + + data (calcpts(j,32), j = 1,neta) /-.4108D-06, -.4060D-06, & + & -.3988D-06, -.3883D-06, -.1873D-05, -.1850D-05, -.3317D-05, & + & -.3268D-05, -.4697D-05, -.6092D-05, -.7438D-05, -.8712D-05, & + & -.9880D-05, -.1089D-04, -.1318D-04, -.1513D-04, -.1659D-04, & + & -.1733D-04, -.1702D-04, -.1515D-04, -.9533D-05, 0.9116D-06, & + & 0.1771D-04, 0.4607D-04, 0.8921D-04, 0.1533D-03, 0.2492D-03, & + & 0.3834D-03, 0.5712D-03, 0.8215D-03, 0.1145D-02, 0.1540D-02, & + & 0.1985D-02, 0.2433D-02, 0.2792D-02, 0.2929D-02, 0.2695D-02, & + & 0.1979D-02, 0.7654D-03, -.8107D-03, -.2468D-02, -.3849D-02, & + & -.4632D-02, -.4666D-02, -.4031D-02, -.2965D-02, -.1732D-02, & + & -.5033D-03, 0.6184D-03, 0.1553D-02, 0.2232D-02, 0.2630D-02, & + & 0.2766D-02, 0.2698D-02, 0.2493D-02, 0.2213D-02, 0.1905D-02, & + & 0.1600D-02, 0.1319D-02, 0.1070D-02, 0.8571D-03, 0.6791D-03, & + & 0.5331D-03, 0.4152D-03, 0.3211D-03, 0.2467D-03, 0.1886D-03, & + & 0.1434D-03, 0.1086D-03, 0.8187D-04, 0.6149D-04, 0.4602D-04, & + & 0.3434D-04/ + + data (calcpts(j,33), j = 1,neta) /-.1502D-05, -.1499D-05, & + & -.1494D-05, -.2987D-05, -.2976D-05, -.2960D-05, -.2938D-05, & + & -.2904D-05, -.2855D-05, -.4283D-05, -.4177D-05, -.4021D-05, & + & -.5293D-05, -.4958D-05, -.5967D-05, -.5246D-05, -.5687D-05, & + & -.4135D-05, -.1857D-05, 0.2986D-05, 0.9379D-05, 0.1956D-04, & + & 0.3607D-04, 0.6194D-04, 0.9788D-04, 0.1516D-03, 0.2260D-03, & + & 0.3319D-03, 0.4751D-03, 0.6637D-03, 0.9059D-03, 0.1200D-02, & + & 0.1530D-02, 0.1861D-02, 0.2124D-02, 0.2225D-02, 0.2050D-02, & + & 0.1508D-02, 0.5710D-03, -.6807D-03, -.2063D-02, -.3315D-02, & + & -.4162D-02, -.4421D-02, -.4069D-02, -.3260D-02, -.2236D-02, & + & -.1198D-02, -.2422D-03, 0.5943D-03, 0.1277D-02, 0.1765D-02, & + & 0.2043D-02, 0.2126D-02, 0.2058D-02, 0.1891D-02, 0.1669D-02, & + & 0.1431D-02, 0.1198D-02, 0.9835D-03, 0.7955D-03, 0.6352D-03, & + & 0.5020D-03, 0.3931D-03, 0.3054D-03, 0.2357D-03, 0.1807D-03, & + & 0.1379D-03, 0.1047D-03, 0.7910D-04, 0.5955D-04, 0.4466D-04, & + & 0.3338D-04/ + + data (calcpts(j,34), j = 1,neta) /-.6676D-06, -.6653D-06, & + & -.6619D-06, -.6570D-06, -.6497D-06, -.6391D-06, -.6234D-06, & + & -.6005D-06, -.5668D-06, -.5174D-06, -.4448D-06, -.3383D-06, & + & -.1820D-06, 0.4757D-07, 0.3840D-06, 0.8782D-06, 0.3104D-05, & + & 0.5667D-05, 0.8728D-05, 0.1252D-04, 0.2037D-04, 0.2979D-04, & + & 0.4449D-04, 0.6552D-04, 0.9590D-04, 0.1378D-03, 0.1958D-03, & + & 0.2772D-03, 0.3849D-03, 0.5267D-03, 0.7048D-03, 0.9213D-03, & + & 0.1163D-02, 0.1404D-02, 0.1595D-02, 0.1666D-02, 0.1531D-02, & + & 0.1122D-02, 0.4051D-03, -.5752D-03, -.1702D-02, -.2792D-02, & + & -.3638D-02, -.4057D-02, -.3963D-02, -.3408D-02, -.2568D-02, & + & -.1655D-02, -.8125D-03, -.8359D-04, 0.5332D-03, 0.1029D-02, & + & 0.1379D-02, 0.1572D-02, 0.1621D-02, 0.1560D-02, 0.1425D-02, & + & 0.1253D-02, 0.1070D-02, 0.8921D-03, 0.7305D-03, 0.5890D-03, & + & 0.4691D-03, 0.3697D-03, 0.2889D-03, 0.2240D-03, 0.1725D-03, & + & 0.1320D-03, 0.1005D-03, 0.7618D-04, 0.5748D-04, 0.4321D-04, & + & 0.3237D-04/ + + data (calcpts(j,35), j = 1,neta) /0.5347D-06, 0.5363D-06, & + & 0.5386D-06, 0.5419D-06, 0.5469D-06, 0.5542D-06, 0.5649D-06, & + & 0.5806D-06, 0.6036D-06, 0.6374D-06, 0.2187D-05, 0.2260D-05, & + & 0.2367D-05, 0.2524D-05, 0.4254D-05, 0.4592D-05, 0.6588D-05, & + & 0.8816D-05, 0.1288D-04, 0.1745D-04, 0.2274D-04, 0.3211D-04, & + & 0.4453D-04, 0.6073D-04, 0.8475D-04, 0.1181D-03, 0.1628D-03, & + & 0.2234D-03, 0.3054D-03, 0.4095D-03, 0.5410D-03, 0.6985D-03, & + & 0.8741D-03, 0.1048D-02, 0.1186D-02, 0.1233D-02, 0.1131D-02, & + & 0.8216D-03, 0.2791D-03, -.4777D-03, -.1375D-02, -.2291D-02, & + & -.3077D-02, -.3580D-02, -.3695D-02, -.3395D-02, -.2766D-02, & + & -.1979D-02, -.1205D-02, -.5397D-03, 0.7416D-05, 0.4582D-03, & + & 0.8161D-03, 0.1067D-02, 0.1201D-02, 0.1229D-02, 0.1175D-02, & + & 0.1069D-02, 0.9362D-03, 0.7963D-03, 0.6621D-03, 0.5404D-03, & + & 0.4347D-03, 0.3453D-03, 0.2716D-03, 0.2118D-03, 0.1638D-03, & + & 0.1259D-03, 0.9621D-04, 0.7313D-04, 0.5534D-04, 0.4170D-04, & + & 0.3129D-04/ + + data (calcpts(j,36), j = 1,neta) /-.1272D-06, -.1261D-06, & + & -.1245D-06, -.1222D-06, -.1188D-06, -.1139D-06, 0.1393D-05, & + & 0.1404D-05, 0.1420D-05, 0.1443D-05, 0.1477D-05, 0.1527D-05, & + & 0.3100D-05, 0.3207D-05, 0.4864D-05, 0.5095D-05, 0.6934D-05, & + & 0.8931D-05, 0.1266D-04, 0.1673D-04, 0.2130D-04, 0.2960D-04, & + & 0.3896D-04, 0.5288D-04, 0.7206D-04, 0.9603D-04, 0.1307D-03, & + & 0.1766D-03, 0.2366D-03, 0.3126D-03, 0.4092D-03, 0.5243D-03, & + & 0.6506D-03, 0.7755D-03, 0.8721D-03, 0.9047D-03, 0.8264D-03, & + & 0.5968D-03, 0.1887D-03, -.3877D-03, -.1088D-02, -.1834D-02, & + & -.2521D-02, -.3038D-02, -.3286D-02, -.3207D-02, -.2811D-02, & + & -.2193D-02, -.1499D-02, -.8651D-03, -.3506D-03, 0.5516D-04, & + & 0.3822D-03, 0.6395D-03, 0.8182D-03, 0.9113D-03, 0.9262D-03, & + & 0.8813D-03, 0.7983D-03, 0.6966D-03, 0.5905D-03, 0.4894D-03, & + & 0.3984D-03, 0.3197D-03, 0.2535D-03, 0.1989D-03, 0.1548D-03, & + & 0.1195D-03, 0.9167D-04, 0.6994D-04, 0.5308D-04, 0.4011D-04, & + & 0.3018D-04/ + + data (calcpts(j,37), j = 1,neta) /-.3661D-07, -.3588D-07, & + & -.3480D-07, -.3323D-07, -.3091D-07, -.2751D-07, 0.1477D-05, & + & 0.1485D-05, 0.1496D-05, 0.1511D-05, 0.1534D-05, 0.1568D-05, & + & 0.3118D-05, 0.3191D-05, 0.4799D-05, 0.4956D-05, 0.6688D-05, & + & 0.8527D-05, 0.1202D-04, 0.1426D-04, 0.1982D-04, 0.2589D-04, & + & 0.3269D-04, 0.4355D-04, 0.5745D-04, 0.7660D-04, 0.1035D-03, & + & 0.1364D-03, 0.1804D-03, 0.2378D-03, 0.3072D-03, 0.3892D-03, & + & 0.4797D-03, 0.5693D-03, 0.6385D-03, 0.6609D-03, 0.6013D-03, & + & 0.4300D-03, 0.1266D-03, -.3072D-03, -.8445D-03, -.1435D-02, & + & -.2010D-02, -.2491D-02, -.2801D-02, -.2875D-02, -.2689D-02, & + & -.2270D-02, -.1706D-02, -.1120D-02, -.6135D-03, -.2218D-03, & + & 0.7605D-04, 0.3118D-03, 0.4963D-03, 0.6232D-03, 0.6876D-03, & + & 0.6946D-03, 0.6579D-03, 0.5936D-03, 0.5163D-03, 0.4364D-03, & + & 0.3607D-03, 0.2929D-03, 0.2344D-03, 0.1855D-03, 0.1452D-03, & + & 0.1128D-03, 0.8695D-04, 0.6660D-04, 0.5073D-04, 0.3844D-04, & + & 0.2901D-04/ + + data (calcpts(j,38), j = 1,neta) /0.4340D-06, 0.4345D-06, & + & 0.4352D-06, 0.5863D-06, 0.5879D-06, 0.7402D-06, 0.8936D-06, & + & 0.1049D-05, 0.1206D-05, 0.1517D-05, 0.1832D-05, 0.2156D-05, & + & 0.2640D-05, 0.3290D-05, 0.4113D-05, 0.5120D-05, 0.6328D-05, & + & 0.7909D-05, 0.1005D-04, 0.1265D-04, 0.1623D-04, 0.2090D-04, & + & 0.2711D-04, 0.3525D-04, 0.4610D-04, 0.6057D-04, 0.7963D-04, & + & 0.1045D-03, 0.1369D-03, 0.1778D-03, 0.2282D-03, 0.2876D-03, & + & 0.3529D-03, 0.4165D-03, 0.4653D-03, 0.4797D-03, 0.4353D-03, & + & 0.3089D-03, 0.8466D-04, -.2385D-03, -.6450D-03, -.1103D-02, & + & -.1567D-02, -.1985D-02, -.2300D-02, -.2460D-02, -.2429D-02, & + & -.2195D-02, -.1796D-02, -.1306D-02, -.8268D-03, -.4301D-03, & + & -.1358D-03, 0.8103D-04, 0.2500D-03, 0.3818D-03, 0.4719D-03, & + & 0.5163D-03, 0.5186D-03, 0.4891D-03, 0.4398D-03, 0.3814D-03, & + & 0.3214D-03, 0.2650D-03, 0.2148D-03, 0.1714D-03, 0.1354D-03, & + & 0.1058D-03, 0.8203D-04, 0.6313D-04, 0.4828D-04, 0.3672D-04, & + & 0.2779D-04/ + + data (calcpts(j,39), j = 1,neta) /0.5623D-07, 0.5657D-07, & + & 0.2071D-06, 0.2078D-06, 0.3589D-06, 0.3605D-06, 0.5128D-06, & + & 0.6662D-06, 0.8212D-06, 0.9785D-06, 0.1289D-05, 0.1605D-05, & + & 0.2078D-05, 0.2562D-05, 0.3212D-05, 0.4036D-05, 0.5043D-05, & + & 0.6251D-05, 0.7983D-05, 0.1012D-04, 0.1287D-04, 0.1645D-04, & + & 0.2127D-04, 0.2748D-04, 0.3561D-04, 0.4644D-04, 0.6040D-04, & + & 0.7877D-04, 0.1022D-03, 0.1320D-03, 0.1684D-03, 0.2110D-03, & + & 0.2576D-03, 0.3029D-03, 0.3373D-03, 0.3468D-03, 0.3138D-03, & + & 0.2211D-03, 0.5647D-04, -.1822D-03, -.4860D-03, -.8348D-03, & + & -.1199D-02, -.1545D-02, -.1832D-02, -.2025D-02, -.2087D-02, & + & -.1997D-02, -.1755D-02, -.1398D-02, -.9886D-03, -.6044D-03, & + & -.2986D-03, -.7958D-04, 0.7717D-04, 0.1978D-03, 0.2916D-03, & + & 0.3554D-03, 0.3859D-03, 0.3857D-03, 0.3623D-03, 0.3247D-03, & + & 0.2808D-03, 0.2361D-03, 0.1942D-03, 0.1570D-03, 0.1251D-03, & + & 0.9858D-04, 0.7692D-04, 0.5953D-04, 0.4575D-04, 0.3493D-04, & + & 0.2653D-04/ + + data (calcpts(j,40), j = 1,neta) /0.5510D-07, 0.2053D-06, & + & 0.2057D-06, 0.2062D-06, 0.3569D-06, 0.3580D-06, 0.5096D-06, & + & 0.6619D-06, 0.8153D-06, 0.9703D-06, 0.1128D-05, 0.1438D-05, & + & 0.1754D-05, 0.2227D-05, 0.2711D-05, 0.3361D-05, 0.4185D-05, & + & 0.5192D-05, 0.6400D-05, 0.8132D-05, 0.1027D-04, 0.1302D-04, & + & 0.1660D-04, 0.2126D-04, 0.2732D-04, 0.3528D-04, 0.4562D-04, & + & 0.5906D-04, 0.7606D-04, 0.9755D-04, 0.1236D-03, 0.1542D-03, & + & 0.1874D-03, 0.2196D-03, 0.2437D-03, 0.2500D-03, 0.2255D-03, & + & 0.1579D-03, 0.3784D-04, -.1373D-03, -.3623D-03, -.6244D-03, & + & -.9049D-03, -.1181D-02, -.1427D-02, -.1616D-02, -.1722D-02, & + & -.1723D-02, -.1607D-02, -.1381D-02, -.1074D-02, -.7406D-03, & + & -.4383D-03, -.2052D-03, -.4368D-04, 0.6896D-04, 0.1547D-03, & + & 0.2212D-03, 0.2663D-03, 0.2872D-03, 0.2859D-03, 0.2676D-03, & + & 0.2391D-03, 0.2061D-03, 0.1729D-03, 0.1419D-03, 0.1145D-03, & + & 0.9106D-04, 0.7162D-04, 0.5580D-04, 0.4311D-04, 0.3307D-04, & + & 0.2523D-04/ + + data (calcpts(j,41), j = 1,neta) /0.1538D-06, 0.1540D-06, & + & 0.1542D-06, 0.3046D-06, 0.3051D-06, 0.4558D-06, 0.4569D-06, & + & 0.6085D-06, 0.6108D-06, 0.7642D-06, 0.9192D-06, 0.1227D-05, & + & 0.1387D-05, 0.1853D-05, 0.2176D-05, 0.2660D-05, 0.3310D-05, & + & 0.4134D-05, 0.5141D-05, 0.6349D-05, 0.8080D-05, 0.1007D-04, & + & 0.1282D-04, 0.1624D-04, 0.2075D-04, 0.2664D-04, 0.3413D-04, & + & 0.4397D-04, 0.5625D-04, 0.7167D-04, 0.9044D-04, 0.1121D-03, & + & 0.1358D-03, 0.1586D-03, 0.1756D-03, 0.1796D-03, 0.1617D-03, & + & 0.1126D-03, 0.2545D-04, -.1023D-03, -.2677D-03, -.4625D-03, & + & -.6750D-03, -.8898D-03, -.1090D-02, -.1259D-02, -.1376D-02, & + & -.1426D-02, -.1393D-02, -.1273D-02, -.1072D-02, -.8171D-03, & + & -.5502D-03, -.3156D-03, -.1398D-03, -.2141D-04, 0.5911D-04, & + & 0.1198D-03, 0.1670D-03, 0.1987D-03, 0.2130D-03, 0.2110D-03, & + & 0.1969D-03, 0.1755D-03, 0.1509D-03, 0.1263D-03, 0.1034D-03, & + & 0.8329D-04, 0.6615D-04, 0.5193D-04, 0.4039D-04, 0.3117D-04, & + & 0.2388D-04/ + + data (calcpts(j,42), j = 1,neta) /0.1268D-06, 0.1269D-06, & + & 0.1271D-06, 0.1273D-06, 0.2777D-06, 0.2782D-06, 0.2789D-06, & + & 0.4300D-06, 0.5816D-06, 0.5839D-06, 0.7373D-06, 0.8923D-06, & + & 0.1050D-05, 0.1360D-05, 0.1676D-05, 0.1999D-05, 0.2484D-05, & + & 0.3133D-05, 0.3957D-05, 0.4814D-05, 0.6172D-05, 0.7603D-05, & + & 0.9741D-05, 0.1219D-04, 0.1561D-04, 0.1981D-04, 0.2539D-04, & + & 0.3239D-04, 0.4125D-04, 0.5232D-04, 0.6577D-04, 0.8122D-04, & + & 0.9796D-04, 0.1141D-03, 0.1261D-03, 0.1287D-03, 0.1156D-03, & + & 0.8019D-04, 0.1712D-04, -.7555D-04, -.1962D-03, -.3400D-03, & + & -.4988D-03, -.6630D-03, -.8216D-03, -.9624D-03, -.1073D-02, & + & -.1142D-02, -.1157D-02, -.1108D-02, -.9944D-03, -.8232D-03, & + & -.6161D-03, -.4059D-03, -.2258D-03, -.9430D-04, -.8106D-05, & + & 0.4920D-04, 0.9207D-04, 0.1254D-03, 0.1477D-03, 0.1575D-03, & + & 0.1554D-03, 0.1445D-03, 0.1285D-03, 0.1102D-03, 0.9204D-04, & + & 0.7524D-04, 0.6046D-04, 0.4794D-04, 0.3757D-04, 0.2919D-04, & + & 0.2248D-04/ + + data (calcpts(j,43), j = 1,neta) /0.3333D-07, 0.3340D-07, & + & 0.1835D-06, 0.1837D-06, 0.1839D-06, 0.1842D-06, 0.3347D-06, & + & 0.3355D-06, 0.3366D-06, 0.4881D-06, 0.6405D-06, 0.6439D-06, & + & 0.7989D-06, 0.1106D-05, 0.1267D-05, 0.1583D-05, 0.1906D-05, & + & 0.2390D-05, 0.3040D-05, 0.3713D-05, 0.4571D-05, 0.5778D-05, & + & 0.7209D-05, 0.9196D-05, 0.1164D-04, 0.1475D-04, 0.1864D-04, & + & 0.2375D-04, 0.3010D-04, 0.3810D-04, 0.4761D-04, 0.5868D-04, & + & 0.7061D-04, 0.8200D-04, 0.9031D-04, 0.9201D-04, 0.8259D-04, & + & 0.5698D-04, 0.1157D-04, -.5540D-04, -.1431D-03, -.2484D-03, & + & -.3660D-03, -.4896D-03, -.6121D-03, -.7254D-03, -.8216D-03, & + & -.8921D-03, -.9283D-03, -.9227D-03, -.8695D-03, -.7683D-03, & + & -.6264D-03, -.4612D-03, -.2978D-03, -.1608D-03, -.6301D-04, & + & -.5616D-06, 0.4006D-04, 0.7022D-04, 0.9372D-04, 0.1094D-03, & + & 0.1160D-03, 0.1141D-03, 0.1058D-03, 0.9379D-04, 0.8031D-04, & + & 0.6693D-04, 0.5461D-04, 0.4381D-04, 0.3468D-04, 0.2715D-04, & + & 0.2104D-04/ + + data (calcpts(j,44), j = 1,neta) /0.8178D-07, 0.9683D-07, & + & 0.1119D-06, 0.1270D-06, 0.1572D-06, 0.1724D-06, 0.2177D-06, & + & 0.2632D-06, 0.3090D-06, 0.3701D-06, 0.4466D-06, 0.5540D-06, & + & 0.6624D-06, 0.8174D-06, 0.9897D-06, 0.1210D-05, 0.1481D-05, & + & 0.1835D-05, 0.2259D-05, 0.2788D-05, 0.3462D-05, 0.4319D-05, & + & 0.5406D-05, 0.6791D-05, 0.8566D-05, 0.1082D-04, 0.1369D-04, & + & 0.1736D-04, 0.2194D-04, 0.2760D-04, 0.3441D-04, 0.4223D-04, & + & 0.5065D-04, 0.5868D-04, 0.6457D-04, 0.6569D-04, 0.5879D-04, & + & 0.4045D-04, 0.7843D-05, -.4037D-04, -.1038D-03, -.1805D-03, & + & -.2670D-03, -.3590D-03, -.4519D-03, -.5404D-03, -.6195D-03, & + & -.6833D-03, -.7262D-03, -.7420D-03, -.7260D-03, -.6746D-03, & + & -.5881D-03, -.4730D-03, -.3430D-03, -.2173D-03, -.1139D-03, & + & -.4169D-04, 0.3367D-05, 0.3205D-04, 0.5322D-04, 0.6976D-04, & + & 0.8076D-04, 0.8520D-04, 0.8352D-04, 0.7725D-04, 0.6834D-04, & + & 0.5838D-04, 0.4857D-04, 0.3955D-04, 0.3168D-04, 0.2505D-04, & + & 0.1957D-04/ + + data (calcpts(j,45), j = 1,neta) /0.3399D-07, 0.4903D-07, & + & 0.4908D-07, 0.6415D-07, 0.9426D-07, 0.1094D-06, 0.1396D-06, & + & 0.1700D-06, 0.2155D-06, 0.2612D-06, 0.3223D-06, 0.3839D-06, & + & 0.4762D-06, 0.5846D-06, 0.7246D-06, 0.8820D-06, 0.1088D-05, & + & 0.1344D-05, 0.1652D-05, 0.2046D-05, 0.2546D-05, 0.3174D-05, & + & 0.3971D-05, 0.4982D-05, 0.6261D-05, 0.7899D-05, 0.9971D-05, & + & 0.1259D-04, 0.1587D-04, 0.1989D-04, 0.2474D-04, 0.3029D-04, & + & 0.3624D-04, 0.4189D-04, 0.4602D-04, 0.4677D-04, 0.4180D-04, & + & 0.2866D-04, 0.5308D-05, -.2928D-04, -.7499D-04, -.1305D-03, & + & -.1937D-03, -.2616D-03, -.3313D-03, -.3991D-03, -.4619D-03, & + & -.5157D-03, -.5569D-03, -.5813D-03, -.5850D-03, -.5648D-03, & + & -.5184D-03, -.4467D-03, -.3548D-03, -.2537D-03, -.1578D-03, & + & -.8039D-04, -.2727D-04, 0.5103D-05, 0.2530D-04, 0.4012D-04, & + & 0.5173D-04, 0.5943D-04, 0.6243D-04, 0.6099D-04, 0.5628D-04, & + & 0.4968D-04, 0.4236D-04, 0.3517D-04, 0.2860D-04, 0.2287D-04, & + & 0.1806D-04/ + + data (calcpts(j,46), j = 1,neta) /0.2403D-07, 0.3905D-07, & + & 0.5409D-07, 0.5414D-07, 0.6921D-07, 0.8432D-07, 0.1145D-06, & + & 0.1297D-06, 0.1601D-06, 0.1906D-06, 0.2363D-06, 0.2974D-06, & + & 0.3589D-06, 0.4363D-06, 0.5447D-06, 0.6547D-06, 0.8120D-06, & + & 0.1003D-05, 0.1229D-05, 0.1522D-05, 0.1886D-05, 0.2341D-05, & + & 0.2923D-05, 0.3645D-05, 0.4581D-05, 0.5753D-05, 0.7236D-05, & + & 0.9121D-05, 0.1145D-04, 0.1432D-04, 0.1775D-04, 0.2168D-04, & + & 0.2590D-04, 0.2987D-04, 0.3277D-04, 0.3325D-04, 0.2967D-04, & + & 0.2028D-04, 0.3616D-05, -.2114D-04, -.5397D-04, -.9405D-04, & + & -.1399D-03, -.1898D-03, -.2413D-03, -.2927D-03, -.3412D-03, & + & -.3847D-03, -.4206D-03, -.4463D-03, -.4591D-03, -.4560D-03, & + & -.4351D-03, -.3952D-03, -.3368D-03, -.2646D-03, -.1869D-03, & + & -.1142D-03, -.5652D-04, -.1763D-04, 0.5553D-05, 0.1974D-04, & + & 0.3009D-04, 0.3822D-04, 0.4360D-04, 0.4561D-04, 0.4443D-04, & + & 0.4090D-04, 0.3603D-04, 0.3067D-04, 0.2542D-04, 0.2064D-04, & + & 0.1816D-04/ + + data (calcpts(j,47), j = 1,neta) /0.3417D-07, 0.3418D-07, & + & 0.3421D-07, 0.4924D-07, 0.6429D-07, 0.6436D-07, 0.7947D-07, & + & 0.1096D-06, 0.1249D-06, 0.1552D-06, 0.1857D-06, 0.2314D-06, & + & 0.2775D-06, 0.3391D-06, 0.4014D-06, 0.4948D-06, 0.6048D-06, & + & 0.7472D-06, 0.9079D-06, 0.1119D-05, 0.1382D-05, 0.1716D-05, & + & 0.2140D-05, 0.2663D-05, 0.3339D-05, 0.4184D-05, 0.5248D-05, & + & 0.6591D-05, 0.8255D-05, 0.1029D-04, 0.1273D-04, 0.1550D-04, & + & 0.1847D-04, 0.2126D-04, 0.2327D-04, 0.2360D-04, 0.2103D-04, & + & 0.1434D-04, 0.2465D-05, -.1521D-04, -.3871D-04, -.6754D-04, & + & -.1007D-03, -.1370D-03, -.1751D-03, -.2133D-03, -.2503D-03, & + & -.2844D-03, -.3140D-03, -.3374D-03, -.3528D-03, -.3583D-03, & + & -.3521D-03, -.3326D-03, -.2990D-03, -.2525D-03, -.1964D-03, & + & -.1370D-03, -.8239D-04, -.3957D-04, -.1122D-04, 0.5333D-05, & + & 0.1525D-04, 0.2350D-04, 0.2827D-04, 0.3192D-04, 0.3325D-04, & + & 0.3231D-04, 0.3967D-04, 0.2610D-04, 0.2217D-04, 0.2139D-04, & + & 0.1488D-04/ + + data (calcpts(j,48), j = 1,neta) /0.1551D-07, 0.3052D-07, & + & 0.3053D-07, 0.3056D-07, 0.4559D-07, 0.4564D-07, 0.6072D-07, & + & 0.7582D-07, 0.9098D-07, 0.1062D-06, 0.1366D-06, 0.1671D-06, & + & 0.1978D-06, 0.2439D-06, 0.2904D-06, 0.3678D-06, 0.4462D-06, & + & 0.5412D-06, 0.6685D-06, 0.8143D-06, 0.1010D-05, 0.1258D-05, & + & 0.1547D-05, 0.1926D-05, 0.2419D-05, 0.3019D-05, 0.3787D-05, & + & 0.4727D-05, 0.5913D-05, 0.7366D-05, 0.9086D-05, 0.1104D-04, & + & 0.1313D-04, 0.1509D-04, 0.1650D-04, 0.1671D-04, 0.1489D-04, & + & 0.1013D-04, 0.1680D-05, -.1091D-04, -.2770D-04, -.4837D-04, & + & -.7228D-04, -.9860D-04, -.1264D-03, -.1548D-03, -.1824D-03, & + & -.2087D-03, -.2323D-03, -.2522D-03, -.2670D-03, -.2758D-03, & + & -.2771D-03, -.2696D-03, -.2523D-03, -.2250D-03, -.1884D-03, & + & -.1451D-03, -.1001D-03, -.5924D-04, -.2765D-04, -.7038D-05, & + & 0.4754D-05, 0.1169D-04, 0.1671D-04, 0.2068D-04, 0.2329D-04, & + & 0.2419D-04, 0.2344D-04, 0.2149D-04, 0.1885D-04, 0.1600D-04, & + & 0.1322D-04/ + + data (calcpts(j,49), j = 1,neta) /0.1268D-07, 0.1269D-07, & + & 0.2770D-07, 0.2771D-07, 0.2774D-07, 0.4277D-07, 0.4282D-07, & + & 0.5790D-07, 0.7300D-07, 0.7316D-07, 0.1034D-06, 0.1187D-06, & + & 0.1492D-06, 0.1800D-06, 0.2110D-06, 0.2576D-06, 0.3200D-06, & + & 0.3984D-06, 0.4784D-06, 0.5907D-06, 0.7364D-06, 0.9022D-06, & + & 0.1120D-05, 0.1394D-05, 0.1743D-05, 0.2175D-05, 0.2714D-05, & + & 0.3389D-05, 0.4234D-05, 0.5260D-05, 0.6466D-05, 0.7858D-05, & + & 0.9321D-05, 0.1070D-04, 0.1170D-04, 0.1182D-04, 0.1052D-04, & + & 0.7142D-05, 0.1146D-05, -.7803D-05, -.1976D-04, -.3455D-04, & + & -.5172D-04, -.7074D-04, -.9095D-04, -.1117D-03, -.1324D-03, & + & -.1522D-03, -.1706D-03, -.1866D-03, -.1996D-03, -.2088D-03, & + & -.2135D-03, -.2124D-03, -.2049D-03, -.1902D-03, -.1683D-03, & + & -.1398D-03, -.1068D-03, -.7290D-04, -.4251D-04, -.1928D-04, & + & -.4354D-05, 0.4011D-05, 0.8844D-05, 0.1234D-04, 0.1510D-04, & + & 0.1693D-04, 0.1753D-04, 0.1695D-04, 0.1551D-04, 0.1360D-04, & + & 0.1152D-04/ + + data (dlaeta(j), j = 1,neta) / & + & -6d0, -5.83333333d0, -5.66666667d0, -5.5d0, -5.33333333d0, & + & -5.16666667d0, -5d0, -4.83333333d0, -4.66666667d0, -4.5d0, & + & -4.33333333d0, -4.16666667d0, -4d0, -3.83333333d0, & + & -3.66666667d0, -3.5d0, -3.33333333d0, -3.16666667d0, -3d0, & + & -2.83333333d0, -2.66666667d0, -2.5d0, -2.33333333d0, & + & -2.16666667d0, -2d0, -1.83333333d0, -1.66666667d0, -1.5d0, & + & -1.33333333d0, -1.16666667d0, -1d0, -0.83333333d0, -0.66666667d0,& + & -0.5d0, -0.33333333d0, -0.16666667d0, 0d0, 0.16666667d0, & + & 0.33333333d0, 0.5d0, 0.66666667d0, 0.83333333d0, 1d0, & + & 1.16666667d0, 1.33333333d0, 1.5d0, 1.66666667d0, 1.83333333d0, & + & 2d0, 2.16666667d0, 2.33333333d0, 2.5d0, 2.66666667d0, & + & 2.83333333d0, 3d0, 3.16666667d0, 3.33333333d0, 3.5d0, & + & 3.66666667d0, 3.83333333d0, 4d0, 4.16666667d0, 4.33333333d0, & + & 4.5d0, 4.66666667d0, 4.83333333d0, 5d0, 5.16666667d0, & + & 5.33333333d0, 5.5d0, 5.66666667d0, 5.83333333d0, 6d0/ + + data (dlaxi(j), j = 1,nxi) / & + & -3d0, -2.83333333d0, -2.66666667d0, -2.5d0, -2.33333333d0, & + & -2.16666667d0, -2d0, -1.83333333d0, -1.66666667d0, -1.5d0, & + & -1.33333333d0, -1.16666667d0, -1d0, -0.83333333d0, -0.66666667d0,& + & -0.5d0, -0.33333333d0, -0.16666667d0, 0d0, 0.16666667d0, & + & 0.33333333d0, 0.5d0, 0.66666667d0, 0.83333333d0, 1d0, & + & 1.16666667d0, 1.33333333d0, 1.5d0, 1.66666667d0, 1.83333333d0, & + & 2d0, 2.16666667d0, 2.33333333d0, 2.5d0, 2.66666667d0, & + & 2.83333333d0, 3d0, 3.16666667d0, 3.33333333d0, 3.5d0, & + & 3.66666667d0, 3.83333333d0, 4d0, 4.16666667d0, 4.33333333d0, & + & 4.5d0, 4.66666667d0, 4.83333333d0, 5d0/ + + dleta = dlog10(eta) + dlxi = dlog10(xi) + if (dlxi .le. dlaxi(1)) dlxi = dlaxi(1) + if (dlxi .ge. dlaxi(nxi)) dlxi = dlaxi(nxi) + if (dleta .ge. dlaeta(neta)) dleta = dlaeta(neta) + if (dleta .le. dlaeta(1)) dleta = dlaeta(1) + call locate(dlaeta,neta, dleta, ieta) + call locate(dlaxi, nxi, dlxi, ixi) +! interpolating between the appropriate points + delxi = 1d0/6d0 + deleta = 1d0/6d0 +! lagrange 3-pt. + if (ixi .le. 2) ixi = 2 + if (ixi .ge. 48) ixi = 48 + if (ieta .le. 2) ieta = 2 + if (ieta .ge. 72) ieta = 72 + pxi = (dlxi - dlaxi(ixi))/delxi + f(-1) = pxi*(pxi-1d0)/2d0*calcpts(ieta-1,ixi-1) + & + & (1d0 - pxi**2)*calcpts(ieta-1,ixi) + & + & pxi*(pxi+1d0)/2d0*calcpts(ieta-1,ixi+1) + f(0) = pxi*(pxi-1d0)/2d0*calcpts(ieta,ixi-1) + & + & (1d0 - pxi**2)*calcpts(ieta,ixi) + & + & pxi*(pxi+1d0)/2d0*calcpts(ieta,ixi+1) + f(1) = pxi*(pxi-1d0)/2d0*calcpts(ieta+1,ixi-1) + & + & (1d0 - pxi**2)*calcpts(ieta+1,ixi) + & + & pxi*(pxi+1d0)/2d0*calcpts(ieta+1,ixi+1) + peta = (dleta - dlaeta(ieta))/deleta + h1_FTg = peta*(peta-1d0)/2d0*f(-1) + & + & (1d0 - peta**2)*f(0) + & + & peta*(peta+1d0)/2d0*f(1) +!MB + + peta*(peta+1d0)/2d0*f(1) + return + END + +! ========================================== + double precision function h1bar_Tg(eta,xi) +! ========================================== + +! eq (12) in PLB347 (1995) 143 - 151 for the transverse piece +! MSbar scheme +! This routine is called subctbar in the original code. +! Called sctbar in updated code (03/06/96). + + implicit none + integer neta, nxi + parameter (neta = 73, nxi = 49) + double precision calcpts(neta, nxi), dlaeta(neta), dlaxi(nxi) + double precision eta, xi, dleta, dlxi + double precision pxi, peta, f(-1:1), delxi, deleta + integer j, ieta, ixi + + data (calcpts(j, 1), j = 1,neta) /0.2829D-03, 0.3429D-03, & + & 0.4153D-03, 0.5032D-03, 0.6093D-03, 0.7385D-03, 0.8944D-03, & + & 0.1084D-02, 0.1313D-02, 0.1591D-02, 0.1928D-02, 0.2339D-02, & + & 0.2827D-02, 0.3429D-02, 0.4159D-02, 0.5038D-02, 0.6106D-02, & + & 0.7404D-02, 0.8979D-02, 0.1089D-01, 0.1322D-01, 0.1605D-01, & + & 0.1950D-01, 0.2372D-01, 0.2888D-01, 0.3520D-01, 0.4295D-01, & + & 0.5243D-01, 0.6398D-01, 0.7789D-01, 0.9419D-01, 0.1127D+00, & + & 0.1321D+00, 0.1504D+00, 0.1646D+00, 0.1713D+00, 0.1691D+00, & + & 0.1584D+00, 0.1416D+00, 0.1221D+00, 0.1025D+00, 0.8429D-01, & + & 0.6827D-01, 0.5456D-01, 0.4314D-01, 0.3383D-01, 0.2625D-01, & + & 0.2023D-01, 0.1549D-01, 0.1175D-01, 0.8913D-02, 0.6710D-02, & + & 0.4996D-02, 0.3763D-02, 0.2807D-02, 0.2058D-02, 0.1515D-02, & + & 0.1108D-02, 0.8360D-03, 0.6327D-03, 0.4304D-03, 0.2955D-03, & + & 0.2278D-03, 0.1604D-03, 0.9327D-04, 0.9293D-04, 0.9271D-04, & + & 0.2589D-04, 0.2578D-04, 0.2571D-04, 0.2566D-04, 0.2563D-04, & + & 0.2561D-04/ + + data (calcpts(j, 2), j = 1,neta) /0.2830D-03, 0.3423D-03, & + & 0.4154D-03, 0.5027D-03, 0.6095D-03, 0.7380D-03, 0.8946D-03, & + & 0.1083D-02, 0.1313D-02, 0.1591D-02, 0.1928D-02, 0.2333D-02, & + & 0.2828D-02, 0.3430D-02, 0.4153D-02, 0.5039D-02, 0.6107D-02, & + & 0.7399D-02, 0.8973D-02, 0.1089D-01, 0.1321D-01, 0.1604D-01, & + & 0.1950D-01, 0.2371D-01, 0.2888D-01, 0.3519D-01, 0.4294D-01, & + & 0.5242D-01, 0.6398D-01, 0.7789D-01, 0.9419D-01, 0.1127D+00, & + & 0.1321D+00, 0.1504D+00, 0.1645D+00, 0.1713D+00, 0.1691D+00, & + & 0.1584D+00, 0.1416D+00, 0.1221D+00, 0.1025D+00, 0.8429D-01, & + & 0.6827D-01, 0.5462D-01, 0.4320D-01, 0.3382D-01, 0.2623D-01, & + & 0.2021D-01, 0.1548D-01, 0.1173D-01, 0.8899D-02, 0.6697D-02, & + & 0.5049D-02, 0.3750D-02, 0.2794D-02, 0.2045D-02, 0.1501D-02, & + & 0.1094D-02, 0.8227D-03, 0.6194D-03, 0.4172D-03, 0.3490D-03, & + & 0.2146D-03, 0.1472D-03, 0.1467D-03, 0.7970D-04, 0.7948D-04, & + & 0.7932D-04, 0.1255D-04, 0.1248D-04, 0.1243D-04, 0.1240D-04, & + & 0.1237D-04/ + + data (calcpts(j, 3), j = 1,neta) /0.2825D-03, 0.3425D-03, & + & 0.4150D-03, 0.5030D-03, 0.6091D-03, 0.7384D-03, 0.8943D-03, & + & 0.1084D-02, 0.1313D-02, 0.1591D-02, 0.1927D-02, 0.2333D-02, & + & 0.2829D-02, 0.3431D-02, 0.4154D-02, 0.5033D-02, 0.6102D-02, & + & 0.7400D-02, 0.8975D-02, 0.1088D-01, 0.1322D-01, 0.1605D-01, & + & 0.1950D-01, 0.2372D-01, 0.2887D-01, 0.3519D-01, 0.4294D-01, & + & 0.5242D-01, 0.6397D-01, 0.7783D-01, 0.9418D-01, 0.1127D+00, & + & 0.1321D+00, 0.1503D+00, 0.1645D+00, 0.1713D+00, 0.1691D+00, & + & 0.1583D+00, 0.1416D+00, 0.1221D+00, 0.1025D+00, 0.8428D-01, & + & 0.6826D-01, 0.5460D-01, 0.4318D-01, 0.3380D-01, 0.2621D-01, & + & 0.2019D-01, 0.1546D-01, 0.1178D-01, 0.8880D-02, 0.6677D-02, & + & 0.5030D-02, 0.3730D-02, 0.2774D-02, 0.2092D-02, 0.1549D-02, & + & 0.1142D-02, 0.8033D-03, 0.6000D-03, 0.4644D-03, 0.3296D-03, & + & 0.2618D-03, 0.1945D-03, 0.1273D-03, 0.6031D-04, 0.6008D-04, & + & 0.5993D-04, 0.5982D-04, -.6914D-05, -.6963D-05, -.6996D-05, & + & -.7019D-05/ + + data (calcpts(j, 4), j = 1,neta) /0.2827D-03, 0.3428D-03, & + & 0.4153D-03, 0.5027D-03, 0.6089D-03, 0.7382D-03, 0.8942D-03, & + & 0.1083D-02, 0.1313D-02, 0.1591D-02, 0.1927D-02, 0.2335D-02, & + & 0.2830D-02, 0.3426D-02, 0.4156D-02, 0.5035D-02, 0.6104D-02, & + & 0.7403D-02, 0.8971D-02, 0.1089D-01, 0.1321D-01, 0.1604D-01, & + & 0.1949D-01, 0.2371D-01, 0.2887D-01, 0.3519D-01, 0.4293D-01, & + & 0.5241D-01, 0.6395D-01, 0.7783D-01, 0.9418D-01, 0.1126D+00, & + & 0.1320D+00, 0.1503D+00, 0.1644D+00, 0.1713D+00, 0.1691D+00, & + & 0.1583D+00, 0.1416D+00, 0.1221D+00, 0.1024D+00, 0.8428D-01, & + & 0.6826D-01, 0.5457D-01, 0.4315D-01, 0.3377D-01, 0.2625D-01, & + & 0.2023D-01, 0.1550D-01, 0.1175D-01, 0.8918D-02, 0.6715D-02, & + & 0.5001D-02, 0.3768D-02, 0.2813D-02, 0.2064D-02, 0.1520D-02, & + & 0.1113D-02, 0.8415D-03, 0.6382D-03, 0.4360D-03, 0.3011D-03, & + & 0.2334D-03, 0.1660D-03, 0.9883D-04, 0.9849D-04, 0.3160D-04, & + & 0.3145D-04, 0.3134D-04, 0.3127D-04, 0.3122D-04, 0.3119D-04, & + & 0.3117D-04/ + + data (calcpts(j, 5), j = 1,neta) /0.2824D-03, 0.3425D-03, & + & 0.4151D-03, 0.5025D-03, 0.6088D-03, 0.7382D-03, 0.8944D-03, & + & 0.1083D-02, 0.1313D-02, 0.1591D-02, 0.1927D-02, 0.2336D-02, & + & 0.2832D-02, 0.3428D-02, 0.4152D-02, 0.5031D-02, 0.6100D-02, & + & 0.7399D-02, 0.8968D-02, 0.1088D-01, 0.1321D-01, 0.1604D-01, & + & 0.1949D-01, 0.2370D-01, 0.2886D-01, 0.3518D-01, 0.4292D-01, & + & 0.5239D-01, 0.6393D-01, 0.7782D-01, 0.9411D-01, 0.1126D+00, & + & 0.1320D+00, 0.1503D+00, 0.1644D+00, 0.1713D+00, 0.1690D+00, & + & 0.1583D+00, 0.1415D+00, 0.1221D+00, 0.1024D+00, 0.8427D-01, & + & 0.6825D-01, 0.5459D-01, 0.4317D-01, 0.3380D-01, 0.2621D-01, & + & 0.2019D-01, 0.1545D-01, 0.1178D-01, 0.8876D-02, 0.6674D-02, & + & 0.5026D-02, 0.3727D-02, 0.2771D-02, 0.2089D-02, 0.1545D-02, & + & 0.1138D-02, 0.7997D-03, 0.5964D-03, 0.4608D-03, 0.3260D-03, & + & 0.2582D-03, 0.1909D-03, 0.1237D-03, 0.5670D-04, 0.5648D-04, & + & 0.5632D-04, 0.5622D-04, 0.5615D-04, -.1057D-04, -.1060D-04, & + & -.1062D-04/ + + data (calcpts(j, 6), j = 1,neta) /0.2829D-03, 0.3424D-03, & + & 0.4150D-03, 0.5026D-03, 0.6090D-03, 0.7379D-03, 0.8935D-03, & + & 0.1083D-02, 0.1312D-02, 0.1590D-02, 0.1925D-02, 0.2332D-02, & + & 0.2828D-02, 0.3424D-02, 0.4155D-02, 0.5035D-02, 0.6098D-02, & + & 0.7398D-02, 0.8967D-02, 0.1088D-01, 0.1320D-01, 0.1603D-01, & + & 0.1948D-01, 0.2369D-01, 0.2885D-01, 0.3516D-01, 0.4290D-01, & + & 0.5237D-01, 0.6390D-01, 0.7776D-01, 0.9410D-01, 0.1125D+00, & + & 0.1319D+00, 0.1502D+00, 0.1643D+00, 0.1711D+00, 0.1690D+00, & + & 0.1582D+00, 0.1415D+00, 0.1220D+00, 0.1024D+00, 0.8425D-01, & + & 0.6824D-01, 0.5459D-01, 0.4318D-01, 0.3380D-01, 0.2621D-01, & + & 0.2020D-01, 0.1546D-01, 0.1178D-01, 0.8882D-02, 0.6679D-02, & + & 0.5031D-02, 0.3732D-02, 0.2776D-02, 0.2094D-02, 0.1550D-02, & + & 0.1143D-02, 0.8052D-03, 0.6018D-03, 0.4662D-03, 0.3314D-03, & + & 0.2637D-03, 0.1963D-03, 0.1291D-03, 0.6213D-04, 0.6190D-04, & + & 0.6175D-04, 0.6164D-04, -.5098D-05, -.5147D-05, -.5180D-05, & + & -.5203D-05/ + + data (calcpts(j, 7), j = 1,neta) /0.2822D-03, 0.3418D-03, & + & 0.4146D-03, 0.5024D-03, 0.6083D-03, 0.7374D-03, 0.8933D-03, & + & 0.1082D-02, 0.1311D-02, 0.1589D-02, 0.1925D-02, 0.2335D-02, & + & 0.2825D-02, 0.3422D-02, 0.4147D-02, 0.5028D-02, 0.6098D-02, & + & 0.7392D-02, 0.8962D-02, 0.1087D-01, 0.1319D-01, 0.1602D-01, & + & 0.1947D-01, 0.2368D-01, 0.2883D-01, 0.3514D-01, 0.4287D-01, & + & 0.5234D-01, 0.6386D-01, 0.7775D-01, 0.9403D-01, 0.1124D+00, & + & 0.1318D+00, 0.1501D+00, 0.1642D+00, 0.1711D+00, 0.1689D+00, & + & 0.1581D+00, 0.1414D+00, 0.1220D+00, 0.1024D+00, 0.8422D-01, & + & 0.6822D-01, 0.5457D-01, 0.4315D-01, 0.3378D-01, 0.2626D-01, & + & 0.2024D-01, 0.1544D-01, 0.1176D-01, 0.8925D-02, 0.6722D-02, & + & 0.5008D-02, 0.3775D-02, 0.2820D-02, 0.2071D-02, 0.1527D-02, & + & 0.1120D-02, 0.8487D-03, 0.5787D-03, 0.4431D-03, 0.3083D-03, & + & 0.2405D-03, 0.1732D-03, 0.1060D-03, 0.1057D-03, 0.3878D-04, & + & 0.3863D-04, 0.3852D-04, 0.3845D-04, 0.3840D-04, 0.3837D-04, & + & 0.3835D-04/ + + data (calcpts(j, 8), j = 1,neta) /0.2819D-03, 0.3417D-03, & + & 0.4140D-03, 0.5020D-03, 0.6082D-03, 0.7369D-03, 0.8925D-03, & + & 0.1081D-02, 0.1311D-02, 0.1588D-02, 0.1923D-02, 0.2327D-02, & + & 0.2824D-02, 0.3422D-02, 0.4148D-02, 0.5023D-02, 0.6094D-02, & + & 0.7383D-02, 0.8954D-02, 0.1087D-01, 0.1319D-01, 0.1601D-01, & + & 0.1946D-01, 0.2366D-01, 0.2880D-01, 0.3511D-01, 0.4283D-01, & + & 0.5229D-01, 0.6380D-01, 0.7762D-01, 0.9395D-01, 0.1123D+00, & + & 0.1317D+00, 0.1500D+00, 0.1640D+00, 0.1709D+00, 0.1687D+00, & + & 0.1580D+00, 0.1414D+00, 0.1219D+00, 0.1023D+00, 0.8419D-01, & + & 0.6819D-01, 0.5450D-01, 0.4315D-01, 0.3378D-01, 0.2626D-01, & + & 0.2017D-01, 0.1544D-01, 0.1176D-01, 0.8926D-02, 0.6724D-02, & + & 0.5010D-02, 0.3777D-02, 0.2755D-02, 0.2073D-02, 0.1529D-02, & + & 0.1122D-02, 0.8504D-03, 0.5805D-03, 0.4449D-03, 0.3100D-03, & + & 0.2423D-03, 0.1749D-03, 0.1078D-03, 0.1074D-03, 0.4054D-04, & + & 0.4039D-04, 0.4028D-04, 0.4021D-04, 0.4016D-04, 0.4013D-04, & + & 0.4011D-04/ + + data (calcpts(j, 9), j = 1,neta) /0.2821D-03, 0.3414D-03, & + & 0.4141D-03, 0.5010D-03, 0.6076D-03, 0.7361D-03, 0.8916D-03, & + & 0.1080D-02, 0.1309D-02, 0.1585D-02, 0.1921D-02, 0.2328D-02, & + & 0.2820D-02, 0.3419D-02, 0.4139D-02, 0.5022D-02, 0.6082D-02, & + & 0.7378D-02, 0.8945D-02, 0.1085D-01, 0.1317D-01, 0.1599D-01, & + & 0.1943D-01, 0.2363D-01, 0.2877D-01, 0.3506D-01, 0.4277D-01, & + & 0.5221D-01, 0.6370D-01, 0.7755D-01, 0.9379D-01, 0.1121D+00, & + & 0.1315D+00, 0.1497D+00, 0.1638D+00, 0.1707D+00, 0.1685D+00, & + & 0.1579D+00, 0.1412D+00, 0.1218D+00, 0.1023D+00, 0.8414D-01, & + & 0.6816D-01, 0.5450D-01, 0.4309D-01, 0.3378D-01, 0.2620D-01, & + & 0.2018D-01, 0.1544D-01, 0.1177D-01, 0.8867D-02, 0.6665D-02, & + & 0.5017D-02, 0.3718D-02, 0.2762D-02, 0.2080D-02, 0.1537D-02, & + & 0.1130D-02, 0.7915D-03, 0.5882D-03, 0.4526D-03, 0.3177D-03, & + & 0.2500D-03, 0.1826D-03, 0.1155D-03, 0.1151D-03, 0.4825D-04, & + & 0.4810D-04, 0.4800D-04, 0.4793D-04, 0.4788D-04, -.1882D-04, & + & -.1885D-04/ + + data (calcpts(j,10), j = 1,neta) /0.2816D-03, 0.3406D-03, & + & 0.4130D-03, 0.5005D-03, 0.6063D-03, 0.7348D-03, 0.8897D-03, & + & 0.1078D-02, 0.1307D-02, 0.1583D-02, 0.1917D-02, 0.2324D-02, & + & 0.2812D-02, 0.3413D-02, 0.4136D-02, 0.5014D-02, 0.6076D-02, & + & 0.7362D-02, 0.8930D-02, 0.1083D-01, 0.1315D-01, 0.1596D-01, & + & 0.1939D-01, 0.2359D-01, 0.2871D-01, 0.3500D-01, 0.4269D-01, & + & 0.5211D-01, 0.6357D-01, 0.7734D-01, 0.9356D-01, 0.1119D+00, & + & 0.1311D+00, 0.1493D+00, 0.1634D+00, 0.1703D+00, 0.1682D+00, & + & 0.1576D+00, 0.1410D+00, 0.1217D+00, 0.1022D+00, 0.8406D-01, & + & 0.6810D-01, 0.5448D-01, 0.4307D-01, 0.3376D-01, 0.2618D-01, & + & 0.2016D-01, 0.1543D-01, 0.1175D-01, 0.8918D-02, 0.6716D-02, & + & 0.5002D-02, 0.3770D-02, 0.2814D-02, 0.2066D-02, 0.1522D-02, & + & 0.1115D-02, 0.8435D-03, 0.5735D-03, 0.4379D-03, 0.3031D-03, & + & 0.2354D-03, 0.1680D-03, 0.1008D-03, 0.1005D-03, 0.3361D-04, & + & 0.3346D-04, 0.3335D-04, 0.3328D-04, 0.3324D-04, 0.3320D-04, & + & 0.3318D-04/ + + data (calcpts(j,11), j = 1,neta) /0.2808D-03, 0.3397D-03, & + & 0.4121D-03, 0.4989D-03, 0.6049D-03, 0.7330D-03, 0.8876D-03, & + & 0.1076D-02, 0.1304D-02, 0.1579D-02, 0.1913D-02, 0.2318D-02, & + & 0.2811D-02, 0.3401D-02, 0.4126D-02, 0.5001D-02, 0.6060D-02, & + & 0.7342D-02, 0.8908D-02, 0.1080D-01, 0.1311D-01, 0.1592D-01, & + & 0.1934D-01, 0.2352D-01, 0.2864D-01, 0.3490D-01, 0.4257D-01, & + & 0.5195D-01, 0.6338D-01, 0.7713D-01, 0.9325D-01, 0.1115D+00, & + & 0.1307D+00, 0.1489D+00, 0.1630D+00, 0.1698D+00, 0.1678D+00, & + & 0.1573D+00, 0.1408D+00, 0.1215D+00, 0.1020D+00, 0.8395D-01, & + & 0.6802D-01, 0.5440D-01, 0.4305D-01, 0.3368D-01, 0.2616D-01, & + & 0.2015D-01, 0.1541D-01, 0.1174D-01, 0.8907D-02, 0.6705D-02, & + & 0.4991D-02, 0.3759D-02, 0.2804D-02, 0.2055D-02, 0.1512D-02, & + & 0.1105D-02, 0.8330D-03, 0.6298D-03, 0.4275D-03, 0.2927D-03, & + & 0.2250D-03, 0.1576D-03, 0.9045D-04, 0.9012D-04, 0.8989D-04, & + & 0.2308D-04, 0.2297D-04, 0.2290D-04, 0.2285D-04, 0.2282D-04, & + & 0.2280D-04/ + + data (calcpts(j,12), j = 1,neta) /0.2794D-03, 0.3384D-03, & + & 0.4104D-03, 0.4976D-03, 0.6028D-03, 0.7303D-03, 0.8845D-03, & + & 0.1072D-02, 0.1298D-02, 0.1573D-02, 0.1906D-02, 0.2310D-02, & + & 0.2798D-02, 0.3391D-02, 0.4107D-02, 0.4980D-02, 0.6037D-02, & + & 0.7318D-02, 0.8875D-02, 0.1076D-01, 0.1306D-01, 0.1586D-01, & + & 0.1927D-01, 0.2343D-01, 0.2853D-01, 0.3476D-01, 0.4239D-01, & + & 0.5173D-01, 0.6310D-01, 0.7678D-01, 0.9279D-01, 0.1109D+00, & + & 0.1301D+00, 0.1481D+00, 0.1622D+00, 0.1691D+00, 0.1672D+00, & + & 0.1568D+00, 0.1404D+00, 0.1212D+00, 0.1018D+00, 0.8379D-01, & + & 0.6790D-01, 0.5432D-01, 0.4298D-01, 0.3368D-01, 0.2616D-01, & + & 0.2015D-01, 0.1542D-01, 0.1174D-01, 0.8843D-02, 0.6708D-02, & + & 0.4995D-02, 0.3762D-02, 0.2807D-02, 0.2059D-02, 0.1515D-02, & + & 0.1108D-02, 0.8366D-03, 0.6334D-03, 0.4312D-03, 0.2963D-03, & + & 0.2286D-03, 0.1613D-03, 0.9411D-04, 0.9378D-04, 0.9356D-04, & + & 0.2674D-04, 0.2664D-04, 0.2657D-04, 0.2652D-04, 0.2649D-04, & + & 0.2647D-04/ + + data (calcpts(j,13), j = 1,neta) /0.2781D-03, 0.3369D-03, & + & 0.4082D-03, 0.4949D-03, 0.5992D-03, 0.7261D-03, 0.8799D-03, & + & 0.1066D-02, 0.1291D-02, 0.1565D-02, 0.1896D-02, 0.2297D-02, & + & 0.2783D-02, 0.3376D-02, 0.4084D-02, 0.4957D-02, 0.6001D-02, & + & 0.7282D-02, 0.8828D-02, 0.1071D-01, 0.1300D-01, 0.1577D-01, & + & 0.1916D-01, 0.2330D-01, 0.2836D-01, 0.3455D-01, 0.4214D-01, & + & 0.5141D-01, 0.6268D-01, 0.7623D-01, 0.9216D-01, 0.1102D+00, & + & 0.1291D+00, 0.1471D+00, 0.1611D+00, 0.1681D+00, 0.1663D+00, & + & 0.1560D+00, 0.1398D+00, 0.1208D+00, 0.1015D+00, 0.8356D-01, & + & 0.6773D-01, 0.5417D-01, 0.4290D-01, 0.3360D-01, 0.2609D-01, & + & 0.2015D-01, 0.1542D-01, 0.1174D-01, 0.8844D-02, 0.6643D-02, & + & 0.4997D-02, 0.3765D-02, 0.2810D-02, 0.2062D-02, 0.1518D-02, & + & 0.1111D-02, 0.8399D-03, 0.6366D-03, 0.4344D-03, 0.2996D-03, & + & 0.2319D-03, 0.1645D-03, 0.9741D-04, 0.9708D-04, 0.9686D-04, & + & 0.3005D-04, 0.2994D-04, 0.2987D-04, 0.2983D-04, 0.2979D-04, & + & 0.2977D-04/ + + data (calcpts(j,14), j = 1,neta) /0.2757D-03, 0.3342D-03, & + & 0.4053D-03, 0.4909D-03, 0.5944D-03, 0.7208D-03, 0.8734D-03, & + & 0.1058D-02, 0.1282D-02, 0.1553D-02, 0.1881D-02, 0.2279D-02, & + & 0.2760D-02, 0.3346D-02, 0.4057D-02, 0.4912D-02, 0.5959D-02, & + & 0.7225D-02, 0.8761D-02, 0.1063D-01, 0.1289D-01, 0.1565D-01, & + & 0.1901D-01, 0.2312D-01, 0.2813D-01, 0.3426D-01, 0.4177D-01, & + & 0.5094D-01, 0.6209D-01, 0.7546D-01, 0.9123D-01, 0.1090D+00, & + & 0.1277D+00, 0.1456D+00, 0.1595D+00, 0.1666D+00, 0.1649D+00, & + & 0.1550D+00, 0.1390D+00, 0.1201D+00, 0.1010D+00, 0.8322D-01, & + & 0.6748D-01, 0.5402D-01, 0.4276D-01, 0.3354D-01, 0.2604D-01, & + & 0.2009D-01, 0.1537D-01, 0.1169D-01, 0.8864D-02, 0.6664D-02, & + & 0.5018D-02, 0.3720D-02, 0.2765D-02, 0.2084D-02, 0.1540D-02, & + & 0.1134D-02, 0.7956D-03, 0.5924D-03, 0.4569D-03, 0.3221D-03, & + & 0.2544D-03, 0.1870D-03, 0.1199D-03, 0.1196D-03, 0.5270D-04, & + & 0.5255D-04, 0.5245D-04, 0.5238D-04, -.1433D-04, -.1436D-04, & + & -.1438D-04/ + + data (calcpts(j,15), j = 1,neta) /0.2728D-03, 0.3303D-03, & + & 0.4008D-03, 0.4855D-03, 0.5879D-03, 0.7125D-03, 0.8631D-03, & + & 0.1045D-02, 0.1267D-02, 0.1535D-02, 0.1860D-02, 0.2254D-02, & + & 0.2733D-02, 0.3311D-02, 0.4014D-02, 0.4862D-02, 0.5890D-02, & + & 0.7144D-02, 0.8656D-02, 0.1050D-01, 0.1274D-01, 0.1547D-01, & + & 0.1879D-01, 0.2284D-01, 0.2779D-01, 0.3384D-01, 0.4124D-01, & + & 0.5028D-01, 0.6126D-01, 0.7442D-01, 0.8991D-01, 0.1074D+00, & + & 0.1259D+00, 0.1435D+00, 0.1573D+00, 0.1644D+00, 0.1630D+00, & + & 0.1534D+00, 0.1378D+00, 0.1192D+00, 0.1004D+00, 0.8273D-01, & + & 0.6712D-01, 0.5375D-01, 0.4256D-01, 0.3335D-01, 0.2591D-01, & + & 0.1998D-01, 0.1532D-01, 0.1165D-01, 0.8822D-02, 0.6623D-02, & + & 0.4978D-02, 0.3748D-02, 0.2793D-02, 0.2045D-02, 0.1502D-02, & + & 0.1095D-02, 0.8240D-03, 0.6209D-03, 0.4188D-03, 0.3507D-03, & + & 0.2163D-03, 0.1490D-03, 0.1485D-03, 0.8154D-04, 0.8133D-04, & + & 0.1452D-04, 0.1442D-04, 0.1435D-04, 0.1431D-04, 0.1427D-04, & + & 0.1425D-04/ + + data (calcpts(j,16), j = 1,neta) /0.2682D-03, 0.3250D-03, & + & 0.3946D-03, 0.4778D-03, 0.5786D-03, 0.7010D-03, 0.8497D-03, & + & 0.1029D-02, 0.1247D-02, 0.1511D-02, 0.1830D-02, 0.2218D-02, & + & 0.2686D-02, 0.3253D-02, 0.3946D-02, 0.4780D-02, 0.5795D-02, & + & 0.7024D-02, 0.8518D-02, 0.1033D-01, 0.1254D-01, 0.1521D-01, & + & 0.1848D-01, 0.2246D-01, 0.2732D-01, 0.3325D-01, 0.4050D-01, & + & 0.4935D-01, 0.6008D-01, 0.7296D-01, 0.8805D-01, 0.1051D+00, & + & 0.1232D+00, 0.1404D+00, 0.1541D+00, 0.1614D+00, 0.1603D+00, & + & 0.1512D+00, 0.1361D+00, 0.1180D+00, 0.9940D-01, 0.8202D-01, & + & 0.6661D-01, 0.5338D-01, 0.4228D-01, 0.3315D-01, 0.2579D-01, & + & 0.1993D-01, 0.1528D-01, 0.1161D-01, 0.8786D-02, 0.6655D-02, & + & 0.4945D-02, 0.3715D-02, 0.2761D-02, 0.2080D-02, 0.1537D-02, & + & 0.1131D-02, 0.7928D-03, 0.5897D-03, 0.4543D-03, 0.3196D-03, & + & 0.2519D-03, 0.1846D-03, 0.1175D-03, 0.1172D-03, 0.5032D-04, & + & 0.5017D-04, 0.5008D-04, 0.5001D-04, 0.4997D-04, -.1673D-04, & + & -.1675D-04/ + + data (calcpts(j,17), j = 1,neta) /0.2625D-03, 0.3178D-03, & + & 0.3854D-03, 0.4667D-03, 0.5652D-03, 0.6851D-03, 0.8304D-03, & + & 0.1006D-02, 0.1219D-02, 0.1476D-02, 0.1789D-02, 0.2167D-02, & + & 0.2629D-02, 0.3185D-02, 0.3855D-02, 0.4675D-02, 0.5665D-02, & + & 0.6864D-02, 0.8322D-02, 0.1010D-01, 0.1225D-01, 0.1486D-01, & + & 0.1804D-01, 0.2192D-01, 0.2666D-01, 0.3243D-01, 0.3947D-01, & + & 0.4806D-01, 0.5845D-01, 0.7091D-01, 0.8548D-01, 0.1020D+00, & + & 0.1195D+00, 0.1363D+00, 0.1497D+00, 0.1571D+00, 0.1566D+00, & + & 0.1481D+00, 0.1336D+00, 0.1161D+00, 0.9804D-01, 0.8102D-01, & + & 0.6588D-01, 0.5284D-01, 0.4189D-01, 0.3291D-01, 0.2564D-01, & + & 0.1978D-01, 0.1514D-01, 0.1154D-01, 0.8721D-02, 0.6593D-02, & + & 0.4951D-02, 0.3722D-02, 0.2768D-02, 0.2022D-02, 0.1479D-02, & + & 0.1139D-02, 0.8017D-03, 0.5988D-03, 0.4634D-03, 0.3287D-03, & + & 0.2611D-03, 0.1938D-03, 0.1267D-03, 0.5977D-04, 0.5957D-04, & + & 0.5944D-04, 0.5934D-04, -.7387D-05, -.7430D-05, -.7460D-05, & + & -.7480D-05/ + + data (calcpts(j,18), j = 1,neta) /0.2543D-03, 0.3078D-03, & + & 0.3732D-03, 0.4520D-03, 0.5474D-03, 0.6629D-03, 0.8035D-03, & + & 0.9733D-03, 0.1180D-02, 0.1429D-02, 0.1731D-02, 0.2098D-02, & + & 0.2541D-02, 0.3079D-02, 0.3729D-02, 0.4525D-02, 0.5479D-02, & + & 0.6644D-02, 0.8051D-02, 0.9766D-02, 0.1184D-01, 0.1437D-01, & + & 0.1745D-01, 0.2119D-01, 0.2575D-01, 0.3131D-01, 0.3808D-01, & + & 0.4632D-01, 0.5627D-01, 0.6816D-01, 0.8206D-01, 0.9782D-01, & + & 0.1145D+00, 0.1306D+00, 0.1438D+00, 0.1513D+00, 0.1513D+00, & + & 0.1437D+00, 0.1302D+00, 0.1135D+00, 0.9614D-01, 0.7963D-01, & + & 0.6486D-01, 0.5210D-01, 0.4140D-01, 0.3251D-01, 0.2532D-01, & + & 0.1955D-01, 0.1505D-01, 0.1146D-01, 0.8710D-02, 0.6519D-02, & + & 0.4945D-02, 0.3651D-02, 0.2766D-02, 0.2020D-02, 0.1478D-02, & + & 0.1138D-02, 0.8008D-03, 0.5980D-03, 0.4628D-03, 0.3282D-03, & + & 0.2606D-03, 0.1934D-03, 0.1263D-03, 0.5934D-04, 0.5915D-04, & + & 0.5902D-04, 0.5893D-04, -.7793D-05, -.7834D-05, -.7862D-05, & + & -.7881D-05/ + + data (calcpts(j,19), j = 1,neta) /0.2427D-03, 0.2943D-03, & + & 0.3564D-03, 0.4321D-03, 0.5233D-03, 0.6339D-03, 0.7677D-03, & + & 0.9304D-03, 0.1128D-02, 0.1366D-02, 0.1654D-02, 0.2005D-02, & + & 0.2429D-02, 0.2943D-02, 0.3568D-02, 0.4323D-02, 0.5235D-02, & + & 0.6346D-02, 0.7694D-02, 0.9331D-02, 0.1131D-01, 0.1372D-01, & + & 0.1665D-01, 0.2022D-01, 0.2455D-01, 0.2983D-01, 0.3625D-01, & + & 0.4403D-01, 0.5342D-01, 0.6460D-01, 0.7767D-01, 0.9241D-01, & + & 0.1081D+00, 0.1234D+00, 0.1360D+00, 0.1437D+00, 0.1443D+00, & + & 0.1378D+00, 0.1256D+00, 0.1100D+00, 0.9352D-01, 0.7771D-01, & + & 0.6346D-01, 0.5109D-01, 0.4065D-01, 0.3199D-01, 0.2496D-01, & + & 0.1934D-01, 0.1485D-01, 0.1134D-01, 0.8593D-02, 0.6472D-02, & + & 0.4902D-02, 0.3676D-02, 0.2725D-02, 0.2047D-02, 0.1505D-02, & + & 0.1100D-02, 0.8295D-03, 0.6269D-03, 0.4251D-03, 0.2906D-03, & + & 0.2231D-03, 0.1559D-03, 0.8884D-04, 0.8859D-04, 0.8841D-04, & + & 0.2162D-04, 0.2154D-04, 0.2149D-04, 0.2145D-04, 0.2142D-04, & + & 0.2140D-04/ + + data (calcpts(j,20), j = 1,neta) /0.2281D-03, 0.2765D-03, & + & 0.3351D-03, 0.4057D-03, 0.4920D-03, 0.5961D-03, 0.7219D-03, & + & 0.8744D-03, 0.1060D-02, 0.1284D-02, 0.1555D-02, 0.1885D-02, & + & 0.2284D-02, 0.2768D-02, 0.3353D-02, 0.4060D-02, 0.4921D-02, & + & 0.5965D-02, 0.7228D-02, 0.8768D-02, 0.1063D-01, 0.1289D-01, & + & 0.1564D-01, 0.1897D-01, 0.2303D-01, 0.2795D-01, 0.3393D-01, & + & 0.4116D-01, 0.4985D-01, 0.6017D-01, 0.7220D-01, 0.8575D-01, & + & 0.1002D+00, 0.1144D+00, 0.1263D+00, 0.1338D+00, 0.1352D+00, & + & 0.1300D+00, 0.1193D+00, 0.1053D+00, 0.8999D-01, 0.7513D-01, & + & 0.6159D-01, 0.4974D-01, 0.3967D-01, 0.3130D-01, 0.2449D-01, & + & 0.1896D-01, 0.1462D-01, 0.1112D-01, 0.8449D-02, 0.6401D-02, & + & 0.4834D-02, 0.3611D-02, 0.2662D-02, 0.1985D-02, 0.1511D-02, & + & 0.1106D-02, 0.7688D-03, 0.5665D-03, 0.4316D-03, 0.2972D-03, & + & 0.2298D-03, 0.1626D-03, 0.9560D-04, 0.9537D-04, 0.2855D-04, & + & 0.2844D-04, 0.2836D-04, 0.2831D-04, 0.2828D-04, 0.2826D-04, & + & 0.2824D-04/ + + data (calcpts(j,21), j = 1,neta) /0.2103D-03, 0.2549D-03, & + & 0.3087D-03, 0.3736D-03, 0.4527D-03, 0.5489D-03, 0.6649D-03, & + & 0.8050D-03, 0.9762D-03, 0.1182D-02, 0.1432D-02, 0.1735D-02, & + & 0.2103D-02, 0.2547D-02, 0.3085D-02, 0.3741D-02, 0.4530D-02, & + & 0.5493D-02, 0.6658D-02, 0.8067D-02, 0.9784D-02, 0.1186D-01, & + & 0.1438D-01, 0.1744D-01, 0.2116D-01, 0.2566D-01, 0.3112D-01, & + & 0.3769D-01, 0.4558D-01, 0.5491D-01, 0.6575D-01, 0.7794D-01, & + & 0.9094D-01, 0.1037D+00, 0.1147D+00, 0.1220D+00, 0.1241D+00, & + & 0.1202D+00, 0.1113D+00, 0.9908D-01, 0.8539D-01, 0.7177D-01, & + & 0.5916D-01, 0.4799D-01, 0.3842D-01, 0.3041D-01, 0.2384D-01, & + & 0.1852D-01, 0.1426D-01, 0.1091D-01, 0.8312D-02, 0.6336D-02, & + & 0.4774D-02, 0.3554D-02, 0.2674D-02, 0.1998D-02, 0.1458D-02, & + & 0.1120D-02, 0.7841D-03, 0.5821D-03, 0.4474D-03, 0.3131D-03, & + & 0.2458D-03, 0.1787D-03, 0.1117D-03, 0.1115D-03, 0.4471D-04, & + & 0.4462D-04, 0.4455D-04, 0.4451D-04, 0.4448D-04, 0.4446D-04, & + & 0.4445D-04/ + + data (calcpts(j,22), j = 1,neta) /0.1892D-03, 0.2287D-03, & + & 0.2776D-03, 0.3361D-03, 0.4075D-03, 0.4932D-03, 0.5976D-03, & + & 0.7242D-03, 0.8775D-03, 0.1063D-02, 0.1288D-02, 0.1560D-02, & + & 0.1890D-02, 0.2291D-02, 0.2775D-02, 0.3362D-02, 0.4075D-02, & + & 0.4940D-02, 0.5984D-02, 0.7251D-02, 0.8790D-02, 0.1066D-01, & + & 0.1292D-01, 0.1566D-01, 0.1898D-01, 0.2301D-01, 0.2788D-01, & + & 0.3373D-01, 0.4073D-01, 0.4899D-01, 0.5855D-01, 0.6927D-01, & + & 0.8071D-01, 0.9201D-01, 0.1019D+00, 0.1087D+00, 0.1111D+00, & + & 0.1086D+00, 0.1016D+00, 0.9138D-01, 0.7959D-01, 0.6752D-01, & + & 0.5609D-01, 0.4579D-01, 0.3685D-01, 0.2929D-01, 0.2304D-01, & + & 0.1796D-01, 0.1389D-01, 0.1066D-01, 0.8130D-02, 0.6135D-02, & + & 0.4644D-02, 0.3495D-02, 0.2617D-02, 0.1942D-02, 0.1470D-02, & + & 0.1067D-02, 0.7975D-03, 0.5958D-03, 0.3947D-03, 0.3272D-03, & + & 0.2600D-03, 0.1930D-03, 0.1261D-03, 0.5924D-04, 0.5913D-04, & + & 0.5905D-04, 0.5900D-04, 0.5896D-04, -.7732D-05, -.7749D-05, & + & -.7760D-05/ + + data (calcpts(j,23), j = 1,neta) /0.1655D-03, 0.2005D-03, & + & 0.2427D-03, 0.2942D-03, 0.3569D-03, 0.4318D-03, 0.5232D-03, & + & 0.6342D-03, 0.7686D-03, 0.9306D-03, 0.1128D-02, 0.1366D-02, & + & 0.1655D-02, 0.2006D-02, 0.2430D-02, 0.2944D-02, 0.3566D-02, & + & 0.4324D-02, 0.5236D-02, 0.6346D-02, 0.7697D-02, 0.9327D-02, & + & 0.1130D-01, 0.1370D-01, 0.1660D-01, 0.2012D-01, 0.2435D-01, & + & 0.2944D-01, 0.3551D-01, 0.4267D-01, 0.5093D-01, 0.6019D-01, & + & 0.7004D-01, 0.7982D-01, 0.8841D-01, 0.9454D-01, 0.9712D-01, & + & 0.9561D-01, 0.9035D-01, 0.8227D-01, 0.7258D-01, 0.6234D-01, & + & 0.5234D-01, 0.4311D-01, 0.3494D-01, 0.2794D-01, 0.2208D-01, & + & 0.1727D-01, 0.1340D-01, 0.1032D-01, 0.7891D-02, 0.6003D-02, & + & 0.4538D-02, 0.3418D-02, 0.2556D-02, 0.1909D-02, 0.1419D-02, & + & 0.1049D-02, 0.7738D-03, 0.5724D-03, 0.4115D-03, 0.3043D-03, & + & 0.2172D-03, 0.1635D-03, 0.1167D-03, 0.8322D-04, 0.5646D-04, & + & 0.4307D-04, 0.2969D-04, 0.2300D-04, 0.1631D-04, 0.9633D-05, & + & 0.2957D-05/ + + data (calcpts(j,24), j = 1,neta) /0.1409D-03, 0.1707D-03, & + & 0.2069D-03, 0.2508D-03, 0.3035D-03, 0.3675D-03, 0.4456D-03, & + & 0.5401D-03, 0.6543D-03, 0.7925D-03, 0.9600D-03, 0.1164D-02, & + & 0.1410D-02, 0.1708D-02, 0.2069D-02, 0.2507D-02, 0.3038D-02, & + & 0.3684D-02, 0.4462D-02, 0.5404D-02, 0.6550D-02, 0.7939D-02, & + & 0.9619D-02, 0.1166D-01, 0.1413D-01, 0.1711D-01, 0.2072D-01, & + & 0.2504D-01, 0.3019D-01, 0.3626D-01, 0.4327D-01, 0.5112D-01, & + & 0.5950D-01, 0.6782D-01, 0.7521D-01, 0.8060D-01, 0.8310D-01, & + & 0.8228D-01, 0.7840D-01, 0.7221D-01, 0.6458D-01, 0.5629D-01, & + & 0.4793D-01, 0.3996D-01, 0.3271D-01, 0.2636D-01, 0.2096D-01, & + & 0.1649D-01, 0.1285D-01, 0.9932D-02, 0.7623D-02, 0.5816D-02, & + & 0.4408D-02, 0.3325D-02, 0.2498D-02, 0.1867D-02, 0.1391D-02, & + & 0.1029D-02, 0.7605D-03, 0.5595D-03, 0.4122D-03, 0.3051D-03, & + & 0.2181D-03, 0.1579D-03, 0.1177D-03, 0.8429D-04, 0.6423D-04, & + & 0.4418D-04, 0.3082D-04, 0.2413D-04, 0.1745D-04, 0.1077D-04, & + & 0.1076D-04/ + + data (calcpts(j,25), j = 1,neta) /0.1168D-03, 0.1415D-03, & + & 0.1715D-03, 0.2077D-03, 0.2514D-03, 0.3048D-03, 0.3695D-03, & + & 0.4475D-03, 0.5420D-03, 0.6569D-03, 0.7959D-03, 0.9642D-03, & + & 0.1169D-02, 0.1415D-02, 0.1715D-02, 0.2078D-02, 0.2518D-02, & + & 0.3051D-02, 0.3697D-02, 0.4481D-02, 0.5431D-02, 0.6581D-02, & + & 0.7974D-02, 0.9667D-02, 0.1171D-01, 0.1419D-01, 0.1717D-01, & + & 0.2076D-01, 0.2503D-01, 0.3008D-01, 0.3591D-01, 0.4247D-01, & + & 0.4949D-01, 0.5653D-01, 0.6285D-01, 0.6757D-01, 0.6993D-01, & + & 0.6954D-01, 0.6664D-01, 0.6189D-01, 0.5601D-01, 0.4956D-01, & + & 0.4291D-01, 0.3634D-01, 0.3015D-01, 0.2456D-01, 0.1970D-01, & + & 0.1560D-01, 0.1222D-01, 0.9487D-02, 0.7313D-02, 0.5599D-02, & + & 0.4256D-02, 0.3222D-02, 0.2424D-02, 0.1814D-02, 0.1359D-02, & + & 0.1011D-02, 0.7496D-03, 0.5489D-03, 0.4018D-03, 0.2948D-03, & + & 0.2146D-03, 0.1611D-03, 0.1143D-03, 0.8092D-04, 0.6087D-04, & + & 0.4084D-04, 0.3415D-04, 0.2080D-04, 0.1413D-04, 0.1412D-04, & + & 0.7449D-05/ + + data (calcpts(j,26), j = 1,neta) /0.9441D-04, 0.1144D-03, & + & 0.1386D-03, 0.1679D-03, 0.2035D-03, 0.2465D-03, 0.2988D-03, & + & 0.3618D-03, 0.4387D-03, 0.5310D-03, 0.6434D-03, 0.7796D-03, & + & 0.9444D-03, 0.1144D-02, 0.1386D-02, 0.1680D-02, 0.2035D-02, & + & 0.2466D-02, 0.2989D-02, 0.3622D-02, 0.4389D-02, 0.5322D-02, & + & 0.6448D-02, 0.7811D-02, 0.9470D-02, 0.1148D-01, 0.1389D-01, & + & 0.1680D-01, 0.2027D-01, 0.2438D-01, 0.2914D-01, 0.3452D-01, & + & 0.4033D-01, 0.4624D-01, 0.5164D-01, 0.5581D-01, 0.5808D-01, & + & 0.5806D-01, 0.5589D-01, 0.5214D-01, 0.4753D-01, 0.4257D-01, & + & 0.3746D-01, 0.3231D-01, 0.2728D-01, 0.2255D-01, 0.1829D-01, & + & 0.1461D-01, 0.1153D-01, 0.8999D-02, 0.6966D-02, 0.5350D-02, & + & 0.4084D-02, 0.3099D-02, 0.2343D-02, 0.1761D-02, 0.1313D-02, & + & 0.9785D-03, 0.7245D-03, 0.5374D-03, 0.3904D-03, 0.2902D-03, & + & 0.2101D-03, 0.1567D-03, 0.1099D-03, 0.7655D-04, 0.5652D-04, & + & 0.4316D-04, 0.2982D-04, 0.1647D-04, 0.1647D-04, 0.9795D-05, & + & 0.3125D-05/ + + data (calcpts(j,27), j = 1,neta) /0.7459D-04, 0.9038D-04, & + & 0.1096D-03, 0.1328D-03, 0.1608D-03, 0.1948D-03, 0.2361D-03, & + & 0.2860D-03, 0.3463D-03, 0.4201D-03, 0.5086D-03, 0.6162D-03, & + & 0.7467D-03, 0.9047D-03, 0.1096D-02, 0.1328D-02, 0.1609D-02, & + & 0.1950D-02, 0.2363D-02, 0.2863D-02, 0.3470D-02, 0.4206D-02, & + & 0.5098D-02, 0.6182D-02, 0.7492D-02, 0.9074D-02, 0.1099D-01, & + & 0.1330D-01, 0.1607D-01, 0.1933D-01, 0.2315D-01, 0.2749D-01, & + & 0.3223D-01, 0.3712D-01, 0.4171D-01, 0.4543D-01, 0.4767D-01, & + & 0.4805D-01, 0.4654D-01, 0.4356D-01, 0.3980D-01, 0.3583D-01, & + & 0.3191D-01, 0.2802D-01, 0.2413D-01, 0.2032D-01, 0.1674D-01, & + & 0.1353D-01, 0.1078D-01, 0.8474D-02, 0.6599D-02, 0.5100D-02, & + & 0.3910D-02, 0.2980D-02, 0.2259D-02, 0.1704D-02, 0.1277D-02, & + & 0.9560D-03, 0.7089D-03, 0.5286D-03, 0.3884D-03, 0.2883D-03, & + & 0.2149D-03, 0.1548D-03, 0.1148D-03, 0.8145D-04, 0.6143D-04, & + & 0.4808D-04, 0.3474D-04, 0.2807D-04, 0.2140D-04, 0.1473D-04, & + & 0.1472D-04/ + + data (calcpts(j,28), j = 1,neta) /0.5791D-04, 0.7018D-04, & + & 0.8503D-04, 0.1030D-03, 0.1248D-03, 0.1512D-03, 0.1832D-03, & + & 0.2219D-03, 0.2689D-03, 0.3258D-03, 0.3947D-03, 0.4780D-03, & + & 0.5794D-03, 0.7018D-03, 0.8505D-03, 0.1030D-02, 0.1249D-02, & + & 0.1513D-02, 0.1834D-02, 0.2222D-02, 0.2693D-02, 0.3264D-02, & + & 0.3956D-02, 0.4796D-02, 0.5814D-02, 0.7043D-02, 0.8538D-02, & + & 0.1034D-01, 0.1248D-01, 0.1505D-01, 0.1805D-01, 0.2148D-01, & + & 0.2527D-01, 0.2925D-01, 0.3310D-01, 0.3637D-01, 0.3858D-01, & + & 0.3935D-01, 0.3852D-01, 0.3628D-01, 0.3320D-01, 0.2986D-01, & + & 0.2667D-01, 0.2369D-01, 0.2079D-01, 0.1789D-01, 0.1503D-01, & + & 0.1235D-01, 0.9957D-02, 0.7905D-02, 0.6194D-02, 0.4811D-02, & + & 0.3709D-02, 0.2841D-02, 0.2160D-02, 0.1633D-02, 0.1232D-02, & + & 0.9185D-03, 0.6850D-03, 0.5115D-03, 0.3781D-03, 0.2780D-03, & + & 0.2046D-03, 0.1512D-03, 0.1112D-03, 0.7787D-04, 0.5786D-04, & + & 0.4452D-04, 0.3119D-04, 0.2452D-04, 0.1785D-04, 0.1118D-04, & + & 0.1118D-04/ + + data (calcpts(j,29), j = 1,neta) /0.4422D-04, 0.5359D-04, & + & 0.6494D-04, 0.7870D-04, 0.9534D-04, 0.1155D-03, 0.1400D-03, & + & 0.1695D-03, 0.2054D-03, 0.2489D-03, 0.3015D-03, 0.3653D-03, & + & 0.4423D-03, 0.5363D-03, 0.6496D-03, 0.7869D-03, 0.9536D-03, & + & 0.1156D-02, 0.1400D-02, 0.1697D-02, 0.2057D-02, 0.2493D-02, & + & 0.3022D-02, 0.3664D-02, 0.4441D-02, 0.5384D-02, 0.6524D-02, & + & 0.7899D-02, 0.9553D-02, 0.1153D-01, 0.1384D-01, 0.1651D-01, & + & 0.1948D-01, 0.2266D-01, 0.2581D-01, 0.2862D-01, 0.3073D-01, & + & 0.3179D-01, 0.3158D-01, 0.3012D-01, 0.2772D-01, 0.2490D-01, & + & 0.2214D-01, 0.1968D-01, 0.1747D-01, 0.1533D-01, 0.1318D-01, & + & 0.1106D-01, 0.9063D-02, 0.7286D-02, 0.5765D-02, 0.4510D-02, & + & 0.3496D-02, 0.2688D-02, 0.2055D-02, 0.1561D-02, 0.1174D-02, & + & 0.8874D-03, 0.6607D-03, 0.4939D-03, 0.3672D-03, 0.2672D-03, & + & 0.2005D-03, 0.1472D-03, 0.1071D-03, 0.7381D-04, 0.5380D-04, & + & 0.4047D-04, 0.2713D-04, 0.2046D-04, 0.1379D-04, 0.7127D-05, & + & 0.7127D-05/ + + data (calcpts(j,30), j = 1,neta) /0.3339D-04, 0.4040D-04, & + & 0.4896D-04, 0.5931D-04, 0.7186D-04, 0.8708D-04, 0.1055D-03, & + & 0.1279D-03, 0.1549D-03, 0.1876D-03, 0.2273D-03, 0.2755D-03, & + & 0.3337D-03, 0.4043D-03, 0.4899D-03, 0.5933D-03, 0.7195D-03, & + & 0.8717D-03, 0.1056D-02, 0.1280D-02, 0.1551D-02, 0.1880D-02, & + & 0.2279D-02, 0.2763D-02, 0.3350D-02, 0.4061D-02, 0.4922D-02, & + & 0.5962D-02, 0.7212D-02, 0.8703D-02, 0.1047D-01, 0.1251D-01, & + & 0.1481D-01, 0.1729D-01, 0.1981D-01, 0.2216D-01, 0.2408D-01, & + & 0.2527D-01, 0.2553D-01, 0.2477D-01, 0.2311D-01, 0.2086D-01, & + & 0.1846D-01, 0.1628D-01, 0.1443D-01, 0.1281D-01, 0.1125D-01, & + & 0.9669D-02, 0.8097D-02, 0.6622D-02, 0.5310D-02, 0.4192D-02, & + & 0.3272D-02, 0.2532D-02, 0.1945D-02, 0.1485D-02, 0.1125D-02, & + & 0.8448D-03, 0.6381D-03, 0.4781D-03, 0.3514D-03, 0.2648D-03, & + & 0.1914D-03, 0.1448D-03, 0.1048D-03, 0.7809D-04, 0.5809D-04, & + & 0.3809D-04, 0.3142D-04, 0.1809D-04, 0.1809D-04, 0.1142D-04, & + & 0.4756D-05/ + + data (calcpts(j,31), j = 1,neta) /0.2490D-04, 0.3016D-04, & + & 0.3654D-04, 0.4428D-04, 0.5367D-04, 0.6502D-04, 0.7877D-04, & + & 0.9543D-04, 0.1156D-03, 0.1401D-03, 0.1697D-03, 0.2056D-03, & + & 0.2490D-03, 0.3017D-03, 0.3656D-03, 0.4430D-03, 0.5366D-03, & + & 0.6505D-03, 0.7880D-03, 0.9552D-03, 0.1158D-02, 0.1403D-02, & + & 0.1701D-02, 0.2062D-02, 0.2499D-02, 0.3031D-02, 0.3673D-02, & + & 0.4450D-02, 0.5386D-02, 0.6504D-02, 0.7828D-02, 0.9372D-02, & + & 0.1112D-01, 0.1302D-01, 0.1501D-01, 0.1691D-01, 0.1855D-01, & + & 0.1974D-01, 0.2028D-01, 0.2007D-01, 0.1909D-01, 0.1747D-01, & + & 0.1552D-01, 0.1357D-01, 0.1189D-01, 0.1053D-01, 0.9356D-02, & + & 0.8220D-02, 0.7059D-02, 0.5903D-02, 0.4817D-02, 0.3855D-02, & + & 0.3039D-02, 0.2368D-02, 0.1827D-02, 0.1400D-02, 0.1067D-02, & + & 0.8068D-03, 0.6068D-03, 0.4535D-03, 0.3402D-03, 0.2535D-03, & + & 0.1869D-03, 0.1402D-03, 0.1002D-03, 0.7354D-04, 0.5354D-04, & + & 0.4021D-04, 0.2687D-04, 0.2021D-04, 0.1354D-04, 0.1354D-04, & + & 0.6874D-05/ + + data (calcpts(j,32), j = 1,neta) /0.1842D-04, 0.2232D-04, & + & 0.2705D-04, 0.3277D-04, 0.3967D-04, 0.4809D-04, 0.5828D-04, & + & 0.7059D-04, 0.8552D-04, 0.1036D-03, 0.1255D-03, 0.1521D-03, & + & 0.1842D-03, 0.2232D-03, 0.2705D-03, 0.3277D-03, 0.3971D-03, & + & 0.4812D-03, 0.5832D-03, 0.7063D-03, 0.8566D-03, 0.1038D-02, & + & 0.1258D-02, 0.1525D-02, 0.1849D-02, 0.2242D-02, 0.2717D-02, & + & 0.3293D-02, 0.3986D-02, 0.4815D-02, 0.5799D-02, 0.6949D-02, & + & 0.8259D-02, 0.9705D-02, 0.1123D-01, 0.1273D-01, 0.1409D-01, & + & 0.1517D-01, 0.1583D-01, 0.1597D-01, 0.1551D-01, 0.1450D-01, & + & 0.1306D-01, 0.1144D-01, 0.9914D-02, 0.8646D-02, 0.7648D-02, & + & 0.6802D-02, 0.5979D-02, 0.5131D-02, 0.4284D-02, 0.3490D-02, & + & 0.2787D-02, 0.2193D-02, 0.1706D-02, 0.1315D-02, 0.1007D-02, & + & 0.7654D-03, 0.5787D-03, 0.4354D-03, 0.3261D-03, 0.2428D-03, & + & 0.1801D-03, 0.1328D-03, 0.9812D-04, 0.7146D-04, 0.5213D-04, & + & 0.3813D-04, 0.2746D-04, 0.1946D-04, 0.1413D-04, 0.1013D-04, & + & 0.6796D-05/ + + data (calcpts(j,33), j = 1,neta) /0.1353D-04, 0.1639D-04, & + & 0.1986D-04, 0.2406D-04, 0.2915D-04, 0.3532D-04, 0.4280D-04, & + & 0.5186D-04, 0.6284D-04, 0.7611D-04, 0.9222D-04, 0.1117D-03, & + & 0.1353D-03, 0.1640D-03, 0.1987D-03, 0.2407D-03, 0.2917D-03, & + & 0.3535D-03, 0.4283D-03, 0.5190D-03, 0.6291D-03, 0.7624D-03, & + & 0.9242D-03, 0.1120D-02, 0.1359D-02, 0.1647D-02, 0.1996D-02, & + & 0.2419D-02, 0.2929D-02, 0.3539D-02, 0.4264D-02, 0.5114D-02, & + & 0.6087D-02, 0.7170D-02, 0.8324D-02, 0.9486D-02, 0.1058D-01, & + & 0.1150D-01, 0.1216D-01, 0.1247D-01, 0.1237D-01, 0.1182D-01, & + & 0.1089D-01, 0.9674D-02, 0.8381D-02, 0.7203D-02, 0.6260D-02, & + & 0.5537D-02, 0.4928D-02, 0.4334D-02, 0.3718D-02, 0.3101D-02, & + & 0.2522D-02, 0.2011D-02, 0.1580D-02, 0.1228D-02, 0.9457D-03, & + & 0.7231D-03, 0.5498D-03, 0.4151D-03, 0.3125D-03, 0.2338D-03, & + & 0.1745D-03, 0.1299D-03, 0.9586D-04, 0.7119D-04, 0.5253D-04, & + & 0.3853D-04, 0.2853D-04, 0.2053D-04, 0.1520D-04, 0.1120D-04, & + & 0.8532D-05/ + + data (calcpts(j,34), j = 1,neta) /0.9884D-05, 0.1197D-04, & + & 0.1451D-04, 0.1758D-04, 0.2129D-04, 0.2579D-04, 0.3125D-04, & + & 0.3787D-04, 0.4585D-04, 0.5560D-04, 0.6733D-04, 0.8161D-04, & + & 0.9883D-04, 0.1198D-03, 0.1451D-03, 0.1758D-03, 0.2130D-03, & + & 0.2581D-03, 0.3128D-03, 0.3790D-03, 0.4594D-03, 0.5567D-03, & + & 0.6748D-03, 0.8180D-03, 0.9920D-03, 0.1203D-02, 0.1457D-02, & + & 0.1766D-02, 0.2138D-02, 0.2585D-02, 0.3116D-02, 0.3739D-02, & + & 0.4456D-02, 0.5258D-02, 0.6121D-02, 0.7005D-02, 0.7857D-02, & + & 0.8612D-02, 0.9205D-02, 0.9575D-02, 0.9668D-02, 0.9447D-02, & + & 0.8908D-02, 0.8095D-02, 0.7109D-02, 0.6099D-02, 0.5209D-02, & + & 0.4514D-02, 0.3993D-02, 0.3557D-02, 0.3130D-02, 0.2683D-02, & + & 0.2236D-02, 0.1816D-02, 0.1445D-02, 0.1134D-02, 0.8796D-03, & + & 0.6770D-03, 0.5170D-03, 0.3924D-03, 0.2930D-03, 0.2224D-03, & + & 0.1664D-03, 0.1237D-03, 0.9174D-04, 0.6774D-04, 0.4974D-04, & + & 0.3641D-04, 0.2708D-04, 0.1974D-04, 0.1441D-04, 0.1041D-04, & + & 0.7744D-05/ + + data (calcpts(j,35), j = 1,neta) /0.7181D-05, 0.8703D-05, & + & 0.1054D-04, 0.1277D-04, 0.1548D-04, 0.1875D-04, 0.2272D-04, & + & 0.2752D-04, 0.3334D-04, 0.4039D-04, 0.4895D-04, 0.5928D-04, & + & 0.7186D-04, 0.8704D-04, 0.1055D-03, 0.1278D-03, 0.1548D-03, & + & 0.1876D-03, 0.2273D-03, 0.2754D-03, 0.3338D-03, 0.4046D-03, & + & 0.4904D-03, 0.5944D-03, 0.7209D-03, 0.8739D-03, 0.1059D-02, & + & 0.1283D-02, 0.1554D-02, 0.1878D-02, 0.2265D-02, 0.2719D-02, & + & 0.3243D-02, 0.3833D-02, 0.4472D-02, 0.5136D-02, 0.5787D-02, & + & 0.6385D-02, 0.6885D-02, 0.7246D-02, 0.7428D-02, 0.7396D-02, & + & 0.7134D-02, 0.6646D-02, 0.5971D-02, 0.5191D-02, 0.4417D-02, & + & 0.3752D-02, 0.3245D-02, 0.2871D-02, 0.2560D-02, 0.2253D-02, & + & 0.1931D-02, 0.1607D-02, 0.1303D-02, 0.1036D-02, 0.8116D-03, & + & 0.6290D-03, 0.4830D-03, 0.3684D-03, 0.2791D-03, 0.2104D-03, & + & 0.1578D-03, 0.1178D-03, 0.8778D-04, 0.6511D-04, 0.4778D-04, & + & 0.3512D-04, 0.2578D-04, 0.1845D-04, 0.1378D-04, 0.9784D-05, & + & 0.7117D-05/ + + data (calcpts(j,36), j = 1,neta) /0.5199D-05, 0.6298D-05, & + & 0.7628D-05, 0.9240D-05, 0.1120D-04, 0.1356D-04, 0.1644D-04, & + & 0.1991D-04, 0.2413D-04, 0.2923D-04, 0.3541D-04, 0.4290D-04, & + & 0.5199D-04, 0.6297D-04, 0.7629D-04, 0.9246D-04, 0.1120D-03, & + & 0.1357D-03, 0.1645D-03, 0.1993D-03, 0.2415D-03, 0.2927D-03, & + & 0.3548D-03, 0.4301D-03, 0.5213D-03, 0.6320D-03, 0.7660D-03, & + & 0.9282D-03, 0.1124D-02, 0.1359D-02, 0.1639D-02, 0.1969D-02, & + & 0.2350D-02, 0.2780D-02, 0.3250D-02, 0.3743D-02, 0.4234D-02, & + & 0.4697D-02, 0.5101D-02, 0.5419D-02, 0.5623D-02, 0.5688D-02, & + & 0.5595D-02, 0.5336D-02, 0.4918D-02, 0.4375D-02, 0.3771D-02, & + & 0.3185D-02, 0.2694D-02, 0.2326D-02, 0.2059D-02, 0.1837D-02, & + & 0.1617D-02, 0.1386D-02, 0.1152D-02, 0.9331D-03, 0.7411D-03, & + & 0.5799D-03, 0.4492D-03, 0.3446D-03, 0.2626D-03, 0.1993D-03, & + & 0.1499D-03, 0.1126D-03, 0.8394D-04, 0.6261D-04, 0.4595D-04, & + & 0.3395D-04, 0.2528D-04, 0.1795D-04, 0.1328D-04, 0.9951D-05, & + & 0.7284D-05/ + + data (calcpts(j,37), j = 1,neta) /0.3747D-05, 0.4542D-05, & + & 0.5498D-05, 0.6662D-05, 0.8071D-05, 0.9782D-05, 0.1185D-04, & + & 0.1435D-04, 0.1739D-04, 0.2107D-04, 0.2553D-04, 0.3093D-04, & + & 0.3748D-04, 0.4540D-04, 0.5502D-04, 0.6667D-04, 0.8072D-04, & + & 0.9783D-04, 0.1185D-03, 0.1437D-03, 0.1741D-03, 0.2110D-03, & + & 0.2558D-03, 0.3100D-03, 0.3758D-03, 0.4556D-03, 0.5522D-03, & + & 0.6690D-03, 0.8100D-03, 0.9794D-03, 0.1181D-02, 0.1419D-02, & + & 0.1695D-02, 0.2008D-02, 0.2351D-02, 0.2714D-02, 0.3080D-02, & + & 0.3432D-02, 0.3749D-02, 0.4013D-02, 0.4205D-02, 0.4308D-02, & + & 0.4308D-02, 0.4192D-02, 0.3958D-02, 0.3614D-02, 0.3188D-02, & + & 0.2726D-02, 0.2289D-02, 0.1928D-02, 0.1663D-02, 0.1473D-02, & + & 0.1315D-02, 0.1158D-02, 0.9917D-03, 0.8239D-03, 0.6665D-03, & + & 0.5292D-03, 0.4132D-03, 0.3199D-03, 0.2452D-03, 0.1865D-03, & + & 0.1412D-03, 0.1066D-03, 0.7989D-04, 0.5923D-04, 0.4389D-04, & + & 0.3256D-04, 0.2389D-04, 0.1723D-04, 0.1323D-04, 0.9229D-05, & + & 0.6563D-05/ + + data (calcpts(j,38), j = 1,neta) /0.2693D-05, 0.3262D-05, & + & 0.3953D-05, 0.4790D-05, 0.5801D-05, 0.7032D-05, 0.8515D-05, & + & 0.1032D-04, 0.1250D-04, 0.1514D-04, 0.1835D-04, 0.2223D-04, & + & 0.2693D-04, 0.3263D-04, 0.3954D-04, 0.4790D-04, 0.5803D-04, & + & 0.7034D-04, 0.8521D-04, 0.1033D-03, 0.1251D-03, 0.1516D-03, & + & 0.1838D-03, 0.2228D-03, 0.2700D-03, 0.3273D-03, 0.3967D-03, & + & 0.4807D-03, 0.5819D-03, 0.7036D-03, 0.8488D-03, 0.1020D-02, & + & 0.1219D-02, 0.1445D-02, 0.1694D-02, 0.1960D-02, 0.2230D-02, & + & 0.2494D-02, 0.2738D-02, 0.2949D-02, 0.3115D-02, 0.3224D-02, & + & 0.3266D-02, 0.3231D-02, 0.3114D-02, 0.2915D-02, 0.2640D-02, & + & 0.2311D-02, 0.1963D-02, 0.1640D-02, 0.1377D-02, 0.1186D-02, & + & 0.1051D-02, 0.9394D-03, 0.8273D-03, 0.7081D-03, 0.5877D-03, & + & 0.4752D-03, 0.3766D-03, 0.2938D-03, 0.2271D-03, 0.1738D-03, & + & 0.1325D-03, 0.9981D-04, 0.7515D-04, 0.5648D-04, 0.4182D-04, & + & 0.3115D-04, 0.2315D-04, 0.1648D-04, 0.1248D-04, 0.9150D-05, & + & 0.6484D-05/ + + data (calcpts(j,39), j = 1,neta) /0.1929D-05, 0.2338D-05, & + & 0.2832D-05, 0.3431D-05, 0.4157D-05, 0.5039D-05, 0.6100D-05, & + & 0.7390D-05, 0.8955D-05, 0.1085D-04, 0.1314D-04, 0.1593D-04, & + & 0.1930D-04, 0.2338D-04, 0.2833D-04, 0.3433D-04, 0.4159D-04, & + & 0.5039D-04, 0.6106D-04, 0.7396D-04, 0.8967D-04, 0.1087D-03, & + & 0.1317D-03, 0.1596D-03, 0.1935D-03, 0.2345D-03, 0.2842D-03, & + & 0.3443D-03, 0.4170D-03, 0.5041D-03, 0.6082D-03, 0.7312D-03, & + & 0.8742D-03, 0.1037D-02, 0.1217D-02, 0.1410D-02, 0.1608D-02, & + & 0.1804D-02, 0.1989D-02, 0.2153D-02, 0.2288D-02, 0.2388D-02, & + & 0.2445D-02, 0.2452D-02, 0.2404D-02, 0.2298D-02, 0.2134D-02, & + & 0.1919D-02, 0.1669D-02, 0.1410D-02, 0.1172D-02, 0.9811D-03, & + & 0.8447D-03, 0.7488D-03, 0.6697D-03, 0.5899D-03, 0.5048D-03, & + & 0.4188D-03, 0.3383D-03, 0.2679D-03, 0.2091D-03, 0.1614D-03, & + & 0.1236D-03, 0.9402D-04, 0.7108D-04, 0.5349D-04, 0.3989D-04, & + & 0.2989D-04, 0.2189D-04, 0.1655D-04, 0.1189D-04, 0.9221D-05, & + & 0.6554D-05/ + + data (calcpts(j,40), j = 1,neta) /0.1379D-05, 0.1671D-05, & + & 0.2025D-05, 0.2453D-05, 0.2972D-05, 0.3600D-05, 0.4362D-05, & + & 0.5285D-05, 0.6401D-05, 0.7759D-05, 0.9399D-05, 0.1138D-04, & + & 0.1380D-04, 0.1671D-04, 0.2025D-04, 0.2454D-04, 0.2973D-04, & + & 0.3602D-04, 0.4364D-04, 0.5288D-04, 0.6408D-04, 0.7768D-04, & + & 0.9415D-04, 0.1141D-03, 0.1382D-03, 0.1676D-03, 0.2031D-03, & + & 0.2461D-03, 0.2980D-03, 0.3602D-03, 0.4347D-03, 0.5226D-03, & + & 0.6251D-03, 0.7419D-03, 0.8716D-03, 0.1011D-02, 0.1155D-02, & + & 0.1300D-02, 0.1438D-02, 0.1563D-02, 0.1670D-02, 0.1755D-02, & + & 0.1812D-02, 0.1837D-02, 0.1825D-02, 0.1775D-02, 0.1685D-02, & + & 0.1554D-02, 0.1389D-02, 0.1201D-02, 0.1009D-02, 0.8352D-03, & + & 0.6976D-03, 0.6001D-03, 0.5322D-03, 0.4763D-03, 0.4197D-03, & + & 0.3590D-03, 0.2976D-03, 0.2402D-03, 0.1901D-03, 0.1482D-03, & + & 0.1143D-03, 0.8746D-04, 0.6646D-04, 0.5026D-04, 0.3773D-04, & + & 0.2826D-04, 0.2106D-04, 0.1546D-04, 0.1153D-04, 0.8464D-05, & + & 0.6264D-05/ + + data (calcpts(j,41), j = 1,neta) /0.9836D-06, 0.1192D-05, & + & 0.1444D-05, 0.1750D-05, 0.2120D-05, 0.2568D-05, 0.3111D-05, & + & 0.3769D-05, 0.4567D-05, 0.5531D-05, 0.6704D-05, 0.8123D-05, & + & 0.9839D-05, 0.1192D-04, 0.1444D-04, 0.1750D-04, 0.2120D-04, & + & 0.2569D-04, 0.3113D-04, 0.3772D-04, 0.4570D-04, 0.5539D-04, & + & 0.6713D-04, 0.8134D-04, 0.9861D-04, 0.1195D-03, 0.1449D-03, & + & 0.1754D-03, 0.2125D-03, 0.2569D-03, 0.3099D-03, 0.3727D-03, & + & 0.4459D-03, 0.5295D-03, 0.6227D-03, 0.7233D-03, 0.8281D-03, & + & 0.9335D-03, 0.1036D-02, 0.1130D-02, 0.1213D-02, 0.1281D-02, & + & 0.1331D-02, 0.1362D-02, 0.1368D-02, 0.1349D-02, 0.1303D-02, & + & 0.1229D-02, 0.1126D-02, 0.1001D-02, 0.8613D-03, 0.7202D-03, & + & 0.5940D-03, 0.4950D-03, 0.4256D-03, 0.3776D-03, 0.3382D-03, & + & 0.2980D-03, 0.2548D-03, 0.2111D-03, 0.1702D-03, 0.1346D-03, & + & 0.1049D-03, 0.8085D-04, 0.6179D-04, 0.4692D-04, 0.3539D-04, & + & 0.2659D-04, 0.1985D-04, 0.1466D-04, 0.1092D-04, 0.8055D-05, & + & 0.5922D-05/ + + data (calcpts(j,42), j = 1,neta) /0.7004D-06, 0.8482D-06, & + & 0.1028D-05, 0.1246D-05, 0.1509D-05, 0.1827D-05, 0.2214D-05, & + & 0.2683D-05, 0.3250D-05, 0.3938D-05, 0.4771D-05, 0.5778D-05, & + & 0.7001D-05, 0.8488D-05, 0.1028D-04, 0.1245D-04, 0.1509D-04, & + & 0.1828D-04, 0.2216D-04, 0.2684D-04, 0.3252D-04, 0.3942D-04, & + & 0.4777D-04, 0.5790D-04, 0.7017D-04, 0.8503D-04, 0.1031D-03, & + & 0.1248D-03, 0.1512D-03, 0.1828D-03, 0.2205D-03, 0.2653D-03, & + & 0.3174D-03, 0.3772D-03, 0.4439D-03, 0.5161D-03, 0.5919D-03, & + & 0.6686D-03, 0.7434D-03, 0.8136D-03, 0.8767D-03, 0.9305D-03, & + & 0.9725D-03, 0.1001D-02, 0.1015D-02, 0.1012D-02, 0.9913D-03, & + & 0.9518D-03, 0.8919D-03, 0.8136D-03, 0.7195D-03, 0.6161D-03, & + & 0.5131D-03, 0.4218D-03, 0.3507D-03, 0.3014D-03, 0.2676D-03, & + & 0.2398D-03, 0.2113D-03, 0.1806D-03, 0.1496D-03, 0.1206D-03, & + & 0.9525D-04, 0.7412D-04, 0.5712D-04, 0.4366D-04, 0.3312D-04, & + & 0.2499D-04, 0.1879D-04, 0.1392D-04, 0.1039D-04, 0.7724D-05, & + & 0.5658D-05/ + + data (calcpts(j,43), j = 1,neta) /0.4974D-06, 0.6029D-06, & + & 0.7301D-06, 0.8846D-06, 0.1071D-05, 0.1298D-05, 0.1573D-05, & + & 0.1906D-05, 0.2309D-05, 0.2798D-05, 0.3389D-05, 0.4106D-05, & + & 0.4975D-05, 0.6027D-05, 0.7305D-05, 0.8846D-05, 0.1072D-04, & + & 0.1299D-04, 0.1574D-04, 0.1907D-04, 0.2311D-04, 0.2800D-04, & + & 0.3393D-04, 0.4113D-04, 0.4985D-04, 0.6041D-04, 0.7320D-04, & + & 0.8870D-04, 0.1073D-03, 0.1298D-03, 0.1566D-03, 0.1884D-03, & + & 0.2256D-03, 0.2681D-03, 0.3157D-03, 0.3675D-03, 0.4220D-03, & + & 0.4776D-03, 0.5321D-03, 0.5840D-03, 0.6313D-03, 0.6725D-03, & + & 0.7062D-03, 0.7312D-03, 0.7465D-03, 0.7510D-03, 0.7440D-03, & + & 0.7243D-03, 0.6914D-03, 0.6450D-03, 0.5856D-03, 0.5156D-03, & + & 0.4396D-03, 0.3647D-03, 0.2989D-03, 0.2481D-03, 0.2132D-03, & + & 0.1893D-03, 0.1697D-03, 0.1496D-03, 0.1278D-03, 0.1058D-03, & + & 0.8526D-04, 0.6726D-04, 0.5232D-04, 0.4032D-04, 0.3079D-04, & + & 0.2333D-04, 0.1759D-04, 0.1319D-04, 0.9859D-05, 0.7325D-05, & + & 0.5459D-05/ + + data (calcpts(j,44), j = 1,neta) /0.3528D-06, 0.4274D-06, & + & 0.5179D-06, 0.6277D-06, 0.7598D-06, 0.9211D-06, 0.1116D-05, & + & 0.1352D-05, 0.1638D-05, 0.1984D-05, 0.2404D-05, 0.2912D-05, & + & 0.3528D-05, 0.4275D-05, 0.5179D-05, 0.6275D-05, 0.7603D-05, & + & 0.9212D-05, 0.1116D-04, 0.1352D-04, 0.1639D-04, 0.1986D-04, & + & 0.2406D-04, 0.2916D-04, 0.3535D-04, 0.4284D-04, 0.5190D-04, & + & 0.6288D-04, 0.7611D-04, 0.9204D-04, 0.1111D-03, 0.1336D-03, & + & 0.1600D-03, 0.1903D-03, 0.2242D-03, 0.2612D-03, 0.3003D-03, & + & 0.3403D-03, 0.3800D-03, 0.4180D-03, 0.4531D-03, 0.4843D-03, & + & 0.5106D-03, 0.5312D-03, 0.5454D-03, 0.5527D-03, 0.5524D-03, & + & 0.5439D-03, 0.5268D-03, 0.5004D-03, 0.4648D-03, 0.4202D-03, & + & 0.3685D-03, 0.3130D-03, 0.2588D-03, 0.2115D-03, 0.1753D-03, & + & 0.1505D-03, 0.1337D-03, 0.1199D-03, 0.1057D-03, 0.9034D-04, & + & 0.7472D-04, 0.6014D-04, 0.4747D-04, 0.3687D-04, 0.2840D-04, & + & 0.2167D-04, 0.1640D-04, 0.1240D-04, 0.9271D-05, 0.6938D-05, & + & 0.5138D-05/ + + data (calcpts(j,45), j = 1,neta) /0.2498D-06, 0.3026D-06, & + & 0.3666D-06, 0.4442D-06, 0.5384D-06, 0.6517D-06, 0.7901D-06, & + & 0.9569D-06, 0.1160D-05, 0.1405D-05, 0.1702D-05, 0.2062D-05, & + & 0.2499D-05, 0.3027D-05, 0.3667D-05, 0.4443D-05, 0.5383D-05, & + & 0.6523D-05, 0.7902D-05, 0.9579D-05, 0.1160D-04, 0.1406D-04, & + & 0.1704D-04, 0.2065D-04, 0.2502D-04, 0.3033D-04, 0.3675D-04, & + & 0.4452D-04, 0.5389D-04, 0.6516D-04, 0.7864D-04, 0.9462D-04, & + & 0.1133D-03, 0.1348D-03, 0.1589D-03, 0.1853D-03, 0.2133D-03, & + & 0.2421D-03, 0.2708D-03, 0.2985D-03, 0.3243D-03, 0.3477D-03, & + & 0.3678D-03, 0.3841D-03, 0.3963D-03, 0.4039D-03, 0.4067D-03, & + & 0.4041D-03, 0.3958D-03, 0.3816D-03, 0.3610D-03, 0.3339D-03, & + & 0.3007D-03, 0.2628D-03, 0.2225D-03, 0.1834D-03, 0.1495D-03, & + & 0.1237D-03, 0.1062D-03, 0.9438D-04, 0.8469D-04, 0.7467D-04, & + & 0.6379D-04, 0.5275D-04, 0.4245D-04, 0.3348D-04, 0.2604D-04, & + & 0.2004D-04, 0.1524D-04, 0.1158D-04, 0.8709D-05, 0.6576D-05, & + & 0.4909D-05/ + + data (calcpts(j,46), j = 1,neta) /0.1766D-06, 0.2140D-06, & + & 0.2593D-06, 0.3141D-06, 0.3805D-06, 0.4610D-06, 0.5583D-06, & + & 0.6765D-06, 0.8200D-06, 0.9935D-06, 0.1204D-05, 0.1458D-05, & + & 0.1766D-05, 0.2140D-05, 0.2593D-05, 0.3142D-05, 0.3807D-05, & + & 0.4612D-05, 0.5588D-05, 0.6771D-05, 0.8207D-05, 0.9939D-05, & + & 0.1205D-04, 0.1460D-04, 0.1770D-04, 0.2144D-04, 0.2598D-04, & + & 0.3147D-04, 0.3810D-04, 0.4606D-04, 0.5559D-04, 0.6689D-04, & + & 0.8012D-04, 0.9534D-04, 0.1125D-03, 0.1312D-03, 0.1512D-03, & + & 0.1719D-03, 0.1925D-03, 0.2126D-03, 0.2316D-03, 0.2488D-03, & + & 0.2640D-03, 0.2767D-03, 0.2866D-03, 0.2936D-03, 0.2972D-03, & + & 0.2976D-03, 0.2942D-03, 0.2869D-03, 0.2754D-03, 0.2595D-03, & + & 0.2392D-03, 0.2147D-03, 0.1870D-03, 0.1578D-03, 0.1297D-03, & + & 0.1055D-03, 0.8715D-04, 0.7480D-04, 0.6651D-04, 0.5970D-04, & + & 0.5264D-04, 0.4496D-04, 0.3716D-04, 0.2989D-04, 0.2356D-04, & + & 0.1830D-04, 0.1407D-04, 0.1073D-04, 0.8131D-05, 0.6124D-05, & + & 0.4591D-05/ + + data (calcpts(j,47), j = 1,neta) /0.1247D-06, 0.1511D-06, & + & 0.1831D-06, 0.2218D-06, 0.2687D-06, 0.3256D-06, 0.3945D-06, & + & 0.4779D-06, 0.5790D-06, 0.7013D-06, 0.8498D-06, 0.1029D-05, & + & 0.1247D-05, 0.1511D-05, 0.1831D-05, 0.2218D-05, 0.2688D-05, & + & 0.3257D-05, 0.3946D-05, 0.4781D-05, 0.5793D-05, 0.7020D-05, & + & 0.8506D-05, 0.1031D-04, 0.1249D-04, 0.1514D-04, 0.1834D-04, & + & 0.2222D-04, 0.2689D-04, 0.3252D-04, 0.3925D-04, 0.4723D-04, & + & 0.5657D-04, 0.6735D-04, 0.7949D-04, 0.9282D-04, 0.1071D-03, & + & 0.1218D-03, 0.1366D-03, 0.1512D-03, 0.1650D-03, 0.1777D-03, & + & 0.1890D-03, 0.1986D-03, 0.2065D-03, 0.2123D-03, 0.2161D-03, & + & 0.2176D-03, 0.2167D-03, 0.2133D-03, 0.2071D-03, 0.1981D-03, & + & 0.1860D-03, 0.1709D-03, 0.1530D-03, 0.1328D-03, 0.1118D-03, & + & 0.9159D-04, 0.7433D-04, 0.6134D-04, 0.5263D-04, 0.4681D-04, & + & 0.4204D-04, 0.3707D-04, 0.3166D-04, 0.2615D-04, 0.2102D-04, & + & 0.1656D-04, 0.1286D-04, 0.9878D-05, 0.7524D-05, 0.5698D-05, & + & 0.4291D-05/ + + data (calcpts(j,48), j = 1,neta) /0.8797D-07, 0.1066D-06, & + & 0.1291D-06, 0.1564D-06, 0.1895D-06, 0.2296D-06, 0.2782D-06, & + & 0.3371D-06, 0.4083D-06, 0.4947D-06, 0.5994D-06, 0.7261D-06, & + & 0.8796D-06, 0.1066D-05, 0.1291D-05, 0.1565D-05, 0.1896D-05, & + & 0.2296D-05, 0.2783D-05, 0.3372D-05, 0.4086D-05, 0.4951D-05, & + & 0.6000D-05, 0.7270D-05, 0.8808D-05, 0.1068D-04, 0.1293D-04, & + & 0.1567D-04, 0.1897D-04, 0.2293D-04, 0.2767D-04, 0.3331D-04, & + & 0.3991D-04, 0.4752D-04, 0.5611D-04, 0.6556D-04, 0.7568D-04, & + & 0.8621D-04, 0.9686D-04, 0.1073D-03, 0.1173D-03, 0.1265D-03, & + & 0.1350D-03, 0.1422D-03, 0.1482D-03, 0.1530D-03, 0.1564D-03, & + & 0.1582D-03, 0.1585D-03, 0.1572D-03, 0.1541D-03, 0.1491D-03, & + & 0.1421D-03, 0.1330D-03, 0.1219D-03, 0.1088D-03, 0.9418D-04, & + & 0.7904D-04, 0.6462D-04, 0.5233D-04, 0.4313D-04, 0.3700D-04, & + & 0.3292D-04, 0.2958D-04, 0.2609D-04, 0.2227D-04, 0.1839D-04, & + & 0.1478D-04, 0.1163D-04, 0.9027D-05, 0.6934D-05, 0.5281D-05, & + & 0.4001D-05/ + + data (calcpts(j,49), j = 1,neta) /0.6194D-07, 0.7506D-07, & + & 0.9095D-07, 0.1102D-06, 0.1335D-06, 0.1617D-06, 0.1960D-06, & + & 0.2374D-06, 0.2876D-06, 0.3485D-06, 0.4222D-06, 0.5115D-06, & + & 0.6198D-06, 0.7509D-06, 0.9094D-06, 0.1102D-05, 0.1335D-05, & + & 0.1618D-05, 0.1960D-05, 0.2375D-05, 0.2878D-05, 0.3488D-05, & + & 0.4226D-05, 0.5121D-05, 0.6206D-05, 0.7520D-05, 0.9108D-05, & + & 0.1104D-04, 0.1335D-04, 0.1615D-04, 0.1949D-04, 0.2346D-04, & + & 0.2811D-04, 0.3348D-04, 0.3956D-04, 0.4625D-04, 0.5343D-04, & + & 0.6092D-04, 0.6852D-04, 0.7603D-04, 0.8325D-04, 0.8997D-04, & + & 0.9617D-04, 0.1015D-03, 0.1062D-03, 0.1099D-03, 0.1127D-03, & + & 0.1145D-03, 0.1153D-03, 0.1150D-03, 0.1135D-03, 0.1109D-03, & + & 0.1070D-03, 0.1017D-03, 0.9490D-04, 0.8672D-04, 0.7719D-04, & + & 0.6667D-04, 0.5582D-04, 0.4553D-04, 0.3680D-04, 0.3030D-04, & + & 0.2599D-04, 0.2313D-04, 0.2079D-04, 0.1833D-04, 0.1565D-04, & + & 0.1292D-04, 0.1038D-04, 0.8170D-05, 0.6337D-05, 0.4864D-05, & + & 0.3704D-05/ + + data (dlaeta(j), j = 1,neta) / & + & -6d0, -5.83333333d0, -5.66666667d0, -5.5d0, -5.33333333d0, & + & -5.16666667d0, -5d0, -4.83333333d0, -4.66666667d0, -4.5d0, & + & -4.33333333d0, -4.16666667d0, -4d0, -3.83333333d0, & + & -3.66666667d0, -3.5d0, -3.33333333d0, -3.16666667d0, -3d0, & + & -2.83333333d0, -2.66666667d0, -2.5d0, -2.33333333d0, & + & -2.16666667d0, -2d0, -1.83333333d0, -1.66666667d0, -1.5d0, & + & -1.33333333d0, -1.16666667d0, -1d0, -0.83333333d0, -0.66666667d0,& + & -0.5d0, -0.33333333d0, -0.16666667d0, 0d0, 0.16666667d0, & + & 0.33333333d0, 0.5d0, 0.66666667d0, 0.83333333d0, 1d0, & + & 1.16666667d0, 1.33333333d0, 1.5d0, 1.66666667d0, 1.83333333d0, & + & 2d0, 2.16666667d0, 2.33333333d0, 2.5d0, 2.66666667d0, & + & 2.83333333d0, 3d0, 3.16666667d0, 3.33333333d0, 3.5d0, & + & 3.66666667d0, 3.83333333d0, 4d0, 4.16666667d0, 4.33333333d0, & + & 4.5d0, 4.66666667d0, 4.83333333d0, 5d0, 5.16666667d0, & + & 5.33333333d0, 5.5d0, 5.66666667d0, 5.83333333d0, 6d0/ + + data (dlaxi(j), j = 1,nxi) / & + & -3d0, -2.83333333d0, -2.66666667d0, -2.5d0, -2.33333333d0, & + & -2.16666667d0, -2d0, -1.83333333d0, -1.66666667d0, -1.5d0, & + & -1.33333333d0, -1.16666667d0, -1d0, -0.83333333d0, -0.66666667d0,& + & -0.5d0, -0.33333333d0, -0.16666667d0, 0d0, 0.16666667d0, & + & 0.33333333d0, 0.5d0, 0.66666667d0, 0.83333333d0, 1d0, & + & 1.16666667d0, 1.33333333d0, 1.5d0, 1.66666667d0, 1.83333333d0, & + & 2d0, 2.16666667d0, 2.33333333d0, 2.5d0, 2.66666667d0, & + & 2.83333333d0, 3d0, 3.16666667d0, 3.33333333d0, 3.5d0, & + & 3.66666667d0, 3.83333333d0, 4d0, 4.16666667d0, 4.33333333d0, & + & 4.5d0, 4.66666667d0, 4.83333333d0, 5d0/ + + dleta = dlog10(eta) + dlxi = dlog10(xi) + if (dlxi .le. dlaxi(1)) dlxi = dlaxi(1) + if (dlxi .ge. dlaxi(nxi)) dlxi = dlaxi(nxi) + if (dleta .ge. dlaeta(neta)) dleta = dlaeta(neta) + if (dleta .le. dlaeta(1)) dleta = dlaeta(1) + call locate(dlaeta,neta, dleta, ieta) + call locate(dlaxi, nxi, dlxi, ixi) +! interpolating between the appropriate points + delxi = 1d0/6d0 + deleta = 1d0/6d0 +! lagrange 3-pt. + if (ixi .le. 2) ixi = 2 + if (ixi .ge. 48) ixi = 48 + if (ieta .le. 2) ieta = 2 + if (ixi .ge. 72) ieta = 72 + pxi = (dlxi - dlaxi(ixi))/delxi + f(-1) = pxi*(pxi-1d0)/2d0*calcpts(ieta-1,ixi-1) + & + & (1d0 - pxi**2)*calcpts(ieta-1,ixi) + & + & pxi*(pxi+1d0)/2d0*calcpts(ieta-1,ixi+1) + f(0) = pxi*(pxi-1d0)/2d0*calcpts(ieta,ixi-1) + & + & (1d0 - pxi**2)*calcpts(ieta,ixi) + & + & pxi*(pxi+1d0)/2d0*calcpts(ieta,ixi+1) + f(1) = pxi*(pxi-1d0)/2d0*calcpts(ieta+1,ixi-1) + & + & (1d0 - pxi**2)*calcpts(ieta+1,ixi) + & + & pxi*(pxi+1d0)/2d0*calcpts(ieta+1,ixi+1) + peta = (dleta - dlaeta(ieta))/deleta + h1bar_Tg = peta*(peta-1d0)/2d0*f(-1) + & + & (1d0 - peta**2)*f(0) + & + & peta*(peta+1d0)/2d0*f(1) +!MB + + peta*(peta+1d0)/2d0*f(1) + return + END + +!DECK ID>, GCORRL. + +! ======================================== + double precision function h1_ALg(eta,xi) +! ======================================== + +! eq (9) in PLB347 (1995) 143 - 151 for the longitudinal piece +! MSbar scheme +! This routine is called subclca in the original code. +! Called sclca in updated code (03/06/96). + + implicit none + integer neta, nxi + parameter (neta = 73, nxi = 49) + double precision calcpts(neta, nxi), dlaeta(neta), dlaxi(nxi) + double precision eta, xi, dleta, dlxi + double precision pxi, peta, f(-1:1), delxi, deleta + integer j, ieta, ixi + + data (calcpts(j, 1), j = 1,neta) /-.1179D-07, -.1428D-07, & + & -.1730D-07, -.2095D-07, -.2538D-07, -.3074D-07, -.3723D-07, & + & -.4509D-07, -.5457D-07, -.6604D-07, -.7989D-07, -.9657D-07, & + & -.1166D-06, -.1406D-06, -.1691D-06, -.2029D-06, -.2423D-06, & + & -.2875D-06, -.3377D-06, -.3910D-06, -.4424D-06, -.4824D-06, & + & -.4929D-06, -.4417D-06, -.2734D-06, 0.1048D-06, 0.8410D-06, & + & 0.2167D-05, 0.4413D-05, 0.8018D-05, 0.1347D-04, 0.2118D-04, & + & 0.3115D-04, 0.4274D-04, 0.5440D-04, 0.6402D-04, 0.6968D-04, & + & 0.7031D-04, 0.6605D-04, 0.5802D-04, 0.4795D-04, 0.3757D-04, & + & 0.2814D-04, 0.2032D-04, 0.1427D-04, 0.9805D-05, 0.6626D-05, & + & 0.4430D-05, 0.2942D-05, 0.1939D-05, 0.1271D-05, 0.8315D-06, & + & 0.5416D-06, 0.3496D-06, 0.2296D-06, 0.1507D-06, 0.9812D-07, & + & 0.6371D-07, 0.3752D-07, 0.2606D-07, 0.1129D-07, 0.1001D-07, & + & 0.6726D-08, -.6033D-10, 0.1982D-08, -.1166D-08, -.3311D-08, & + & -.4773D-08, 0.8985D-09, 0.2197D-09, -.2427D-09, -.5576D-09, & + & -.7721D-09/ + + data (calcpts(j, 2), j = 1,neta) /-.1730D-07, -.2096D-07, & + & -.2538D-07, -.3075D-07, -.3725D-07, -.4512D-07, -.5464D-07, & + & -.6617D-07, -.8009D-07, -.9693D-07, -.1173D-06, -.1417D-06, & + & -.1711D-06, -.2063D-06, -.2482D-06, -.2978D-06, -.3556D-06, & + & -.4219D-06, -.4957D-06, -.5739D-06, -.6493D-06, -.7080D-06, & + & -.7235D-06, -.6485D-06, -.4017D-06, 0.1531D-06, 0.1234D-05, & + & 0.3179D-05, 0.6475D-05, 0.1177D-04, 0.1977D-04, 0.3108D-04, & + & 0.4572D-04, 0.6272D-04, 0.7983D-04, 0.9395D-04, 0.1023D-03, & + & 0.1032D-03, 0.9692D-04, 0.8514D-04, 0.7037D-04, 0.5514D-04, & + & 0.4130D-04, 0.2982D-04, 0.2094D-04, 0.1439D-04, 0.9726D-05, & + & 0.6501D-05, 0.4316D-05, 0.2843D-05, 0.1869D-05, 0.1219D-05, & + & 0.7955D-06, 0.5175D-06, 0.3379D-06, 0.2175D-06, 0.1385D-06, & + & 0.8579D-07, 0.5801D-07, 0.3185D-07, 0.2039D-07, 0.1227D-07, & + & 0.4342D-08, 0.1049D-08, 0.9303D-09, -.3690D-08, -.1711D-09, & + & -.2317D-08, -.3777D-08, -.4773D-08, -.5452D-08, -.5914D-08, & + & -.6228D-08/ + + data (calcpts(j, 3), j = 1,neta) /-.2537D-07, -.3074D-07, & + & -.3724D-07, -.4511D-07, -.5465D-07, -.6619D-07, -.8016D-07, & + & -.9707D-07, -.1175D-06, -.1422D-06, -.1720D-06, -.2079D-06, & + & -.2510D-06, -.3027D-06, -.3642D-06, -.4368D-06, -.5217D-06, & + & -.6189D-06, -.7272D-06, -.8419D-06, -.9525D-06, -.1039D-05, & + & -.1061D-05, -.9512D-06, -.5895D-06, 0.2244D-06, 0.1810D-05, & + & 0.4663D-05, 0.9499D-05, 0.1726D-04, 0.2900D-04, 0.4559D-04, & + & 0.6706D-04, 0.9199D-04, 0.1171D-03, 0.1378D-03, 0.1500D-03, & + & 0.1513D-03, 0.1421D-03, 0.1249D-03, 0.1032D-03, 0.8086D-04, & + & 0.6056D-04, 0.4373D-04, 0.3071D-04, 0.2110D-04, 0.1427D-04, & + & 0.9545D-05, 0.6330D-05, 0.4175D-05, 0.2746D-05, 0.1799D-05, & + & 0.1177D-05, 0.7653D-06, 0.4997D-06, 0.3263D-06, 0.2127D-06, & + & 0.1402D-06, 0.9418D-07, 0.5982D-07, 0.4034D-07, 0.2889D-07, & + & 0.2081D-07, 0.1287D-07, 0.9587D-08, 0.9478D-08, 0.4861D-08, & + & 0.8381D-08, 0.6240D-08, 0.4779D-08, 0.3784D-08, 0.3106D-08, & + & 0.2644D-08/ + + data (calcpts(j, 4), j = 1,neta) /-.3724D-07, -.4511D-07, & + & -.5464D-07, -.6620D-07, -.8019D-07, -.9713D-07, -.1176D-06, & + & -.1424D-06, -.1724D-06, -.2087D-06, -.2524D-06, -.3051D-06, & + & -.3684D-06, -.4442D-06, -.5344D-06, -.6411D-06, -.7656D-06, & + & -.9083D-06, -.1067D-05, -.1236D-05, -.1398D-05, -.1524D-05, & + & -.1558D-05, -.1397D-05, -.8658D-06, 0.3268D-06, 0.2652D-05, & + & 0.6837D-05, 0.1393D-04, 0.2531D-04, 0.4253D-04, 0.6687D-04, & + & 0.9836D-04, 0.1349D-03, 0.1717D-03, 0.2021D-03, 0.2200D-03, & + & 0.2219D-03, 0.2085D-03, 0.1831D-03, 0.1514D-03, 0.1186D-03, & + & 0.8883D-04, 0.6414D-04, 0.4504D-04, 0.3095D-04, 0.2093D-04, & + & 0.1400D-04, 0.9283D-05, 0.6119D-05, 0.4024D-05, 0.2635D-05, & + & 0.1720D-05, 0.1122D-05, 0.7284D-06, 0.4753D-06, 0.3088D-06, & + & 0.2015D-06, 0.1291D-06, 0.8310D-07, 0.5541D-07, 0.3594D-07, & + & 0.2453D-07, 0.1644D-07, 0.8512D-08, 0.5240D-08, 0.5134D-08, & + & 0.7185D-08, 0.4044D-08, 0.1901D-08, 0.4413D-09, 0.6114D-08, & + & 0.5437D-08/ + + data (calcpts(j, 5), j = 1,neta) /-.5464D-07, -.6620D-07, & + & -.8018D-07, -.9714D-07, -.1177D-06, -.1425D-06, -.1726D-06, & + & -.2090D-06, -.2530D-06, -.3062D-06, -.3704D-06, -.4477D-06, & + & -.5406D-06, -.6519D-06, -.7842D-06, -.9407D-06, -.1123D-05, & + & -.1333D-05, -.1566D-05, -.1813D-05, -.2052D-05, -.2229D-05, & + & -.2287D-05, -.2051D-05, -.1274D-05, 0.4740D-06, 0.3881D-05, & + & 0.1002D-04, 0.2042D-04, 0.3710D-04, 0.6236D-04, 0.9805D-04, & + & 0.1442D-03, 0.1979D-03, 0.2518D-03, 0.2964D-03, 0.3225D-03, & + & 0.3254D-03, 0.3056D-03, 0.2685D-03, 0.2219D-03, 0.1739D-03, & + & 0.1302D-03, 0.9403D-04, 0.6603D-04, 0.4537D-04, 0.3067D-04, & + & 0.2051D-04, 0.1360D-04, 0.8964D-05, 0.5884D-05, 0.3854D-05, & + & 0.2514D-05, 0.1636D-05, 0.1062D-05, 0.6875D-06, 0.4415D-06, & + & 0.2878D-06, 0.1807D-06, 0.1151D-06, 0.6913D-07, 0.4147D-07, & + & 0.2875D-07, 0.1733D-07, 0.9258D-08, 0.1351D-08, -.1914D-08, & + & -.2016D-08, 0.4406D-10, -.3098D-08, -.5239D-08, -.6697D-08, & + & -.7690D-08/ + + data (calcpts(j, 6), j = 1,neta) /-.8015D-07, -.9710D-07, & + & -.1176D-06, -.1425D-06, -.1726D-06, -.2090D-06, -.2532D-06, & + & -.3066D-06, -.3711D-06, -.4491D-06, -.5433D-06, -.6566D-06, & + & -.7929D-06, -.9561D-06, -.1150D-05, -.1380D-05, -.1648D-05, & + & -.1955D-05, -.2297D-05, -.2660D-05, -.3010D-05, -.3283D-05, & + & -.3357D-05, -.3012D-05, -.1874D-05, 0.6859D-06, 0.5677D-05, & + & 0.1467D-04, 0.2990D-04, 0.5435D-04, 0.9137D-04, 0.1437D-03, & + & 0.2113D-03, 0.2900D-03, 0.3690D-03, 0.4343D-03, 0.4726D-03, & + & 0.4768D-03, 0.4478D-03, 0.3933D-03, 0.3251D-03, 0.2547D-03, & + & 0.1908D-03, 0.1377D-03, 0.9673D-04, 0.6645D-04, 0.4493D-04, & + & 0.3004D-04, 0.1995D-04, 0.1316D-04, 0.8593D-05, 0.5674D-05, & + & 0.3711D-05, 0.2394D-05, 0.1547D-05, 0.1026D-05, 0.6864D-06, & + & 0.4268D-06, 0.2468D-06, 0.1668D-06, 0.8797D-07, 0.5549D-07, & + & 0.5467D-07, 0.8638D-08, 0.4394D-07, 0.2258D-07, 0.8028D-08, & + & -.1890D-08, -.8640D-08, -.1324D-07, -.1638D-07, -.1852D-07, & + & -.1997D-07/ + + data (calcpts(j, 7), j = 1,neta) /-.1175D-06, -.1424D-06, & + & -.1725D-06, -.2089D-06, -.2531D-06, -.3065D-06, -.3712D-06, & + & -.4496D-06, -.5441D-06, -.6585D-06, -.7966D-06, -.9629D-06, & + & -.1163D-05, -.1402D-05, -.1687D-05, -.2023D-05, -.2417D-05, & + & -.2867D-05, -.3369D-05, -.3901D-05, -.4415D-05, -.4817D-05, & + & -.4927D-05, -.4425D-05, -.2761D-05, 0.9843D-06, 0.8293D-05, & + & 0.2145D-04, 0.4376D-04, 0.7956D-04, 0.1338D-03, 0.2103D-03, & + & 0.3094D-03, 0.4245D-03, 0.5403D-03, 0.6358D-03, 0.6919D-03, & + & 0.6980D-03, 0.6555D-03, 0.5757D-03, 0.4758D-03, 0.3728D-03, & + & 0.2792D-03, 0.2016D-03, 0.1416D-03, 0.9723D-04, 0.6578D-04, & + & 0.4393D-04, 0.2913D-04, 0.1919D-04, 0.1264D-04, 0.8225D-05, & + & 0.5357D-05, 0.3523D-05, 0.2272D-05, 0.1492D-05, 0.9729D-06, & + & 0.6333D-06, 0.3745D-06, 0.2620D-06, 0.1824D-06, 0.1038D-06, & + & 0.7170D-07, 0.7095D-07, 0.2502D-07, -.6248D-08, 0.3911D-07, & + & 0.2459D-07, 0.1470D-07, 0.7959D-08, 0.3366D-08, 0.2383D-09, & + & -.1893D-08/ + + data (calcpts(j, 8), j = 1,neta) /-.1723D-06, -.2087D-06, & + & -.2528D-06, -.3063D-06, -.3710D-06, -.4494D-06, -.5442D-06, & + & -.6590D-06, -.7977D-06, -.9654D-06, -.1168D-05, -.1412D-05, & + & -.1705D-05, -.2055D-05, -.2473D-05, -.2966D-05, -.3543D-05, & + & -.4204D-05, -.4940D-05, -.5721D-05, -.6476D-05, -.7067D-05, & + & -.7232D-05, -.6503D-05, -.4077D-05, 0.1394D-05, 0.1208D-04, & + & 0.3131D-04, 0.6393D-04, 0.1163D-03, 0.1956D-03, 0.3076D-03, & + & 0.4526D-03, 0.6210D-03, 0.7904D-03, 0.9301D-03, 0.1012D-02, & + & 0.1021D-02, 0.9584D-03, 0.8418D-03, 0.6956D-03, 0.5450D-03, & + & 0.4082D-03, 0.2947D-03, 0.2069D-03, 0.1421D-03, 0.9608D-04, & + & 0.6424D-04, 0.4255D-04, 0.2802D-04, 0.1842D-04, 0.1201D-04, & + & 0.7843D-05, 0.5108D-05, 0.3342D-05, 0.2159D-05, 0.1384D-05, & + & 0.8661D-06, 0.5282D-06, 0.3378D-06, 0.2262D-06, 0.1472D-06, & + & 0.6927D-07, 0.3732D-07, 0.3679D-07, -.8953D-08, -.4013D-07, & + & 0.5292D-08, -.9167D-08, -.1903D-07, -.2575D-07, -.3033D-07, & + & -.3344D-07/ + + data (calcpts(j, 9), j = 1,neta) /-.2523D-06, -.3056D-06, & + & -.3702D-06, -.4485D-06, -.5433D-06, -.6580D-06, -.7969D-06, & + & -.9650D-06, -.1168D-05, -.1414D-05, -.1710D-05, -.2067D-05, & + & -.2496D-05, -.3010D-05, -.3621D-05, -.4344D-05, -.5189D-05, & + & -.6157D-05, -.7236D-05, -.8381D-05, -.9489D-05, -.1036D-04, & + & -.1061D-04, -.9553D-05, -.6026D-05, 0.1952D-05, 0.1753D-04, & + & 0.4560D-04, 0.9323D-04, 0.1697D-03, 0.2854D-03, 0.4491D-03, & + & 0.6608D-03, 0.9066D-03, 0.1154D-02, 0.1358D-02, 0.1477D-02, & + & 0.1489D-02, 0.1398D-02, 0.1228D-02, 0.1015D-02, 0.7949D-03, & + & 0.5953D-03, 0.4298D-03, 0.3017D-03, 0.2073D-03, 0.1401D-03, & + & 0.9366D-04, 0.6213D-04, 0.4095D-04, 0.2689D-04, 0.1763D-04, & + & 0.1148D-04, 0.7522D-05, 0.4865D-05, 0.3176D-05, 0.2071D-05, & + & 0.1367D-05, 0.9203D-06, 0.5863D-06, 0.3981D-06, 0.2880D-06, & + & 0.2103D-06, 0.1330D-06, 0.1016D-06, 0.1015D-06, 0.5597D-07, & + & 0.9162D-07, 0.7051D-07, 0.5611D-07, 0.4630D-07, 0.3963D-07, & + & 0.3507D-07/ + + data (calcpts(j,10), j = 1,neta) /-.3692D-06, -.4473D-06, & + & -.5418D-06, -.6564D-06, -.7951D-06, -.9630D-06, -.1166D-05, & + & -.1412D-05, -.1710D-05, -.2069D-05, -.2503D-05, -.3025D-05, & + & -.3653D-05, -.4405D-05, -.5300D-05, -.6359D-05, -.7596D-05, & + & -.9014D-05, -.1059D-04, -.1228D-04, -.1390D-04, -.1519D-04, & + & -.1557D-04, -.1406D-04, -.8939D-05, 0.2642D-05, 0.2530D-04, & + & 0.6612D-04, 0.1355D-03, 0.2468D-03, 0.4155D-03, 0.6540D-03, & + & 0.9626D-03, 0.1321D-02, 0.1681D-02, 0.1977D-02, 0.2151D-02, & + & 0.2168D-02, 0.2035D-02, 0.1787D-02, 0.1476D-02, 0.1157D-02, & + & 0.8661D-03, 0.6252D-03, 0.4389D-03, 0.3014D-03, 0.2036D-03, & + & 0.1361D-03, 0.9018D-04, 0.5939D-04, 0.3901D-04, 0.2549D-04, & + & 0.1665D-04, 0.1087D-04, 0.7076D-05, 0.4575D-05, 0.2974D-05, & + & 0.1947D-05, 0.1253D-05, 0.8136D-06, 0.5508D-06, 0.3657D-06, & + & 0.2582D-06, 0.1818D-06, 0.1055D-06, 0.7487D-07, 0.7522D-07, & + & 0.3003D-07, 0.6594D-07, 0.4496D-07, 0.3066D-07, 0.2093D-07, & + & 0.1430D-07/ + + data (calcpts(j,11), j = 1,neta) /-.5396D-06, -.6538D-06, & + & -.7919D-06, -.9593D-06, -.1162D-05, -.1408D-05, -.1705D-05, & + & -.2064D-05, -.2499D-05, -.3024D-05, -.3658D-05, -.4422D-05, & + & -.5340D-05, -.6440D-05, -.7748D-05, -.9296D-05, -.1111D-04, & + & -.1318D-04, -.1550D-04, -.1796D-04, -.2035D-04, -.2225D-04, & + & -.2285D-04, -.2070D-04, -.1334D-04, 0.3407D-05, 0.3622D-04, & + & 0.9542D-04, 0.1961D-03, 0.3577D-03, 0.6026D-03, 0.9490D-03, & + & 0.1397D-02, 0.1918D-02, 0.2441D-02, 0.2870D-02, 0.3121D-02, & + & 0.3145D-02, 0.2951D-02, 0.2590D-02, 0.2140D-02, 0.1676D-02, & + & 0.1255D-02, 0.9058D-03, 0.6357D-03, 0.4364D-03, 0.2948D-03, & + & 0.1969D-03, 0.1304D-03, 0.8575D-04, 0.5625D-04, 0.3676D-04, & + & 0.2393D-04, 0.1552D-04, 0.1008D-04, 0.6481D-05, 0.4160D-05, & + & 0.2653D-05, 0.1713D-05, 0.1101D-05, 0.6720D-06, 0.4159D-06, & + & 0.2361D-06, 0.1315D-06, 0.5727D-07, 0.4929D-07, 0.1966D-07, & + & -.4596D-07, -.2396D-07, -.5443D-07, -.8516D-08, -.2265D-07, & + & -.3228D-07/ + + data (calcpts(j,12), j = 1,neta) /-.7869D-06, -.9534D-06, & + & -.1155D-05, -.1399D-05, -.1695D-05, -.2053D-05, -.2486D-05, & + & -.3010D-05, -.3644D-05, -.4410D-05, -.5335D-05, -.6449D-05, & + & -.7788D-05, -.9392D-05, -.1130D-04, -.1356D-04, -.1620D-04, & + & -.1923D-04, -.2262D-04, -.2623D-04, -.2974D-04, -.3256D-04, & + & -.3352D-04, -.3053D-04, -.2001D-04, 0.4009D-05, 0.5124D-04, & + & 0.1366D-03, 0.2818D-03, 0.5152D-03, 0.8691D-03, 0.1370D-02, & + & 0.2017D-02, 0.2770D-02, 0.3525D-02, 0.4144D-02, 0.4503D-02, & + & 0.4535D-02, 0.4252D-02, 0.3731D-02, 0.3082D-02, 0.2414D-02, & + & 0.1807D-02, 0.1304D-02, 0.9149D-03, 0.6277D-03, 0.4238D-03, & + & 0.2828D-03, 0.1872D-03, 0.1229D-03, 0.8080D-04, 0.5295D-04, & + & 0.3401D-04, 0.2244D-04, 0.1462D-04, 0.9176D-05, 0.6076D-05, & + & 0.3683D-05, 0.2688D-05, 0.1315D-05, 0.1259D-05, 0.3109D-06, & + & 0.3326D-06, 0.5592D-06, 0.2594D-06, 0.5532D-07, -.8377D-07, & + & -.1786D-06, -.2431D-06, -.2871D-06, -.3171D-06, -.3375D-06, & + & 0.3153D-06/ + + data (calcpts(j,13), j = 1,neta) /-.1144D-05, -.1386D-05, & + & -.1679D-05, -.2034D-05, -.2464D-05, -.2985D-05, -.3615D-05, & + & -.4377D-05, -.5298D-05, -.6413D-05, -.7758D-05, -.9378D-05, & + & -.1133D-04, -.1366D-04, -.1644D-04, -.1973D-04, -.2357D-04, & + & -.2799D-04, -.3293D-04, -.3821D-04, -.4338D-04, -.4758D-04, & + & -.4914D-04, -.4507D-04, -.3027D-04, 0.3885D-05, 0.7130D-04, & + & 0.1933D-03, 0.4011D-03, 0.7355D-03, 0.1243D-02, 0.1961D-02, & + & 0.2891D-02, 0.3971D-02, 0.5053D-02, 0.5938D-02, 0.6447D-02, & + & 0.6486D-02, 0.6077D-02, 0.5330D-02, 0.4401D-02, 0.3446D-02, & + & 0.2579D-02, 0.1861D-02, 0.1304D-02, 0.8946D-03, 0.6032D-03, & + & 0.4024D-03, 0.2659D-03, 0.1747D-03, 0.1141D-03, 0.7479D-04, & + & 0.4834D-04, 0.3132D-04, 0.2016D-04, 0.1329D-04, 0.8727D-05, & + & 0.5761D-05, 0.3467D-05, 0.2542D-05, 0.1215D-05, 0.1189D-05, & + & 0.2640D-06, 0.2996D-06, 0.5363D-06, 0.2436D-06, 0.4415D-07, & + & -.9180D-07, -.1843D-06, -.2474D-06, -.2904D-06, -.3197D-06, & + & 0.3270D-06/ + + data (calcpts(j,14), j = 1,neta) /-.1657D-05, -.2007D-05, & + & -.2431D-05, -.2945D-05, -.3568D-05, -.4322D-05, -.5234D-05, & + & -.6338D-05, -.7672D-05, -.9286D-05, -.1123D-04, -.1358D-04, & + & -.1640D-04, -.1978D-04, -.2381D-04, -.2858D-04, -.3416D-04, & + & -.4059D-04, -.4778D-04, -.5550D-04, -.6310D-04, -.6938D-04, & + & -.7199D-04, -.6670D-04, -.4629D-04, 0.1539D-05, 0.9639D-04, & + & 0.2687D-03, 0.5627D-03, 0.1037D-02, 0.1757D-02, 0.2777D-02, & + & 0.4099D-02, 0.5632D-02, 0.7167D-02, 0.8417D-02, 0.9127D-02, & + & 0.9171D-02, 0.8582D-02, 0.7520D-02, 0.6206D-02, 0.4858D-02, & + & 0.3635D-02, 0.2621D-02, 0.1836D-02, 0.1258D-02, 0.8476D-03, & + & 0.5644D-03, 0.3724D-03, 0.2439D-03, 0.1595D-03, 0.1036D-03, & + & 0.6734D-04, 0.4349D-04, 0.2802D-04, 0.1813D-04, 0.1171D-04, & + & 0.7432D-05, 0.4671D-05, 0.2520D-05, 0.1690D-05, 0.1095D-05, & + & 0.4487D-06, 0.2198D-06, 0.2762D-06, -.1392D-06, -.4223D-06, & + & 0.5138D-07, -.7992D-07, -.1695D-06, -.2305D-06, -.2721D-06, & + & -.3004D-06/ + + data (calcpts(j,15), j = 1,neta) /-.2383D-05, -.2887D-05, & + & -.3497D-05, -.4237D-05, -.5132D-05, -.6216D-05, -.7528D-05, & + & -.9117D-05, -.1104D-04, -.1336D-04, -.1616D-04, -.1954D-04, & + & -.2360D-04, -.2847D-04, -.3427D-04, -.4115D-04, -.4920D-04, & + & -.5849D-04, -.6892D-04, -.8016D-04, -.9134D-04, -.1008D-03, & + & -.1052D-03, -.9882D-04, -.7144D-04, -.5986D-05, 0.1249D-03, & + & 0.3641D-03, 0.7735D-03, 0.1435D-02, 0.2441D-02, 0.3868D-02, & + & 0.5719D-02, 0.7864D-02, 0.1001D-01, 0.1174D-01, 0.1271D-01, & + & 0.1274D-01, 0.1190D-01, 0.1042D-01, 0.8590D-02, 0.6721D-02, & + & 0.5026D-02, 0.3621D-02, 0.2535D-02, 0.1734D-02, 0.1166D-02, & + & 0.7749D-03, 0.5102D-03, 0.3340D-03, 0.2176D-03, 0.1414D-03, & + & 0.9123D-04, 0.5901D-04, 0.3835D-04, 0.2483D-04, 0.1587D-04, & + & 0.1004D-04, 0.6855D-05, 0.4387D-05, 0.3100D-05, 0.1738D-05, & + & 0.1237D-05, 0.1319D-05, 0.4663D-06, 0.5524D-06, 0.8235D-06, & + & 0.5539D-06, 0.3704D-06, 0.2452D-06, 0.1599D-06, 0.7685D-06, & + & 0.7290D-06/ + + data (calcpts(j,16), j = 1,neta) /-.3399D-05, -.4118D-05, & + & -.4987D-05, -.6042D-05, -.7320D-05, -.8866D-05, -.1074D-04, & + & -.1300D-04, -.1574D-04, -.1905D-04, -.2305D-04, -.2787D-04, & + & -.3367D-04, -.4062D-04, -.4892D-04, -.5875D-04, -.7030D-04, & + & -.8363D-04, -.9867D-04, -.1150D-03, -.1314D-03, -.1457D-03, & + & -.1534D-03, -.1467D-03, -.1116D-03, -.2496D-04, 0.1510D-03, & + & 0.4744D-03, 0.1031D-02, 0.1933D-02, 0.3310D-02, 0.5266D-02, & + & 0.7804D-02, 0.1074D-01, 0.1367D-01, 0.1602D-01, 0.1729D-01, & + & 0.1729D-01, 0.1611D-01, 0.1407D-01, 0.1159D-01, 0.9058D-02, & + & 0.6768D-02, 0.4871D-02, 0.3403D-02, 0.2322D-02, 0.1558D-02, & + & 0.1031D-02, 0.6766D-03, 0.4404D-03, 0.2855D-03, 0.1841D-03, & + & 0.1183D-03, 0.7551D-04, 0.4836D-04, 0.3095D-04, 0.1992D-04, & + & 0.1215D-04, 0.7833D-05, 0.5229D-05, 0.3152D-05, 0.2130D-05, & + & 0.1620D-05, 0.5744D-06, 0.7410D-06, 0.6133D-06, 0.7196D-07, & + & 0.3697D-06, 0.1186D-06, -.5265D-07, 0.4973D-06, 0.4179D-06, & + & 0.3637D-06/ + + data (calcpts(j,17), j = 1,neta) /-.4787D-05, -.5799D-05, & + & -.7024D-05, -.8510D-05, -.1031D-04, -.1249D-04, -.1512D-04, & + & -.1831D-04, -.2217D-04, -.2684D-04, -.3247D-04, -.3927D-04, & + & -.4744D-04, -.5726D-04, -.6897D-04, -.8288D-04, -.9925D-04, & + & -.1182D-03, -.1397D-03, -.1632D-03, -.1872D-03, -.2089D-03, & + & -.2225D-03, -.2175D-03, -.1756D-03, -.6628D-04, 0.1608D-03, & + & 0.5829D-03, 0.1315D-02, 0.2507D-02, 0.4333D-02, 0.6934D-02, & + & 0.1031D-01, 0.1423D-01, 0.1811D-01, 0.2118D-01, 0.2278D-01, & + & 0.2267D-01, 0.2103D-01, 0.1831D-01, 0.1505D-01, 0.1175D-01, & + & 0.8769D-02, 0.6299D-02, 0.4389D-02, 0.2984D-02, 0.1991D-02, & + & 0.1311D-02, 0.8538D-03, 0.5514D-03, 0.3545D-03, 0.2259D-03, & + & 0.1436D-03, 0.9038D-04, 0.5691D-04, 0.3544D-04, 0.2219D-04, & + & 0.1349D-04, 0.8014D-05, 0.4806D-05, 0.2954D-05, 0.1390D-05, & + & 0.7233D-06, 0.4491D-06, -.4337D-06, -.1554D-06, -.2076D-06, & + & -.6975D-06, -.3643D-06, -.5918D-06, -.8006D-07, -.1856D-06, & + & -.2575D-06/ + + data (calcpts(j,18), j = 1,neta) /-.6622D-05, -.8023D-05, & + & -.9718D-05, -.1177D-04, -.1426D-04, -.1728D-04, -.2092D-04, & + & -.2534D-04, -.3068D-04, -.3714D-04, -.4494D-04, -.5435D-04, & + & -.6568D-04, -.7930D-04, -.9556D-04, -.1149D-03, -.1377D-03, & + & -.1643D-03, -.1945D-03, -.2280D-03, -.2629D-03, -.2957D-03, & + & -.3192D-03, -.3204D-03, -.2763D-03, -.1477D-03, 0.1293D-03, & + & 0.6528D-03, 0.1571D-02, 0.3078D-02, 0.5398D-02, 0.8718D-02, & + & 0.1304D-01, 0.1805D-01, 0.2298D-01, 0.2680D-01, 0.2868D-01, & + & 0.2835D-01, 0.2612D-01, 0.2263D-01, 0.1854D-01, 0.1444D-01, & + & 0.1075D-01, 0.7700D-02, 0.5341D-02, 0.3610D-02, 0.2390D-02, & + & 0.1559D-02, 0.1004D-02, 0.6399D-03, 0.4053D-03, 0.2541D-03, & + & 0.1585D-03, 0.9786D-04, 0.6010D-04, 0.3658D-04, 0.2153D-04, & + & 0.1259D-04, 0.7535D-05, 0.4100D-05, 0.2275D-05, 0.6996D-06, & + & 0.4511D-06, 0.2193D-06, -.4223D-06, -.4336D-06, -.1650D-07, & + & 0.2570D-07, -.3993D-06, -.2249D-07, -.2200D-06, -.3545D-06, & + & -.4461D-06/ + + data (calcpts(j,19), j = 1,neta) /-.8944D-05, -.1084D-04, & + & -.1313D-04, -.1590D-04, -.1926D-04, -.2333D-04, -.2826D-04, & + & -.3423D-04, -.4144D-04, -.5018D-04, -.6073D-04, -.7346D-04, & + & -.8880D-04, -.1072D-03, -.1293D-03, -.1556D-03, -.1868D-03, & + & -.2231D-03, -.2649D-03, -.3117D-03, -.3616D-03, -.4106D-03, & + & -.4504D-03, -.4657D-03, -.4291D-03, -.2940D-03, 0.1615D-04, & + & 0.6224D-03, 0.1702D-02, 0.3494D-02, 0.6278D-02, 0.1028D-01, & + & 0.1552D-01, 0.2159D-01, 0.2751D-01, 0.3198D-01, 0.3397D-01, & + & 0.3323D-01, 0.3029D-01, 0.2600D-01, 0.2118D-01, 0.1643D-01, & + & 0.1219D-01, 0.8681D-02, 0.5976D-02, 0.3995D-02, 0.2606D-02, & + & 0.1672D-02, 0.1050D-02, 0.6528D-03, 0.4005D-03, 0.2438D-03, & + & 0.1417D-03, 0.8085D-04, 0.5090D-04, 0.2916D-04, 0.1133D-04, & + & 0.9738D-05, -.7403D-06, 0.3042D-05, -.1345D-05, -.2214D-05, & + & -.6755D-06, -.4174D-05, 0.1085D-06, -.1515D-05, -.2621D-05, & + & -.3374D-05, 0.2779D-05, 0.2429D-05, 0.2191D-05, 0.2029D-05, & + & 0.1918D-05/ + + data (calcpts(j,20), j = 1,neta) /-.1170D-04, -.1418D-04, & + & -.1718D-04, -.2081D-04, -.2521D-04, -.3054D-04, -.3699D-04, & + & -.4480D-04, -.5424D-04, -.6568D-04, -.7950D-04, -.9619D-04, & + & -.1163D-03, -.1405D-03, -.1696D-03, -.2043D-03, -.2455D-03, & + & -.2939D-03, -.3500D-03, -.4137D-03, -.4831D-03, -.5545D-03, & + & -.6190D-03, -.6600D-03, -.6477D-03, -.5303D-03, -.2221D-03, & + & 0.4126D-03, 0.1576D-02, 0.3543D-02, 0.6635D-02, 0.1113D-01, & + & 0.1703D-01, 0.2388D-01, 0.3049D-01, 0.3532D-01, 0.3712D-01, & + & 0.3572D-01, 0.3197D-01, 0.2701D-01, 0.2174D-01, 0.1674D-01, & + & 0.1232D-01, 0.8686D-02, 0.5892D-02, 0.3851D-02, 0.2443D-02, & + & 0.1508D-02, 0.9013D-03, 0.5197D-03, 0.2912D-03, 0.1579D-03, & + & 0.7953D-04, 0.3170D-04, 0.7900D-05, -.3297D-05, -.7561D-05, & + & -.6888D-05, -.7032D-05, -.1196D-04, -.4404D-05, -.6222D-05, & + & -.5329D-05, -.2602D-05, -.5286D-05, -.4467D-06, -.1692D-05, & + & -.2541D-05, -.3118D-05, -.3512D-05, -.3781D-05, -.3963D-05, & + & -.4088D-05/ + + data (calcpts(j,21), j = 1,neta) /-.1470D-04, -.1781D-04, & + & -.2158D-04, -.2614D-04, -.3167D-04, -.3836D-04, -.4647D-04, & + & -.5628D-04, -.6815D-04, -.8253D-04, -.9992D-04, -.1209D-03, & + & -.1463D-03, -.1768D-03, -.2135D-03, -.2575D-03, -.3099D-03, & + & -.3718D-03, -.4443D-03, -.5276D-03, -.6206D-03, -.7201D-03, & + & -.8181D-03, -.8986D-03, -.9318D-03, -.8660D-03, -.6136D-03, & + & -.3460D-04, 0.1080D-02, 0.3021D-02, 0.6132D-02, 0.1071D-01, & + & 0.1680D-01, 0.2386D-01, 0.3062D-01, 0.3531D-01, 0.3655D-01, & + & 0.3428D-01, 0.2968D-01, 0.2428D-01, 0.1905D-01, 0.1439D-01, & + & 0.1041D-01, 0.7176D-02, 0.4703D-02, 0.2916D-02, 0.1706D-02, & + & 0.9332D-03, 0.4593D-03, 0.1896D-03, 0.4181D-04, -.3145D-04, & + & -.5890D-04, -.6627D-04, -.6098D-04, -.5508D-04, -.4132D-04, & + & -.3532D-04, -.2972D-04, -.2194D-04, -.1481D-04, -.1025D-04, & + & -.9558D-05, -.6966D-05, -.3075D-05, -.4965D-05, 0.4133D-06, & + & -.4645D-06, -.1062D-05, -.1469D-05, -.1747D-05, -.1936D-05, & + & -.2065D-05/ + + data (calcpts(j,22), j = 1,neta) /-.1759D-04, -.2131D-04, & + & -.2581D-04, -.3127D-04, -.3788D-04, -.4589D-04, -.5559D-04, & + & -.6734D-04, -.8155D-04, -.9876D-04, -.1196D-03, -.1448D-03, & + & -.1752D-03, -.2119D-03, -.2560D-03, -.3091D-03, -.3725D-03, & + & -.4480D-03, -.5370D-03, -.6406D-03, -.7588D-03, -.8898D-03, & + & -.1027D-02, -.1158D-02, -.1257D-02, -.1277D-02, -.1139D-02, & + & -.7134D-03, 0.1963D-03, 0.1866D-02, 0.4629D-02, 0.8781D-02, & + & 0.1438D-01, 0.2091D-01, 0.2711D-01, 0.3112D-01, 0.3152D-01, & + & 0.2827D-01, 0.2292D-01, 0.1735D-01, 0.1266D-01, 0.9007D-02, & + & 0.6154D-02, 0.3926D-02, 0.2252D-02, 0.1077D-02, 0.3285D-03, & + & -.1048D-03, -.3108D-03, -.3821D-03, -.3808D-03, -.3361D-03, & + & -.2800D-03, -.2292D-03, -.1760D-03, -.1380D-03, -.1006D-03, & + & -.7878D-04, -.5814D-04, -.4252D-04, -.2794D-04, -.2284D-04, & + & -.1511D-04, -.1227D-04, -.8204D-05, -.3311D-05, -.4519D-05, & + & -.5343D-05, 0.7633D-06, 0.3809D-06, 0.1204D-06, -.5698D-07, & + & -.1778D-06/ + + data (calcpts(j,23), j = 1,neta) /-.1989D-04, -.2409D-04, & + & -.2918D-04, -.3536D-04, -.4284D-04, -.5190D-04, -.6287D-04, & + & -.7616D-04, -.9223D-04, -.1117D-03, -.1353D-03, -.1638D-03, & + & -.1983D-03, -.2399D-03, -.2901D-03, -.3506D-03, -.4231D-03, & + & -.5098D-03, -.6129D-03, -.7342D-03, -.8750D-03, -.1036D-02, & + & -.1212D-02, -.1397D-02, -.1569D-02, -.1695D-02, -.1710D-02, & + & -.1509D-02, -.9289D-03, 0.2640D-03, 0.2358D-02, 0.5620D-02, & + & 0.1011D-01, 0.1541D-01, 0.2038D-01, 0.2331D-01, 0.2276D-01, & + & 0.1873D-01, 0.1286D-01, 0.7356D-02, 0.3497D-02, 0.1266D-02, & + & 0.3697D-04, -.7100D-03, -.1187D-02, -.1463D-02, -.1552D-02, & + & -.1489D-02, -.1333D-02, -.1135D-02, -.9232D-03, -.7340D-03, & + & -.5716D-03, -.4336D-03, -.3286D-03, -.2446D-03, -.1785D-03, & + & -.1308D-03, -.9282D-04, -.6781D-04, -.5136D-04, -.3832D-04, & + & -.2306D-04, -.1963D-04, -.1516D-04, -.9997D-05, -.4353D-05, & + & -.5049D-05, -.5523D-05, -.5847D-05, 0.5996D-06, 0.4496D-06, & + & 0.3474D-06/ + + data (calcpts(j,24), j = 1,neta) /-.2117D-04, -.2564D-04, & + & -.3106D-04, -.3763D-04, -.4560D-04, -.5524D-04, -.6692D-04, & + & -.8107D-04, -.9819D-04, -.1189D-03, -.1441D-03, -.1745D-03, & + & -.2112D-03, -.2557D-03, -.3093D-03, -.3741D-03, -.4520D-03, & + & -.5456D-03, -.6574D-03, -.7902D-03, -.9465D-03, -.1128D-02, & + & -.1335D-02, -.1564D-02, -.1803D-02, -.2029D-02, -.2199D-02, & + & -.2238D-02, -.2028D-02, -.1394D-02, -.1156D-03, 0.2017D-02, & + & 0.5066D-02, 0.8726D-02, 0.1210D-01, 0.1376D-01, 0.1244D-01, & + & 0.8023D-02, 0.2015D-02, -.3294D-02, -.6393D-02, -.7245D-02, & + & -.6777D-02, -.5883D-02, -.5009D-02, -.4254D-02, -.3594D-02, & + & -.2993D-02, -.2443D-02, -.1947D-02, -.1520D-02, -.1169D-02, & + & -.8818D-03, -.6554D-03, -.4863D-03, -.3526D-03, -.2554D-03, & + & -.1867D-03, -.1368D-03, -.9494D-04, -.6941D-04, -.4806D-04, & + & -.3168D-04, -.2748D-04, -.1583D-04, -.1031D-04, -.1109D-04, & + & -.4956D-05, -.5318D-05, -.5565D-05, 0.9334D-06, 0.8188D-06, & + & 0.7408D-06/ + + data (calcpts(j,25), j = 1,neta) /-.2120D-04, -.2568D-04, & + & -.3111D-04, -.3769D-04, -.4567D-04, -.5532D-04, -.6702D-04, & + & -.8120D-04, -.9835D-04, -.1191D-03, -.1443D-03, -.1748D-03, & + & -.2117D-03, -.2563D-03, -.3102D-03, -.3754D-03, -.4540D-03, & + & -.5486D-03, -.6623D-03, -.7982D-03, -.9596D-03, -.1150D-02, & + & -.1372D-02, -.1626D-02, -.1907D-02, -.2205D-02, -.2495D-02, & + & -.2732D-02, -.2841D-02, -.2708D-02, -.2186D-02, -.1130D-02, & + & 0.5125D-03, 0.2538D-02, 0.4317D-02, 0.4811D-02, 0.2999D-02, & + & -.1337D-02, -.7059D-02, -.1210D-01, -.1476D-01, -.1475D-01, & + & -.1299D-01, -.1067D-01, -.8534D-02, -.6815D-02, -.5453D-02, & + & -.4354D-02, -.3441D-02, -.2691D-02, -.2071D-02, -.1573D-02, & + & -.1175D-02, -.8679D-03, -.6419D-03, -.4655D-03, -.3374D-03, & + & -.2412D-03, -.1729D-03, -.1209D-03, -.8633D-04, -.6337D-04, & + & -.4589D-04, -.3428D-04, -.2211D-04, -.1625D-04, -.1012D-04, & + & -.1049D-04, -.4079D-05, -.4251D-05, -.4369D-05, -.4448D-05, & + & -.4503D-05/ + + data (calcpts(j,26), j = 1,neta) /-.2004D-04, -.2428D-04, & + & -.2941D-04, -.3563D-04, -.4317D-04, -.5230D-04, -.6336D-04, & + & -.7677D-04, -.9298D-04, -.1126D-03, -.1365D-03, -.1653D-03, & + & -.2002D-03, -.2425D-03, -.2936D-03, -.3554D-03, -.4301D-03, & + & -.5202D-03, -.6287D-03, -.7591D-03, -.9150D-03, -.1101D-02, & + & -.1321D-02, -.1577D-02, -.1872D-02, -.2202D-02, -.2558D-02, & + & -.2917D-02, -.3239D-02, -.3459D-02, -.3493D-02, -.3253D-02, & + & -.2705D-02, -.1976D-02, -.1463D-02, -.1853D-02, -.3876D-02, & + & -.7789D-02, -.1288D-01, -.1756D-01, -.2015D-01, -.1998D-01, & + & -.1766D-01, -.1444D-01, -.1135D-01, -.8830D-02, -.6891D-02, & + & -.5395D-02, -.4216D-02, -.3267D-02, -.2506D-02, -.1896D-02, & + & -.1418D-02, -.1049D-02, -.7705D-03, -.5611D-03, -.4041D-03, & + & -.2886D-03, -.2095D-03, -.1480D-03, -.1048D-03, -.7391D-04, & + & -.5554D-04, -.3665D-04, -.2408D-04, -.1793D-04, -.1162D-04, & + & -.1186D-04, -.5353D-05, -.5465D-05, -.5541D-05, 0.1074D-05, & + & 0.1039D-05/ + + data (calcpts(j,27), j = 1,neta) /-.1799D-04, -.2179D-04, & + & -.2640D-04, -.3199D-04, -.3875D-04, -.4695D-04, -.5688D-04, & + & -.6891D-04, -.8347D-04, -.1011D-03, -.1225D-03, -.1484D-03, & + & -.1798D-03, -.2178D-03, -.2637D-03, -.3193D-03, -.3866D-03, & + & -.4678D-03, -.5659D-03, -.6842D-03, -.8261D-03, -.9964D-03, & + & -.1200D-02, -.1440D-02, -.1722D-02, -.2048D-02, -.2416D-02, & + & -.2821D-02, -.3243D-02, -.3654D-02, -.4010D-02, -.4266D-02, & + & -.4407D-02, -.4507D-02, -.4803D-02, -.5710D-02, -.7709D-02, & + & -.1103D-01, -.1532D-01, -.1951D-01, -.2220D-01, -.2245D-01, & + & -.2037D-01, -.1695D-01, -.1334D-01, -.1025D-01, -.7864D-02, & + & -.6080D-02, -.4713D-02, -.3649D-02, -.2801D-02, -.2129D-02, & + & -.1595D-02, -.1187D-02, -.8684D-03, -.6365D-03, -.4599D-03, & + & -.3334D-03, -.2381D-03, -.1680D-03, -.1235D-03, -.8495D-04, & + & -.5929D-04, -.4665D-04, -.3378D-04, -.2077D-04, -.1432D-04, & + & -.1447D-04, -.7903D-05, -.7972D-05, -.8019D-05, -.1384D-05, & + & -.1406D-05/ + + data (calcpts(j,28), j = 1,neta) /-.1544D-04, -.1871D-04, & + & -.2266D-04, -.2745D-04, -.3326D-04, -.4030D-04, -.4882D-04, & + & -.5915D-04, -.7165D-04, -.8681D-04, -.1052D-03, -.1274D-03, & + & -.1543D-03, -.1870D-03, -.2264D-03, -.2742D-03, -.3321D-03, & + & -.4021D-03, -.4866D-03, -.5888D-03, -.7117D-03, -.8598D-03, & + & -.1037D-02, -.1249D-02, -.1501D-02, -.1797D-02, -.2141D-02, & + & -.2533D-02, -.2970D-02, -.3441D-02, -.3929D-02, -.4414D-02, & + & -.4893D-02, -.5410D-02, -.6097D-02, -.7195D-02, -.8996D-02, & + & -.1169D-01, -.1512D-01, -.1871D-01, -.2144D-01, -.2235D-01, & + & -.2108D-01, -.1813D-01, -.1453D-01, -.1116D-01, -.8466D-02, & + & -.6453D-02, -.4965D-02, -.3831D-02, -.2950D-02, -.2251D-02, & + & -.1699D-02, -.1272D-02, -.9380D-03, -.6869D-03, -.4997D-03, & + & -.3571D-03, -.2600D-03, -.1819D-03, -.1299D-03, -.9075D-04, & + & -.6469D-04, -.4510D-04, -.3205D-04, -.2558D-04, -.1904D-04, & + & -.1246D-04, -.5857D-05, -.5898D-05, -.5926D-05, -.5946D-05, & + & 0.7080D-06/ + + data (calcpts(j,29), j = 1,neta) /-.1277D-04, -.1547D-04, & + & -.1874D-04, -.2270D-04, -.2750D-04, -.3332D-04, -.4037D-04, & + & -.4891D-04, -.5924D-04, -.7178D-04, -.8697D-04, -.1054D-03, & + & -.1276D-03, -.1546D-03, -.1873D-03, -.2268D-03, -.2748D-03, & + & -.3327D-03, -.4028D-03, -.4876D-03, -.5898D-03, -.7133D-03, & + & -.8618D-03, -.1040D-02, -.1253D-02, -.1506D-02, -.1804D-02, & + & -.2152D-02, -.2552D-02, -.3002D-02, -.3499D-02, -.4038D-02, & + & -.4618D-02, -.5268D-02, -.6058D-02, -.7120D-02, -.8624D-02, & + & -.1070D-01, -.1334D-01, -.1624D-01, -.1880D-01, -.2025D-01, & + & -.1999D-01, -.1802D-01, -.1495D-01, -.1167D-01, -.8823D-02, & + & -.6636D-02, -.5040D-02, -.3866D-02, -.2982D-02, -.2286D-02, & + & -.1743D-02, -.1308D-02, -.9757D-03, -.7144D-03, -.5247D-03, & + & -.3806D-03, -.2689D-03, -.1968D-03, -.1376D-03, -.9809D-04, & + & -.7179D-04, -.5204D-04, -.3221D-04, -.2566D-04, -.1907D-04, & + & -.1246D-04, -.5827D-05, -.5852D-05, -.5869D-05, 0.7861D-06, & + & 0.7782D-06/ + + data (calcpts(j,30), j = 1,neta) /-.1024D-04, -.1241D-04, & + & -.1503D-04, -.1821D-04, -.2206D-04, -.2673D-04, -.3238D-04, & + & -.3923D-04, -.4753D-04, -.5758D-04, -.6977D-04, -.8452D-04, & + & -.1024D-03, -.1240D-03, -.1502D-03, -.1820D-03, -.2205D-03, & + & -.2670D-03, -.3233D-03, -.3915D-03, -.4738D-03, -.5733D-03, & + & -.6933D-03, -.8376D-03, -.1011D-02, -.1218D-02, -.1464D-02, & + & -.1754D-02, -.2094D-02, -.2485D-02, -.2929D-02, -.3427D-02, & + & -.3981D-02, -.4606D-02, -.5340D-02, -.6249D-02, -.7431D-02, & + & -.8975D-02, -.1091D-01, -.1312D-01, -.1531D-01, -.1698D-01, & + & -.1754D-01, -.1668D-01, -.1456D-01, -.1177D-01, -.9012D-02, & + & -.6734D-02, -.5036D-02, -.3817D-02, -.2926D-02, -.2254D-02, & + & -.1725D-02, -.1312D-02, -.9835D-03, -.7334D-03, -.5357D-03, & + & -.3905D-03, -.2849D-03, -.2056D-03, -.1461D-03, -.9979D-04, & + & -.7335D-04, -.5350D-04, -.3361D-04, -.2701D-04, -.2039D-04, & + & -.1376D-04, -.7115D-05, -.7130D-05, -.7141D-05, -.4813D-06, & + & -.4861D-06/ + + data (calcpts(j,31), j = 1,neta) /-.8016D-05, -.9712D-05, & + & -.1176D-04, -.1425D-04, -.1727D-04, -.2092D-04, -.2535D-04, & + & -.3071D-04, -.3720D-04, -.4507D-04, -.5461D-04, -.6616D-04, & + & -.8015D-04, -.9711D-04, -.1176D-03, -.1425D-03, -.1726D-03, & + & -.2091D-03, -.2532D-03, -.3066D-03, -.3712D-03, -.4493D-03, & + & -.5436D-03, -.6573D-03, -.7940D-03, -.9580D-03, -.1154D-02, & + & -.1386D-02, -.1661D-02, -.1980D-02, -.2349D-02, -.2769D-02, & + & -.3242D-02, -.3776D-02, -.4389D-02, -.5113D-02, -.6000D-02, & + & -.7105D-02, -.8465D-02, -.1006D-01, -.1178D-01, -.1334D-01, & + & -.1435D-01, -.1440D-01, -.1333D-01, -.1135D-01, -.8994D-02, & + & -.6786D-02, -.5024D-02, -.3742D-02, -.2832D-02, -.2172D-02, & + & -.1671D-02, -.1280D-02, -.9694D-03, -.7248D-03, -.5396D-03, & + & -.3939D-03, -.2879D-03, -.2083D-03, -.1486D-03, -.1088D-03, & + & -.7564D-04, -.5574D-04, -.3580D-04, -.2918D-04, -.1588D-04, & + & -.1590D-04, -.9249D-05, -.9259D-05, -.2599D-05, -.2604D-05, & + & -.2607D-05/ + + data (calcpts(j,32), j = 1,neta) /-.6153D-05, -.7455D-05, & + & -.9030D-05, -.1094D-04, -.1326D-04, -.1606D-04, -.1946D-04, & + & -.2357D-04, -.2856D-04, -.3460D-04, -.4192D-04, -.5078D-04, & + & -.6152D-04, -.7454D-04, -.9028D-04, -.1094D-03, -.1325D-03, & + & -.1605D-03, -.1944D-03, -.2355D-03, -.2851D-03, -.3451D-03, & + & -.4177D-03, -.5052D-03, -.6106D-03, -.7374D-03, -.8890D-03, & + & -.1070D-02, -.1284D-02, -.1536D-02, -.1828D-02, -.2163D-02, & + & -.2543D-02, -.2970D-02, -.3452D-02, -.4003D-02, -.4647D-02, & + & -.5416D-02, -.6342D-02, -.7441D-02, -.8684D-02, -.9956D-02, & + & -.1104D-01, -.1161D-01, -.1141D-01, -.1034D-01, -.8643D-02, & + & -.6739D-02, -.5023D-02, -.3691D-02, -.2739D-02, -.2071D-02, & + & -.1588D-02, -.1222D-02, -.9344D-03, -.7078D-03, -.5294D-03, & + & -.3914D-03, -.2865D-03, -.2075D-03, -.1497D-03, -.1065D-03, & + & -.7590D-04, -.5396D-04, -.3800D-04, -.2670D-04, -.1872D-04, & + & -.1273D-04, -.8742D-05, -.6082D-05, -.4086D-05, -.2756D-05, & + & -.1425D-05/ + + data (calcpts(j,33), j = 1,neta) /-.4652D-05, -.5636D-05, & + & -.6827D-05, -.8271D-05, -.1002D-04, -.1214D-04, -.1471D-04, & + & -.1782D-04, -.2159D-04, -.2616D-04, -.3169D-04, -.3839D-04, & + & -.4651D-04, -.5635D-04, -.6826D-04, -.8269D-04, -.1002D-03, & + & -.1214D-03, -.1470D-03, -.1780D-03, -.2156D-03, -.2610D-03, & + & -.3160D-03, -.3822D-03, -.4622D-03, -.5584D-03, -.6736D-03, & + & -.8114D-03, -.9751D-03, -.1168D-02, -.1392D-02, -.1651D-02, & + & -.1944D-02, -.2273D-02, -.2639D-02, -.3046D-02, -.3505D-02, & + & -.4031D-02, -.4646D-02, -.5373D-02, -.6219D-02, -.7152D-02, & + & -.8076D-02, -.8811D-02, -.9122D-02, -.8814D-02, -.7864D-02, & + & -.6474D-02, -.4981D-02, -.3676D-02, -.2685D-02, -.1986D-02, & + & -.1501D-02, -.1151D-02, -.8859D-03, -.6775D-03, -.5128D-03, & + & -.3839D-03, -.2835D-03, -.2077D-03, -.1505D-03, -.1086D-03, & + & -.7804D-04, -.5541D-04, -.3944D-04, -.2813D-04, -.2014D-04, & + & -.1415D-04, -.1016D-04, -.7497D-05, -.5500D-05, -.4169D-05, & + & -.2837D-05/ + + data (calcpts(j,34), j = 1,neta) /-.3472D-05, -.4207D-05, & + & -.5096D-05, -.6174D-05, -.7481D-05, -.9063D-05, -.1098D-04, & + & -.1330D-04, -.1611D-04, -.1952D-04, -.2366D-04, -.2866D-04, & + & -.3472D-04, -.4207D-04, -.5095D-04, -.6173D-04, -.7479D-04, & + & -.9059D-04, -.1097D-03, -.1329D-03, -.1609D-03, -.1949D-03, & + & -.2359D-03, -.2855D-03, -.3452D-03, -.4172D-03, -.5035D-03, & + & -.6068D-03, -.7296D-03, -.8745D-03, -.1044D-02, -.1239D-02, & + & -.1460D-02, -.1707D-02, -.1978D-02, -.2274D-02, -.2596D-02, & + & -.2953D-02, -.3356D-02, -.3824D-02, -.4374D-02, -.5007D-02, & + & -.5697D-02, -.6361D-02, -.6858D-02, -.7012D-02, -.6688D-02, & + & -.5890D-02, -.4790D-02, -.3645D-02, -.2667D-02, -.1936D-02, & + & -.1429D-02, -.1079D-02, -.8275D-03, -.6368D-03, -.4866D-03, & + & -.3682D-03, -.2751D-03, -.2032D-03, -.1480D-03, -.1074D-03, & + & -.7742D-04, -.5545D-04, -.3947D-04, -.2815D-04, -.1949D-04, & + & -.1416D-04, -.1017D-04, -.6839D-05, -.4841D-05, -.3509D-05, & + & -.2843D-05/ + + data (calcpts(j,35), j = 1,neta) /-.2566D-05, -.3109D-05, & + & -.3766D-05, -.4563D-05, -.5529D-05, -.6698D-05, -.8115D-05, & + & -.9832D-05, -.1191D-04, -.1443D-04, -.1748D-04, -.2118D-04, & + & -.2566D-04, -.3109D-04, -.3766D-04, -.4562D-04, -.5527D-04, & + & -.6696D-04, -.8110D-04, -.9824D-04, -.1190D-03, -.1441D-03, & + & -.1744D-03, -.2110D-03, -.2552D-03, -.3085D-03, -.3724D-03, & + & -.4489D-03, -.5400D-03, -.6474D-03, -.7730D-03, -.9178D-03, & + & -.1082D-02, -.1264D-02, -.1463D-02, -.1676D-02, -.1901D-02, & + & -.2142D-02, -.2405D-02, -.2702D-02, -.3048D-02, -.3455D-02, & + & -.3924D-02, -.4429D-02, -.4904D-02, -.5239D-02, -.5304D-02, & + & -.5007D-02, -.4363D-02, -.3511D-02, -.2647D-02, -.1922D-02, & + & -.1388D-02, -.1022D-02, -.7714D-03, -.5912D-03, -.4549D-03, & + & -.3477D-03, -.2625D-03, -.1960D-03, -.1440D-03, -.1054D-03, & + & -.7611D-04, -.5480D-04, -.3881D-04, -.2749D-04, -.1949D-04, & + & -.1350D-04, -.9501D-05, -.6836D-05, -.4838D-05, -.3505D-05, & + & -.2173D-05/ + + data (calcpts(j,36), j = 1,neta) /-.1882D-05, -.2280D-05, & + & -.2762D-05, -.3346D-05, -.4055D-05, -.4912D-05, -.5951D-05, & + & -.7210D-05, -.8734D-05, -.1058D-04, -.1282D-04, -.1553D-04, & + & -.1882D-04, -.2280D-04, -.2762D-04, -.3346D-04, -.4054D-04, & + & -.4910D-04, -.5948D-04, -.7205D-04, -.8724D-04, -.1056D-03, & + & -.1279D-03, -.1548D-03, -.1872D-03, -.2263D-03, -.2732D-03, & + & -.3294D-03, -.3962D-03, -.4752D-03, -.5675D-03, -.6739D-03, & + & -.7942D-03, -.9276D-03, -.1072D-02, -.1224D-02, -.1382D-02, & + & -.1545D-02, -.1717D-02, -.1904D-02, -.2118D-02, -.2370D-02, & + & -.2669D-02, -.3013D-02, -.3381D-02, -.3720D-02, -.3946D-02, & + & -.3963D-02, -.3711D-02, -.3205D-02, -.2557D-02, -.1912D-02, & + & -.1379D-02, -.9917D-03, -.7282D-03, -.5492D-03, -.4207D-03, & + & -.3236D-03, -.2470D-03, -.1871D-03, -.1391D-03, -.1025D-03, & + & -.7449D-04, -.5384D-04, -.3852D-04, -.2786D-04, -.1986D-04, & + & -.1387D-04, -.9868D-05, -.6536D-05, -.4537D-05, -.3204D-05, & + & -.2538D-05/ + + data (calcpts(j,37), j = 1,neta) /-.1371D-05, -.1661D-05, & + & -.2012D-05, -.2438D-05, -.2954D-05, -.3579D-05, -.4336D-05, & + & -.5253D-05, -.6363D-05, -.7709D-05, -.9341D-05, -.1132D-04, & + & -.1371D-04, -.1661D-04, -.2012D-04, -.2438D-04, -.2953D-04, & + & -.3577D-04, -.4333D-04, -.5249D-04, -.6356D-04, -.7697D-04, & + & -.9319D-04, -.1128D-03, -.1364D-03, -.1649D-03, -.1991D-03, & + & -.2400D-03, -.2888D-03, -.3463D-03, -.4136D-03, -.4912D-03, & + & -.5787D-03, -.6755D-03, -.7795D-03, -.8880D-03, -.9986D-03, & + & -.1110D-02, -.1223D-02, -.1341D-02, -.1472D-02, -.1625D-02, & + & -.1808D-02, -.2026D-02, -.2278D-02, -.2546D-02, -.2787D-02, & + & -.2939D-02, -.2933D-02, -.2727D-02, -.2338D-02, -.1851D-02, & + & -.1374D-02, -.9852D-03, -.7055D-03, -.5172D-03, -.3894D-03, & + & -.2988D-03, -.2296D-03, -.1756D-03, -.1323D-03, -.9832D-04, & + & -.7234D-04, -.5302D-04, -.3836D-04, -.2703D-04, -.1970D-04, & + & -.1370D-04, -.9704D-05, -.7038D-05, -.5039D-05, -.3706D-05, & + & -.2373D-05/ + + data (calcpts(j,38), j = 1,neta) /-.9934D-06, -.1204D-05, & + & -.1458D-05, -.1767D-05, -.2140D-05, -.2593D-05, -.3141D-05, & + & -.3806D-05, -.4611D-05, -.5586D-05, -.6768D-05, -.8200D-05, & + & -.9934D-05, -.1204D-04, -.1458D-04, -.1766D-04, -.2140D-04, & + & -.2592D-04, -.3140D-04, -.3803D-04, -.4606D-04, -.5577D-04, & + & -.6753D-04, -.8172D-04, -.9885D-04, -.1195D-03, -.1443D-03, & + & -.1739D-03, -.2093D-03, -.2510D-03, -.2997D-03, -.3559D-03, & + & -.4192D-03, -.4891D-03, -.5638D-03, -.6411D-03, -.7187D-03, & + & -.7950D-03, -.8699D-03, -.9455D-03, -.1026D-02, -.1117D-02, & + & -.1226D-02, -.1358D-02, -.1518D-02, -.1702D-02, -.1895D-02, & + & -.2067D-02, -.2170D-02, -.2155D-02, -.1991D-02, -.1696D-02, & + & -.1334D-02, -.9843D-03, -.7016D-03, -.5005D-03, -.3659D-03, & + & -.2753D-03, -.2113D-03, -.1620D-03, -.1240D-03, -.9339D-04, & + & -.6940D-04, -.5141D-04, -.3741D-04, -.2675D-04, -.1942D-04, & + & -.1342D-04, -.9422D-05, -.6756D-05, -.4756D-05, -.3423D-05, & + & -.2090D-05/ + + data (calcpts(j,39), j = 1,neta) /-.7169D-06, -.8686D-06, & + & -.1052D-05, -.1275D-05, -.1545D-05, -.1871D-05, -.2267D-05, & + & -.2747D-05, -.3327D-05, -.4031D-05, -.4884D-05, -.5917D-05, & + & -.7169D-05, -.8685D-05, -.1052D-04, -.1275D-04, -.1544D-04, & + & -.1871D-04, -.2266D-04, -.2745D-04, -.3324D-04, -.4025D-04, & + & -.4873D-04, -.5897D-04, -.7134D-04, -.8623D-04, -.1041D-03, & + & -.1255D-03, -.1510D-03, -.1811D-03, -.2163D-03, -.2568D-03, & + & -.3024D-03, -.3527D-03, -.4062D-03, -.4612D-03, -.5158D-03, & + & -.5685D-03, -.6187D-03, -.6676D-03, -.7174D-03, -.7719D-03, & + & -.8355D-03, -.9132D-03, -.1009D-02, -.1126D-02, -.1259D-02, & + & -.1399D-02, -.1521D-02, -.1591D-02, -.1573D-02, -.1446D-02, & + & -.1226D-02, -.9584D-03, -.7031D-03, -.4988D-03, -.3545D-03, & + & -.2587D-03, -.1947D-03, -.1492D-03, -.1147D-03, -.8761D-04, & + & -.6616D-04, -.4956D-04, -.3623D-04, -.2623D-04, -.1890D-04, & + & -.1357D-04, -.9571D-05, -.6905D-05, -.4905D-05, -.3572D-05, & + & -.2239D-05/ + + data (calcpts(j,40), j = 1,neta) /-.5152D-06, -.6243D-06, & + & -.7562D-06, -.9162D-06, -.1110D-05, -.1345D-05, -.1629D-05, & + & -.1974D-05, -.2391D-05, -.2897D-05, -.3510D-05, -.4253D-05, & + & -.5152D-05, -.6242D-05, -.7561D-05, -.9160D-05, -.1110D-04, & + & -.1344D-04, -.1628D-04, -.1973D-04, -.2389D-04, -.2893D-04, & + & -.3502D-04, -.4238D-04, -.5127D-04, -.6197D-04, -.7482D-04, & + & -.9021D-04, -.1085D-03, -.1302D-03, -.1554D-03, -.1845D-03, & + & -.2173D-03, -.2533D-03, -.2915D-03, -.3306D-03, -.3691D-03, & + & -.4057D-03, -.4398D-03, -.4717D-03, -.5030D-03, -.5357D-03, & + & -.5727D-03, -.6176D-03, -.6733D-03, -.7430D-03, -.8276D-03, & + & -.9246D-03, -.1025D-02, -.1112D-02, -.1159D-02, -.1142D-02, & + & -.1046D-02, -.8819D-03, -.6861D-03, -.5007D-03, -.3536D-03, & + & -.2504D-03, -.1824D-03, -.1371D-03, -.1051D-03, -.8080D-04, & + & -.6168D-04, -.4655D-04, -.3462D-04, -.2542D-04, -.1848D-04, & + & -.1335D-04, -.9553D-05, -.6820D-05, -.4820D-05, -.3420D-05, & + & -.2420D-05/ + + data (calcpts(j,41), j = 1,neta) /-.3691D-06, -.4472D-06, & + & -.5416D-06, -.6563D-06, -.7952D-06, -.9633D-06, -.1167D-05, & + & -.1414D-05, -.1713D-05, -.2075D-05, -.2514D-05, -.3046D-05, & + & -.3691D-05, -.4471D-05, -.5416D-05, -.6562D-05, -.7950D-05, & + & -.9630D-05, -.1167D-04, -.1413D-04, -.1711D-04, -.2072D-04, & + & -.2509D-04, -.3036D-04, -.3672D-04, -.4439D-04, -.5360D-04, & + & -.6462D-04, -.7775D-04, -.9324D-04, -.1113D-03, -.1322D-03, & + & -.1556D-03, -.1813D-03, -.2086D-03, -.2364D-03, -.2635D-03, & + & -.2890D-03, -.3124D-03, -.3336D-03, -.3535D-03, -.3734D-03, & + & -.3951D-03, -.4206D-03, -.4523D-03, -.4925D-03, -.5429D-03, & + & -.6043D-03, -.6745D-03, -.7467D-03, -.8083D-03, -.8408D-03, & + & -.8255D-03, -.7532D-03, -.6325D-03, -.4898D-03, -.3558D-03, & + & -.2501D-03, -.1766D-03, -.1284D-03, -.9645D-04, -.7386D-04, & + & -.5680D-04, -.4333D-04, -.3267D-04, -.2427D-04, -.1780D-04, & + & -.1294D-04, -.9270D-05, -.6670D-05, -.4737D-05, -.3337D-05, & + & -.2337D-05/ + + data (calcpts(j,42), j = 1,neta) /-.2638D-06, -.3195D-06, & + & -.3871D-06, -.4689D-06, -.5682D-06, -.6883D-06, -.8339D-06, & + & -.1010D-05, -.1224D-05, -.1483D-05, -.1797D-05, -.2177D-05, & + & -.2637D-05, -.3195D-05, -.3870D-05, -.4688D-05, -.5680D-05, & + & -.6881D-05, -.8335D-05, -.1010D-04, -.1223D-04, -.1481D-04, & + & -.1793D-04, -.2169D-04, -.2624D-04, -.3172D-04, -.3830D-04, & + & -.4617D-04, -.5555D-04, -.6662D-04, -.7954D-04, -.9441D-04, & + & -.1111D-03, -.1295D-03, -.1489D-03, -.1686D-03, -.1878D-03, & + & -.2057D-03, -.2218D-03, -.2361D-03, -.2490D-03, -.2613D-03, & + & -.2741D-03, -.2886D-03, -.3064D-03, -.3289D-03, -.3579D-03, & + & -.3944D-03, -.4389D-03, -.4895D-03, -.5414D-03, -.5851D-03, & + & -.6073D-03, -.5946D-03, -.5408D-03, -.4524D-03, -.3489D-03, & + & -.2524D-03, -.1767D-03, -.1244D-03, -.9029D-04, -.6776D-04, & + & -.5190D-04, -.3990D-04, -.3044D-04, -.2297D-04, -.1704D-04, & + & -.1250D-04, -.9105D-05, -.6505D-05, -.4638D-05, -.3305D-05, & + & -.2372D-05/ + + data (calcpts(j,43), j = 1,neta) /-.1880D-06, -.2277D-06, & + & -.2758D-06, -.3342D-06, -.4049D-06, -.4906D-06, -.5944D-06, & + & -.7201D-06, -.8723D-06, -.1057D-05, -.1281D-05, -.1551D-05, & + & -.1879D-05, -.2277D-05, -.2758D-05, -.3342D-05, -.4049D-05, & + & -.4904D-05, -.5941D-05, -.7196D-05, -.8714D-05, -.1055D-04, & + & -.1278D-04, -.1546D-04, -.1870D-04, -.2261D-04, -.2729D-04, & + & -.3291D-04, -.3959D-04, -.4748D-04, -.5669D-04, -.6728D-04, & + & -.7919D-04, -.9224D-04, -.1060D-03, -.1200D-03, -.1336D-03, & + & -.1462D-03, -.1573D-03, -.1670D-03, -.1755D-03, -.1833D-03, & + & -.1910D-03, -.1993D-03, -.2093D-03, -.2217D-03, -.2379D-03, & + & -.2588D-03, -.2852D-03, -.3172D-03, -.3537D-03, -.3909D-03, & + & -.4218D-03, -.4371D-03, -.4269D-03, -.3872D-03, -.3228D-03, & + & -.2480D-03, -.1787D-03, -.1247D-03, -.8754D-04, -.6341D-04, & + & -.4755D-04, -.3642D-04, -.2802D-04, -.2135D-04, -.1609D-04, & + & -.1195D-04, -.8754D-05, -.6354D-05, -.4554D-05, -.3288D-05, & + & -.2288D-05/ + + data (calcpts(j,44), j = 1,neta) /-.1338D-06, -.1621D-06, & + & -.1963D-06, -.2378D-06, -.2880D-06, -.3489D-06, -.4227D-06, & + & -.5121D-06, -.6204D-06, -.7516D-06, -.9106D-06, -.1103D-05, & + & -.1337D-05, -.1619D-05, -.1961D-05, -.2376D-05, -.2879D-05, & + & -.3488D-05, -.4225D-05, -.5117D-05, -.6197D-05, -.7504D-05, & + & -.9086D-05, -.1100D-04, -.1330D-04, -.1608D-04, -.1941D-04, & + & -.2340D-04, -.2815D-04, -.3376D-04, -.4031D-04, -.4784D-04, & + & -.5630D-04, -.6557D-04, -.7537D-04, -.8529D-04, -.9487D-04, & + & -.1037D-03, -.1115D-03, -.1182D-03, -.1238D-03, -.1288D-03, & + & -.1335D-03, -.1384D-03, -.1439D-03, -.1508D-03, -.1596D-03, & + & -.1712D-03, -.1863D-03, -.2053D-03, -.2284D-03, -.2546D-03, & + & -.2812D-03, -.3031D-03, -.3135D-03, -.3057D-03, -.2764D-03, & + & -.2298D-03, -.1760D-03, -.1263D-03, -.8785D-04, -.6152D-04, & + & -.4446D-04, -.3332D-04, -.2552D-04, -.1959D-04, -.1499D-04, & + & -.1126D-04, -.8392D-05, -.6126D-05, -.4459D-05, -.3193D-05, & + & -.2259D-05/ + + data (calcpts(j,45), j = 1,neta) /-.9473D-07, -.1149D-06, & + & -.1392D-06, -.1688D-06, -.2045D-06, -.2477D-06, -.3001D-06, & + & -.3636D-06, -.4404D-06, -.5337D-06, -.6466D-06, -.7833D-06, & + & -.9490D-06, -.1150D-05, -.1393D-05, -.1687D-05, -.2044D-05, & + & -.2476D-05, -.3000D-05, -.3634D-05, -.4400D-05, -.5328D-05, & + & -.6451D-05, -.7807D-05, -.9444D-05, -.1142D-04, -.1378D-04, & + & -.1662D-04, -.1999D-04, -.2397D-04, -.2862D-04, -.3397D-04, & + & -.3997D-04, -.4655D-04, -.5350D-04, -.6052D-04, -.6730D-04, & + & -.7351D-04, -.7896D-04, -.8357D-04, -.8742D-04, -.9068D-04, & + & -.9360D-04, -.9648D-04, -.9962D-04, -.1034D-03, -.1082D-03, & + & -.1145D-03, -.1228D-03, -.1336D-03, -.1473D-03, -.1640D-03, & + & -.1827D-03, -.2017D-03, -.2172D-03, -.2243D-03, -.2184D-03, & + & -.1970D-03, -.1634D-03, -.1247D-03, -.8922D-04, -.6185D-04, & + & -.4319D-04, -.3121D-04, -.2337D-04, -.1791D-04, -.1377D-04, & + & -.1051D-04, -.7907D-05, -.5907D-05, -.4307D-05, -.3107D-05, & + & -.2241D-05/ + + data (calcpts(j,46), j = 1,neta) /-.6701D-07, -.8119D-07, & + & -.9870D-07, -.1195D-06, -.1447D-06, -.1754D-06, -.2127D-06, & + & -.2576D-06, -.3120D-06, -.3781D-06, -.4581D-06, -.5551D-06, & + & -.6724D-06, -.8147D-06, -.9868D-06, -.1196D-05, -.1449D-05, & + & -.1755D-05, -.2125D-05, -.2575D-05, -.3118D-05, -.3776D-05, & + & -.4571D-05, -.5532D-05, -.6691D-05, -.8089D-05, -.9765D-05, & + & -.1177D-04, -.1416D-04, -.1699D-04, -.2028D-04, -.2407D-04, & + & -.2832D-04, -.3298D-04, -.3790D-04, -.4286D-04, -.4765D-04, & + & -.5203D-04, -.5584D-04, -.5904D-04, -.6167D-04, -.6384D-04, & + & -.6570D-04, -.6744D-04, -.6924D-04, -.7133D-04, -.7392D-04, & + & -.7731D-04, -.8181D-04, -.8777D-04, -.9555D-04, -.1054D-03, & + & -.1173D-03, -.1308D-03, -.1443D-03, -.1552D-03, -.1602D-03, & + & -.1556D-03, -.1401D-03, -.1158D-03, -.8818D-04, -.6290D-04, & + & -.4347D-04, -.3029D-04, -.2185D-04, -.1636D-04, -.1252D-04, & + & -.9628D-05, -.7341D-05, -.5528D-05, -.4108D-05, -.3008D-05, & + & -.2181D-05/ + + data (calcpts(j,47), j = 1,neta) /-.4757D-07, -.5758D-07, & + & -.6968D-07, -.8450D-07, -.1024D-06, -.1242D-06, -.1503D-06, & + & -.1822D-06, -.2207D-06, -.2675D-06, -.3240D-06, -.3926D-06, & + & -.4757D-06, -.5763D-06, -.6981D-06, -.8458D-06, -.1025D-05, & + & -.1241D-05, -.1504D-05, -.1821D-05, -.2206D-05, -.2671D-05, & + & -.3234D-05, -.3913D-05, -.4734D-05, -.5722D-05, -.6908D-05, & + & -.8329D-05, -.1002D-04, -.1202D-04, -.1435D-04, -.1702D-04, & + & -.2003D-04, -.2333D-04, -.2680D-04, -.3031D-04, -.3369D-04, & + & -.3677D-04, -.3945D-04, -.4168D-04, -.4349D-04, -.4495D-04, & + & -.4616D-04, -.4724D-04, -.4829D-04, -.4945D-04, -.5086D-04, & + & -.5267D-04, -.5507D-04, -.5828D-04, -.6256D-04, -.6814D-04, & + & -.7521D-04, -.8374D-04, -.9332D-04, -.1029D-03, -.1107D-03, & + & -.1141D-03, -.1106D-03, -.9943D-04, -.8204D-04, -.6228D-04, & + & -.4429D-04, -.3052D-04, -.2122D-04, -.1528D-04, -.1143D-04, & + & -.8745D-05, -.6726D-05, -.5126D-05, -.3859D-05, -.2859D-05, & + & -.2092D-05/ + + data (calcpts(j,48), j = 1,neta) /-.3318D-07, -.4036D-07, & + & -.4933D-07, -.5977D-07, -.7242D-07, -.8763D-07, -.1062D-06, & + & -.1288D-06, -.1559D-06, -.1890D-06, -.2290D-06, -.2774D-06, & + & -.3361D-06, -.4072D-06, -.4933D-06, -.5976D-06, -.7240D-06, & + & -.8771D-06, -.1062D-05, -.1287D-05, -.1558D-05, -.1887D-05, & + & -.2285D-05, -.2765D-05, -.3345D-05, -.4043D-05, -.4881D-05, & + & -.5885D-05, -.7080D-05, -.8490D-05, -.1014D-04, -.1203D-04, & + & -.1415D-04, -.1648D-04, -.1893D-04, -.2141D-04, -.2379D-04, & + & -.2597D-04, -.2785D-04, -.2941D-04, -.3066D-04, -.3166D-04, & + & -.3246D-04, -.3313D-04, -.3376D-04, -.3442D-04, -.3519D-04, & + & -.3615D-04, -.3743D-04, -.3914D-04, -.4144D-04, -.4450D-04, & + & -.4849D-04, -.5354D-04, -.5964D-04, -.6647D-04, -.7329D-04, & + & -.7875D-04, -.8108D-04, -.7854D-04, -.7046D-04, -.5801D-04, & + & -.4393D-04, -.3116D-04, -.2142D-04, -.1486D-04, -.1069D-04, & + & -.7993D-05, -.6113D-05, -.4700D-05, -.3586D-05, -.2700D-05, & + & -.2000D-05/ + + data (calcpts(j,49), j = 1,neta) /-.2387D-07, -.2858D-07, & + & -.3511D-07, -.4218D-07, -.5120D-07, -.6191D-07, -.7500D-07, & + & -.9087D-07, -.1101D-06, -.1334D-06, -.1616D-06, -.1957D-06, & + & -.2372D-06, -.2873D-06, -.3480D-06, -.4217D-06, -.5109D-06, & + & -.6189D-06, -.7496D-06, -.9081D-06, -.1100D-05, -.1332D-05, & + & -.1612D-05, -.1951D-05, -.2360D-05, -.2853D-05, -.3444D-05, & + & -.4152D-05, -.4995D-05, -.5990D-05, -.7151D-05, -.8486D-05, & + & -.9986D-05, -.1163D-04, -.1336D-04, -.1510D-04, -.1678D-04, & + & -.1831D-04, -.1963D-04, -.2073D-04, -.2160D-04, -.2228D-04, & + & -.2282D-04, -.2326D-04, -.2364D-04, -.2402D-04, -.2445D-04, & + & -.2496D-04, -.2563D-04, -.2653D-04, -.2775D-04, -.2939D-04, & + & -.3159D-04, -.3444D-04, -.3805D-04, -.4239D-04, -.4725D-04, & + & -.5208D-04, -.5593D-04, -.5753D-04, -.5566D-04, -.4986D-04, & + & -.4097D-04, -.3095D-04, -.2190D-04, -.1502D-04, -.1040D-04, & + & -.7471D-05, -.5584D-05, -.4271D-05, -.3284D-05, -.2504D-05, & + & -.1884D-05/ + + data (dlaeta(j), j = 1,neta) / & + & -6d0, -5.83333333d0, -5.66666667d0, -5.5d0, -5.33333333d0, & + & -5.16666667d0, -5d0, -4.83333333d0, -4.66666667d0, -4.5d0, & + & -4.33333333d0, -4.16666667d0, -4d0, -3.83333333d0, & + & -3.66666667d0, -3.5d0, -3.33333333d0, -3.16666667d0, -3d0, & + & -2.83333333d0, -2.66666667d0, -2.5d0, -2.33333333d0, & + & -2.16666667d0, -2d0, -1.83333333d0, -1.66666667d0, -1.5d0, & + & -1.33333333d0, -1.16666667d0, -1d0, -0.83333333d0, -0.66666667d0,& + & -0.5d0, -0.33333333d0, -0.16666667d0, 0d0, 0.16666667d0, & + & 0.33333333d0, 0.5d0, 0.66666667d0, 0.83333333d0, 1d0, & + & 1.16666667d0, 1.33333333d0, 1.5d0, 1.66666667d0, 1.83333333d0, & + & 2d0, 2.16666667d0, 2.33333333d0, 2.5d0, 2.66666667d0, & + & 2.83333333d0, 3d0, 3.16666667d0, 3.33333333d0, 3.5d0, & + & 3.66666667d0, 3.83333333d0, 4d0, 4.16666667d0, 4.33333333d0, & + & 4.5d0, 4.66666667d0, 4.83333333d0, 5d0, 5.16666667d0, & + & 5.33333333d0, 5.5d0, 5.66666667d0, 5.83333333d0, 6d0/ + + data (dlaxi(j), j = 1,nxi) / & + & -3d0, -2.83333333d0, -2.66666667d0, -2.5d0, -2.33333333d0, & + & -2.16666667d0, -2d0, -1.83333333d0, -1.66666667d0, -1.5d0, & + & -1.33333333d0, -1.16666667d0, -1d0, -0.83333333d0, -0.66666667d0,& + & -0.5d0, -0.33333333d0, -0.16666667d0, 0d0, 0.16666667d0, & + & 0.33333333d0, 0.5d0, 0.66666667d0, 0.83333333d0, 1d0, & + & 1.16666667d0, 1.33333333d0, 1.5d0, 1.66666667d0, 1.83333333d0, & + & 2d0, 2.16666667d0, 2.33333333d0, 2.5d0, 2.66666667d0, & + & 2.83333333d0, 3d0, 3.16666667d0, 3.33333333d0, 3.5d0, & + & 3.66666667d0, 3.83333333d0, 4d0, 4.16666667d0, 4.33333333d0, & + & 4.5d0, 4.66666667d0, 4.83333333d0, 5d0/ + + dleta = dlog10(eta) + dlxi = dlog10(xi) + if (dlxi .le. dlaxi(1)) dlxi = dlaxi(1) + if (dlxi .ge. dlaxi(nxi)) dlxi = dlaxi(nxi) + if (dleta .ge. dlaeta(neta)) dleta = dlaeta(neta) + if (dleta .le. dlaeta(1)) dleta = dlaeta(1) + call locate(dlaeta,neta, dleta, ieta) + call locate(dlaxi, nxi, dlxi, ixi) +! interpolating between the appropriate points + delxi = 1d0/6d0 + deleta = 1d0/6d0 +! lagrange 3-pt. + if (ixi .le. 2) ixi = 2 + if (ixi .ge. 48) ixi = 48 + if (ieta .le. 2) ieta = 2 + if (ieta .ge. 72) ieta = 72 + pxi = (dlxi - dlaxi(ixi))/delxi + f(-1) = pxi*(pxi-1d0)/2d0*calcpts(ieta-1,ixi-1) + & + & (1d0 - pxi**2)*calcpts(ieta-1,ixi) + & + & pxi*(pxi+1d0)/2d0*calcpts(ieta-1,ixi+1) + f(0) = pxi*(pxi-1d0)/2d0*calcpts(ieta,ixi-1) + & + & (1d0 - pxi**2)*calcpts(ieta,ixi) + & + & pxi*(pxi+1d0)/2d0*calcpts(ieta,ixi+1) + f(1) = pxi*(pxi-1d0)/2d0*calcpts(ieta+1,ixi-1) + & + & (1d0 - pxi**2)*calcpts(ieta+1,ixi) + & + & pxi*(pxi+1d0)/2d0*calcpts(ieta+1,ixi+1) + peta = (dleta - dlaeta(ieta))/deleta + h1_ALg = peta*(peta-1d0)/2d0*f(-1) + & + & (1d0 - peta**2)*f(0) + & + & peta*(peta+1d0)/2d0*f(1) +!MB + + peta*(peta+1d0)/2d0*f(1) + return + END + +! ======================================== + double precision function h1_FLg(eta,xi) +! ======================================== + +! eq (10) in PLB347 (1995) 143 - 151 for the longitudinal piece +! MSbar scheme +! This routine is called subclcf in the original code. +! Called sclcf in updated code (03/06/96). + + implicit none + integer neta, nxi + parameter (neta = 73, nxi = 49) + double precision calcpts(neta, nxi), dlaeta(neta), dlaxi(nxi) + double precision eta, xi, dleta, dlxi + double precision pxi, peta, f(-1:1), delxi, deleta + integer j, ieta, ixi + + data (calcpts(j, 1), j = 1,neta) /-.1526D-12, -.3323D-12, & + & -.3907D-12, -.6839D-12, -.1600D-11, -.3278D-11, -.4479D-11, & + & -.9221D-11, -.1419D-10, -.2587D-10, -.4799D-10, -.7559D-10, & + & -.1451D-09, -.2621D-09, -.4500D-09, -.8116D-09, -.1474D-08, & + & -.2638D-08, -.4581D-08, -.8208D-08, -.1447D-07, -.2578D-07, & + & -.4622D-07, -.8126D-07, -.1450D-06, -.2590D-06, -.4588D-06, & + & -.8141D-06, -.1438D-05, -.2515D-05, -.4340D-05, -.7316D-05, & + & -.1190D-04, -.1839D-04, -.2652D-04, -.3509D-04, -.4205D-04, & + & -.4536D-04, -.4420D-04, -.3927D-04, -.3230D-04, -.2498D-04, & + & -.1844D-04, -.1315D-04, -.9162D-05, -.6272D-05, -.4243D-05, & + & -.2849D-05, -.1902D-05, -.1265D-05, -.8396D-06, -.5559D-06, & + & -.3675D-06, -.2427D-06, -.1601D-06, -.1055D-06, -.6950D-07, & + & -.4569D-07, -.3001D-07, -.1968D-07, -.1290D-07, -.8435D-08, & + & -.5514D-08, -.3594D-08, -.4557D-08, -.3116D-08, -.2128D-08, & + & -.1452D-08, -.9914D-09, -.6763D-09, -.4610D-09, -.3142D-09, & + & -.2142D-09/ + + data (calcpts(j, 2), j = 1,neta) /-.1979D-12, -.6116D-12, & + & -.5642D-12, -.1280D-11, -.3041D-11, -.3966D-11, -.7910D-11, & + & -.1347D-10, -.2032D-10, -.3911D-10, -.7392D-10, -.1265D-09, & + & -.2222D-09, -.4048D-09, -.6812D-09, -.1207D-08, -.2240D-08, & + & -.3794D-08, -.6782D-08, -.1216D-07, -.2132D-07, -.3805D-07, & + & -.6763D-07, -.1202D-06, -.2143D-06, -.3812D-06, -.6731D-06, & + & -.1196D-05, -.2112D-05, -.3695D-05, -.6377D-05, -.1074D-04, & + & -.1746D-04, -.2699D-04, -.3893D-04, -.5150D-04, -.6170D-04, & + & -.6657D-04, -.6486D-04, -.5763D-04, -.4739D-04, -.3665D-04, & + & -.2706D-04, -.1930D-04, -.1345D-04, -.9205D-05, -.6227D-05, & + & -.4180D-05, -.2791D-05, -.1856D-05, -.1232D-05, -.8156D-06, & + & -.5392D-06, -.3562D-06, -.2349D-06, -.1548D-06, -.1020D-06, & + & -.6705D-07, -.4403D-07, -.2888D-07, -.1893D-07, -.1238D-07, & + & -.8090D-08, -.5273D-08, -.3429D-08, -.4572D-08, -.3123D-08, & + & -.2131D-08, -.1455D-08, -.9921D-09, -.6764D-09, -.4611D-09, & + & -.3143D-09/ + + data (calcpts(j, 3), j = 1,neta) /-.2047D-12, -.4402D-12, & + & -.5594D-12, -.1213D-11, -.3449D-11, -.4707D-11, -.9446D-11, & + & -.1768D-10, -.2612D-10, -.5612D-10, -.9231D-10, -.1774D-09, & + & -.3093D-09, -.5600D-09, -.9492D-09, -.1660D-08, -.3105D-08, & + & -.5504D-08, -.9882D-08, -.1767D-07, -.3091D-07, -.5602D-07, & + & -.9938D-07, -.1750D-06, -.3126D-06, -.5560D-06, -.9846D-06, & + & -.1747D-05, -.3092D-05, -.5405D-05, -.9329D-05, -.1574D-04, & + & -.2559D-04, -.3955D-04, -.5706D-04, -.7550D-04, -.9047D-04, & + & -.9761D-04, -.9510D-04, -.8452D-04, -.6949D-04, -.5375D-04, & + & -.3968D-04, -.2830D-04, -.1972D-04, -.1350D-04, -.9131D-05, & + & -.6129D-05, -.4092D-05, -.2721D-05, -.1806D-05, -.1196D-05, & + & -.7903D-06, -.5220D-06, -.3444D-06, -.2268D-06, -.1495D-06, & + & -.9828D-07, -.6453D-07, -.4234D-07, -.2774D-07, -.1814D-07, & + & -.1186D-07, -.7726D-08, -.5024D-08, -.3262D-08, -.4580D-08, & + & -.3126D-08, -.2133D-08, -.1455D-08, -.9916D-09, -.6762D-09, & + & -.4608D-09/ + + data (calcpts(j, 4), j = 1,neta) /-.3980D-12, -.9437D-12, & + & -.1372D-11, -.2820D-11, -.4058D-11, -.7437D-11, -.1433D-10, & + & -.2712D-10, -.4303D-10, -.7171D-10, -.1424D-09, -.2625D-09, & + & -.4584D-09, -.8241D-09, -.1411D-08, -.2519D-08, -.4554D-08, & + & -.8235D-08, -.1450D-07, -.2605D-07, -.4624D-07, -.8090D-07, & + & -.1457D-06, -.2586D-06, -.4593D-06, -.8177D-06, -.1447D-05, & + & -.2562D-05, -.4530D-05, -.7931D-05, -.1368D-04, -.2309D-04, & + & -.3753D-04, -.5802D-04, -.8370D-04, -.1107D-03, -.1327D-03, & + & -.1432D-03, -.1395D-03, -.1240D-03, -.1019D-03, -.7884D-04, & + & -.5820D-04, -.4152D-04, -.2892D-04, -.1980D-04, -.1339D-04, & + & -.8990D-05, -.6002D-05, -.3991D-05, -.2649D-05, -.1754D-05, & + & -.1159D-05, -.7655D-06, -.5050D-06, -.3328D-06, -.2192D-06, & + & -.1441D-06, -.9463D-07, -.6208D-07, -.4067D-07, -.2659D-07, & + & -.1738D-07, -.1133D-07, -.7365D-08, -.4782D-08, -.3097D-08, & + & -.4585D-08, -.3129D-08, -.2134D-08, -.1454D-08, -.9915D-09, & + & -.6759D-09/ + + data (calcpts(j, 5), j = 1,neta) /-.8492D-12, -.1819D-11, & + & -.1594D-11, -.4321D-11, -.7149D-11, -.1278D-10, -.2327D-10, & + & -.4772D-10, -.5993D-10, -.1160D-09, -.2318D-09, -.3877D-09, & + & -.6909D-09, -.1180D-08, -.2148D-08, -.3792D-08, -.6799D-08, & + & -.1217D-07, -.2153D-07, -.3862D-07, -.6690D-07, -.1197D-06, & + & -.2149D-06, -.3801D-06, -.6744D-06, -.1203D-05, -.2123D-05, & + & -.3762D-05, -.6655D-05, -.1164D-04, -.2008D-04, -.3386D-04, & + & -.5505D-04, -.8509D-04, -.1227D-03, -.1624D-03, -.1945D-03, & + & -.2099D-03, -.2045D-03, -.1818D-03, -.1495D-03, -.1156D-03, & + & -.8534D-04, -.6087D-04, -.4240D-04, -.2902D-04, -.1963D-04, & + & -.1318D-04, -.8800D-05, -.5851D-05, -.3883D-05, -.2571D-05, & + & -.1699D-05, -.1122D-05, -.7403D-06, -.4877D-06, -.3213D-06, & + & -.2112D-06, -.1387D-06, -.9099D-07, -.5960D-07, -.3897D-07, & + & -.2547D-07, -.1659D-07, -.1079D-07, -.7007D-08, -.4537D-08, & + & -.2929D-08, -.4588D-08, -.3128D-08, -.2132D-08, -.1454D-08, & + & -.9910D-09/ + + data (calcpts(j, 6), j = 1,neta) /-.1553D-11, -.2541D-11, & + & -.1878D-11, -.5611D-11, -.1141D-10, -.1789D-10, -.3021D-10, & + & -.5472D-10, -.9229D-10, -.1729D-09, -.3173D-09, -.5690D-09, & + & -.1020D-08, -.1828D-08, -.3025D-08, -.5610D-08, -.9985D-08, & + & -.1771D-07, -.3101D-07, -.5642D-07, -.9798D-07, -.1758D-06, & + & -.3135D-06, -.5555D-06, -.9859D-06, -.1752D-05, -.3104D-05, & + & -.5519D-05, -.9739D-05, -.1703D-04, -.2940D-04, -.4958D-04, & + & -.8056D-04, -.1245D-03, -.1798D-03, -.2378D-03, -.2849D-03, & + & -.3075D-03, -.2996D-03, -.2663D-03, -.2190D-03, -.1694D-03, & + & -.1250D-03, -.8919D-04, -.6212D-04, -.4252D-04, -.2876D-04, & + & -.1931D-04, -.1289D-04, -.8570D-05, -.5687D-05, -.3765D-05, & + & -.2488D-05, -.1643D-05, -.1084D-05, -.7140D-06, -.4703D-06, & + & -.3092D-06, -.2030D-06, -.1332D-06, -.8723D-07, -.5703D-07, & + & -.3726D-07, -.2427D-07, -.1579D-07, -.1025D-07, -.6635D-08, & + & -.4282D-08, -.2759D-08, -.4583D-08, -.3124D-08, -.2130D-08, & + & -.1452D-08/ + + data (calcpts(j, 7), j = 1,neta) /-.1951D-11, -.3023D-11, & + & -.3552D-11, -.6768D-11, -.1542D-10, -.3304D-10, -.4905D-10, & + & -.8922D-10, -.1383D-09, -.2580D-09, -.4742D-09, -.7587D-09, & + & -.1494D-08, -.2591D-08, -.4467D-08, -.8113D-08, -.1468D-07, & + & -.2642D-07, -.4627D-07, -.8186D-07, -.1445D-06, -.2566D-06, & + & -.4593D-06, -.8145D-06, -.1443D-05, -.2580D-05, -.4555D-05, & + & -.8069D-05, -.1426D-04, -.2494D-04, -.4300D-04, -.7255D-04, & + & -.1179D-03, -.1822D-03, -.2629D-03, -.3479D-03, -.4170D-03, & + & -.4500D-03, -.4386D-03, -.3898D-03, -.3205D-03, -.2479D-03, & + & -.1830D-03, -.1305D-03, -.9092D-04, -.6223D-04, -.4210D-04, & + & -.2826D-04, -.1886D-04, -.1254D-04, -.8322D-05, -.5508D-05, & + & -.3640D-05, -.2404D-05, -.1585D-05, -.1044D-05, -.6877D-06, & + & -.4521D-06, -.2967D-06, -.1947D-06, -.1275D-06, -.8334D-07, & + & -.5444D-07, -.3546D-07, -.2305D-07, -.1496D-07, -.9679D-08, & + & -.6249D-08, -.4026D-08, -.2581D-08, -.4573D-08, -.3117D-08, & + & -.2125D-08/ + + data (calcpts(j, 8), j = 1,neta) /-.3202D-11, -.4660D-11, & + & -.6771D-11, -.1185D-10, -.2005D-10, -.3729D-10, -.7634D-10, & + & -.1351D-09, -.2145D-09, -.3817D-09, -.7858D-09, -.1241D-08, & + & -.2195D-08, -.3904D-08, -.6628D-08, -.1198D-07, -.2138D-07, & + & -.3774D-07, -.6762D-07, -.1203D-06, -.2116D-06, -.3773D-06, & + & -.6675D-06, -.1188D-05, -.2118D-05, -.3769D-05, -.6672D-05, & + & -.1182D-04, -.2086D-04, -.3649D-04, -.6290D-04, -.1060D-03, & + & -.1724D-03, -.2665D-03, -.3843D-03, -.5086D-03, -.6095D-03, & + & -.6578D-03, -.6413D-03, -.5699D-03, -.4687D-03, -.3625D-03, & + & -.2676D-03, -.1909D-03, -.1329D-03, -.9100D-04, -.6154D-04, & + & -.4130D-04, -.2757D-04, -.1833D-04, -.1216D-04, -.8049D-05, & + & -.5319D-05, -.3511D-05, -.2316D-05, -.1525D-05, -.1004D-05, & + & -.6600D-06, -.4332D-06, -.2840D-06, -.1861D-06, -.1216D-06, & + & -.7942D-07, -.5172D-07, -.3361D-07, -.2180D-07, -.1412D-07, & + & -.9108D-08, -.5862D-08, -.3756D-08, -.2397D-08, -.4558D-08, & + & -.3106D-08/ + + data (calcpts(j, 9), j = 1,neta) /-.2020D-11, -.5453D-11, & + & -.5060D-11, -.1092D-10, -.3336D-10, -.5003D-10, -.9420D-10, & + & -.1724D-09, -.2710D-09, -.5493D-09, -.9121D-09, -.1654D-08, & + & -.2942D-08, -.5559D-08, -.9296D-08, -.1649D-07, -.3097D-07, & + & -.5391D-07, -.9745D-07, -.1736D-06, -.3048D-06, -.5456D-06, & + & -.9811D-06, -.1731D-05, -.3082D-05, -.5485D-05, -.9689D-05, & + & -.1719D-04, -.3034D-04, -.5312D-04, -.9155D-04, -.1544D-03, & + & -.2510D-03, -.3881D-03, -.5599D-03, -.7412D-03, -.8885D-03, & + & -.9592D-03, -.9351D-03, -.8313D-03, -.6838D-03, -.5289D-03, & + & -.3904D-03, -.2785D-03, -.1939D-03, -.1327D-03, -.8974D-04, & + & -.6022D-04, -.4019D-04, -.2671D-04, -.1772D-04, -.1173D-04, & + & -.7748D-05, -.5113D-05, -.3372D-05, -.2221D-05, -.1462D-05, & + & -.9603D-06, -.6301D-06, -.4131D-06, -.2704D-06, -.1766D-06, & + & -.1153D-06, -.7510D-07, -.4878D-07, -.3163D-07, -.2046D-07, & + & -.1318D-07, -.8481D-08, -.5434D-08, -.3464D-08, -.2200D-08, & + & -.4531D-08/ + + data (calcpts(j,10), j = 1,neta) /-.4329D-11, -.8017D-11, & + & -.1468D-10, -.1912D-10, -.4450D-10, -.7630D-10, -.1318D-09, & + & -.2570D-09, -.4401D-09, -.7766D-09, -.1464D-08, -.2495D-08, & + & -.4473D-08, -.8107D-08, -.1423D-07, -.2431D-07, -.4600D-07, & + & -.7971D-07, -.1427D-06, -.2553D-06, -.4500D-06, -.8034D-06, & + & -.1424D-05, -.2529D-05, -.4495D-05, -.7996D-05, -.1418D-04, & + & -.2511D-04, -.4424D-04, -.7734D-04, -.1333D-03, -.2246D-03, & + & -.3650D-03, -.5643D-03, -.8141D-03, -.1078D-02, -.1292D-02, & + & -.1396D-02, -.1361D-02, -.1210D-02, -.9954D-03, -.7700D-03, & + & -.5684D-03, -.4053D-03, -.2823D-03, -.1931D-03, -.1306D-03, & + & -.8760D-04, -.5845D-04, -.3884D-04, -.2576D-04, -.1704D-04, & + & -.1125D-04, -.7428D-05, -.4896D-05, -.3223D-05, -.2121D-05, & + & -.1393D-05, -.9137D-06, -.5988D-06, -.3918D-06, -.2558D-06, & + & -.1670D-06, -.1086D-06, -.7052D-07, -.4570D-07, -.2953D-07, & + & -.1901D-07, -.1223D-07, -.7824D-08, -.4982D-08, -.3159D-08, & + & -.1992D-08/ + + data (calcpts(j,11), j = 1,neta) /-.7740D-11, -.1319D-10, & + & -.1127D-10, -.3932D-10, -.7316D-10, -.1185D-09, -.2253D-09, & + & -.4273D-09, -.7028D-09, -.1122D-08, -.2186D-08, -.3787D-08, & + & -.6692D-08, -.1282D-07, -.2105D-07, -.3761D-07, -.6681D-07, & + & -.1181D-06, -.2093D-06, -.3678D-06, -.6528D-06, -.1171D-05, & + & -.2076D-05, -.3676D-05, -.6540D-05, -.1168D-04, -.2046D-04, & + & -.3634D-04, -.6416D-04, -.1120D-03, -.1930D-03, -.3253D-03, & + & -.5284D-03, -.8167D-03, -.1178D-02, -.1560D-02, -.1872D-02, & + & -.2022D-02, -.1973D-02, -.1755D-02, -.1444D-02, -.1117D-02, & + & -.8243D-03, -.5878D-03, -.4092D-03, -.2799D-03, -.1892D-03, & + & -.1269D-03, -.8463D-04, -.5622D-04, -.3727D-04, -.2465D-04, & + & -.1627D-04, -.1073D-04, -.7072D-05, -.4653D-05, -.3060D-05, & + & -.2009D-05, -.1317D-05, -.8626D-06, -.5641D-06, -.3682D-06, & + & -.2400D-06, -.1560D-06, -.1012D-06, -.6552D-07, -.4230D-07, & + & -.2721D-07, -.1746D-07, -.1116D-07, -.7094D-08, -.4488D-08, & + & -.2823D-08/ + + data (calcpts(j,12), j = 1,neta) /-.5151D-11, -.2014D-10, & + & -.2631D-10, -.4695D-10, -.1052D-09, -.1791D-09, -.3485D-09, & + & -.6448D-09, -.8489D-09, -.1639D-08, -.3087D-08, -.5399D-08, & + & -.9179D-08, -.1779D-07, -.2957D-07, -.5384D-07, -.9629D-07, & + & -.1688D-06, -.3013D-06, -.5323D-06, -.9346D-06, -.1675D-05, & + & -.2995D-05, -.5313D-05, -.9461D-05, -.1675D-04, -.2958D-04, & + & -.5241D-04, -.9238D-04, -.1612D-03, -.2776D-03, -.4674D-03, & + & -.7593D-03, -.1173D-02, -.1694D-02, -.2243D-02, -.2692D-02, & + & -.2911D-02, -.2842D-02, -.2528D-02, -.2081D-02, -.1610D-02, & + & -.1188D-02, -.8472D-03, -.5896D-03, -.4031D-03, -.2724D-03, & + & -.1826D-03, -.1217D-03, -.8082D-04, -.5355D-04, -.3539D-04, & + & -.2335D-04, -.1540D-04, -.1014D-04, -.6664D-05, -.4380D-05, & + & -.2873D-05, -.1881D-05, -.1231D-05, -.8042D-06, -.5242D-06, & + & -.3414D-06, -.2216D-06, -.1435D-06, -.9286D-07, -.5979D-07, & + & -.3840D-07, -.2459D-07, -.1567D-07, -.9930D-08, -.6256D-08, & + & -.3925D-08/ + + data (calcpts(j,13), j = 1,neta) /-.1063D-10, -.3297D-10, & + & -.2997D-10, -.6987D-10, -.1541D-09, -.1764D-09, -.4019D-09, & + & -.7702D-09, -.1329D-08, -.2305D-08, -.4447D-08, -.7561D-08, & + & -.1408D-07, -.2476D-07, -.4276D-07, -.7568D-07, -.1385D-06, & + & -.2503D-06, -.4271D-06, -.7685D-06, -.1350D-05, -.2407D-05, & + & -.4305D-05, -.7545D-05, -.1347D-04, -.2398D-04, -.4235D-04, & + & -.7490D-04, -.1318D-03, -.2300D-03, -.3951D-03, -.6661D-03, & + & -.1080D-02, -.1670D-02, -.2411D-02, -.3195D-02, -.3840D-02, & + & -.4154D-02, -.4059D-02, -.3614D-02, -.2975D-02, -.2302D-02, & + & -.1699D-02, -.1211D-02, -.8425D-03, -.5757D-03, -.3887D-03, & + & -.2604D-03, -.1735D-03, -.1151D-03, -.7620D-04, -.5031D-04, & + & -.3317D-04, -.2184D-04, -.1437D-04, -.9435D-05, -.6194D-05, & + & -.4058D-05, -.2655D-05, -.1734D-05, -.1131D-05, -.7362D-06, & + & -.4786D-06, -.3101D-06, -.2004D-06, -.1293D-06, -.8305D-07, & + & -.5313D-07, -.3392D-07, -.2152D-07, -.1358D-07, -.8518D-08, & + & -.5306D-08/ + + data (calcpts(j,14), j = 1,neta) /-.2328D-10, -.4109D-10, & + & -.6336D-10, -.1073D-09, -.2166D-09, -.4000D-09, -.6766D-09, & + & -.1298D-08, -.1955D-08, -.3561D-08, -.6533D-08, -.1121D-07, & + & -.1965D-07, -.3564D-07, -.6167D-07, -.1104D-06, -.2020D-06, & + & -.3533D-06, -.6145D-06, -.1108D-05, -.1935D-05, -.3441D-05, & + & -.6092D-05, -.1088D-04, -.1924D-04, -.3402D-04, -.5993D-04, & + & -.1058D-03, -.1861D-03, -.3243D-03, -.5572D-03, -.9357D-03, & + & -.1517D-02, -.2345D-02, -.3386D-02, -.4491D-02, -.5401D-02, & + & -.5853D-02, -.5726D-02, -.5103D-02, -.4204D-02, -.3254D-02, & + & -.2401D-02, -.1710D-02, -.1189D-02, -.8120D-03, -.5478D-03, & + & -.3666D-03, -.2439D-03, -.1616D-03, -.1069D-03, -.7047D-04, & + & -.4639D-04, -.3050D-04, -.2003D-04, -.1314D-04, -.8608D-05, & + & -.5629D-05, -.3675D-05, -.2396D-05, -.1559D-05, -.1012D-05, & + & -.6559D-06, -.4238D-06, -.2728D-06, -.1752D-06, -.1121D-06, & + & -.7147D-07, -.4532D-07, -.2857D-07, -.1789D-07, -.1112D-07, & + & -.6848D-08/ + + data (calcpts(j,15), j = 1,neta) /-.1614D-10, -.4985D-10, & + & -.4193D-10, -.9810D-10, -.3052D-09, -.5043D-09, -.7527D-09, & + & -.1530D-08, -.2329D-08, -.3894D-08, -.8865D-08, -.1514D-07, & + & -.2616D-07, -.4793D-07, -.8227D-07, -.1503D-06, -.2650D-06, & + & -.4862D-06, -.8500D-06, -.1523D-05, -.2672D-05, -.4765D-05, & + & -.8445D-05, -.1498D-04, -.2667D-04, -.4723D-04, -.8297D-04, & + & -.1465D-03, -.2575D-03, -.4472D-03, -.7674D-03, -.1288D-02, & + & -.2085D-02, -.3222D-02, -.4654D-02, -.6183D-02, -.7451D-02, & + & -.8090D-02, -.7929D-02, -.7077D-02, -.5836D-02, -.4518D-02, & + & -.3333D-02, -.2373D-02, -.1648D-02, -.1124D-02, -.7570D-03, & + & -.5058D-03, -.3360D-03, -.2222D-03, -.1467D-03, -.9650D-04, & + & -.6339D-04, -.4159D-04, -.2725D-04, -.1782D-04, -.1165D-04, & + & -.7591D-05, -.4940D-05, -.3209D-05, -.2080D-05, -.1345D-05, & + & -.8676D-06, -.5575D-06, -.3569D-06, -.2278D-06, -.1446D-06, & + & -.9136D-07, -.5733D-07, -.3575D-07, -.2207D-07, -.1349D-07, & + & -.8146D-08/ + + data (calcpts(j,16), j = 1,neta) /-.3779D-10, -.7818D-10, & + & -.8196D-10, -.1363D-09, -.4489D-09, -.6883D-09, -.1116D-08, & + & -.2256D-08, -.3465D-08, -.5744D-08, -.1173D-07, -.2133D-07, & + & -.3697D-07, -.6801D-07, -.1161D-06, -.2106D-06, -.3768D-06, & + & -.6683D-06, -.1181D-05, -.2105D-05, -.3688D-05, -.6626D-05, & + & -.1173D-04, -.2059D-04, -.3645D-04, -.6435D-04, -.1129D-03, & + & -.1981D-03, -.3482D-03, -.6031D-03, -.1029D-02, -.1724D-02, & + & -.2789D-02, -.4304D-02, -.6223D-02, -.8281D-02, -.1000D-01, & + & -.1089D-01, -.1071D-01, -.9576D-02, -.7907D-02, -.6124D-02, & + & -.4516D-02, -.3212D-02, -.2228D-02, -.1516D-02, -.1019D-02, & + & -.6792D-03, -.4498D-03, -.2967D-03, -.1952D-03, -.1281D-03, & + & -.8383D-04, -.5480D-04, -.3576D-04, -.2330D-04, -.1516D-04, & + & -.9831D-05, -.6362D-05, -.4111D-05, -.2647D-05, -.1699D-05, & + & -.1088D-05, -.6925D-06, -.4388D-06, -.2768D-06, -.1733D-06, & + & -.1077D-06, -.6648D-07, -.4052D-07, -.2428D-07, -.1431D-07, & + & -.8243D-08/ + + data (calcpts(j,17), j = 1,neta) /-.6224D-10, -.1157D-09, & + & -.2071D-09, -.2779D-09, -.5111D-09, -.1001D-08, -.1657D-08, & + & -.3073D-08, -.4998D-08, -.8622D-08, -.1677D-07, -.2878D-07, & + & -.5099D-07, -.9334D-07, -.1627D-06, -.2805D-06, -.5088D-06, & + & -.9048D-06, -.1583D-05, -.2830D-05, -.4949D-05, -.8740D-05, & + & -.1552D-04, -.2748D-04, -.4835D-04, -.8505D-04, -.1485D-03, & + & -.2604D-03, -.4541D-03, -.7820D-03, -.1333D-02, -.2222D-02, & + & -.3583D-02, -.5523D-02, -.7988D-02, -.1065D-01, -.1292D-01, & + & -.1413D-01, -.1394D-01, -.1251D-01, -.1035D-01, -.8017D-02, & + & -.5909D-02, -.4197D-02, -.2903D-02, -.1970D-02, -.1319D-02, & + & -.8760D-03, -.5778D-03, -.3793D-03, -.2484D-03, -.1620D-03, & + & -.1055D-03, -.6854D-04, -.4444D-04, -.2874D-04, -.1856D-04, & + & -.1194D-04, -.7653D-05, -.4891D-05, -.3114D-05, -.1972D-05, & + & -.1244D-05, -.7786D-06, -.4830D-06, -.2973D-06, -.1809D-06, & + & -.1085D-06, -.6401D-07, -.3663D-07, -.2033D-07, -.1066D-07, & + & -.5102D-08/ + + data (calcpts(j,18), j = 1,neta) /-.6221D-10, -.1474D-09, & + & -.1298D-09, -.3912D-09, -.6718D-09, -.1189D-08, -.2102D-08, & + & -.4431D-08, -.5705D-08, -.1121D-07, -.2129D-07, -.3646D-07, & + & -.6552D-07, -.1150D-06, -.1978D-06, -.3621D-06, -.6497D-06, & + & -.1157D-05, -.2045D-05, -.3569D-05, -.6302D-05, -.1123D-04, & + & -.1991D-04, -.3492D-04, -.6120D-04, -.1076D-03, -.1863D-03, & + & -.3256D-03, -.5637D-03, -.9672D-03, -.1635D-02, -.2711D-02, & + & -.4353D-02, -.6694D-02, -.9686D-02, -.1295D-01, -.1579D-01, & + & -.1736D-01, -.1723D-01, -.1553D-01, -.1289D-01, -.9997D-02, & + & -.7362D-02, -.5214D-02, -.3594D-02, -.2427D-02, -.1616D-02, & + & -.1066D-02, -.6979D-03, -.4545D-03, -.2951D-03, -.1908D-03, & + & -.1230D-03, -.7906D-04, -.5065D-04, -.3233D-04, -.2058D-04, & + & -.1301D-04, -.8195D-05, -.5126D-05, -.3183D-05, -.1957D-05, & + & -.1192D-05, -.7138D-06, -.4200D-06, -.2413D-06, -.1338D-06, & + & -.7023D-07, -.3388D-07, -.1335D-07, -.2407D-08, 0.2877D-08, & + & 0.4963D-08/ + + data (calcpts(j,19), j = 1,neta) /-.7602D-10, -.1220D-09, & + & -.2737D-09, -.3859D-09, -.9139D-09, -.1511D-08, -.2536D-08, & + & -.4168D-08, -.7125D-08, -.1412D-07, -.2662D-07, -.4549D-07, & + & -.8145D-07, -.1415D-06, -.2551D-06, -.4471D-06, -.7992D-06, & + & -.1408D-05, -.2494D-05, -.4496D-05, -.7735D-05, -.1362D-04, & + & -.2398D-04, -.4201D-04, -.7350D-04, -.1277D-03, -.2213D-03, & + & -.3840D-03, -.6589D-03, -.1119D-02, -.1875D-02, -.3080D-02, & + & -.4910D-02, -.7516D-02, -.1087D-01, -.1458D-01, -.1788D-01, & + & -.1984D-01, -.1985D-01, -.1801D-01, -.1501D-01, -.1166D-01, & + & -.8571D-02, -.6046D-02, -.4139D-02, -.2772D-02, -.1828D-02, & + & -.1192D-02, -.7704D-03, -.4946D-03, -.3161D-03, -.2009D-03, & + & -.1269D-03, -.7981D-04, -.4988D-04, -.3093D-04, -.1903D-04, & + & -.1158D-04, -.6948D-05, -.4099D-05, -.2360D-05, -.1313D-05, & + & -.6978D-06, -.3404D-06, -.1395D-06, -.3238D-07, 0.2071D-07, & + & 0.4317D-07, 0.4897D-07, 0.4694D-07, 0.4109D-07, 0.3426D-07, & + & 0.2766D-07/ + + data (calcpts(j,20), j = 1,neta) /-.1486D-09, -.2084D-09, & + & -.2156D-09, -.5165D-09, -.1028D-08, -.1695D-08, -.2959D-08, & + & -.5026D-08, -.9531D-08, -.1689D-07, -.3069D-07, -.5319D-07, & + & -.9289D-07, -.1644D-06, -.2927D-06, -.5169D-06, -.9236D-06, & + & -.1621D-05, -.2863D-05, -.5112D-05, -.8725D-05, -.1553D-04, & + & -.2730D-04, -.4743D-04, -.8240D-04, -.1426D-03, -.2449D-03, & + & -.4185D-03, -.7110D-03, -.1193D-02, -.1971D-02, -.3194D-02, & + & -.5033D-02, -.7630D-02, -.1101D-01, -.1480D-01, -.1829D-01, & + & -.2051D-01, -.2077D-01, -.1904D-01, -.1596D-01, -.1242D-01, & + & -.9104D-02, -.6373D-02, -.4315D-02, -.2845D-02, -.1840D-02, & + & -.1173D-02, -.7391D-03, -.4604D-03, -.2842D-03, -.1733D-03, & + & -.1043D-03, -.6193D-04, -.3594D-04, -.2030D-04, -.1104D-04, & + & -.5610D-05, -.2531D-05, -.8511D-06, 0.3114D-08, 0.4043D-06, & + & 0.5460D-06, 0.5568D-06, 0.5061D-06, 0.4303D-06, 0.3510D-06, & + & 0.2788D-06, 0.2167D-06, 0.1660D-06, 0.1256D-06, 0.9417D-07, & + & 0.6990D-07/ + + data (calcpts(j,21), j = 1,neta) /-.5347D-10, -.2247D-09, & + & -.2536D-09, -.4946D-09, -.1075D-08, -.1854D-08, -.3507D-08, & + & -.6687D-08, -.9907D-08, -.1667D-07, -.3265D-07, -.5625D-07, & + & -.9228D-07, -.1809D-06, -.3111D-06, -.5438D-06, -.9714D-06, & + & -.1708D-05, -.3045D-05, -.5259D-05, -.9173D-05, -.1617D-04, & + & -.2835D-04, -.4914D-04, -.8478D-04, -.1455D-03, -.2474D-03, & + & -.4174D-03, -.6997D-03, -.1152D-02, -.1866D-02, -.2962D-02, & + & -.4565D-02, -.6829D-02, -.9739D-02, -.1308D-01, -.1630D-01, & + & -.1854D-01, -.1909D-01, -.1776D-01, -.1503D-01, -.1172D-01, & + & -.8532D-02, -.5885D-02, -.3892D-02, -.2485D-02, -.1542D-02, & + & -.9325D-03, -.5493D-03, -.3140D-03, -.1730D-03, -.9005D-04, & + & -.4266D-04, -.1663D-04, -.2895D-05, 0.3602D-05, 0.6205D-05, & + & 0.6783D-05, 0.6345D-05, 0.5478D-05, 0.4528D-05, 0.3614D-05, & + & 0.2823D-05, 0.2169D-05, 0.1646D-05, 0.1236D-05, 0.9190D-06, & + & 0.6792D-06, 0.4982D-06, 0.3639D-06, 0.2646D-06, 0.1917D-06, & + & 0.1382D-06/ + + data (calcpts(j,22), j = 1,neta) /-.1087D-09, -.2056D-09, & + & -.2857D-09, -.4519D-09, -.1035D-08, -.1817D-08, -.3161D-08, & + & -.6500D-08, -.8736D-08, -.1626D-07, -.3079D-07, -.5446D-07, & + & -.9652D-07, -.1794D-06, -.3003D-06, -.5267D-06, -.9420D-06, & + & -.1654D-05, -.2896D-05, -.5136D-05, -.8853D-05, -.1543D-04, & + & -.2682D-04, -.4618D-04, -.7917D-04, -.1347D-03, -.2258D-03, & + & -.3773D-03, -.6192D-03, -.9964D-03, -.1572D-02, -.2419D-02, & + & -.3614D-02, -.5217D-02, -.7271D-02, -.9648D-02, -.1207D-01, & + & -.1397D-01, -.1470D-01, -.1397D-01, -.1198D-01, -.9338D-02, & + & -.6697D-02, -.4463D-02, -.2789D-02, -.1633D-02, -.8906D-03, & + & -.4390D-03, -.1801D-03, -.4064D-04, 0.2741D-04, 0.5574D-04, & + & 0.6281D-04, 0.5925D-04, 0.5137D-04, 0.4233D-04, 0.3375D-04, & + & 0.2630D-04, 0.2016D-04, 0.1524D-04, 0.1141D-04, 0.8462D-05, & + & 0.6232D-05, 0.4565D-05, 0.3327D-05, 0.2415D-05, 0.1745D-05, & + & 0.1257D-05, 0.9025D-06, 0.6467D-06, 0.4621D-06, 0.3295D-06, & + & 0.2345D-06/ + + data (calcpts(j,23), j = 1,neta) /-.7139D-10, -.2032D-09, & + & -.2202D-09, -.4896D-09, -.9366D-09, -.1551D-08, -.2642D-08, & + & -.4985D-08, -.8101D-08, -.1518D-07, -.2690D-07, -.4750D-07, & + & -.8275D-07, -.1502D-06, -.2509D-06, -.4601D-06, -.8073D-06, & + & -.1424D-05, -.2501D-05, -.4335D-05, -.7507D-05, -.1324D-04, & + & -.2278D-04, -.3909D-04, -.6652D-04, -.1117D-03, -.1864D-03, & + & -.3059D-03, -.4916D-03, -.7702D-03, -.1172D-02, -.1726D-02, & + & -.2437D-02, -.3320D-02, -.4357D-02, -.5539D-02, -.6817D-02, & + & -.7998D-02, -.8679D-02, -.8506D-02, -.7418D-02, -.5731D-02, & + & -.3914D-02, -.2337D-02, -.1169D-02, -.4055D-03, 0.3533D-04, & + & 0.2515D-03, 0.3307D-03, 0.3336D-03, 0.2995D-03, 0.2522D-03, & + & 0.2037D-03, 0.1599D-03, 0.1229D-03, 0.9307D-04, 0.6966D-04, & + & 0.5164D-04, 0.3801D-04, 0.2780D-04, 0.2022D-04, 0.1464D-04, & + & 0.1056D-04, 0.7597D-05, 0.5449D-05, 0.3897D-05, 0.2780D-05, & + & 0.1980D-05, 0.1407D-05, 0.9980D-06, 0.7070D-06, 0.5001D-06, & + & 0.3532D-06/ + + data (calcpts(j,24), j = 1,neta) /-.6663D-10, -.1430D-09, & + & -.2377D-09, -.3509D-09, -.6307D-09, -.1200D-08, -.2150D-08, & + & -.3945D-08, -.6802D-08, -.1085D-07, -.2096D-07, -.3674D-07, & + & -.6488D-07, -.1169D-06, -.1955D-06, -.3622D-06, -.6396D-06, & + & -.1117D-05, -.1942D-05, -.3415D-05, -.5853D-05, -.1026D-04, & + & -.1762D-04, -.2996D-04, -.5068D-04, -.8471D-04, -.1387D-03, & + & -.2242D-03, -.3522D-03, -.5364D-03, -.7826D-03, -.1086D-02, & + & -.1409D-02, -.1705D-02, -.1925D-02, -.2067D-02, -.2263D-02, & + & -.2561D-02, -.2916D-02, -.3021D-02, -.2667D-02, -.1883D-02, & + & -.9116D-03, -.3166D-04, 0.5909D-03, 0.9319D-03, 0.1045D-02, & + & 0.1008D-02, 0.8924D-03, 0.7462D-03, 0.6003D-03, 0.4697D-03, & + & 0.3600D-03, 0.2715D-03, 0.2024D-03, 0.1493D-03, 0.1095D-03, & + & 0.7967D-04, 0.5773D-04, 0.4164D-04, 0.2993D-04, 0.2145D-04, & + & 0.1532D-04, 0.1093D-04, 0.7775D-05, 0.5521D-05, 0.3914D-05, & + & 0.2770D-05, 0.1958D-05, 0.1382D-05, 0.9741D-06, 0.6859D-06, & + & 0.4824D-06/ + + data (calcpts(j,25), j = 1,neta) /-.4096D-10, -.1024D-09, & + & -.1250D-09, -.3239D-09, -.5429D-09, -.8035D-09, -.1449D-08, & + & -.2800D-08, -.4499D-08, -.7629D-08, -.1569D-07, -.2552D-07, & + & -.4639D-07, -.8264D-07, -.1419D-06, -.2453D-06, -.4483D-06, & + & -.7893D-06, -.1374D-05, -.2390D-05, -.4106D-05, -.7060D-05, & + & -.1218D-04, -.2085D-04, -.3488D-04, -.5793D-04, -.9397D-04, & + & -.1492D-03, -.2306D-03, -.3418D-03, -.4774D-03, -.6178D-03, & + & -.7062D-03, -.6706D-03, -.4351D-03, 0.5732D-05, 0.5147D-03, & + & 0.8986D-03, 0.1007D-02, 0.9469D-03, 0.9506D-03, 0.1159D-02, & + & 0.1518D-02, 0.1865D-02, 0.2064D-02, 0.2073D-02, 0.1925D-02, & + & 0.1681D-02, 0.1401D-02, 0.1126D-02, 0.8806D-03, 0.6745D-03, & + & 0.5082D-03, 0.3782D-03, 0.2785D-03, 0.2036D-03, 0.1479D-03, & + & 0.1069D-03, 0.7687D-04, 0.5511D-04, 0.3939D-04, 0.2808D-04, & + & 0.1997D-04, 0.1418D-04, 0.1005D-04, 0.7106D-05, 0.5020D-05, & + & 0.3543D-05, 0.2496D-05, 0.1757D-05, 0.1235D-05, 0.8675D-06, & + & 0.6088D-06/ + + data (calcpts(j,26), j = 1,neta) /-.2490D-10, -.4478D-10, & + & -.7078D-10, -.1422D-09, -.2641D-09, -.4349D-09, -.8422D-09, & + & -.1633D-08, -.2776D-08, -.5104D-08, -.9995D-08, -.1603D-07, & + & -.2874D-07, -.5237D-07, -.8911D-07, -.1598D-06, -.2803D-06, & + & -.5038D-06, -.8796D-06, -.1533D-05, -.2617D-05, -.4537D-05, & + & -.7801D-05, -.1317D-04, -.2206D-04, -.3644D-04, -.5860D-04, & + & -.9246D-04, -.1406D-03, -.2029D-03, -.2731D-03, -.3271D-03, & + & -.3154D-03, -.1690D-03, 0.1905D-03, 0.7872D-03, 0.1531D-02, & + & 0.2217D-02, 0.2644D-02, 0.2781D-02, 0.2773D-02, 0.2790D-02, & + & 0.2883D-02, 0.2974D-02, 0.2965D-02, 0.2807D-02, 0.2523D-02, & + & 0.2162D-02, 0.1780D-02, 0.1420D-02, 0.1104D-02, 0.8416D-03, & + & 0.6316D-03, 0.4681D-03, 0.3436D-03, 0.2503D-03, 0.1812D-03, & + & 0.1305D-03, 0.9363D-04, 0.6694D-04, 0.4772D-04, 0.3394D-04, & + & 0.2408D-04, 0.1706D-04, 0.1206D-04, 0.8518D-05, 0.6007D-05, & + & 0.4231D-05, 0.2976D-05, 0.2092D-05, 0.1468D-05, 0.1030D-05, & + & 0.7222D-06/ + + data (calcpts(j,27), j = 1,neta) /-.1861D-10, -.4714D-10, & + & -.5830D-10, -.1150D-09, -.2267D-09, -.3674D-09, -.6322D-09, & + & -.1213D-08, -.1915D-08, -.3361D-08, -.6083D-08, -.1054D-07, & + & -.1793D-07, -.3229D-07, -.5634D-07, -.9872D-07, -.1754D-06, & + & -.3049D-06, -.5304D-06, -.9291D-06, -.1583D-05, -.2729D-05, & + & -.4670D-05, -.7874D-05, -.1317D-04, -.2164D-04, -.3451D-04, & + & -.5416D-04, -.8138D-04, -.1156D-03, -.1509D-03, -.1696D-03, & + & -.1364D-03, 0.1381D-05, 0.3043D-03, 0.8057D-03, 0.1457D-02, & + & 0.2117D-02, 0.2619D-02, 0.2886D-02, 0.2985D-02, 0.3045D-02, & + & 0.3136D-02, 0.3219D-02, 0.3210D-02, 0.3060D-02, 0.2775D-02, & + & 0.2400D-02, 0.1996D-02, 0.1603D-02, 0.1254D-02, 0.9594D-03, & + & 0.7220D-03, 0.5360D-03, 0.3939D-03, 0.2869D-03, 0.2078D-03, & + & 0.1496D-03, 0.1072D-03, 0.7659D-04, 0.5455D-04, 0.3875D-04, & + & 0.2748D-04, 0.1944D-04, 0.1374D-04, 0.9692D-05, 0.6829D-05, & + & 0.4805D-05, 0.3378D-05, 0.2372D-05, 0.1665D-05, 0.1167D-05, & + & 0.8173D-06/ + + data (calcpts(j,28), j = 1,neta) /-.1221D-10, -.1892D-10, & + & -.3565D-10, -.6203D-10, -.1164D-09, -.2009D-09, -.3449D-09, & + & -.6346D-09, -.9467D-09, -.1799D-08, -.3369D-08, -.5811D-08, & + & -.1014D-07, -.1789D-07, -.3099D-07, -.5488D-07, -.9664D-07, & + & -.1698D-06, -.2948D-06, -.5086D-06, -.8873D-06, -.1524D-05, & + & -.2600D-05, -.4375D-05, -.7292D-05, -.1205D-04, -.1922D-04, & + & -.2985D-04, -.4471D-04, -.6283D-04, -.8037D-04, -.8662D-04, & + & -.5937D-04, 0.3383D-04, 0.2353D-03, 0.5676D-03, 0.1014D-02, & + & 0.1492D-02, 0.1891D-02, 0.2147D-02, 0.2293D-02, 0.2421D-02, & + & 0.2591D-02, 0.2779D-02, 0.2896D-02, 0.2874D-02, 0.2698D-02, & + & 0.2404D-02, 0.2044D-02, 0.1673D-02, 0.1327D-02, 0.1026D-02, & + & 0.7784D-03, 0.5813D-03, 0.4289D-03, 0.3133D-03, 0.2274D-03, & + & 0.1638D-03, 0.1176D-03, 0.8402D-04, 0.5985D-04, 0.4252D-04, & + & 0.3015D-04, 0.2132D-04, 0.1506D-04, 0.1062D-04, 0.7483D-05, & + & 0.5265D-05, 0.3700D-05, 0.2597D-05, 0.1821D-05, 0.1277D-05, & + & 0.8940D-06/ + + data (calcpts(j,29), j = 1,neta) /-.4983D-11, -.9790D-11, & + & -.1290D-10, -.3188D-10, -.5737D-10, -.9069D-10, -.1687D-09, & + & -.3056D-09, -.4990D-09, -.9079D-09, -.1750D-08, -.2956D-08, & + & -.5178D-08, -.9420D-08, -.1603D-07, -.2899D-07, -.5115D-07, & + & -.8900D-07, -.1549D-06, -.2717D-06, -.4668D-06, -.8112D-06, & + & -.1373D-05, -.2324D-05, -.3879D-05, -.6359D-05, -.1017D-04, & + & -.1589D-04, -.2369D-04, -.3311D-04, -.4219D-04, -.4462D-04, & + & -.2846D-04, 0.2510D-04, 0.1398D-03, 0.3315D-03, 0.5920D-03, & + & 0.8776D-03, 0.1124D-02, 0.1291D-02, 0.1397D-02, 0.1514D-02, & + & 0.1710D-02, 0.1973D-02, 0.2224D-02, 0.2368D-02, 0.2357D-02, & + & 0.2201D-02, 0.1943D-02, 0.1636D-02, 0.1327D-02, 0.1045D-02, & + & 0.8027D-03, 0.6054D-03, 0.4498D-03, 0.3305D-03, 0.2406D-03, & + & 0.1739D-03, 0.1250D-03, 0.8948D-04, 0.6380D-04, 0.4535D-04, & + & 0.3216D-04, 0.2276D-04, 0.1608D-04, 0.1134D-04, 0.7988D-05, & + & 0.5620D-05, 0.3948D-05, 0.2772D-05, 0.1944D-05, 0.1362D-05, & + & 0.9538D-06/ + + data (calcpts(j,30), j = 1,neta) /-.2854D-11, -.4437D-11, & + & -.7638D-11, -.1380D-10, -.2918D-10, -.5391D-10, -.8799D-10, & + & -.1632D-09, -.2688D-09, -.4775D-09, -.8800D-09, -.1564D-08, & + & -.2775D-08, -.4964D-08, -.8434D-08, -.1488D-07, -.2652D-07, & + & -.4610D-07, -.8079D-07, -.1414D-06, -.2420D-06, -.4168D-06, & + & -.7136D-06, -.1200D-05, -.2009D-05, -.3292D-05, -.5263D-05, & + & -.8193D-05, -.1227D-04, -.1725D-04, -.2189D-04, -.2334D-04, & + & -.1515D-04, 0.1224D-04, 0.7142D-04, 0.1709D-03, 0.3063D-03, & + & 0.4543D-03, 0.5785D-03, 0.6537D-03, 0.6912D-03, 0.7457D-03, & + & 0.8840D-03, 0.1130D-02, 0.1433D-02, 0.1699D-02, 0.1847D-02, & + & 0.1847D-02, 0.1719D-02, 0.1508D-02, 0.1263D-02, 0.1019D-02, & + & 0.7975D-03, 0.6098D-03, 0.4581D-03, 0.3392D-03, 0.2483D-03, & + & 0.1804D-03, 0.1300D-03, 0.9327D-04, 0.6661D-04, 0.4742D-04, & + & 0.3365D-04, 0.2383D-04, 0.1684D-04, 0.1188D-04, 0.8370D-05, & + & 0.5889D-05, 0.4138D-05, 0.2905D-05, 0.2038D-05, 0.1428D-05, & + & 0.9997D-06/ + + data (calcpts(j,31), j = 1,neta) /-.9247D-12, -.2620D-11, & + & -.4429D-11, -.7357D-11, -.1432D-10, -.2601D-10, -.4498D-10, & + & -.8562D-10, -.1330D-09, -.2509D-09, -.4525D-09, -.7727D-09, & + & -.1383D-08, -.2448D-08, -.4206D-08, -.7491D-08, -.1325D-07, & + & -.2328D-07, -.4055D-07, -.7122D-07, -.1212D-06, -.2087D-06, & + & -.3586D-06, -.6048D-06, -.1010D-05, -.1663D-05, -.2651D-05, & + & -.4146D-05, -.6220D-05, -.8759D-05, -.1125D-04, -.1221D-04, & + & -.8548D-05, 0.4577D-05, 0.3298D-04, 0.8095D-04, 0.1456D-03, & + & 0.2140D-03, 0.2653D-03, 0.2830D-03, 0.2709D-03, 0.2637D-03, & + & 0.3173D-03, 0.4761D-03, 0.7347D-03, 0.1029D-02, 0.1273D-02, & + & 0.1403D-02, 0.1407D-02, 0.1307D-02, 0.1142D-02, 0.9523D-03, & + & 0.7647D-03, 0.5962D-03, 0.4544D-03, 0.3402D-03, 0.2512D-03, & + & 0.1834D-03, 0.1329D-03, 0.9566D-04, 0.6849D-04, 0.4883D-04, & + & 0.3470D-04, 0.2460D-04, 0.1740D-04, 0.1228D-04, 0.8652D-05, & + & 0.6089D-05, 0.4280D-05, 0.3004D-05, 0.2107D-05, 0.1477D-05, & + & 0.1034D-05/ + + data (calcpts(j,32), j = 1,neta) /0.2151D-11, 0.8299D-12, & + & 0.1550D-11, -.1431D-11, -.5444D-11, -.1006D-10, -.1886D-10, & + & -.3642D-10, -.5890D-10, -.1180D-09, -.2167D-09, -.3646D-09, & + & -.6557D-09, -.1191D-08, -.2029D-08, -.3601D-08, -.6539D-08, & + & -.1130D-07, -.1982D-07, -.3464D-07, -.5947D-07, -.1027D-06, & + & -.1758D-06, -.2982D-06, -.4972D-06, -.8188D-06, -.1314D-05, & + & -.2050D-05, -.3091D-05, -.4386D-05, -.5697D-05, -.6336D-05, & + & -.4837D-05, 0.1010D-05, 0.1405D-04, 0.3593D-04, 0.6474D-04, & + & 0.9324D-04, 0.1093D-03, 0.1019D-03, 0.7001D-04, 0.3092D-04, & + & 0.2157D-04, 0.8568D-04, 0.2472D-03, 0.4866D-03, 0.7427D-03, & + & 0.9454D-03, 0.1051D-02, 0.1053D-02, 0.9759D-03, 0.8503D-03, & + & 0.7063D-03, 0.5654D-03, 0.4394D-03, 0.3339D-03, 0.2494D-03, & + & 0.1837D-03, 0.1339D-03, 0.9681D-04, 0.6956D-04, 0.4972D-04, & + & 0.3540D-04, 0.2512D-04, 0.1779D-04, 0.1256D-04, 0.8858D-05, & + & 0.6235D-05, 0.4384D-05, 0.3079D-05, 0.2160D-05, 0.1514D-05, & + & 0.1060D-05/ + + data (calcpts(j,33), j = 1,neta) /-.4830D-11, -.3510D-11, & + & -.2885D-11, -.2197D-11, -.5301D-11, -.7682D-11, -.1224D-10, & + & -.2146D-10, -.3607D-10, -.6335D-10, -.1117D-09, -.1940D-09, & + & -.3413D-09, -.6064D-09, -.1037D-08, -.1847D-08, -.3234D-08, & + & -.5704D-08, -.9849D-08, -.1719D-07, -.2943D-07, -.5075D-07, & + & -.8699D-07, -.1473D-06, -.2450D-06, -.4040D-06, -.6487D-06, & + & -.1017D-05, -.1536D-05, -.2197D-05, -.2877D-05, -.3300D-05, & + & -.2760D-05, -.2738D-06, 0.5417D-05, 0.1496D-04, 0.2710D-04, & + & 0.3770D-04, 0.3981D-04, 0.2627D-04, -.5854D-05, -.5007D-04, & + & -.8679D-04, -.8547D-04, -.1608D-04, 0.1319D-03, 0.3348D-03, & + & 0.5416D-03, 0.6997D-03, 0.7792D-03, 0.7796D-03, 0.7201D-03, & + & 0.6254D-03, 0.5179D-03, 0.4134D-03, 0.3205D-03, 0.2430D-03, & + & 0.1811D-03, 0.1331D-03, 0.9683D-04, 0.6990D-04, 0.5014D-04, & + & 0.3579D-04, 0.2544D-04, 0.1804D-04, 0.1276D-04, 0.9000D-05, & + & 0.6340D-05, 0.4459D-05, 0.3132D-05, 0.2198D-05, 0.1540D-05, & + & 0.1079D-05/ + + data (calcpts(j,34), j = 1,neta) /-.4478D-11, -.5153D-11, & + & -.5308D-11, -.4177D-11, -.4213D-11, -.4759D-11, -.5756D-11, & + & -.1097D-10, -.1695D-10, -.2947D-10, -.5351D-10, -.9124D-10, & + & -.1597D-09, -.2835D-09, -.5010D-09, -.8807D-09, -.1553D-08, & + & -.2698D-08, -.4757D-08, -.8210D-08, -.1417D-07, -.2437D-07, & + & -.4186D-07, -.7064D-07, -.1181D-06, -.1950D-06, -.3131D-06, & + & -.4943D-06, -.7498D-06, -.1078D-05, -.1435D-05, -.1678D-05, & + & -.1527D-05, -.5054D-06, 0.1898D-05, 0.5895D-05, 0.1073D-04, & + & 0.1406D-04, 0.1199D-04, 0.9194D-07, -.2455D-04, -.6061D-04, & + & -.9966D-04, -.1249D-03, -.1138D-03, -.4696D-04, 0.7833D-04, & + & 0.2402D-03, 0.3989D-03, 0.5166D-03, 0.5738D-03, 0.5720D-03, & + & 0.5266D-03, 0.4559D-03, 0.3765D-03, 0.2997D-03, 0.2318D-03, & + & 0.1754D-03, 0.1305D-03, 0.9577D-04, 0.6957D-04, 0.5013D-04, & + & 0.3592D-04, 0.2560D-04, 0.1818D-04, 0.1287D-04, 0.9093D-05, & + & 0.6410D-05, 0.4511D-05, 0.3170D-05, 0.2224D-05, 0.1560D-05, & + & 0.1093D-05/ + + data (calcpts(j,35), j = 1,neta) /-.1445D-10, -.1011D-11, & + & 0.7187D-12, -.4568D-11, -.1821D-11, -.4338D-11, -.3443D-11, & + & -.5130D-11, -.7749D-11, -.1404D-10, -.2392D-10, -.4275D-10, & + & -.7507D-10, -.1339D-09, -.2362D-09, -.4118D-09, -.7348D-09, & + & -.1279D-08, -.2235D-08, -.3895D-08, -.6681D-08, -.1161D-07, & + & -.1988D-07, -.3368D-07, -.5648D-07, -.9351D-07, -.1508D-06, & + & -.2386D-06, -.3626D-06, -.5248D-06, -.7084D-06, -.8508D-06, & + & -.8231D-06, -.4278D-06, 0.5567D-06, 0.2181D-05, 0.3960D-05, & + & 0.4671D-05, 0.2131D-05, -.6248D-05, -.2267D-04, -.4762D-04, & + & -.7831D-04, -.1071D-03, -.1211D-03, -.1046D-03, -.4569D-04, & + & 0.5467D-04, 0.1784D-03, 0.2957D-03, 0.3805D-03, 0.4201D-03, & + & 0.4170D-03, 0.3824D-03, 0.3301D-03, 0.2720D-03, 0.2161D-03, & + & 0.1668D-03, 0.1260D-03, 0.9353D-04, 0.6854D-04, 0.4972D-04, & + & 0.3579D-04, 0.2560D-04, 0.1822D-04, 0.1293D-04, 0.9145D-05, & + & 0.6452D-05, 0.4545D-05, 0.3195D-05, 0.2244D-05, 0.1573D-05, & + & 0.1102D-05/ + + data (calcpts(j,36), j = 1,neta) /0.6876D-11, -.4528D-12, & + & 0.3776D-11, 0.3938D-12, -.4144D-11, 0.7553D-12, -.3980D-11, & + & -.1515D-11, -.4962D-11, -.7698D-11, -.1130D-10, -.2065D-10, & + & -.3616D-10, -.6477D-10, -.1112D-09, -.1966D-09, -.3543D-09, & + & -.6119D-09, -.1063D-08, -.1860D-08, -.3216D-08, -.5546D-08, & + & -.9528D-08, -.1609D-07, -.2715D-07, -.4477D-07, -.7242D-07, & + & -.1148D-06, -.1757D-06, -.2565D-06, -.3483D-06, -.4296D-06, & + & -.4394D-06, -.2954D-06, 0.9171D-07, 0.7169D-06, 0.1319D-05, & + & 0.1220D-05, -.7291D-06, -.6002D-05, -.1603D-04, -.3165D-04, & + & -.5234D-04, -.7523D-04, -.9426D-04, -.1001D-03, -.8223D-04, & + & -.3349D-04, 0.4377D-04, 0.1353D-03, 0.2199D-03, 0.2796D-03, & + & 0.3062D-03, 0.3022D-03, 0.2761D-03, 0.2377D-03, 0.1954D-03, & + & 0.1549D-03, 0.1194D-03, 0.9004D-04, 0.6675D-04, 0.4884D-04, & + & 0.3538D-04, 0.2544D-04, 0.1818D-04, 0.1293D-04, 0.9162D-05, & + & 0.6474D-05, 0.4563D-05, 0.3211D-05, 0.2256D-05, 0.1582D-05, & + & 0.1109D-05/ + + data (calcpts(j,37), j = 1,neta) /0.3214D-11, 0.2471D-11, & + & 0.1989D-11, 0.4786D-11, 0.2349D-11, -.4747D-11, 0.3463D-12, & + & 0.2695D-12, -.4435D-13, -.1458D-11, -.6294D-11, -.9686D-11, & + & -.1874D-10, -.2966D-10, -.5306D-10, -.9410D-10, -.1660D-09, & + & -.2915D-09, -.5026D-09, -.8926D-09, -.1533D-08, -.2640D-08, & + & -.4533D-08, -.7698D-08, -.1291D-07, -.2141D-07, -.3468D-07, & + & -.5509D-07, -.8459D-07, -.1242D-06, -.1711D-06, -.2145D-06, & + & -.2301D-06, -.1838D-06, -.3719D-07, 0.1903D-06, 0.3566D-06, & + & 0.1064D-06, -.1167D-05, -.4265D-05, -.1005D-04, -.1920D-04, & + & -.3191D-04, -.4735D-04, -.6312D-04, -.7473D-04, -.7563D-04, & + & -.5884D-04, -.2025D-04, 0.3754D-04, 0.1038D-03, 0.1636D-03, & + & 0.2047D-03, 0.2223D-03, 0.2181D-03, 0.1986D-03, 0.1705D-03, & + & 0.1398D-03, 0.1107D-03, 0.8517D-04, 0.6412D-04, 0.4747D-04, & + & 0.3469D-04, 0.2511D-04, 0.1803D-04, 0.1287D-04, 0.9141D-05, & + & 0.6472D-05, 0.4569D-05, 0.3217D-05, 0.2262D-05, 0.1588D-05, & + & 0.1113D-05/ + + data (calcpts(j,38), j = 1,neta) /0.2265D-10, -.4611D-11, & + & 0.1382D-10, 0.1316D-10, -.3562D-11, -.2469D-11, -.3007D-12, & + & -.6720D-11, 0.3697D-11, -.9792D-12, -.1845D-11, -.3928D-11, & + & -.8268D-11, -.1260D-10, -.2389D-10, -.4290D-10, -.7696D-10, & + & -.1363D-09, -.2383D-09, -.4171D-09, -.7147D-09, -.1251D-08, & + & -.2138D-08, -.3636D-08, -.6118D-08, -.1016D-07, -.1648D-07, & + & -.2633D-07, -.4057D-07, -.5986D-07, -.8323D-07, -.1064D-06, & + & -.1190D-06, -.1063D-06, -.5577D-07, 0.2084D-07, 0.4457D-07, & + & -.1681D-06, -.9323D-06, -.2673D-05, -.5877D-05, -.1100D-04, & + & -.1834D-04, -.2781D-04, -.3861D-04, -.4890D-04, -.5543D-04, & + & -.5375D-04, -.3926D-04, -.9647D-05, 0.3266D-04, 0.7984D-04, & + & 0.1215D-03, 0.1495D-03, 0.1608D-03, 0.1569D-03, 0.1422D-03, & + & 0.1218D-03, 0.9973D-04, 0.7881D-04, 0.6055D-04, 0.4554D-04, & + & 0.3367D-04, 0.2458D-04, 0.1776D-04, 0.1274D-04, 0.9085D-05, & + & 0.6448D-05, 0.4561D-05, 0.3217D-05, 0.2265D-05, 0.1590D-05, & + & 0.1116D-05/ + + data (calcpts(j,39), j = 1,neta) /0.8899D-11, 0.2293D-10, & + & 0.1677D-11, -.1608D-10, 0.2425D-11, -.1380D-10, 0.4994D-11, & + & 0.2777D-12, 0.8584D-11, 0.6138D-11, 0.2812D-11, 0.1515D-11, & + & -.1299D-11, -.8634D-11, -.1286D-10, -.2092D-10, -.3649D-10, & + & -.6586D-10, -.1145D-09, -.2014D-09, -.3462D-09, -.5964D-09, & + & -.1022D-08, -.1742D-08, -.2924D-08, -.4869D-08, -.7902D-08, & + & -.1260D-07, -.1952D-07, -.2905D-07, -.4074D-07, -.5301D-07, & + & -.6136D-07, -.5983D-07, -.4423D-07, -.2299D-07, -.3755D-07, & + & -.1818D-06, -.6164D-06, -.1563D-05, -.3287D-05, -.6063D-05, & + & -.1012D-04, -.1557D-04, -.2225D-04, -.2948D-04, -.3591D-04, & + & -.3926D-04, -.3647D-04, -.2462D-04, -.2424D-05, 0.2807D-04, & + & 0.6125D-04, 0.8998D-04, 0.1088D-03, 0.1158D-03, 0.1124D-03, & + & 0.1016D-03, 0.8679D-04, 0.7093D-04, 0.5596D-04, 0.4296D-04, & + & 0.3226D-04, 0.2383D-04, 0.1737D-04, 0.1254D-04, 0.8988D-05, & + & 0.6403D-05, 0.4540D-05, 0.3208D-05, 0.2262D-05, 0.1590D-05, & + & 0.1116D-05/ + + data (calcpts(j,40), j = 1,neta) /0.3289D-10, 0.2708D-10, & + & 0.3539D-10, -.6742D-11, 0.5593D-11, 0.7691D-11, 0.2261D-10, & + & 0.8058D-11, -.1388D-12, 0.9135D-11, 0.1398D-10, -.2515D-11, & + & 0.1087D-11, -.2156D-11, -.3048D-11, -.1035D-10, -.1705D-10, & + & -.3096D-10, -.5363D-10, -.9460D-10, -.1621D-09, -.2806D-09, & + & -.4827D-09, -.8212D-09, -.1382D-08, -.2294D-08, -.3755D-08, & + & -.5997D-08, -.9319D-08, -.1391D-07, -.1973D-07, -.2600D-07, & + & -.3104D-07, -.3247D-07, -.2878D-07, -.2572D-07, -.4432D-07, & + & -.1324D-06, -.3711D-06, -.8743D-06, -.1782D-05, -.3251D-05, & + & -.5431D-05, -.8440D-05, -.1229D-04, -.1682D-04, -.2151D-04, & + & -.2537D-04, -.2682D-04, -.2382D-04, -.1447D-04, 0.1894D-05, & + & 0.2362D-04, 0.4674D-04, 0.6637D-04, 0.7893D-04, 0.8326D-04, & + & 0.8034D-04, 0.7236D-04, 0.6169D-04, 0.5034D-04, 0.3966D-04, & + & 0.3040D-04, 0.2281D-04, 0.1683D-04, 0.1226D-04, 0.8842D-05, & + & 0.6330D-05, 0.4506D-05, 0.3192D-05, 0.2254D-05, 0.1587D-05, & + & 0.1116D-05/ + + data (calcpts(j,41), j = 1,neta) /0.8070D-10, 0.7208D-10, & + & -.9969D-11, 0.4621D-10, 0.3142D-10, 0.1773D-10, 0.2619D-10, & + & 0.5520D-11, 0.1387D-10, -.2577D-11, 0.4067D-11, -.4187D-11, & + & 0.1809D-11, 0.1111D-11, 0.3716D-11, -.1177D-11, -.5532D-11, & + & -.9871D-11, -.2146D-10, -.4289D-10, -.7489D-10, -.1314D-09, & + & -.2265D-09, -.3856D-09, -.6518D-09, -.1086D-08, -.1774D-08, & + & -.2838D-08, -.4438D-08, -.6668D-08, -.9526D-08, -.1275D-07, & + & -.1562D-07, -.1721D-07, -.1718D-07, -.1892D-07, -.3309D-07, & + & -.8376D-07, -.2116D-06, -.4746D-06, -.9454D-06, -.1708D-05, & + & -.2854D-05, -.4465D-05, -.6595D-05, -.9230D-05, -.1222D-04, & + & -.1518D-04, -.1741D-04, -.1781D-04, -.1502D-04, -.7817D-05, & + & 0.4090D-05, 0.1945D-04, 0.3544D-04, 0.4878D-04, 0.5709D-04, & + & 0.5967D-04, 0.5728D-04, 0.5143D-04, 0.4375D-04, 0.3564D-04, & + & 0.2805D-04, 0.2148D-04, 0.1609D-04, 0.1187D-04, 0.8635D-05, & + & 0.6223D-05, 0.4450D-05, 0.3165D-05, 0.2241D-05, 0.1581D-05, & + & 0.1113D-05/ + + data (calcpts(j,42), j = 1,neta) /-.5846D-10, -.7014D-10, & + & -.5778D-10, -.1180D-09, -.2375D-10, -.5015D-10, -.7008D-11, & + & 0.8792D-11, -.1201D-10, -.3614D-10, -.1938D-10, -.1763D-10, & + & 0.7249D-11, -.6352D-11, -.4248D-11, -.9391D-11, -.7513D-11, & + & -.1266D-10, -.1417D-10, -.2237D-10, -.3978D-10, -.6331D-10, & + & -.1093D-09, -.1839D-09, -.3089D-09, -.5148D-09, -.8423D-09, & + & -.1355D-08, -.2121D-08, -.3203D-08, -.4610D-08, -.6246D-08, & + & -.7828D-08, -.9010D-08, -.9846D-08, -.1204D-07, -.2119D-07, & + & -.4927D-07, -.1165D-06, -.2519D-06, -.4931D-06, -.8844D-06, & + & -.1476D-05, -.2321D-05, -.3462D-05, -.4926D-05, -.6685D-05, & + & -.8617D-05, -.1044D-04, -.1166D-04, -.1152D-04, -.9118D-05, & + & -.3686D-05, 0.4897D-05, 0.1567D-04, 0.2668D-04, 0.3570D-04, & + & 0.4116D-04, 0.4267D-04, 0.4075D-04, 0.3648D-04, 0.3097D-04, & + & 0.2520D-04, 0.1981D-04, 0.1515D-04, 0.1134D-04, 0.8355D-05, & + & 0.6075D-05, 0.4374D-05, 0.3126D-05, 0.2221D-05, 0.1572D-05, & + & 0.1108D-05/ + + data (calcpts(j,43), j = 1,neta) /0.1136D-10, -.8782D-10, & + & 0.6688D-10, -.2130D-10, 0.8003D-10, 0.2656D-10, -.1288D-10, & + & -.8851D-11, -.1165D-10, -.1624D-11, 0.1652D-11, 0.3481D-11, & + & -.9166D-11, -.8690D-11, -.1727D-11, 0.2107D-11, 0.7933D-11, & + & -.2786D-11, -.5017D-11, -.1410D-10, -.1768D-10, -.3233D-10, & + & -.4968D-10, -.8618D-10, -.1465D-09, -.2441D-09, -.3988D-09, & + & -.6432D-09, -.1010D-08, -.1531D-08, -.2219D-08, -.3050D-08, & + & -.3898D-08, -.4655D-08, -.5410D-08, -.7109D-08, -.1256D-07, & + & -.2769D-07, -.6255D-07, -.1316D-06, -.2538D-06, -.4523D-06, & + & -.7542D-06, -.1189D-05, -.1789D-05, -.2576D-05, -.3560D-05, & + & -.4712D-05, -.5939D-05, -.7035D-05, -.7651D-05, -.7277D-05, & + & -.5307D-05, -.1264D-05, 0.4879D-05, 0.1241D-04, 0.1996D-04, & + & 0.2602D-04, 0.2959D-04, 0.3043D-04, 0.2893D-04, 0.2583D-04, & + & 0.2188D-04, 0.1779D-04, 0.1397D-04, 0.1067D-04, 0.7984D-05, & + & 0.5875D-05, 0.4269D-05, 0.3070D-05, 0.2193D-05, 0.1557D-05, & + & 0.1101D-05/ + + data (calcpts(j,44), j = 1,neta) /0.2906D-09, -.1005D-09, & + & -.3852D-10, -.4085D-10, 0.4381D-10, 0.4428D-10, 0.1203D-11, & + & -.1534D-10, -.7004D-11, 0.1085D-10, 0.1420D-10, -.1206D-10, & + & 0.4450D-11, 0.9734D-11, -.1428D-10, 0.5013D-12, -.3193D-11, & + & 0.5180D-11, 0.8894D-12, -.6236D-12, -.1257D-10, -.1550D-10, & + & -.2144D-10, -.4033D-10, -.6840D-10, -.1162D-09, -.1881D-09, & + & -.3056D-09, -.4808D-09, -.7301D-09, -.1067D-08, -.1479D-08, & + & -.1927D-08, -.2374D-08, -.2901D-08, -.3997D-08, -.7078D-08, & + & -.1508D-07, -.3295D-07, -.6784D-07, -.1293D-06, -.2292D-06, & + & -.3817D-06, -.6034D-06, -.9124D-06, -.1326D-05, -.1859D-05, & + & -.2509D-05, -.3253D-05, -.4018D-05, -.4658D-05, -.4929D-05, & + & -.4484D-05, -.2922D-05, 0.5770D-07, 0.4431D-05, 0.9675D-05, & + & 0.1484D-04, 0.1891D-04, 0.2124D-04, 0.2167D-04, 0.2052D-04, & + & 0.1825D-04, 0.1545D-04, 0.1254D-04, 0.9835D-05, 0.7509D-05, & + & 0.5613D-05, 0.4126D-05, 0.2995D-05, 0.2154D-05, 0.1537D-05, & + & 0.1091D-05/ + + data (calcpts(j,45), j = 1,neta) /0.6116D-10, 0.3562D-09, & + & 0.3791D-09, 0.2375D-09, 0.1795D-09, 0.2456D-09, 0.2054D-09, & + & 0.3163D-09, 0.1831D-09, 0.1081D-09, 0.5660D-10, 0.8214D-10, & + & 0.7798D-10, 0.1560D-10, 0.1258D-10, 0.2074D-10, 0.3867D-10, & + & 0.6209D-11, 0.2225D-10, 0.1446D-10, 0.1357D-10, 0.4389D-11, & + & -.7446D-11, -.1488D-10, -.2801D-10, -.5172D-10, -.8844D-10, & + & -.1439D-09, -.2279D-09, -.3493D-09, -.5138D-09, -.7197D-09, & + & -.9534D-09, -.1207D-08, -.1533D-08, -.2187D-08, -.3875D-08, & + & -.8040D-08, -.1711D-07, -.3462D-07, -.6532D-07, -.1152D-06, & + & -.1917D-06, -.3035D-06, -.4610D-06, -.6749D-06, -.9555D-06, & + & -.1309D-05, -.1734D-05, -.2207D-05, -.2676D-05, -.3038D-05, & + & -.3120D-05, -.2687D-05, -.1476D-05, 0.7008D-06, 0.3801D-05, & + & 0.7441D-05, 0.1096D-04, 0.1369D-04, 0.1519D-04, 0.1540D-04, & + & 0.1452D-04, 0.1289D-04, 0.1089D-04, 0.8827D-05, 0.6918D-05, & + & 0.5277D-05, 0.3942D-05, 0.2896D-05, 0.2101D-05, 0.1509D-05, & + & 0.1076D-05/ + + data (calcpts(j,46), j = 1,neta) /0.1917D-09, -.1535D-09, & + & 0.4083D-09, 0.2116D-09, 0.9985D-10, -.3683D-11, 0.6403D-10, & + & 0.2144D-10, 0.7432D-11, 0.7975D-10, -.1710D-10, 0.2668D-10, & + & -.1262D-10, 0.4799D-11, 0.3884D-11, -.4044D-11, 0.4642D-11, & + & -.6977D-11, 0.6772D-11, 0.2195D-10, 0.1218D-10, 0.8504D-11, & + & -.4265D-11, -.5370D-11, -.1092D-10, -.2660D-10, -.4248D-10, & + & -.7007D-10, -.1082D-09, -.1669D-09, -.2471D-09, -.3489D-09, & + & -.4687D-09, -.6066D-09, -.7951D-09, -.1165D-08, -.2068D-08, & + & -.4211D-08, -.8778D-08, -.1752D-07, -.3277D-07, -.5755D-07, & + & -.9563D-07, -.1516D-06, -.2311D-06, -.3402D-06, -.4856D-06, & + & -.6733D-06, -.9060D-06, -.1180D-05, -.1478D-05, -.1760D-05, & + & -.1953D-05, -.1940D-05, -.1557D-05, -.6336D-06, 0.9465D-06, & + & 0.3136D-05, 0.5659D-05, 0.8059D-05, 0.9882D-05, 0.1085D-04, & + & 0.1093D-04, 0.1026D-04, 0.9090D-05, 0.7666D-05, 0.6207D-05, & + & 0.4860D-05, 0.3705D-05, 0.2766D-05, 0.2031D-05, 0.1472D-05, & + & 0.1057D-05/ + + data (calcpts(j,47), j = 1,neta) /0.2895D-09, -.2610D-09, & + & -.3456D-09, -.1412D-09, -.3047D-10, -.2021D-10, -.2062D-09, & + & -.9289D-10, 0.4744D-10, -.9101D-10, -.2432D-10, -.1832D-10, & + & 0.5847D-10, -.2453D-10, -.3673D-10, -.2271D-10, 0.1469D-10, & + & -.5788D-11, -.7590D-11, -.1979D-10, 0.1805D-10, -.6081D-11, & + & -.2603D-11, -.8448D-11, -.6680D-11, -.1677D-10, -.2327D-10, & + & -.3327D-10, -.5595D-10, -.7616D-10, -.1179D-09, -.1698D-09, & + & -.2286D-09, -.3027D-09, -.4085D-09, -.6112D-09, -.1086D-08, & + & -.2176D-08, -.4463D-08, -.8801D-08, -.1634D-07, -.2859D-07, & + & -.4746D-07, -.7531D-07, -.1151D-06, -.1702D-06, -.2447D-06, & + & -.3423D-06, -.4663D-06, -.6178D-06, -.7926D-06, -.9777D-06, & + & -.1144D-05, -.1239D-05, -.1182D-05, -.8625D-06, -.1674D-06, & + & 0.9738D-06, 0.2517D-05, 0.4263D-05, 0.5896D-05, 0.7111D-05, & + & 0.7731D-05, 0.7740D-05, 0.7242D-05, 0.6402D-05, 0.5391D-05, & + & 0.4360D-05, 0.3411D-05, 0.2599D-05, 0.1938D-05, 0.1422D-05, & + & 0.1030D-05/ + + data (calcpts(j,48), j = 1,neta) /-.1464D-09, 0.1705D-10, & + & 0.2130D-09, -.6478D-10, 0.5286D-09, 0.1417D-09, 0.3096D-09, & + & 0.1552D-09, -.5639D-10, 0.1330D-09, 0.1519D-09, 0.5894D-10, & + & 0.5478D-10, 0.4993D-10, 0.4679D-10, -.7341D-10, 0.3779D-10, & + & 0.4836D-10, 0.5389D-10, 0.6009D-11, -.5886D-12, 0.1044D-10, & + & -.2832D-11, 0.1719D-10, 0.4355D-11, -.2739D-11, -.1025D-10, & + & -.1470D-10, -.1767D-10, -.3432D-10, -.5392D-10, -.7840D-10, & + & -.1105D-09, -.1499D-09, -.2074D-09, -.3156D-09, -.5618D-09, & + & -.1113D-08, -.2252D-08, -.4395D-08, -.8110D-08, -.1414D-07, & + & -.2344D-07, -.3724D-07, -.5702D-07, -.8466D-07, -.1223D-06, & + & -.1724D-06, -.2372D-06, -.3185D-06, -.4163D-06, -.5270D-06, & + & -.6404D-06, -.7353D-06, -.7752D-06, -.7035D-06, -.4463D-06, & + & 0.7188D-07, 0.8923D-06, 0.1977D-05, 0.3184D-05, 0.4294D-05, & + & 0.5103D-05, 0.5499D-05, 0.5475D-05, 0.5106D-05, 0.4503D-05, & + & 0.3787D-05, 0.3060D-05, 0.2392D-05, 0.1821D-05, 0.1357D-05, & + & 0.9954D-06/ + + data (calcpts(j,49), j = 1,neta) /0.5682D-09, 0.1002D-08, & + & -.8636D-09, 0.3879D-09, -.6704D-09, -.1877D-09, 0.6433D-10, & + & 0.4983D-09, 0.2832D-09, 0.1430D-09, -.1107D-09, -.2155D-09, & + & -.7760D-10, 0.9064D-10, 0.5010D-10, 0.5425D-10, -.2434D-10, & + & 0.2420D-11, -.3557D-10, -.2176D-10, 0.2093D-10, 0.3055D-11, & + & -.5441D-12, 0.2863D-11, 0.5720D-12, -.4297D-11, -.8496D-11, & + & 0.8641D-12, -.1555D-10, -.1598D-10, -.2747D-10, -.3948D-10, & + & -.5439D-10, -.7508D-10, -.1040D-09, -.1614D-09, -.2881D-09, & + & -.5647D-09, -.1129D-08, -.2184D-08, -.4008D-08, -.6967D-08, & + & -.1154D-07, -.1834D-07, -.2814D-07, -.4188D-07, -.6078D-07, & + & -.8618D-07, -.1195D-06, -.1623D-06, -.2151D-06, -.2778D-06, & + & -.3471D-06, -.4155D-06, -.4677D-06, -.4778D-06, -.4068D-06, & + & -.2046D-06, 0.1783D-06, 0.7663D-06, 0.1528D-05, 0.2361D-05, & + & 0.3115D-05, 0.3654D-05, 0.3904D-05, 0.3867D-05, 0.3595D-05, & + & 0.3165D-05, 0.2658D-05, 0.2146D-05, 0.1677D-05, 0.1275D-05, & + & 0.9499D-06/ + + data (dlaeta(j), j = 1,neta) / & + & -6d0, -5.83333333d0, -5.66666667d0, -5.5d0, -5.33333333d0, & + & -5.16666667d0, -5d0, -4.83333333d0, -4.66666667d0, -4.5d0, & + & -4.33333333d0, -4.16666667d0, -4d0, -3.83333333d0, & + & -3.66666667d0, -3.5d0, -3.33333333d0, -3.16666667d0, -3d0, & + & -2.83333333d0, -2.66666667d0, -2.5d0, -2.33333333d0, & + & -2.16666667d0, -2d0, -1.83333333d0, -1.66666667d0, -1.5d0, & + & -1.33333333d0, -1.16666667d0, -1d0, -0.83333333d0, -0.66666667d0,& + & -0.5d0, -0.33333333d0, -0.16666667d0, 0d0, 0.16666667d0, & + & 0.33333333d0, 0.5d0, 0.66666667d0, 0.83333333d0, 1d0, & + & 1.16666667d0, 1.33333333d0, 1.5d0, 1.66666667d0, 1.83333333d0, & + & 2d0, 2.16666667d0, 2.33333333d0, 2.5d0, 2.66666667d0, & + & 2.83333333d0, 3d0, 3.16666667d0, 3.33333333d0, 3.5d0, & + & 3.66666667d0, 3.83333333d0, 4d0, 4.16666667d0, 4.33333333d0, & + & 4.5d0, 4.66666667d0, 4.83333333d0, 5d0, 5.16666667d0, & + & 5.33333333d0, 5.5d0, 5.66666667d0, 5.83333333d0, 6d0/ + + data (dlaxi(j), j = 1,nxi) / & + & -3d0, -2.83333333d0, -2.66666667d0, -2.5d0, -2.33333333d0, & + & -2.16666667d0, -2d0, -1.83333333d0, -1.66666667d0, -1.5d0, & + & -1.33333333d0, -1.16666667d0, -1d0, -0.83333333d0, -0.66666667d0,& + & -0.5d0, -0.33333333d0, -0.16666667d0, 0d0, 0.16666667d0, & + & 0.33333333d0, 0.5d0, 0.66666667d0, 0.83333333d0, 1d0, & + & 1.16666667d0, 1.33333333d0, 1.5d0, 1.66666667d0, 1.83333333d0, & + & 2d0, 2.16666667d0, 2.33333333d0, 2.5d0, 2.66666667d0, & + & 2.83333333d0, 3d0, 3.16666667d0, 3.33333333d0, 3.5d0, & + & 3.66666667d0, 3.83333333d0, 4d0, 4.16666667d0, 4.33333333d0, & + & 4.5d0, 4.66666667d0, 4.83333333d0, 5d0/ + + dleta = dlog10(eta) + dlxi = dlog10(xi) + if (dlxi .le. dlaxi(1)) dlxi = dlaxi(1) + if (dlxi .ge. dlaxi(nxi)) dlxi = dlaxi(nxi) + if (dleta .ge. dlaeta(neta)) dleta = dlaeta(neta) + if (dleta .le. dlaeta(1)) dleta = dlaeta(1) + call locate(dlaeta,neta, dleta, ieta) + call locate(dlaxi, nxi, dlxi, ixi) +! interpolating between the appropriate points + delxi = 1d0/6d0 + deleta = 1d0/6d0 +! lagrange 3-pt. + if (ixi .le. 2) ixi = 2 + if (ixi .ge. 48) ixi = 48 + if (ieta .le. 2) ieta = 2 + if (ieta .ge. 72) ieta = 72 + pxi = (dlxi - dlaxi(ixi))/delxi + f(-1) = pxi*(pxi-1d0)/2d0*calcpts(ieta-1,ixi-1) + & + & (1d0 - pxi**2)*calcpts(ieta-1,ixi) + & + & pxi*(pxi+1d0)/2d0*calcpts(ieta-1,ixi+1) + f(0) = pxi*(pxi-1d0)/2d0*calcpts(ieta,ixi-1) + & + & (1d0 - pxi**2)*calcpts(ieta,ixi) + & + & pxi*(pxi+1d0)/2d0*calcpts(ieta,ixi+1) + f(1) = pxi*(pxi-1d0)/2d0*calcpts(ieta+1,ixi-1) + & + & (1d0 - pxi**2)*calcpts(ieta+1,ixi) + & + & pxi*(pxi+1d0)/2d0*calcpts(ieta+1,ixi+1) + peta = (dleta - dlaeta(ieta))/deleta + h1_FLg = peta*(peta-1d0)/2d0*f(-1) + & + & (1d0 - peta**2)*f(0) + & + & peta*(peta+1d0)/2d0*f(1) +!MB + + peta*(peta+1d0)/2d0*f(1) + return + END + +! ========================================== + double precision function h1bar_Lg(eta,xi) +! ========================================== + +! eq (12) in PLB347 (1995) 143 - 151 for the longitudinal piece +! MSbar scheme +! This routine is called subclbar in the original code. +! Called sclbar in updated code (03/06/96). + + implicit none + integer neta, nxi + parameter (neta = 73, nxi = 49) + double precision calcpts(neta, nxi), dlaeta(neta), dlaxi(nxi) + double precision eta, xi, dleta, dlxi + double precision pxi, peta, f(-1:1), delxi, deleta + integer j, ieta, ixi + + data (calcpts(j, 1), j = 1,neta) /0.7071D-08, 0.8567D-08, & + & 0.1038D-07, 0.1257D-07, 0.1524D-07, 0.1846D-07, 0.2236D-07, & + & 0.2710D-07, 0.3283D-07, 0.3978D-07, 0.4822D-07, 0.5844D-07, & + & 0.7084D-07, 0.8591D-07, 0.1042D-06, 0.1265D-06, 0.1537D-06, & + & 0.1870D-06, 0.2279D-06, 0.2786D-06, 0.3418D-06, 0.4217D-06, & + & 0.5243D-06, 0.6586D-06, 0.8386D-06, 0.1086D-05, 0.1434D-05, & + & 0.1933D-05, 0.2658D-05, 0.3705D-05, 0.5187D-05, 0.7191D-05, & + & 0.9704D-05, 0.1252D-04, 0.1518D-04, 0.1707D-04, 0.1771D-04, & + & 0.1701D-04, 0.1527D-04, 0.1299D-04, 0.1059D-04, 0.8349D-05, & + & 0.6403D-05, 0.4797D-05, 0.3525D-05, 0.2546D-05, 0.1816D-05, & + & 0.1282D-05, 0.8938D-06, 0.6230D-06, 0.4303D-06, 0.2961D-06, & + & 0.2068D-06, 0.1394D-06, 0.9358D-07, 0.6473D-07, 0.4295D-07, & + & 0.3262D-07, 0.1892D-07, 0.1412D-07, 0.1085D-07, 0.8620D-08, & + & 0.7103D-08, 0.6068D-08, 0.5363D-08, -.1784D-08, -.2111D-08, & + & -.2334D-08, -.2486D-08, -.2589D-08, -.2660D-08, -.2708D-08, & + & -.2741D-08/ + + data (calcpts(j, 2), j = 1,neta) /0.1038D-07, 0.1257D-07, & + & 0.1523D-07, 0.1845D-07, 0.2236D-07, 0.2709D-07, 0.3282D-07, & + & 0.3977D-07, 0.4818D-07, 0.5839D-07, 0.7077D-07, 0.8577D-07, & + & 0.1040D-06, 0.1261D-06, 0.1529D-06, 0.1857D-06, 0.2256D-06, & + & 0.2745D-06, 0.3345D-06, 0.4089D-06, 0.5016D-06, 0.6189D-06, & + & 0.7695D-06, 0.9666D-06, 0.1231D-05, 0.1593D-05, 0.2104D-05, & + & 0.2837D-05, 0.3901D-05, 0.5438D-05, 0.7612D-05, 0.1055D-04, & + & 0.1424D-04, 0.1838D-04, 0.2228D-04, 0.2506D-04, 0.2600D-04, & + & 0.2497D-04, 0.2241D-04, 0.1906D-04, 0.1554D-04, 0.1225D-04, & + & 0.9395D-05, 0.7042D-05, 0.5175D-05, 0.3742D-05, 0.2663D-05, & + & 0.1879D-05, 0.1317D-05, 0.9144D-06, 0.6334D-06, 0.4387D-06, & + & 0.2970D-06, 0.2074D-06, 0.1398D-06, 0.9388D-07, 0.6503D-07, & + & 0.4321D-07, 0.3288D-07, 0.1917D-07, 0.1438D-07, 0.1111D-07, & + & 0.8879D-08, 0.7360D-08, 0.6325D-08, 0.5620D-08, 0.5140D-08, & + & 0.4813D-08, 0.4590D-08, 0.4438D-08, 0.4335D-08, 0.4264D-08, & + & 0.4216D-08/ + + data (calcpts(j, 3), j = 1,neta) /0.1522D-07, 0.1844D-07, & + & 0.2234D-07, 0.2707D-07, 0.3280D-07, 0.3974D-07, 0.4815D-07, & + & 0.5834D-07, 0.7068D-07, 0.8565D-07, 0.1038D-06, 0.1258D-06, & + & 0.1525D-06, 0.1850D-06, 0.2244D-06, 0.2724D-06, 0.3309D-06, & + & 0.4026D-06, 0.4907D-06, 0.5998D-06, 0.7358D-06, 0.9079D-06, & + & 0.1129D-05, 0.1418D-05, 0.1805D-05, 0.2338D-05, 0.3087D-05, & + & 0.4163D-05, 0.5723D-05, 0.7978D-05, 0.1117D-04, 0.1548D-04, & + & 0.2090D-04, 0.2696D-04, 0.3269D-04, 0.3676D-04, 0.3814D-04, & + & 0.3662D-04, 0.3287D-04, 0.2796D-04, 0.2279D-04, 0.1796D-04, & + & 0.1378D-04, 0.1033D-04, 0.7581D-05, 0.5477D-05, 0.3902D-05, & + & 0.2753D-05, 0.1925D-05, 0.1338D-05, 0.9239D-06, 0.6335D-06, & + & 0.4377D-06, 0.2956D-06, 0.1991D-06, 0.1380D-06, 0.9217D-07, & + & 0.6328D-07, 0.4146D-07, 0.2447D-07, 0.1743D-07, 0.1263D-07, & + & 0.9369D-08, 0.4751D-09, -.1043D-08, -.2076D-08, -.2780D-08, & + & -.3260D-08, -.3587D-08, -.3809D-08, -.3961D-08, -.4065D-08, & + & -.4135D-08/ + + data (calcpts(j, 4), j = 1,neta) /0.2234D-07, 0.2706D-07, & + & 0.3278D-07, 0.3972D-07, 0.4813D-07, 0.5831D-07, 0.7065D-07, & + & 0.8560D-07, 0.1037D-06, 0.1257D-06, 0.1523D-06, 0.1846D-06, & + & 0.2238D-06, 0.2714D-06, 0.3292D-06, 0.3996D-06, 0.4856D-06, & + & 0.5907D-06, 0.7200D-06, 0.8801D-06, 0.1080D-05, 0.1332D-05, & + & 0.1656D-05, 0.2081D-05, 0.2649D-05, 0.3430D-05, 0.4529D-05, & + & 0.6107D-05, 0.8395D-05, 0.1171D-04, 0.1638D-04, 0.2272D-04, & + & 0.3066D-04, 0.3956D-04, 0.4796D-04, 0.5393D-04, 0.5596D-04, & + & 0.5373D-04, 0.4823D-04, 0.4102D-04, 0.3344D-04, 0.2636D-04, & + & 0.2021D-04, 0.1515D-04, 0.1113D-04, 0.8040D-05, 0.5732D-05, & + & 0.4043D-05, 0.2826D-05, 0.1960D-05, 0.1359D-05, 0.9340D-06, & + & 0.6419D-06, 0.4389D-06, 0.2964D-06, 0.2064D-06, 0.1387D-06, & + & 0.9274D-07, 0.6384D-07, 0.4204D-07, 0.3172D-07, 0.1801D-07, & + & 0.1322D-07, 0.9956D-08, 0.7730D-08, -.4522D-09, -.1485D-08, & + & -.2189D-08, -.2668D-08, -.2995D-08, -.3218D-08, -.3369D-08, & + & -.3473D-08/ + + data (calcpts(j, 5), j = 1,neta) /0.3277D-07, 0.3971D-07, & + & 0.4810D-07, 0.5828D-07, 0.7061D-07, 0.8555D-07, 0.1036D-06, & + & 0.1256D-06, 0.1522D-06, 0.1844D-06, 0.2235D-06, 0.2708D-06, & + & 0.3283D-06, 0.3982D-06, 0.4830D-06, 0.5863D-06, 0.7124D-06, & + & 0.8667D-06, 0.1056D-05, 0.1291D-05, 0.1584D-05, 0.1954D-05, & + & 0.2430D-05, 0.3052D-05, 0.3886D-05, 0.5032D-05, 0.6644D-05, & + & 0.8958D-05, 0.1231D-04, 0.1717D-04, 0.2403D-04, 0.3332D-04, & + & 0.4497D-04, 0.5803D-04, 0.7035D-04, 0.7913D-04, 0.8209D-04, & + & 0.7883D-04, 0.7075D-04, 0.6016D-04, 0.4905D-04, 0.3866D-04, & + & 0.2965D-04, 0.2222D-04, 0.1633D-04, 0.1179D-04, 0.8411D-05, & + & 0.5937D-05, 0.4149D-05, 0.2887D-05, 0.1997D-05, 0.1377D-05, & + & 0.9428D-06, 0.6499D-06, 0.4463D-06, 0.3037D-06, 0.2070D-06, & + & 0.1459D-06, 0.9995D-07, 0.7108D-07, 0.4928D-07, 0.3230D-07, & + & 0.2527D-07, 0.2048D-07, 0.1055D-07, 0.8328D-08, 0.6813D-08, & + & 0.5781D-08, 0.5079D-08, 0.4599D-08, 0.4273D-08, 0.4051D-08, & + & 0.3899D-08/ + + data (calcpts(j, 6), j = 1,neta) /0.4805D-07, 0.5822D-07, & + & 0.7053D-07, 0.8545D-07, 0.1035D-06, 0.1254D-06, 0.1520D-06, & + & 0.1842D-06, 0.2231D-06, 0.2704D-06, 0.3277D-06, 0.3971D-06, & + & 0.4815D-06, 0.5839D-06, 0.7082D-06, 0.8597D-06, 0.1045D-05, & + & 0.1271D-05, 0.1549D-05, 0.1893D-05, 0.2323D-05, 0.2866D-05, & + & 0.3563D-05, 0.4475D-05, 0.5698D-05, 0.7377D-05, 0.9741D-05, & + & 0.1313D-04, 0.1806D-04, 0.2517D-04, 0.3524D-04, 0.4885D-04, & + & 0.6594D-04, 0.8508D-04, 0.1032D-03, 0.1160D-03, 0.1204D-03, & + & 0.1156D-03, 0.1037D-03, 0.8819D-04, 0.7189D-04, 0.5667D-04, & + & 0.4346D-04, 0.3256D-04, 0.2392D-04, 0.1729D-04, 0.1232D-04, & + & 0.8691D-05, 0.6081D-05, 0.4225D-05, 0.2921D-05, 0.2010D-05, & + & 0.1380D-05, 0.9449D-06, 0.6514D-06, 0.4410D-06, 0.3051D-06, & + & 0.2084D-06, 0.1406D-06, 0.9476D-07, 0.6592D-07, 0.4414D-07, & + & 0.3385D-07, 0.2016D-07, 0.1538D-07, 0.1212D-07, 0.9899D-08, & + & 0.8387D-08, 0.6908D-09, -.1138D-10, -.4898D-09, -.8155D-09, & + & -.1037D-08/ + + data (calcpts(j, 7), j = 1,neta) /0.7044D-07, 0.8534D-07, & + & 0.1034D-06, 0.1253D-06, 0.1518D-06, 0.1839D-06, 0.2228D-06, & + & 0.2699D-06, 0.3270D-06, 0.3963D-06, 0.4803D-06, 0.5821D-06, & + & 0.7057D-06, 0.8558D-06, 0.1038D-05, 0.1260D-05, 0.1531D-05, & + & 0.1863D-05, 0.2270D-05, 0.2775D-05, 0.3405D-05, 0.4200D-05, & + & 0.5222D-05, 0.6559D-05, 0.8351D-05, 0.1081D-04, 0.1428D-04, & + & 0.1925D-04, 0.2646D-04, 0.3688D-04, 0.5164D-04, 0.7160D-04, & + & 0.9666D-04, 0.1247D-03, 0.1512D-03, 0.1701D-03, 0.1764D-03, & + & 0.1694D-03, 0.1520D-03, 0.1292D-03, 0.1053D-03, 0.8300D-04, & + & 0.6365D-04, 0.4768D-04, 0.3504D-04, 0.2532D-04, 0.1805D-04, & + & 0.1274D-04, 0.8887D-05, 0.6193D-05, 0.4276D-05, 0.2941D-05, & + & 0.2053D-05, 0.1382D-05, 0.9261D-06, 0.6392D-06, 0.4224D-06, & + & 0.3199D-06, 0.1833D-06, 0.1356D-06, 0.1032D-06, 0.8102D-07, & + & 0.6595D-07, 0.5567D-07, 0.4867D-07, 0.4390D-07, 0.4065D-07, & + & 0.3843D-07, 0.3693D-07, 0.3590D-07, 0.3520D-07, 0.3472D-07, & + & 0.3440D-07/ + + data (calcpts(j, 8), j = 1,neta) /0.1032D-06, 0.1250D-06, & + & 0.1515D-06, 0.1835D-06, 0.2223D-06, 0.2694D-06, 0.3264D-06, & + & 0.3955D-06, 0.4791D-06, 0.5806D-06, 0.7037D-06, 0.8529D-06, & + & 0.1034D-05, 0.1254D-05, 0.1521D-05, 0.1846D-05, 0.2243D-05, & + & 0.2729D-05, 0.3326D-05, 0.4065D-05, 0.4988D-05, 0.6154D-05, & + & 0.7650D-05, 0.9609D-05, 0.1223D-04, 0.1583D-04, 0.2091D-04, & + & 0.2819D-04, 0.3875D-04, 0.5401D-04, 0.7562D-04, 0.1049D-03, & + & 0.1415D-03, 0.1826D-03, 0.2215D-03, 0.2492D-03, 0.2585D-03, & + & 0.2481D-03, 0.2226D-03, 0.1892D-03, 0.1542D-03, 0.1215D-03, & + & 0.9315D-04, 0.6981D-04, 0.5128D-04, 0.3707D-04, 0.2644D-04, & + & 0.1866D-04, 0.1302D-04, 0.9091D-05, 0.6303D-05, 0.4304D-05, & + & 0.2964D-05, 0.2075D-05, 0.1403D-05, 0.9480D-06, 0.6617D-06, & + & 0.4450D-06, 0.3427D-06, 0.2064D-06, 0.1589D-06, 0.1265D-06, & + & 0.1045D-06, 0.8944D-07, 0.1253D-07, 0.5554D-08, 0.8006D-09, & + & -.2439D-08, -.4644D-08, -.6148D-08, -.7172D-08, -.7870D-08, & + & -.8345D-08/ + + data (calcpts(j, 9), j = 1,neta) /0.1510D-06, 0.1829D-06, & + & 0.2216D-06, 0.2685D-06, 0.3253D-06, 0.3941D-06, 0.4775D-06, & + & 0.5786D-06, 0.7010D-06, 0.8495D-06, 0.1030D-05, 0.1248D-05, & + & 0.1513D-05, 0.1834D-05, 0.2225D-05, 0.2701D-05, 0.3282D-05, & + & 0.3992D-05, 0.4866D-05, 0.5948D-05, 0.7297D-05, 0.9002D-05, & + & 0.1119D-04, 0.1406D-04, 0.1789D-04, 0.2316D-04, 0.3058D-04, & + & 0.4123D-04, 0.5667D-04, 0.7900D-04, 0.1106D-03, 0.1534D-03, & + & 0.2071D-03, 0.2673D-03, 0.3241D-03, 0.3646D-03, 0.3781D-03, & + & 0.3629D-03, 0.3255D-03, 0.2765D-03, 0.2252D-03, 0.1775D-03, & + & 0.1361D-03, 0.1019D-03, 0.7488D-04, 0.5409D-04, 0.3859D-04, & + & 0.2717D-04, 0.1898D-04, 0.1318D-04, 0.9152D-05, 0.6280D-05, & + & 0.4277D-05, 0.2938D-05, 0.1983D-05, 0.1379D-05, 0.9252D-06, & + & 0.6396D-06, 0.4236D-06, 0.2553D-06, 0.1859D-06, 0.1387D-06, & + & 0.3983D-07, 0.1788D-07, 0.2928D-08, -.7253D-08, -.1419D-07, & + & -.1892D-07, -.2214D-07, -.2433D-07, -.2583D-07, -.2685D-07, & + & -.2754D-07/ + + data (calcpts(j,10), j = 1,neta) /0.2207D-06, 0.2674D-06, & + & 0.3239D-06, 0.3924D-06, 0.4755D-06, 0.5761D-06, 0.6980D-06, & + & 0.8458D-06, 0.1025D-05, 0.1242D-05, 0.1505D-05, 0.1824D-05, & + & 0.2211D-05, 0.2681D-05, 0.3252D-05, 0.3948D-05, 0.4797D-05, & + & 0.5836D-05, 0.7113D-05, 0.8694D-05, 0.1066D-04, 0.1316D-04, & + & 0.1636D-04, 0.2054D-04, 0.2614D-04, 0.3384D-04, 0.4467D-04, & + & 0.6022D-04, 0.8277D-04, 0.1154D-03, 0.1615D-03, 0.2240D-03, & + & 0.3025D-03, 0.3905D-03, 0.4737D-03, 0.5328D-03, 0.5527D-03, & + & 0.5302D-03, 0.4753D-03, 0.4036D-03, 0.3286D-03, 0.2589D-03, & + & 0.1984D-03, 0.1486D-03, 0.1092D-03, 0.7896D-04, 0.5628D-04, & + & 0.3968D-04, 0.2778D-04, 0.1927D-04, 0.1335D-04, 0.9172D-05, & + & 0.6298D-05, 0.4299D-05, 0.2963D-05, 0.2012D-05, 0.1345D-05, & + & 0.9590D-06, 0.6082D-06, 0.4600D-06, 0.2924D-06, 0.2235D-06, & + & 0.1100D-06, 0.7802D-07, 0.5624D-07, 0.4141D-07, 0.3130D-07, & + & 0.2441D-07, 0.1972D-07, 0.1652D-07, 0.1435D-07, 0.1286D-07, & + & 0.1185D-07/ + + data (calcpts(j,11), j = 1,neta) /0.3220D-06, 0.3901D-06, & + & 0.4725D-06, 0.5725D-06, 0.6937D-06, 0.8405D-06, 0.1018D-05, & + & 0.1234D-05, 0.1495D-05, 0.1811D-05, 0.2195D-05, 0.2661D-05, & + & 0.3226D-05, 0.3912D-05, 0.4745D-05, 0.5760D-05, 0.6999D-05, & + & 0.8514D-05, 0.1038D-04, 0.1268D-04, 0.1556D-04, 0.1919D-04, & + & 0.2385D-04, 0.2996D-04, 0.3812D-04, 0.4934D-04, 0.6512D-04, & + & 0.8776D-04, 0.1206D-03, 0.1681D-03, 0.2354D-03, 0.3265D-03, & + & 0.4410D-03, 0.5695D-03, 0.6909D-03, 0.7773D-03, 0.8061D-03, & + & 0.7730D-03, 0.6925D-03, 0.5877D-03, 0.4781D-03, 0.3765D-03, & + & 0.2886D-03, 0.2162D-03, 0.1589D-03, 0.1148D-03, 0.8193D-04, & + & 0.5780D-04, 0.4049D-04, 0.2811D-04, 0.1949D-04, 0.1344D-04, & + & 0.9262D-05, 0.6335D-05, 0.4346D-05, 0.3018D-05, 0.2074D-05, & + & 0.1411D-05, 0.1028D-05, 0.6800D-06, 0.4667D-06, 0.3667D-06, & + & 0.2320D-06, 0.1856D-06, 0.1540D-06, 0.1325D-06, 0.1178D-06, & + & 0.1078D-06, 0.1010D-06, 0.9635D-07, 0.9319D-07, 0.9104D-07, & + & 0.8957D-07/ + + data (calcpts(j,12), j = 1,neta) /0.4683D-06, 0.5674D-06, & + & 0.6873D-06, 0.8327D-06, 0.1009D-05, 0.1222D-05, 0.1481D-05, & + & 0.1795D-05, 0.2174D-05, 0.2635D-05, 0.3193D-05, 0.3870D-05, & + & 0.4692D-05, 0.5689D-05, 0.6901D-05, 0.8377D-05, 0.1018D-04, & + & 0.1238D-04, 0.1509D-04, 0.1844D-04, 0.2262D-04, 0.2790D-04, & + & 0.3468D-04, 0.4354D-04, 0.5541D-04, 0.7170D-04, 0.9460D-04, & + & 0.1275D-03, 0.1751D-03, 0.2441D-03, 0.3418D-03, 0.4742D-03, & + & 0.6407D-03, 0.8277D-03, 0.1005D-02, 0.1130D-02, 0.1172D-02, & + & 0.1123D-02, 0.1005D-02, 0.8521D-03, 0.6927D-03, 0.5450D-03, & + & 0.4176D-03, 0.3128D-03, 0.2299D-03, 0.1662D-03, 0.1186D-03, & + & 0.8370D-04, 0.5860D-04, 0.4075D-04, 0.2823D-04, 0.1950D-04, & + & 0.1342D-04, 0.9210D-05, 0.6376D-05, 0.4340D-05, 0.3028D-05, & + & 0.2093D-05, 0.1437D-05, 0.1060D-05, 0.7149D-06, 0.5039D-06, & + & 0.4057D-06, 0.2720D-06, 0.2264D-06, 0.1953D-06, 0.1741D-06, & + & 0.1597D-06, 0.1499D-06, 0.1431D-06, 0.1386D-06, 0.1355D-06, & + & 0.1334D-06/ + + data (calcpts(j,13), j = 1,neta) /0.6783D-06, 0.8219D-06, & + & 0.9956D-06, 0.1206D-05, 0.1462D-05, 0.1771D-05, 0.2145D-05, & + & 0.2600D-05, 0.3150D-05, 0.3817D-05, 0.4626D-05, 0.5606D-05, & + & 0.6796D-05, 0.8242D-05, 0.9996D-05, 0.1213D-04, 0.1474D-04, & + & 0.1793D-04, 0.2186D-04, 0.2671D-04, 0.3276D-04, 0.4041D-04, & + & 0.5021D-04, 0.6303D-04, 0.8018D-04, 0.1037D-03, 0.1368D-03, & + & 0.1842D-03, 0.2531D-03, 0.3527D-03, 0.4939D-03, 0.6854D-03, & + & 0.9269D-03, 0.1198D-02, 0.1455D-02, 0.1638D-02, 0.1697D-02, & + & 0.1625D-02, 0.1452D-02, 0.1229D-02, 0.9978D-03, 0.7844D-03, & + & 0.6007D-03, 0.4499D-03, 0.3307D-03, 0.2392D-03, 0.1708D-03, & + & 0.1206D-03, 0.8451D-04, 0.5882D-04, 0.4067D-04, 0.2798D-04, & + & 0.1955D-04, 0.1315D-04, 0.9469D-05, 0.6745D-05, 0.4676D-05, & + & 0.3051D-05, 0.2398D-05, 0.1953D-05, 0.9828D-06, 0.7760D-06, & + & 0.6353D-06, 0.5393D-06, 0.4738D-06, 0.4293D-06, 0.3989D-06, & + & 0.3782D-06, 0.3641D-06, 0.3545D-06, 0.3480D-06, 0.3435D-06, & + & 0.3405D-06/ + + data (calcpts(j,14), j = 1,neta) /0.9761D-06, 0.1183D-05, & + & 0.1433D-05, 0.1736D-05, 0.2103D-05, 0.2548D-05, 0.3087D-05, & + & 0.3741D-05, 0.4532D-05, 0.5492D-05, 0.6656D-05, 0.8067D-05, & + & 0.9780D-05, 0.1186D-04, 0.1438D-04, 0.1746D-04, 0.2121D-04, & + & 0.2580D-04, 0.3145D-04, 0.3843D-04, 0.4712D-04, 0.5811D-04, & + & 0.7220D-04, 0.9060D-04, 0.1152D-03, 0.1490D-03, 0.1964D-03, & + & 0.2644D-03, 0.3630D-03, 0.5058D-03, 0.7084D-03, 0.9837D-03, & + & 0.1331D-02, 0.1722D-02, 0.2093D-02, 0.2357D-02, 0.2442D-02, & + & 0.2335D-02, 0.2083D-02, 0.1759D-02, 0.1425D-02, 0.1118D-02, & + & 0.8558D-03, 0.6404D-03, 0.4707D-03, 0.3408D-03, 0.2433D-03, & + & 0.1714D-03, 0.1205D-03, 0.8340D-04, 0.5819D-04, 0.4026D-04, & + & 0.2781D-04, 0.1890D-04, 0.1263D-04, 0.9049D-05, 0.6393D-05, & + & 0.4368D-05, 0.2775D-05, 0.2145D-05, 0.1714D-05, 0.7546D-06, & + & 0.5551D-06, 0.4189D-06, 0.3261D-06, 0.2630D-06, 0.2199D-06, & + & 0.1906D-06, 0.1707D-06, 0.1570D-06, 0.1478D-06, 0.1414D-06, & + & 0.1371D-06/ + + data (calcpts(j,15), j = 1,neta) /0.1392D-05, 0.1687D-05, & + & 0.2044D-05, 0.2476D-05, 0.3000D-05, 0.3635D-05, 0.4404D-05, & + & 0.5337D-05, 0.6465D-05, 0.7835D-05, 0.9495D-05, 0.1151D-04, & + & 0.1395D-04, 0.1692D-04, 0.2052D-04, 0.2491D-04, 0.3026D-04, & + & 0.3680D-04, 0.4485D-04, 0.5480D-04, 0.6719D-04, 0.8283D-04, & + & 0.1029D-03, 0.1290D-03, 0.1640D-03, 0.2119D-03, 0.2792D-03, & + & 0.3756D-03, 0.5155D-03, 0.7180D-03, 0.1006D-02, 0.1397D-02, & + & 0.1893D-02, 0.2452D-02, 0.2984D-02, 0.3362D-02, 0.3482D-02, & + & 0.3324D-02, 0.2956D-02, 0.2488D-02, 0.2009D-02, 0.1574D-02, & + & 0.1203D-02, 0.9001D-03, 0.6612D-03, 0.4787D-03, 0.3412D-03, & + & 0.2412D-03, 0.1686D-03, 0.1173D-03, 0.8115D-04, 0.5598D-04, & + & 0.3859D-04, 0.2589D-04, 0.1793D-04, 0.1186D-04, 0.8419D-05, & + & 0.5190D-05, 0.3898D-05, 0.2351D-05, 0.1751D-05, 0.6754D-06, & + & 0.3970D-06, 0.2070D-06, 0.7757D-07, -.1055D-07, -.7060D-07, & + & -.1115D-06, -.1394D-06, -.1584D-06, -.1713D-06, -.1801D-06, & + & -.1862D-06/ + + data (calcpts(j,16), j = 1,neta) /0.1963D-05, 0.2378D-05, & + & 0.2881D-05, 0.3490D-05, 0.4229D-05, 0.5124D-05, 0.6208D-05, & + & 0.7522D-05, 0.9113D-05, 0.1104D-04, 0.1338D-04, 0.1622D-04, & + & 0.1966D-04, 0.2384D-04, 0.2892D-04, 0.3510D-04, 0.4264D-04, & + & 0.5186D-04, 0.6319D-04, 0.7719D-04, 0.9463D-04, 0.1166D-03, & + & 0.1448D-03, 0.1815D-03, 0.2304D-03, 0.2975D-03, 0.3914D-03, & + & 0.5261D-03, 0.7214D-03, 0.1005D-02, 0.1407D-02, 0.1957D-02, & + & 0.2654D-02, 0.3445D-02, 0.4200D-02, 0.4737D-02, 0.4905D-02, & + & 0.4672D-02, 0.4139D-02, 0.3467D-02, 0.2788D-02, 0.2177D-02, & + & 0.1661D-02, 0.1242D-02, 0.9134D-03, 0.6611D-03, 0.4721D-03, & + & 0.3337D-03, 0.2342D-03, 0.1627D-03, 0.1128D-03, 0.7755D-04, & + & 0.5352D-04, 0.3630D-04, 0.2484D-04, 0.1728D-04, 0.1149D-04, & + & 0.7571D-05, 0.5140D-05, 0.3272D-05, 0.2453D-05, 0.1894D-05, & + & 0.8474D-06, 0.5881D-06, 0.4114D-06, 0.2911D-06, 0.2091D-06, & + & 0.1532D-06, 0.1152D-06, 0.8923D-07, 0.7155D-07, 0.5952D-07, & + & 0.5132D-07/ + + data (calcpts(j,17), j = 1,neta) /0.2719D-05, 0.3294D-05, & + & 0.3990D-05, 0.4835D-05, 0.5858D-05, 0.7098D-05, 0.8599D-05, & + & 0.1042D-04, 0.1262D-04, 0.1530D-04, 0.1854D-04, 0.2247D-04, & + & 0.2724D-04, 0.3303D-04, 0.4005D-04, 0.4862D-04, 0.5906D-04, & + & 0.7181D-04, 0.8748D-04, 0.1068D-03, 0.1309D-03, 0.1613D-03, & + & 0.2001D-03, 0.2506D-03, 0.3179D-03, 0.4097D-03, 0.5383D-03, & + & 0.7223D-03, 0.9891D-03, 0.1376D-02, 0.1929D-02, 0.2685D-02, & + & 0.3648D-02, 0.4749D-02, 0.5806D-02, 0.6560D-02, 0.6792D-02, & + & 0.6451D-02, 0.5686D-02, 0.4731D-02, 0.3782D-02, 0.2938D-02, & + & 0.2236D-02, 0.1671D-02, 0.1228D-02, 0.8906D-03, 0.6366D-03, & + & 0.4510D-03, 0.3165D-03, 0.2206D-03, 0.1529D-03, 0.1054D-03, & + & 0.7247D-04, 0.5007D-04, 0.3397D-04, 0.2328D-04, 0.1627D-04, & + & 0.1085D-04, 0.7844D-05, 0.4920D-05, 0.3835D-05, 0.2430D-05, & + & 0.1926D-05, 0.1583D-05, 0.6827D-06, 0.5235D-06, 0.4149D-06, & + & 0.3410D-06, 0.2907D-06, 0.2563D-06, 0.2329D-06, 0.2170D-06, & + & 0.2062D-06/ + + data (calcpts(j,18), j = 1,neta) /0.3677D-05, 0.4455D-05, & + & 0.5396D-05, 0.6538D-05, 0.7922D-05, 0.9598D-05, 0.1163D-04, & + & 0.1409D-04, 0.1707D-04, 0.2068D-04, 0.2507D-04, 0.3038D-04, & + & 0.3683D-04, 0.4466D-04, 0.5415D-04, 0.6572D-04, 0.7983D-04, & + & 0.9706D-04, 0.1182D-03, 0.1443D-03, 0.1768D-03, 0.2176D-03, & + & 0.2697D-03, 0.3374D-03, 0.4273D-03, 0.5497D-03, 0.7207D-03, & + & 0.9649D-03, 0.1319D-02, 0.1833D-02, 0.2568D-02, 0.3579D-02, & + & 0.4879D-02, 0.6374D-02, 0.7823D-02, 0.8865D-02, 0.9184D-02, & + & 0.8698D-02, 0.7616D-02, 0.6282D-02, 0.4975D-02, 0.3839D-02, & + & 0.2909D-02, 0.2170D-02, 0.1597D-02, 0.1158D-02, 0.8295D-03, & + & 0.5883D-03, 0.4137D-03, 0.2884D-03, 0.2003D-03, 0.1379D-03, & + & 0.9479D-04, 0.6551D-04, 0.4453D-04, 0.3054D-04, 0.2084D-04, & + & 0.1450D-04, 0.9540D-05, 0.6857D-05, 0.4815D-05, 0.3211D-05, & + & 0.1906D-05, 0.1471D-05, 0.1174D-05, 0.9723D-06, 0.1680D-06, & + & 0.7420D-07, 0.1038D-07, -.3316D-07, -.6282D-07, -.8302D-07, & + & -.9678D-07/ + + data (calcpts(j,19), j = 1,neta) /0.4815D-05, 0.5834D-05, & + & 0.7067D-05, 0.8563D-05, 0.1038D-04, 0.1257D-04, 0.1523D-04, & + & 0.1845D-04, 0.2236D-04, 0.2709D-04, 0.3283D-04, 0.3979D-04, & + & 0.4823D-04, 0.5848D-04, 0.7091D-04, 0.8605D-04, 0.1045D-03, & + & 0.1270D-03, 0.1547D-03, 0.1887D-03, 0.2310D-03, 0.2842D-03, & + & 0.3518D-03, 0.4393D-03, 0.5551D-03, 0.7123D-03, 0.9310D-03, & + & 0.1242D-02, 0.1694D-02, 0.2349D-02, 0.3290D-02, 0.4593D-02, & + & 0.6281D-02, 0.8248D-02, 0.1018D-01, 0.1159D-01, 0.1204D-01, & + & 0.1138D-01, 0.9887D-02, 0.8062D-02, 0.6306D-02, 0.4815D-02, & + & 0.3625D-02, 0.2697D-02, 0.1984D-02, 0.1442D-02, 0.1035D-02, & + & 0.7363D-03, 0.5187D-03, 0.3626D-03, 0.2517D-03, 0.1742D-03, & + & 0.1200D-03, 0.8207D-04, 0.5639D-04, 0.3855D-04, 0.2627D-04, & + & 0.1773D-04, 0.1218D-04, 0.8433D-05, 0.5453D-05, 0.3663D-05, & + & 0.2898D-05, 0.1710D-05, 0.1355D-05, 0.1113D-05, 0.2814D-06, & + & 0.1690D-06, 0.9258D-07, 0.4042D-07, 0.4880D-08, -.1932D-07, & + & -.3580D-07/ + + data (calcpts(j,20), j = 1,neta) /0.6052D-05, 0.7332D-05, & + & 0.8882D-05, 0.1076D-04, 0.1304D-04, 0.1580D-04, 0.1914D-04, & + & 0.2319D-04, 0.2810D-04, 0.3405D-04, 0.4126D-04, 0.5000D-04, & + & 0.6060D-04, 0.7348D-04, 0.8909D-04, 0.1081D-03, 0.1313D-03, & + & 0.1595D-03, 0.1941D-03, 0.2368D-03, 0.2896D-03, 0.3558D-03, & + & 0.4397D-03, 0.5479D-03, 0.6905D-03, 0.8828D-03, 0.1149D-02, & + & 0.1527D-02, 0.2073D-02, 0.2866D-02, 0.4009D-02, 0.5604D-02, & + & 0.7695D-02, 0.1017D-01, 0.1265D-01, 0.1452D-01, 0.1516D-01, & + & 0.1433D-01, 0.1237D-01, 0.9951D-02, 0.7656D-02, 0.5758D-02, & + & 0.4289D-02, 0.3177D-02, 0.2336D-02, 0.1702D-02, 0.1227D-02, & + & 0.8756D-03, 0.6190D-03, 0.4342D-03, 0.3023D-03, 0.2098D-03, & + & 0.1449D-03, 0.9966D-04, 0.6879D-04, 0.4702D-04, 0.3254D-04, & + & 0.2208D-04, 0.1546D-04, 0.1077D-04, 0.7606D-05, 0.5022D-05, & + & 0.3505D-05, 0.2924D-05, 0.1862D-05, 0.1593D-05, 0.1409D-05, & + & 0.6174D-06, 0.5323D-06, 0.4742D-06, 0.4347D-06, 0.4077D-06, & + & 0.3894D-06/ + + data (calcpts(j,21), j = 1,neta) /0.7225D-05, 0.8754D-05, & + & 0.1060D-04, 0.1285D-04, 0.1557D-04, 0.1886D-04, 0.2285D-04, & + & 0.2769D-04, 0.3354D-04, 0.4064D-04, 0.4925D-04, 0.5969D-04, & + & 0.7234D-04, 0.8770D-04, 0.1063D-03, 0.1290D-03, 0.1566D-03, & + & 0.1902D-03, 0.2314D-03, 0.2821D-03, 0.3446D-03, 0.4228D-03, & + & 0.5215D-03, 0.6482D-03, 0.8139D-03, 0.1036D-02, 0.1341D-02, & + & 0.1772D-02, 0.2391D-02, 0.3291D-02, 0.4591D-02, 0.6420D-02, & + & 0.8852D-02, 0.1179D-01, 0.1482D-01, 0.1722D-01, 0.1815D-01, & + & 0.1725D-01, 0.1484D-01, 0.1179D-01, 0.8890D-02, 0.6547D-02, & + & 0.4798D-02, 0.3523D-02, 0.2586D-02, 0.1889D-02, 0.1369D-02, & + & 0.9817D-03, 0.6970D-03, 0.4904D-03, 0.3405D-03, 0.2364D-03, & + & 0.1636D-03, 0.1165D-03, 0.7802D-04, 0.5204D-04, 0.3676D-04, & + & 0.2420D-04, 0.1352D-04, 0.1079D-04, 0.8921D-05, 0.7650D-05, & + & 0.1180D-06, -.4722D-06, -.8743D-06, -.1148D-05, -.1335D-05, & + & -.1462D-05, -.1548D-05, -.1607D-05, -.1648D-05, -.1675D-05, & + & -.1694D-05/ + + data (calcpts(j,22), j = 1,neta) /0.8126D-05, 0.9846D-05, & + & 0.1193D-04, 0.1445D-04, 0.1751D-04, 0.2121D-04, 0.2570D-04, & + & 0.3114D-04, 0.3772D-04, 0.4571D-04, 0.5539D-04, 0.6712D-04, & + & 0.8135D-04, 0.9862D-04, 0.1195D-03, 0.1450D-03, 0.1760D-03, & + & 0.2137D-03, 0.2598D-03, 0.3164D-03, 0.3862D-03, 0.4730D-03, & + & 0.5821D-03, 0.7212D-03, 0.9018D-03, 0.1142D-02, 0.1468D-02, & + & 0.1925D-02, 0.2577D-02, 0.3522D-02, 0.4889D-02, 0.6829D-02, & + & 0.9448D-02, 0.1269D-01, 0.1617D-01, 0.1908D-01, 0.2047D-01, & + & 0.1972D-01, 0.1705D-01, 0.1345D-01, 0.9946D-02, 0.7133D-02, & + & 0.5103D-02, 0.3690D-02, 0.2694D-02, 0.1972D-02, 0.1441D-02, & + & 0.1041D-02, 0.7446D-03, 0.5284D-03, 0.3724D-03, 0.2599D-03, & + & 0.1772D-03, 0.1258D-03, 0.8889D-04, 0.5733D-04, 0.4279D-04, & + & 0.3074D-04, 0.2041D-04, 0.1124D-04, 0.9540D-05, 0.8379D-05, & + & 0.9215D-06, 0.3822D-06, 0.1478D-07, -.2354D-06, -.4059D-06, & + & -.5221D-06, -.6012D-06, -.6551D-06, -.6919D-06, -.7169D-06, & + & -.7339D-06/ + + data (calcpts(j,23), j = 1,neta) /0.8555D-05, 0.1037D-04, & + & 0.1256D-04, 0.1521D-04, 0.1843D-04, 0.2233D-04, 0.2706D-04, & + & 0.3278D-04, 0.3971D-04, 0.4812D-04, 0.5831D-04, 0.7066D-04, & + & 0.8563D-04, 0.1038D-03, 0.1258D-03, 0.1526D-03, 0.1851D-03, & + & 0.2247D-03, 0.2731D-03, 0.3323D-03, 0.4050D-03, 0.4952D-03, & + & 0.6079D-03, 0.7506D-03, 0.9342D-03, 0.1175D-02, 0.1500D-02, & + & 0.1948D-02, 0.2582D-02, 0.3494D-02, 0.4813D-02, 0.6696D-02, & + & 0.9276D-02, 0.1255D-01, 0.1623D-01, 0.1956D-01, 0.2150D-01, & + & 0.2122D-01, 0.1870D-01, 0.1484D-01, 0.1085D-01, 0.7583D-02, & + & 0.5254D-02, 0.3705D-02, 0.2674D-02, 0.1958D-02, 0.1439D-02, & + & 0.1054D-02, 0.7605D-03, 0.5451D-03, 0.3902D-03, 0.2743D-03, & + & 0.1917D-03, 0.1316D-03, 0.9125D-04, 0.6188D-04, 0.4216D-04, & + & 0.3112D-04, 0.2148D-04, 0.1279D-04, 0.1140D-04, 0.3796D-05, & + & 0.3154D-05, 0.2717D-05, 0.2418D-05, 0.2215D-05, 0.2077D-05, & + & 0.1983D-05, 0.1919D-05, 0.1875D-05, 0.1845D-05, 0.1825D-05, & + & 0.1811D-05/ + + data (calcpts(j,24), j = 1,neta) /0.8413D-05, 0.1019D-04, & + & 0.1235D-04, 0.1496D-04, 0.1813D-04, 0.2196D-04, 0.2661D-04, & + & 0.3224D-04, 0.3905D-04, 0.4732D-04, 0.5734D-04, 0.6948D-04, & + & 0.8420D-04, 0.1020D-03, 0.1237D-03, 0.1500D-03, 0.1819D-03, & + & 0.2207D-03, 0.2680D-03, 0.3259D-03, 0.3968D-03, 0.4842D-03, & + & 0.5930D-03, 0.7296D-03, 0.9037D-03, 0.1130D-02, 0.1429D-02, & + & 0.1837D-02, 0.2406D-02, 0.3215D-02, 0.4381D-02, 0.6047D-02, & + & 0.8359D-02, 0.1138D-01, 0.1491D-01, 0.1838D-01, 0.2084D-01, & + & 0.2132D-01, 0.1945D-01, 0.1584D-01, 0.1168D-01, 0.8046D-02, & + & 0.5399D-02, 0.3674D-02, 0.2589D-02, 0.1882D-02, 0.1394D-02, & + & 0.1027D-02, 0.7572D-03, 0.5472D-03, 0.3965D-03, 0.2795D-03, & + & 0.1985D-03, 0.1375D-03, 0.9440D-04, 0.6770D-04, 0.4313D-04, & + & 0.3334D-04, 0.2454D-04, 0.1643D-04, 0.8770D-05, 0.8095D-05, & + & 0.7637D-05, 0.6570D-06, 0.4437D-06, 0.2984D-06, 0.1995D-06, & + & 0.1320D-06, 0.8611D-07, 0.5480D-07, 0.3347D-07, 0.1894D-07, & + & 0.9044D-08/ + + data (calcpts(j,25), j = 1,neta) /0.7746D-05, 0.9385D-05, & + & 0.1137D-04, 0.1377D-04, 0.1669D-04, 0.2022D-04, 0.2450D-04, & + & 0.2968D-04, 0.3595D-04, 0.4356D-04, 0.5279D-04, 0.6396D-04, & + & 0.7750D-04, 0.9393D-04, 0.1138D-03, 0.1380D-03, 0.1673D-03, & + & 0.2030D-03, 0.2464D-03, 0.2993D-03, 0.3640D-03, 0.4435D-03, & + & 0.5418D-03, 0.6644D-03, 0.8191D-03, 0.1017D-02, 0.1276D-02, & + & 0.1623D-02, 0.2097D-02, 0.2763D-02, 0.3711D-02, 0.5062D-02, & + & 0.6951D-02, 0.9470D-02, 0.1255D-01, 0.1582D-01, 0.1854D-01, & + & 0.1980D-01, 0.1897D-01, 0.1619D-01, 0.1236D-01, 0.8615D-02, & + & 0.5685D-02, 0.3727D-02, 0.2527D-02, 0.1798D-02, 0.1322D-02, & + & 0.9898D-03, 0.7401D-03, 0.5472D-03, 0.3930D-03, 0.2873D-03, & + & 0.2008D-03, 0.1385D-03, 0.9903D-04, 0.6815D-04, 0.4528D-04, & + & 0.2999D-04, 0.2199D-04, 0.1441D-04, 0.1379D-04, 0.6702D-05, & + & 0.6414D-05, 0.6217D-05, -.5833D-06, -.6745D-06, -.7366D-06, & + & -.7790D-06, -.8078D-06, -.8274D-06, -.8408D-06, -.8499D-06, & + & -.8561D-06/ + + data (calcpts(j,26), j = 1,neta) /0.6715D-05, 0.8136D-05, & + & 0.9855D-05, 0.1194D-04, 0.1447D-04, 0.1753D-04, 0.2123D-04, & + & 0.2573D-04, 0.3117D-04, 0.3776D-04, 0.4576D-04, 0.5544D-04, & + & 0.6718D-04, 0.8141D-04, 0.9864D-04, 0.1196D-03, 0.1450D-03, & + & 0.1758D-03, 0.2132D-03, 0.2589D-03, 0.3145D-03, 0.3827D-03, & + & 0.4666D-03, 0.5705D-03, 0.7003D-03, 0.8648D-03, 0.1076D-02, & + & 0.1354D-02, 0.1727D-02, 0.2241D-02, 0.2960D-02, 0.3976D-02, & + & 0.5397D-02, 0.7320D-02, 0.9753D-02, 0.1251D-01, 0.1514D-01, & + & 0.1691D-01, 0.1715D-01, 0.1558D-01, 0.1263D-01, 0.9184D-02, & + & 0.6147D-02, 0.3950D-02, 0.2568D-02, 0.1754D-02, 0.1266D-02, & + & 0.9457D-03, 0.7134D-03, 0.5339D-03, 0.3943D-03, 0.2873D-03, & + & 0.2062D-03, 0.1459D-03, 0.1026D-03, 0.7161D-04, 0.5138D-04, & + & 0.3698D-04, 0.2292D-04, 0.1576D-04, 0.8751D-05, 0.8521D-05, & + & 0.1697D-05, 0.1590D-05, 0.1517D-05, 0.1467D-05, 0.1433D-05, & + & 0.1410D-05, 0.1394D-05, 0.1384D-05, 0.1376D-05, 0.1371D-05, & + & 0.1368D-05/ + + data (calcpts(j,27), j = 1,neta) /0.5527D-05, 0.6697D-05, & + & 0.8112D-05, 0.9828D-05, 0.1191D-04, 0.1443D-04, 0.1748D-04, & + & 0.2118D-04, 0.2565D-04, 0.3108D-04, 0.3766D-04, 0.4563D-04, & + & 0.5529D-04, 0.6700D-04, 0.8117D-04, 0.9838D-04, 0.1193D-03, & + & 0.1446D-03, 0.1753D-03, 0.2127D-03, 0.2582D-03, 0.3138D-03, & + & 0.3820D-03, 0.4658D-03, 0.5698D-03, 0.7001D-03, 0.8652D-03, & + & 0.1078D-02, 0.1359D-02, 0.1736D-02, 0.2254D-02, 0.2975D-02, & + & 0.3975D-02, 0.5336D-02, 0.7100D-02, 0.9208D-02, 0.1142D-01, & + & 0.1330D-01, 0.1427D-01, 0.1389D-01, 0.1213D-01, 0.9453D-02, & + & 0.6646D-02, 0.4334D-02, 0.2749D-02, 0.1791D-02, 0.1239D-02, & + & 0.9080D-03, 0.6858D-03, 0.5201D-03, 0.3907D-03, 0.2893D-03, & + & 0.2107D-03, 0.1511D-03, 0.1076D-03, 0.7520D-04, 0.5248D-04, & + & 0.3666D-04, 0.2566D-04, 0.1810D-04, 0.1261D-04, 0.8501D-05, & + & 0.6429D-05, 0.4380D-05, 0.3013D-05, 0.2324D-05, 0.1642D-05, & + & 0.1631D-05, 0.9573D-06, 0.9524D-06, 0.9491D-06, 0.9468D-06, & + & 0.9452D-06/ + + data (calcpts(j,28), j = 1,neta) /0.4356D-05, 0.5278D-05, & + & 0.6393D-05, 0.7746D-05, 0.9385D-05, 0.1137D-04, 0.1377D-04, & + & 0.1669D-04, 0.2022D-04, 0.2450D-04, 0.2968D-04, 0.3596D-04, & + & 0.4357D-04, 0.5279D-04, 0.6396D-04, 0.7751D-04, 0.9394D-04, & + & 0.1139D-03, 0.1380D-03, 0.1674D-03, 0.2031D-03, 0.2466D-03, & + & 0.2997D-03, 0.3648D-03, 0.4450D-03, 0.5445D-03, 0.6690D-03, & + & 0.8273D-03, 0.1031D-02, 0.1300D-02, 0.1660D-02, 0.2150D-02, & + & 0.2822D-02, 0.3731D-02, 0.4925D-02, 0.6402D-02, 0.8068D-02, & + & 0.9700D-02, 0.1093D-01, 0.1138D-01, 0.1074D-01, 0.9100D-02, & + & 0.6902D-02, 0.4741D-02, 0.3044D-02, 0.1922D-02, 0.1261D-02, & + & 0.8844D-03, 0.6548D-03, 0.4977D-03, 0.3789D-03, 0.2847D-03, & + & 0.2103D-03, 0.1528D-03, 0.1097D-03, 0.7798D-04, 0.5441D-04, & + & 0.3824D-04, 0.2613D-04, 0.1806D-04, 0.1267D-04, 0.8635D-05, & + & 0.5944D-05, 0.3927D-05, 0.3250D-05, 0.1909D-05, 0.1237D-05, & + & 0.1233D-05, 0.5641D-06, 0.5624D-06, 0.5613D-06, 0.5605D-06, & + & 0.5600D-06/ + + data (calcpts(j,29), j = 1,neta) /0.3316D-05, 0.4017D-05, & + & 0.4866D-05, 0.5896D-05, 0.7143D-05, 0.8654D-05, 0.1048D-04, & + & 0.1270D-04, 0.1539D-04, 0.1864D-04, 0.2259D-04, 0.2737D-04, & + & 0.3316D-04, 0.4018D-04, 0.4868D-04, 0.5898D-04, 0.7148D-04, & + & 0.8663D-04, 0.1050D-03, 0.1273D-03, 0.1544D-03, 0.1873D-03, & + & 0.2274D-03, 0.2764D-03, 0.3363D-03, 0.4102D-03, 0.5017D-03, & + & 0.6164D-03, 0.7619D-03, 0.9490D-03, 0.1194D-02, 0.1520D-02, & + & 0.1957D-02, 0.2541D-02, 0.3310D-02, 0.4278D-02, 0.5426D-02, & + & 0.6659D-02, 0.7797D-02, 0.8574D-02, 0.8706D-02, 0.8034D-02, & + & 0.6662D-02, 0.4955D-02, 0.3351D-02, 0.2133D-02, 0.1347D-02, & + & 0.8913D-03, 0.6316D-03, 0.4717D-03, 0.3603D-03, 0.2743D-03, & + & 0.2056D-03, 0.1516D-03, 0.1102D-03, 0.7889D-04, 0.5555D-04, & + & 0.3887D-04, 0.2687D-04, 0.1887D-04, 0.1287D-04, 0.8864D-05, & + & 0.6196D-05, 0.4195D-05, 0.2861D-05, 0.1528D-05, 0.8609D-06, & + & 0.8608D-06, 0.1940D-06, 0.1939D-06, 0.1939D-06, 0.1938D-06, & + & 0.1938D-06/ + + data (calcpts(j,30), j = 1,neta) /0.2456D-05, 0.2976D-05, & + & 0.3605D-05, 0.4368D-05, 0.5292D-05, 0.6411D-05, 0.7767D-05, & + & 0.9411D-05, 0.1140D-04, 0.1381D-04, 0.1674D-04, 0.2027D-04, & + & 0.2456D-04, 0.2976D-04, 0.3606D-04, 0.4369D-04, 0.5294D-04, & + & 0.6415D-04, 0.7774D-04, 0.9423D-04, 0.1142D-03, 0.1385D-03, & + & 0.1680D-03, 0.2040D-03, 0.2478D-03, 0.3016D-03, 0.3675D-03, & + & 0.4493D-03, 0.5515D-03, 0.6804D-03, 0.8454D-03, 0.1060D-02, & + & 0.1340D-02, 0.1708D-02, 0.2186D-02, 0.2794D-02, 0.3532D-02, & + & 0.4376D-02, 0.5249D-02, 0.6019D-02, 0.6490D-02, 0.6471D-02, & + & 0.5869D-02, 0.4789D-02, 0.3513D-02, 0.2351D-02, 0.1490D-02, & + & 0.9437D-03, 0.6290D-03, 0.4496D-03, 0.3378D-03, 0.2583D-03, & + & 0.1967D-03, 0.1476D-03, 0.1085D-03, 0.7861D-04, 0.5603D-04, & + & 0.3942D-04, 0.2812D-04, 0.1948D-04, 0.1350D-04, 0.9509D-05, & + & 0.6184D-05, 0.4190D-05, 0.2860D-05, 0.2196D-05, 0.1531D-05, & + & 0.8655D-06, 0.8663D-06, 0.2002D-06, 0.2006D-06, 0.2009D-06, & + & 0.2010D-06/ + + data (calcpts(j,31), j = 1,neta) /0.1782D-05, 0.2159D-05, & + & 0.2615D-05, 0.3168D-05, 0.3839D-05, 0.4650D-05, 0.5634D-05, & + & 0.6826D-05, 0.8269D-05, 0.1002D-04, 0.1214D-04, 0.1471D-04, & + & 0.1782D-04, 0.2159D-04, 0.2615D-04, 0.3169D-04, 0.3839D-04, & + & 0.4652D-04, 0.5637D-04, 0.6831D-04, 0.8278D-04, 0.1003D-03, & + & 0.1217D-03, 0.1476D-03, 0.1791D-03, 0.2175D-03, 0.2644D-03, & + & 0.3220D-03, 0.3931D-03, 0.4814D-03, 0.5922D-03, 0.7325D-03, & + & 0.9115D-03, 0.1141D-02, 0.1435D-02, 0.1805D-02, 0.2259D-02, & + & 0.2796D-02, 0.3394D-02, 0.3997D-02, 0.4507D-02, 0.4786D-02, & + & 0.4704D-02, 0.4211D-02, 0.3395D-02, 0.2465D-02, 0.1639D-02, & + & 0.1036D-02, 0.6582D-03, 0.4417D-03, 0.3174D-03, 0.2395D-03, & + & 0.1833D-03, 0.1396D-03, 0.1045D-03, 0.7664D-04, 0.5541D-04, & + & 0.3948D-04, 0.2819D-04, 0.1956D-04, 0.1358D-04, 0.9596D-05, & + & 0.6273D-05, 0.4280D-05, 0.2951D-05, 0.2288D-05, 0.1623D-05, & + & 0.9582D-06, 0.9592D-06, 0.2932D-06, 0.2937D-06, 0.2940D-06, & + & 0.2942D-06/ + + data (calcpts(j,32), j = 1,neta) /0.1272D-05, 0.1541D-05, & + & 0.1866D-05, 0.2261D-05, 0.2740D-05, 0.3319D-05, 0.4021D-05, & + & 0.4872D-05, 0.5902D-05, 0.7150D-05, 0.8664D-05, 0.1050D-04, & + & 0.1272D-04, 0.1541D-04, 0.1866D-04, 0.2261D-04, 0.2740D-04, & + & 0.3320D-04, 0.4022D-04, 0.4874D-04, 0.5904D-04, 0.7155D-04, & + & 0.8673D-04, 0.1051D-03, 0.1274D-03, 0.1546D-03, 0.1876D-03, & + & 0.2278D-03, 0.2770D-03, 0.3373D-03, 0.4117D-03, 0.5039D-03, & + & 0.6187D-03, 0.7624D-03, 0.9419D-03, 0.1164D-02, 0.1437D-02, & + & 0.1763D-02, 0.2141D-02, 0.2555D-02, 0.2964D-02, 0.3298D-02, & + & 0.3459D-02, 0.3363D-02, 0.2980D-02, 0.2382D-02, 0.1717D-02, & + & 0.1136D-02, 0.7172D-03, 0.4566D-03, 0.3082D-03, 0.2229D-03, & + & 0.1680D-03, 0.1290D-03, 0.9783D-04, 0.7330D-04, 0.5406D-04, & + & 0.3879D-04, 0.2751D-04, 0.1953D-04, 0.1356D-04, 0.9569D-05, & + & 0.6245D-05, 0.4252D-05, 0.2923D-05, 0.2259D-05, 0.1594D-05, & + & 0.9291D-06, 0.2634D-06, 0.2640D-06, 0.2645D-06, 0.2648D-06, & + & 0.2650D-06/ + + data (calcpts(j,33), j = 1,neta) /0.8970D-06, 0.1087D-05, & + & 0.1317D-05, 0.1595D-05, 0.1933D-05, 0.2341D-05, 0.2837D-05, & + & 0.3437D-05, 0.4163D-05, 0.5044D-05, 0.6112D-05, 0.7404D-05, & + & 0.8970D-05, 0.1087D-04, 0.1317D-04, 0.1595D-04, 0.1933D-04, & + & 0.2341D-04, 0.2837D-04, 0.3437D-04, 0.4163D-04, 0.5045D-04, & + & 0.6112D-04, 0.7405D-04, 0.8972D-04, 0.1087D-03, 0.1317D-03, & + & 0.1597D-03, 0.1936D-03, 0.2347D-03, 0.2848D-03, 0.3457D-03, & + & 0.4200D-03, 0.5106D-03, 0.6210D-03, 0.7547D-03, 0.9159D-03, & + & 0.1109D-02, 0.1336D-02, 0.1597D-02, 0.1879D-02, 0.2154D-02, & + & 0.2370D-02, 0.2463D-02, 0.2373D-02, 0.2087D-02, 0.1657D-02, & + & 0.1189D-02, 0.7842D-03, 0.4950D-03, 0.3161D-03, 0.2139D-03, & + & 0.1556D-03, 0.1179D-03, 0.9002D-04, 0.6880D-04, 0.5155D-04, & + & 0.3760D-04, 0.2763D-04, 0.1966D-04, 0.1368D-04, 0.9687D-05, & + & 0.7028D-05, 0.5033D-05, 0.3036D-05, 0.2372D-05, 0.1707D-05, & + & 0.1042D-05, 0.1042D-05, 0.3762D-06, 0.3766D-06, 0.3768D-06, & + & 0.3770D-06/ + + data (calcpts(j,34), j = 1,neta) /0.6268D-06, 0.7595D-06, & + & 0.9200D-06, 0.1115D-05, 0.1351D-05, 0.1636D-05, 0.1982D-05, & + & 0.2402D-05, 0.2909D-05, 0.3525D-05, 0.4271D-05, 0.5174D-05, & + & 0.6268D-05, 0.7595D-05, 0.9200D-05, 0.1115D-04, 0.1350D-04, & + & 0.1636D-04, 0.1982D-04, 0.2401D-04, 0.2908D-04, 0.3523D-04, & + & 0.4268D-04, 0.5169D-04, 0.6260D-04, 0.7581D-04, 0.9176D-04, & + & 0.1110D-03, 0.1343D-03, 0.1624D-03, 0.1961D-03, 0.2367D-03, & + & 0.2851D-03, 0.3429D-03, 0.4115D-03, 0.4925D-03, 0.5880D-03, & + & 0.7006D-03, 0.8336D-03, 0.9893D-03, 0.1167D-02, 0.1358D-02, & + & 0.1540D-02, 0.1681D-02, 0.1733D-02, 0.1659D-02, 0.1450D-02, & + & 0.1146D-02, 0.8190D-03, 0.5392D-03, 0.3403D-03, 0.2178D-03, & + & 0.1480D-03, 0.1076D-03, 0.8157D-04, 0.6259D-04, 0.4758D-04, & + & 0.3556D-04, 0.2612D-04, 0.1887D-04, 0.1348D-04, 0.9490D-05, & + & 0.6696D-05, 0.4633D-05, 0.3236D-05, 0.2238D-05, 0.1572D-05, & + & 0.1106D-05, 0.7737D-06, 0.5075D-06, 0.3744D-06, 0.3079D-06, & + & 0.1747D-06/ + + data (calcpts(j,35), j = 1,neta) /0.4350D-06, 0.5271D-06, & + & 0.6385D-06, 0.7736D-06, 0.9373D-06, 0.1136D-05, 0.1376D-05, & + & 0.1667D-05, 0.2019D-05, 0.2446D-05, 0.2964D-05, 0.3591D-05, & + & 0.4350D-05, 0.5271D-05, 0.6385D-05, 0.7735D-05, 0.9372D-05, & + & 0.1135D-04, 0.1375D-04, 0.1666D-04, 0.2018D-04, 0.2445D-04, & + & 0.2961D-04, 0.3585D-04, 0.4340D-04, 0.5253D-04, 0.6354D-04, & + & 0.7681D-04, 0.9277D-04, 0.1119D-03, 0.1347D-03, 0.1618D-03, & + & 0.1937D-03, 0.2310D-03, 0.2742D-03, 0.3239D-03, 0.3809D-03, & + & 0.4467D-03, 0.5232D-03, 0.6132D-03, 0.7186D-03, 0.8385D-03, & + & 0.9666D-03, 0.1088D-02, 0.1179D-02, 0.1209D-02, 0.1152D-02, & + & 0.1002D-02, 0.7892D-03, 0.5624D-03, 0.3697D-03, 0.2333D-03, & + & 0.1496D-03, 0.1018D-03, 0.7418D-04, 0.5625D-04, 0.4316D-04, & + & 0.3279D-04, 0.2447D-04, 0.1795D-04, 0.1296D-04, 0.9234D-05, & + & 0.6505D-05, 0.4508D-05, 0.3110D-05, 0.2178D-05, 0.1446D-05, & + & 0.9797D-06, 0.6468D-06, 0.4471D-06, 0.3140D-06, 0.1808D-06, & + & 0.1142D-06/ + + data (calcpts(j,36), j = 1,neta) /0.3005D-06, 0.3641D-06, & + & 0.4410D-06, 0.5343D-06, 0.6474D-06, 0.7844D-06, 0.9503D-06, & + & 0.1151D-05, 0.1395D-05, 0.1690D-05, 0.2047D-05, 0.2480D-05, & + & 0.3005D-05, 0.3641D-05, 0.4410D-05, 0.5343D-05, 0.6473D-05, & + & 0.7842D-05, 0.9500D-05, 0.1151D-04, 0.1394D-04, 0.1688D-04, & + & 0.2044D-04, 0.2475D-04, 0.2996D-04, 0.3624D-04, 0.4381D-04, & + & 0.5293D-04, 0.6385D-04, 0.7688D-04, 0.9234D-04, 0.1105D-03, & + & 0.1317D-03, 0.1561D-03, 0.1837D-03, 0.2147D-03, 0.2492D-03, & + & 0.2879D-03, 0.3319D-03, 0.3831D-03, 0.4434D-03, 0.5142D-03, & + & 0.5948D-03, 0.6807D-03, 0.7617D-03, 0.8210D-03, 0.8378D-03, & + & 0.7949D-03, 0.6898D-03, 0.5417D-03, 0.3854D-03, 0.2531D-03, & + & 0.1597D-03, 0.1025D-03, 0.6996D-04, 0.5100D-04, 0.3870D-04, & + & 0.2972D-04, 0.2253D-04, 0.1688D-04, 0.1235D-04, 0.8956D-05, & + & 0.6359D-05, 0.4494D-05, 0.3096D-05, 0.2163D-05, 0.1497D-05, & + & 0.1031D-05, 0.6979D-06, 0.4981D-06, 0.2982D-06, 0.2317D-06, & + & 0.1651D-06/ + + data (calcpts(j,37), j = 1,neta) /0.2068D-06, 0.2505D-06, & + & 0.3035D-06, 0.3677D-06, 0.4455D-06, 0.5397D-06, 0.6539D-06, & + & 0.7923D-06, 0.9597D-06, 0.1163D-05, 0.1409D-05, 0.1707D-05, & + & 0.2068D-05, 0.2505D-05, 0.3035D-05, 0.3677D-05, 0.4454D-05, & + & 0.5396D-05, 0.6537D-05, 0.7918D-05, 0.9589D-05, 0.1161D-04, & + & 0.1406D-04, 0.1703D-04, 0.2060D-04, 0.2492D-04, 0.3011D-04, & + & 0.3636D-04, 0.4383D-04, 0.5271D-04, 0.6320D-04, 0.7547D-04, & + & 0.8960D-04, 0.1057D-03, 0.1236D-03, 0.1432D-03, 0.1645D-03, & + & 0.1875D-03, 0.2130D-03, 0.2420D-03, 0.2759D-03, 0.3161D-03, & + & 0.3636D-03, 0.4177D-03, 0.4753D-03, 0.5293D-03, 0.5682D-03, & + & 0.5779D-03, 0.5467D-03, 0.4734D-03, 0.3711D-03, 0.2636D-03, & + & 0.1730D-03, 0.1092D-03, 0.7015D-04, 0.4791D-04, 0.3500D-04, & + & 0.2655D-04, 0.2036D-04, 0.1550D-04, 0.1157D-04, 0.8508D-05, & + & 0.6110D-05, 0.4379D-05, 0.3046D-05, 0.2114D-05, 0.1514D-05, & + & 0.1048D-05, 0.7145D-06, 0.5147D-06, 0.3148D-06, 0.2482D-06, & + & 0.1816D-06/ + + data (calcpts(j,38), j = 1,neta) /0.1419D-06, 0.1719D-06, & + & 0.2082D-06, 0.2523D-06, 0.3057D-06, 0.3703D-06, 0.4487D-06, & + & 0.5436D-06, 0.6585D-06, 0.7978D-06, 0.9667D-06, 0.1171D-05, & + & 0.1419D-05, 0.1719D-05, 0.2082D-05, 0.2523D-05, 0.3056D-05, & + & 0.3702D-05, 0.4485D-05, 0.5433D-05, 0.6579D-05, 0.7968D-05, & + & 0.9649D-05, 0.1168D-04, 0.1413D-04, 0.1709D-04, 0.2065D-04, & + & 0.2492D-04, 0.3002D-04, 0.3607D-04, 0.4320D-04, 0.5149D-04, & + & 0.6098D-04, 0.7165D-04, 0.8339D-04, 0.9600D-04, 0.1093D-03, & + & 0.1234D-03, 0.1383D-03, 0.1548D-03, 0.1737D-03, 0.1960D-03, & + & 0.2228D-03, 0.2547D-03, 0.2911D-03, 0.3297D-03, 0.3658D-03, & + & 0.3915D-03, 0.3972D-03, 0.3750D-03, 0.3241D-03, 0.2537D-03, & + & 0.1801D-03, 0.1181D-03, 0.7455D-04, 0.4790D-04, 0.3279D-04, & + & 0.2393D-04, 0.1820D-04, 0.1394D-04, 0.1061D-04, 0.7880D-05, & + & 0.5815D-05, 0.4149D-05, 0.2950D-05, 0.2084D-05, 0.1417D-05, & + & 0.1017D-05, 0.6842D-06, 0.2843D-06, 0.2844D-06, 0.2178D-06, & + & 0.1512D-06/ + + data (calcpts(j,39), j = 1,neta) /0.9721D-07, 0.1178D-06, & + & 0.1427D-06, 0.1729D-06, 0.2094D-06, 0.2537D-06, 0.3074D-06, & + & 0.3724D-06, 0.4511D-06, 0.5466D-06, 0.6623D-06, 0.8023D-06, & + & 0.9720D-06, 0.1178D-05, 0.1427D-05, 0.1728D-05, 0.2094D-05, & + & 0.2537D-05, 0.3073D-05, 0.3722D-05, 0.4507D-05, 0.5459D-05, & + & 0.6610D-05, 0.8000D-05, 0.9679D-05, 0.1170D-04, 0.1414D-04, & + & 0.1705D-04, 0.2054D-04, 0.2466D-04, 0.2951D-04, 0.3513D-04, & + & 0.4153D-04, 0.4867D-04, 0.5644D-04, 0.6466D-04, 0.7316D-04, & + & 0.8184D-04, 0.9078D-04, 0.1003D-03, 0.1108D-03, 0.1231D-03, & + & 0.1379D-03, 0.1558D-03, 0.1771D-03, 0.2016D-03, 0.2277D-03, & + & 0.2518D-03, 0.2689D-03, 0.2724D-03, 0.2567D-03, 0.2216D-03, & + & 0.1733D-03, 0.1230D-03, 0.8063D-04, 0.5093D-04, 0.3276D-04, & + & 0.2239D-04, 0.1640D-04, 0.1247D-04, 0.9535D-05, 0.7270D-05, & + & 0.5404D-05, 0.4005D-05, 0.2872D-05, 0.2072D-05, 0.1473D-05, & + & 0.1006D-05, 0.7395D-06, 0.4729D-06, 0.3396D-06, 0.2730D-06, & + & 0.2064D-06/ + + data (calcpts(j,40), j = 1,neta) /0.6647D-07, 0.8054D-07, & + & 0.9756D-07, 0.1182D-06, 0.1432D-06, 0.1735D-06, 0.2102D-06, & + & 0.2547D-06, 0.3085D-06, 0.3738D-06, 0.4529D-06, 0.5486D-06, & + & 0.6647D-06, 0.8053D-06, 0.9755D-06, 0.1182D-05, 0.1432D-05, & + & 0.1734D-05, 0.2101D-05, 0.2545D-05, 0.3082D-05, 0.3732D-05, & + & 0.4519D-05, 0.5470D-05, 0.6617D-05, 0.8001D-05, 0.9662D-05, & + & 0.1166D-04, 0.1403D-04, 0.1684D-04, 0.2014D-04, 0.2395D-04, & + & 0.2828D-04, 0.3308D-04, 0.3826D-04, 0.4367D-04, 0.4917D-04, & + & 0.5464D-04, 0.6008D-04, 0.6564D-04, 0.7160D-04, 0.7835D-04, & + & 0.8637D-04, 0.9616D-04, 0.1081D-03, 0.1225D-03, 0.1390D-03, & + & 0.1566D-03, 0.1729D-03, 0.1843D-03, 0.1864D-03, 0.1755D-03, & + & 0.1513D-03, 0.1183D-03, 0.8387D-04, 0.5499D-04, 0.3474D-04, & + & 0.2235D-04, 0.1530D-04, 0.1119D-04, 0.8507D-05, 0.6528D-05, & + & 0.4955D-05, 0.3703D-05, 0.2716D-05, 0.1963D-05, 0.1397D-05, & + & 0.9834D-06, 0.6902D-06, 0.4835D-06, 0.3369D-06, 0.2303D-06, & + & 0.1636D-06/ + + data (calcpts(j,41), j = 1,neta) /0.4540D-07, 0.5501D-07, & + & 0.6663D-07, 0.8073D-07, 0.9782D-07, 0.1185D-06, 0.1436D-06, & + & 0.1740D-06, 0.2107D-06, 0.2553D-06, 0.3093D-06, 0.3747D-06, & + & 0.4540D-06, 0.5501D-06, 0.6663D-06, 0.8072D-06, 0.9780D-06, & + & 0.1185D-05, 0.1435D-05, 0.1738D-05, 0.2105D-05, 0.2549D-05, & + & 0.3087D-05, 0.3736D-05, 0.4519D-05, 0.5464D-05, 0.6598D-05, & + & 0.7957D-05, 0.9578D-05, 0.1149D-04, 0.1374D-04, 0.1633D-04, & + & 0.1926D-04, 0.2250D-04, 0.2597D-04, 0.2956D-04, 0.3316D-04, & + & 0.3667D-04, 0.4005D-04, 0.4337D-04, 0.4679D-04, 0.5052D-04, & + & 0.5486D-04, 0.6013D-04, 0.6665D-04, 0.7469D-04, 0.8439D-04, & + & 0.9556D-04, 0.1074D-03, 0.1184D-03, 0.1261D-03, 0.1274D-03, & + & 0.1198D-03, 0.1033D-03, 0.8069D-04, 0.5719D-04, 0.3748D-04, & + & 0.2367D-04, 0.1524D-04, 0.1043D-04, 0.7626D-05, 0.5800D-05, & + & 0.4447D-05, 0.3374D-05, 0.2521D-05, 0.1848D-05, 0.1328D-05, & + & 0.9483D-06, 0.6683D-06, 0.4617D-06, 0.3217D-06, 0.2217D-06, & + & 0.1484D-06/ + + data (calcpts(j,42), j = 1,neta) /0.3100D-07, 0.3755D-07, & + & 0.4549D-07, 0.5512D-07, 0.6678D-07, 0.8090D-07, 0.9801D-07, & + & 0.1188D-06, 0.1439D-06, 0.1743D-06, 0.2112D-06, 0.2558D-06, & + & 0.3099D-06, 0.3755D-06, 0.4549D-06, 0.5511D-06, 0.6677D-06, & + & 0.8088D-06, 0.9797D-06, 0.1187D-05, 0.1437D-05, 0.1740D-05, & + & 0.2107D-05, 0.2550D-05, 0.3085D-05, 0.3729D-05, 0.4503D-05, & + & 0.5431D-05, 0.6536D-05, 0.7841D-05, 0.9368D-05, 0.1113D-04, & + & 0.1312D-04, 0.1531D-04, 0.1765D-04, 0.2005D-04, 0.2243D-04, & + & 0.2471D-04, 0.2685D-04, 0.2888D-04, 0.3088D-04, 0.3297D-04, & + & 0.3533D-04, 0.3814D-04, 0.4162D-04, 0.4599D-04, 0.5141D-04, & + & 0.5796D-04, 0.6552D-04, 0.7356D-04, 0.8100D-04, 0.8616D-04, & + & 0.8698D-04, 0.8179D-04, 0.7046D-04, 0.5502D-04, 0.3899D-04, & + & 0.2555D-04, 0.1615D-04, 0.1039D-04, 0.7120D-05, 0.5207D-05, & + & 0.3961D-05, 0.3035D-05, 0.2308D-05, 0.1722D-05, 0.1262D-05, & + & 0.9083D-06, 0.6484D-06, 0.4550D-06, 0.3217D-06, 0.2217D-06, & + & 0.1551D-06/ + + data (calcpts(j,43), j = 1,neta) /0.2115D-07, 0.2562D-07, & + & 0.3104D-07, 0.3760D-07, 0.4556D-07, 0.5520D-07, 0.6687D-07, & + & 0.8102D-07, 0.9814D-07, 0.1189D-06, 0.1441D-06, 0.1745D-06, & + & 0.2115D-06, 0.2562D-06, 0.3103D-06, 0.3760D-06, 0.4555D-06, & + & 0.5518D-06, 0.6684D-06, 0.8097D-06, 0.9804D-06, 0.1187D-05, & + & 0.1438D-05, 0.1740D-05, 0.2105D-05, 0.2544D-05, 0.3072D-05, & + & 0.3704D-05, 0.4457D-05, 0.5347D-05, 0.6387D-05, 0.7585D-05, & + & 0.8936D-05, 0.1042D-04, 0.1200D-04, 0.1362D-04, 0.1520D-04, & + & 0.1670D-04, 0.1808D-04, 0.1934D-04, 0.2054D-04, 0.2173D-04, & + & 0.2303D-04, 0.2453D-04, 0.2637D-04, 0.2869D-04, 0.3162D-04, & + & 0.3529D-04, 0.3972D-04, 0.4485D-04, 0.5030D-04, 0.5534D-04, & + & 0.5882D-04, 0.5935D-04, 0.5579D-04, 0.4805D-04, 0.3751D-04, & + & 0.2657D-04, 0.1742D-04, 0.1101D-04, 0.7086D-05, 0.4853D-05, & + & 0.3553D-05, 0.2700D-05, 0.2073D-05, 0.1573D-05, 0.1167D-05, & + & 0.8600D-06, 0.6200D-06, 0.4400D-06, 0.3134D-06, 0.2201D-06, & + & 0.1534D-06/ + + data (calcpts(j,44), j = 1,neta) /0.1442D-07, 0.1747D-07, & + & 0.2116D-07, 0.2564D-07, 0.3107D-07, 0.3764D-07, 0.4560D-07, & + & 0.5525D-07, 0.6692D-07, 0.8108D-07, 0.9824D-07, 0.1190D-06, & + & 0.1442D-06, 0.1747D-06, 0.2116D-06, 0.2564D-06, 0.3106D-06, & + & 0.3763D-06, 0.4558D-06, 0.5521D-06, 0.6685D-06, 0.8096D-06, & + & 0.9802D-06, 0.1186D-05, 0.1435D-05, 0.1735D-05, 0.2094D-05, & + & 0.2525D-05, 0.3039D-05, 0.3645D-05, 0.4353D-05, 0.5168D-05, & + & 0.6086D-05, 0.7095D-05, 0.8165D-05, 0.9254D-05, 0.1032D-04, & + & 0.1131D-04, 0.1221D-04, 0.1301D-04, 0.1374D-04, 0.1444D-04, & + & 0.1516D-04, 0.1597D-04, 0.1694D-04, 0.1816D-04, 0.1971D-04, & + & 0.2169D-04, 0.2416D-04, 0.2718D-04, 0.3065D-04, 0.3435D-04, & + & 0.3778D-04, 0.4014D-04, 0.4048D-04, 0.3803D-04, 0.3275D-04, & + & 0.2556D-04, 0.1811D-04, 0.1187D-04, 0.7499D-05, 0.4826D-05, & + & 0.3306D-05, 0.2419D-05, 0.1840D-05, 0.1413D-05, 0.1073D-05, & + & 0.7996D-06, 0.5863D-06, 0.4197D-06, 0.2997D-06, 0.2130D-06, & + & 0.1463D-06/ + + data (calcpts(j,45), j = 1,neta) /0.9834D-08, 0.1192D-07, & + & 0.1443D-07, 0.1749D-07, 0.2119D-07, 0.2567D-07, 0.3110D-07, & + & 0.3768D-07, 0.4564D-07, 0.5530D-07, 0.6700D-07, 0.8117D-07, & + & 0.9834D-07, 0.1191D-06, 0.1443D-06, 0.1748D-06, 0.2118D-06, & + & 0.2566D-06, 0.3108D-06, 0.3765D-06, 0.4559D-06, 0.5521D-06, & + & 0.6685D-06, 0.8090D-06, 0.9786D-06, 0.1183D-05, 0.1428D-05, & + & 0.1722D-05, 0.2072D-05, 0.2485D-05, 0.2968D-05, 0.3523D-05, & + & 0.4148D-05, 0.4833D-05, 0.5559D-05, 0.6296D-05, 0.7012D-05, & + & 0.7676D-05, 0.8269D-05, 0.8788D-05, 0.9244D-05, 0.9661D-05, & + & 0.1007D-04, 0.1051D-04, 0.1102D-04, 0.1166D-04, 0.1247D-04, & + & 0.1351D-04, 0.1485D-04, 0.1653D-04, 0.1857D-04, 0.2094D-04, & + & 0.2345D-04, 0.2578D-04, 0.2738D-04, 0.2760D-04, 0.2593D-04, & + & 0.2233D-04, 0.1743D-04, 0.1234D-04, 0.8090D-05, 0.5112D-05, & + & 0.3293D-05, 0.2254D-05, 0.1654D-05, 0.1254D-05, 0.9610D-06, & + & 0.7277D-06, 0.5477D-06, 0.4011D-06, 0.2877D-06, 0.2077D-06, & + & 0.1477D-06/ + + data (calcpts(j,46), j = 1,neta) /0.6703D-08, 0.8121D-08, & + & 0.9837D-08, 0.1192D-07, 0.1444D-07, 0.1750D-07, 0.2120D-07, & + & 0.2568D-07, 0.3111D-07, 0.3769D-07, 0.4567D-07, 0.5532D-07, & + & 0.6702D-07, 0.8121D-07, 0.9836D-07, 0.1192D-06, 0.1444D-06, & + & 0.1749D-06, 0.2119D-06, 0.2566D-06, 0.3108D-06, 0.3763D-06, & + & 0.4556D-06, 0.5514D-06, 0.6670D-06, 0.8063D-06, 0.9734D-06, & + & 0.1174D-05, 0.1412D-05, 0.1694D-05, 0.2022D-05, 0.2400D-05, & + & 0.2825D-05, 0.3292D-05, 0.3785D-05, 0.4284D-05, 0.4768D-05, & + & 0.5214D-05, 0.5608D-05, 0.5947D-05, 0.6237D-05, 0.6492D-05, & + & 0.6730D-05, 0.6974D-05, 0.7248D-05, 0.7579D-05, 0.7998D-05, & + & 0.8541D-05, 0.9245D-05, 0.1015D-04, 0.1129D-04, 0.1268D-04, & + & 0.1429D-04, 0.1600D-04, 0.1758D-04, 0.1867D-04, 0.1881D-04, & + & 0.1768D-04, 0.1522D-04, 0.1187D-04, 0.8410D-05, 0.5511D-05, & + & 0.3483D-05, 0.2243D-05, 0.1537D-05, 0.1125D-05, 0.8554D-06, & + & 0.6561D-06, 0.4988D-06, 0.3721D-06, 0.2728D-06, 0.1974D-06, & + & 0.1408D-06/ + + data (calcpts(j,47), j = 1,neta) /0.4567D-08, 0.5534D-08, & + & 0.6703D-08, 0.8122D-08, 0.9841D-08, 0.1192D-07, 0.1444D-07, & + & 0.1750D-07, 0.2120D-07, 0.2568D-07, 0.3112D-07, 0.3770D-07, & + & 0.4567D-07, 0.5534D-07, 0.6703D-07, 0.8121D-07, 0.9838D-07, & + & 0.1192D-06, 0.1444D-06, 0.1749D-06, 0.2118D-06, 0.2564D-06, & + & 0.3105D-06, 0.3757D-06, 0.4545D-06, 0.5494D-06, 0.6633D-06, & + & 0.7997D-06, 0.9622D-06, 0.1154D-05, 0.1378D-05, 0.1635D-05, & + & 0.1925D-05, 0.2242D-05, 0.2577D-05, 0.2916D-05, 0.3243D-05, & + & 0.3544D-05, 0.3808D-05, 0.4032D-05, 0.4219D-05, 0.4378D-05, & + & 0.4520D-05, 0.4658D-05, 0.4807D-05, 0.4980D-05, 0.5197D-05, & + & 0.5476D-05, 0.5841D-05, 0.6317D-05, 0.6932D-05, 0.7708D-05, & + & 0.8653D-05, 0.9745D-05, 0.1091D-04, 0.1199D-04, 0.1273D-04, & + & 0.1283D-04, 0.1205D-04, 0.1037D-04, 0.8089D-05, 0.5729D-05, & + & 0.3755D-05, 0.2372D-05, 0.1527D-05, 0.1047D-05, 0.7661D-06, & + & 0.5821D-06, 0.4461D-06, 0.3387D-06, 0.2527D-06, 0.1854D-06, & + & 0.1334D-06/ + + data (calcpts(j,48), j = 1,neta) /0.3113D-08, 0.3771D-08, & + & 0.4568D-08, 0.5535D-08, 0.6707D-08, 0.8125D-08, 0.9843D-08, & + & 0.1193D-07, 0.1445D-07, 0.1750D-07, 0.2121D-07, 0.2569D-07, & + & 0.3113D-07, 0.3771D-07, 0.4568D-07, 0.5534D-07, 0.6705D-07, & + & 0.8122D-07, 0.9839D-07, 0.1192D-06, 0.1443D-06, 0.1748D-06, & + & 0.2116D-06, 0.2561D-06, 0.3097D-06, 0.3744D-06, 0.4520D-06, & + & 0.5450D-06, 0.6557D-06, 0.7863D-06, 0.9388D-06, 0.1114D-05, & + & 0.1311D-05, 0.1527D-05, 0.1755D-05, 0.1986D-05, 0.2208D-05, & + & 0.2411D-05, 0.2588D-05, 0.2738D-05, 0.2860D-05, 0.2962D-05, & + & 0.3048D-05, 0.3128D-05, 0.3210D-05, 0.3302D-05, 0.3414D-05, & + & 0.3557D-05, 0.3744D-05, 0.3991D-05, 0.4314D-05, 0.4731D-05, & + & 0.5259D-05, 0.5902D-05, 0.6646D-05, 0.7437D-05, 0.8169D-05, & + & 0.8672D-05, 0.8739D-05, 0.8207D-05, 0.7063D-05, 0.5512D-05, & + & 0.3904D-05, 0.2558D-05, 0.1616D-05, 0.1041D-05, 0.7134D-06, & + & 0.5221D-06, 0.3968D-06, 0.3048D-06, 0.2315D-06, 0.1728D-06, & + & 0.1261D-06/ + + data (calcpts(j,49), j = 1,neta) /0.2121D-08, 0.2570D-08, & + & 0.3113D-08, 0.3772D-08, 0.4570D-08, 0.5536D-08, 0.6708D-08, & + & 0.8127D-08, 0.9844D-08, 0.1193D-07, 0.1445D-07, 0.1751D-07, & + & 0.2121D-07, 0.2570D-07, 0.3113D-07, 0.3771D-07, 0.4569D-07, & + & 0.5535D-07, 0.6704D-07, 0.8121D-07, 0.9834D-07, 0.1191D-06, & + & 0.1442D-06, 0.1745D-06, 0.2111D-06, 0.2551D-06, 0.3080D-06, & + & 0.3714D-06, 0.4468D-06, 0.5358D-06, 0.6397D-06, 0.7591D-06, & + & 0.8934D-06, 0.1040D-05, 0.1195D-05, 0.1352D-05, 0.1503D-05, & + & 0.1641D-05, 0.1761D-05, 0.1861D-05, 0.1942D-05, 0.2007D-05, & + & 0.2061D-05, 0.2109D-05, 0.2155D-05, 0.2205D-05, 0.2263D-05, & + & 0.2336D-05, 0.2431D-05, 0.2557D-05, 0.2724D-05, 0.2944D-05, & + & 0.3228D-05, 0.3586D-05, 0.4024D-05, 0.4530D-05, 0.5069D-05, & + & 0.5567D-05, 0.5910D-05, 0.5955D-05, 0.5592D-05, 0.4813D-05, & + & 0.3756D-05, 0.2660D-05, 0.1743D-05, 0.1101D-05, 0.7091D-06, & + & 0.4858D-06, 0.3558D-06, 0.2705D-06, 0.2078D-06, 0.1578D-06, & + & 0.1178D-06/ + + data (dlaeta(j), j = 1,neta) / & + & -6d0, -5.83333333d0, -5.66666667d0, -5.5d0, -5.33333333d0, & + & -5.16666667d0, -5d0, -4.83333333d0, -4.66666667d0, -4.5d0, & + & -4.33333333d0, -4.16666667d0, -4d0, -3.83333333d0, & + & -3.66666667d0, -3.5d0, -3.33333333d0, -3.16666667d0, -3d0, & + & -2.83333333d0, -2.66666667d0, -2.5d0, -2.33333333d0, & + & -2.16666667d0, -2d0, -1.83333333d0, -1.66666667d0, -1.5d0, & + & -1.33333333d0, -1.16666667d0, -1d0, -0.83333333d0, -0.66666667d0,& + & -0.5d0, -0.33333333d0, -0.16666667d0, 0d0, 0.16666667d0, & + & 0.33333333d0, 0.5d0, 0.66666667d0, 0.83333333d0, 1d0, & + & 1.16666667d0, 1.33333333d0, 1.5d0, 1.66666667d0, 1.83333333d0, & + & 2d0, 2.16666667d0, 2.33333333d0, 2.5d0, 2.66666667d0, & + & 2.83333333d0, 3d0, 3.16666667d0, 3.33333333d0, 3.5d0, & + & 3.66666667d0, 3.83333333d0, 4d0, 4.16666667d0, 4.33333333d0, & + & 4.5d0, 4.66666667d0, 4.83333333d0, 5d0, 5.16666667d0, & + & 5.33333333d0, 5.5d0, 5.66666667d0, 5.83333333d0, 6d0/ + + data (dlaxi(j), j = 1,nxi) / & + & -3d0, -2.83333333d0, -2.66666667d0, -2.5d0, -2.33333333d0, & + & -2.16666667d0, -2d0, -1.83333333d0, -1.66666667d0, -1.5d0, & + & -1.33333333d0, -1.16666667d0, -1d0, -0.83333333d0, -0.66666667d0,& + & -0.5d0, -0.33333333d0, -0.16666667d0, 0d0, 0.16666667d0, & + & 0.33333333d0, 0.5d0, 0.66666667d0, 0.83333333d0, 1d0, & + & 1.16666667d0, 1.33333333d0, 1.5d0, 1.66666667d0, 1.83333333d0, & + & 2d0, 2.16666667d0, 2.33333333d0, 2.5d0, 2.66666667d0, & + & 2.83333333d0, 3d0, 3.16666667d0, 3.33333333d0, 3.5d0, & + & 3.66666667d0, 3.83333333d0, 4d0, 4.16666667d0, 4.33333333d0, & + & 4.5d0, 4.66666667d0, 4.83333333d0, 5d0/ + + dleta = dlog10(eta) + dlxi = dlog10(xi) + if (dlxi .le. dlaxi(1)) dlxi = dlaxi(1) + if (dlxi .ge. dlaxi(nxi)) dlxi = dlaxi(nxi) + if (dleta .ge. dlaeta(neta)) dleta = dlaeta(neta) + if (dleta .le. dlaeta(1)) dleta = dlaeta(1) + call locate(dlaeta,neta, dleta, ieta) + call locate(dlaxi, nxi, dlxi, ixi) +! interpolating between the appropriate points + delxi = 1d0/6d0 + deleta = 1d0/6d0 +! lagrange 3-pt. + if (ixi .le. 2) ixi = 2 + if (ixi .ge. 48) ixi = 48 + if (ieta .le. 2) ieta = 2 + if (ixi .ge. 72) ieta = 72 + pxi = (dlxi - dlaxi(ixi))/delxi + f(-1) = pxi*(pxi-1d0)/2d0*calcpts(ieta-1,ixi-1) + & + & (1d0 - pxi**2)*calcpts(ieta-1,ixi) + & + & pxi*(pxi+1d0)/2d0*calcpts(ieta-1,ixi+1) + f(0) = pxi*(pxi-1d0)/2d0*calcpts(ieta,ixi-1) + & + & (1d0 - pxi**2)*calcpts(ieta,ixi) + & + & pxi*(pxi+1d0)/2d0*calcpts(ieta,ixi+1) + f(1) = pxi*(pxi-1d0)/2d0*calcpts(ieta+1,ixi-1) + & + & (1d0 - pxi**2)*calcpts(ieta+1,ixi) + & + & pxi*(pxi+1d0)/2d0*calcpts(ieta+1,ixi+1) + peta = (dleta - dlaeta(ieta))/deleta + h1bar_Lg = peta*(peta-1d0)/2d0*f(-1) + & + & (1d0 - peta**2)*f(0) + & + & peta*(peta+1d0)/2d0*f(1) +!MB + + peta*(peta+1d0)/2d0*f(1) + return + END + +!DECK ID>, QCORRT. + +! ======================================== + double precision function h1_HTq(eta,xi) +! ======================================== + +! eq (26) in PLB347 (1995) 143 - 151 for the transverse piece +! MSbar scheme +! This routine is called subcqht in the original code. +! Called schqt in updated code (03/06/96). + + implicit none + integer neta, nxi + parameter (neta = 73, nxi = 49) + double precision calcpts(neta, nxi), dlaeta(neta), dlaxi(nxi) + double precision eta, xi, dleta, dlxi + double precision pxi, peta, f(-1:1), delxi, deleta + integer j, ieta, ixi + + data (calcpts(j, 1), j = 1,neta) /-.9757D-09, -.1701D-08, & + & -.2961D-08, -.5155D-08, -.8967D-08, -.1559D-07, -.2708D-07, & + & -.4703D-07, -.8158D-07, -.1415D-06, -.2452D-06, -.4245D-06, & + & -.7345D-06, -.1270D-05, -.2194D-05, -.3787D-05, -.6531D-05, & + & -.1125D-04, -.1936D-04, -.3327D-04, -.5709D-04, -.9784D-04, & + & -.1674D-03, -.2859D-03, -.4868D-03, -.8266D-03, -.1398D-02, & + & -.2352D-02, -.3932D-02, -.6512D-02, -.1065D-01, -.1711D-01, & + & -.2682D-01, -.4073D-01, -.5935D-01, -.8225D-01, -.1077D+00, & + & -.1325D+00, -.1534D+00, -.1673D+00, -.1729D+00, -.1704D+00, & + & -.1612D+00, -.1472D+00, -.1307D+00, -.1132D+00, -.9612D-01, & + & -.8027D-01, -.6602D-01, -.5365D-01, -.4317D-01, -.3440D-01, & + & -.2727D-01, -.2137D-01, -.1673D-01, -.1295D-01, -.1003D-01, & + & -.7682D-02, -.5769D-02, -.4444D-02, -.3410D-02, -.2522D-02, & + & -.1930D-02, -.1485D-02, -.1039D-02, -.7414D-03, -.5931D-03, & + & -.4443D-03, -.2950D-03, -.2956D-03, -.1459D-03, -.1462D-03, & + & -.1464D-03/ + + data (calcpts(j, 2), j = 1,neta) /-.9756D-09, -.1701D-08, & + & -.2961D-08, -.5155D-08, -.8966D-08, -.1559D-07, -.2708D-07, & + & -.4701D-07, -.8156D-07, -.1415D-06, -.2452D-06, -.4245D-06, & + & -.7345D-06, -.1270D-05, -.2194D-05, -.3786D-05, -.6529D-05, & + & -.1125D-04, -.1936D-04, -.3327D-04, -.5708D-04, -.9783D-04, & + & -.1674D-03, -.2857D-03, -.4866D-03, -.8264D-03, -.1397D-02, & + & -.2352D-02, -.3932D-02, -.6511D-02, -.1065D-01, -.1711D-01, & + & -.2682D-01, -.4073D-01, -.5935D-01, -.8225D-01, -.1076D+00, & + & -.1325D+00, -.1534D+00, -.1673D+00, -.1729D+00, -.1704D+00, & + & -.1612D+00, -.1472D+00, -.1307D+00, -.1132D+00, -.9610D-01, & + & -.8026D-01, -.6600D-01, -.5363D-01, -.4316D-01, -.3439D-01, & + & -.2725D-01, -.2135D-01, -.1672D-01, -.1293D-01, -.1001D-01, & + & -.7667D-02, -.5903D-02, -.4428D-02, -.3395D-02, -.2507D-02, & + & -.1914D-02, -.1470D-02, -.1023D-02, -.8760D-03, -.5777D-03, & + & -.4288D-03, -.2796D-03, -.2801D-03, -.1305D-03, -.1308D-03, & + & -.1309D-03/ + + data (calcpts(j, 3), j = 1,neta) /-.9753D-09, -.1700D-08, & + & -.2960D-08, -.5153D-08, -.8964D-08, -.1558D-07, -.2707D-07, & + & -.4701D-07, -.8154D-07, -.1414D-06, -.2450D-06, -.4243D-06, & + & -.7343D-06, -.1270D-05, -.2193D-05, -.3785D-05, -.6528D-05, & + & -.1124D-04, -.1935D-04, -.3325D-04, -.5708D-04, -.9781D-04, & + & -.1673D-03, -.2857D-03, -.4866D-03, -.8262D-03, -.1397D-02, & + & -.2351D-02, -.3931D-02, -.6510D-02, -.1064D-01, -.1710D-01, & + & -.2681D-01, -.4072D-01, -.5934D-01, -.8223D-01, -.1076D+00, & + & -.1325D+00, -.1533D+00, -.1673D+00, -.1729D+00, -.1704D+00, & + & -.1612D+00, -.1472D+00, -.1307D+00, -.1132D+00, -.9611D-01, & + & -.8024D-01, -.6598D-01, -.5376D-01, -.4314D-01, -.3437D-01, & + & -.2723D-01, -.2133D-01, -.1670D-01, -.1291D-01, -.9990D-02, & + & -.7644D-02, -.5881D-02, -.4405D-02, -.3372D-02, -.2484D-02, & + & -.1892D-02, -.1447D-02, -.1001D-02, -.8533D-03, -.5550D-03, & + & -.4062D-03, -.2570D-03, -.2575D-03, -.1079D-03, -.1081D-03, & + & -.1083D-03/ + + data (calcpts(j, 4), j = 1,neta) /-.9749D-09, -.1699D-08, & + & -.2960D-08, -.5150D-08, -.8961D-08, -.1558D-07, -.2706D-07, & + & -.4698D-07, -.8151D-07, -.1414D-06, -.2450D-06, -.4241D-06, & + & -.7340D-06, -.1269D-05, -.2192D-05, -.3785D-05, -.6526D-05, & + & -.1124D-04, -.1934D-04, -.3325D-04, -.5704D-04, -.9777D-04, & + & -.1673D-03, -.2855D-03, -.4864D-03, -.8260D-03, -.1397D-02, & + & -.2351D-02, -.3930D-02, -.6508D-02, -.1064D-01, -.1710D-01, & + & -.2680D-01, -.4071D-01, -.5932D-01, -.8222D-01, -.1076D+00, & + & -.1325D+00, -.1533D+00, -.1673D+00, -.1729D+00, -.1704D+00, & + & -.1611D+00, -.1472D+00, -.1306D+00, -.1132D+00, -.9609D-01, & + & -.8020D-01, -.6610D-01, -.5373D-01, -.4325D-01, -.3448D-01, & + & -.2720D-01, -.2144D-01, -.1666D-01, -.1288D-01, -.9957D-02, & + & -.7611D-02, -.5847D-02, -.4372D-02, -.3339D-02, -.2601D-02, & + & -.1859D-02, -.1414D-02, -.1118D-02, -.8201D-03, -.5218D-03, & + & -.3729D-03, -.3737D-03, -.2243D-03, -.2246D-03, -.7488D-04, & + & -.7505D-04/ + + data (calcpts(j, 5), j = 1,neta) /-.9743D-09, -.1698D-08, & + & -.2958D-08, -.5147D-08, -.8956D-08, -.1557D-07, -.2705D-07, & + & -.4696D-07, -.8146D-07, -.1413D-06, -.2448D-06, -.4240D-06, & + & -.7335D-06, -.1268D-05, -.2191D-05, -.3781D-05, -.6522D-05, & + & -.1124D-04, -.1933D-04, -.3323D-04, -.5702D-04, -.9773D-04, & + & -.1672D-03, -.2855D-03, -.4862D-03, -.8256D-03, -.1396D-02, & + & -.2350D-02, -.3928D-02, -.6505D-02, -.1064D-01, -.1709D-01, & + & -.2679D-01, -.4069D-01, -.5930D-01, -.8219D-01, -.1076D+00, & + & -.1324D+00, -.1533D+00, -.1672D+00, -.1729D+00, -.1703D+00, & + & -.1611D+00, -.1472D+00, -.1306D+00, -.1132D+00, -.9609D-01, & + & -.8015D-01, -.6605D-01, -.5368D-01, -.4320D-01, -.3444D-01, & + & -.2730D-01, -.2140D-01, -.1661D-01, -.1298D-01, -.9909D-02, & + & -.7712D-02, -.5799D-02, -.4473D-02, -.3440D-02, -.2552D-02, & + & -.1960D-02, -.1365D-02, -.1069D-02, -.7713D-03, -.6230D-03, & + & -.4742D-03, -.3249D-03, -.1755D-03, -.1758D-03, -.1761D-03, & + & -.2626D-04/ + + data (calcpts(j, 6), j = 1,neta) /-.9735D-09, -.1697D-08, & + & -.2955D-08, -.5144D-08, -.8947D-08, -.1555D-07, -.2702D-07, & + & -.4691D-07, -.8139D-07, -.1411D-06, -.2447D-06, -.4236D-06, & + & -.7330D-06, -.1267D-05, -.2189D-05, -.3779D-05, -.6517D-05, & + & -.1123D-04, -.1932D-04, -.3320D-04, -.5697D-04, -.9766D-04, & + & -.1671D-03, -.2853D-03, -.4858D-03, -.8250D-03, -.1395D-02, & + & -.2348D-02, -.3925D-02, -.6501D-02, -.1063D-01, -.1708D-01, & + & -.2678D-01, -.4067D-01, -.5927D-01, -.8214D-01, -.1075D+00, & + & -.1324D+00, -.1532D+00, -.1672D+00, -.1728D+00, -.1703D+00, & + & -.1611D+00, -.1472D+00, -.1306D+00, -.1132D+00, -.9608D-01, & + & -.8023D-01, -.6598D-01, -.5361D-01, -.4313D-01, -.3436D-01, & + & -.2723D-01, -.2132D-01, -.1669D-01, -.1291D-01, -.9987D-02, & + & -.7641D-02, -.5877D-02, -.4402D-02, -.3369D-02, -.2480D-02, & + & -.1888D-02, -.1444D-02, -.1147D-02, -.8498D-03, -.5515D-03, & + & -.4026D-03, -.2534D-03, -.2540D-03, -.1043D-03, -.1046D-03, & + & -.1047D-03/ + + data (calcpts(j, 7), j = 1,neta) /-.9721D-09, -.1695D-08, & + & -.2951D-08, -.5137D-08, -.8936D-08, -.1553D-07, -.2698D-07, & + & -.4686D-07, -.8129D-07, -.1410D-06, -.2443D-06, -.4231D-06, & + & -.7321D-06, -.1266D-05, -.2187D-05, -.3774D-05, -.6510D-05, & + & -.1121D-04, -.1930D-04, -.3317D-04, -.5691D-04, -.9755D-04, & + & -.1669D-03, -.2849D-03, -.4853D-03, -.8241D-03, -.1394D-02, & + & -.2346D-02, -.3921D-02, -.6495D-02, -.1062D-01, -.1707D-01, & + & -.2676D-01, -.4064D-01, -.5922D-01, -.8209D-01, -.1075D+00, & + & -.1323D+00, -.1531D+00, -.1671D+00, -.1727D+00, -.1702D+00, & + & -.1610D+00, -.1471D+00, -.1306D+00, -.1131D+00, -.9606D-01, & + & -.8013D-01, -.6602D-01, -.5365D-01, -.4318D-01, -.3441D-01, & + & -.2727D-01, -.2137D-01, -.1674D-01, -.1295D-01, -.1003D-01, & + & -.7686D-02, -.5772D-02, -.4447D-02, -.3414D-02, -.2526D-02, & + & -.1933D-02, -.1489D-02, -.1042D-02, -.7449D-03, -.5966D-03, & + & -.4477D-03, -.2985D-03, -.5991D-03, -.1494D-03, -.1497D-03, & + & -.1498D-03/ + + data (calcpts(j, 8), j = 1,neta) /-.9703D-09, -.1691D-08, & + & -.2945D-08, -.5127D-08, -.8919D-08, -.1550D-07, -.2693D-07, & + & -.4678D-07, -.8114D-07, -.1407D-06, -.2438D-06, -.4223D-06, & + & -.7308D-06, -.1264D-05, -.2183D-05, -.3768D-05, -.6498D-05, & + & -.1119D-04, -.1926D-04, -.3311D-04, -.5682D-04, -.9739D-04, & + & -.1666D-03, -.2846D-03, -.4845D-03, -.8229D-03, -.1392D-02, & + & -.2342D-02, -.3917D-02, -.6486D-02, -.1061D-01, -.1705D-01, & + & -.2672D-01, -.4059D-01, -.5917D-01, -.8200D-01, -.1074D+00, & + & -.1322D+00, -.1530D+00, -.1670D+00, -.1726D+00, -.1702D+00, & + & -.1610D+00, -.1471D+00, -.1305D+00, -.1131D+00, -.9603D-01, & + & -.8013D-01, -.6602D-01, -.5365D-01, -.4318D-01, -.3441D-01, & + & -.2727D-01, -.2137D-01, -.1674D-01, -.1295D-01, -.1003D-01, & + & -.7682D-02, -.5768D-02, -.4443D-02, -.3410D-02, -.2522D-02, & + & -.1930D-02, -.1485D-02, -.1039D-02, -.7411D-03, -.5928D-03, & + & -.4439D-03, -.2947D-03, -.2952D-03, -.1456D-03, -.1459D-03, & + & -.1460D-03/ + + data (calcpts(j, 9), j = 1,neta) /-.9676D-09, -.1687D-08, & + & -.2937D-08, -.5112D-08, -.8895D-08, -.1546D-07, -.2687D-07, & + & -.4664D-07, -.8092D-07, -.1403D-06, -.2433D-06, -.4212D-06, & + & -.7289D-06, -.1260D-05, -.2177D-05, -.3759D-05, -.6482D-05, & + & -.1117D-04, -.1922D-04, -.3304D-04, -.5668D-04, -.9717D-04, & + & -.1663D-03, -.2839D-03, -.4836D-03, -.8212D-03, -.1389D-02, & + & -.2338D-02, -.3909D-02, -.6474D-02, -.1059D-01, -.1701D-01, & + & -.2668D-01, -.4052D-01, -.5907D-01, -.8188D-01, -.1072D+00, & + & -.1320D+00, -.1528D+00, -.1668D+00, -.1725D+00, -.1700D+00, & + & -.1608D+00, -.1470D+00, -.1304D+00, -.1130D+00, -.9599D-01, & + & -.8021D-01, -.6595D-01, -.5358D-01, -.4310D-01, -.3448D-01, & + & -.2719D-01, -.2129D-01, -.1666D-01, -.1288D-01, -.9954D-02, & + & -.7607D-02, -.5844D-02, -.4518D-02, -.3335D-02, -.2597D-02, & + & -.1855D-02, -.1410D-02, -.1114D-02, -.8161D-03, -.6677D-03, & + & -.3689D-03, -.3697D-03, -.2202D-03, -.2206D-03, -.7083D-04, & + & -.7100D-04/ + + data (calcpts(j,10), j = 1,neta) /-.9636D-09, -.1680D-08, & + & -.2925D-08, -.5093D-08, -.8858D-08, -.1540D-07, -.2675D-07, & + & -.4646D-07, -.8061D-07, -.1398D-06, -.2423D-06, -.4196D-06, & + & -.7262D-06, -.1256D-05, -.2169D-05, -.3745D-05, -.6458D-05, & + & -.1113D-04, -.1915D-04, -.3292D-04, -.5650D-04, -.9684D-04, & + & -.1657D-03, -.2829D-03, -.4819D-03, -.8185D-03, -.1384D-02, & + & -.2331D-02, -.3897D-02, -.6455D-02, -.1056D-01, -.1697D-01, & + & -.2661D-01, -.4042D-01, -.5892D-01, -.8169D-01, -.1070D+00, & + & -.1318D+00, -.1526D+00, -.1666D+00, -.1723D+00, -.1698D+00, & + & -.1607D+00, -.1468D+00, -.1304D+00, -.1130D+00, -.9592D-01, & + & -.8004D-01, -.6593D-01, -.5355D-01, -.4308D-01, -.3445D-01, & + & -.2717D-01, -.2141D-01, -.1663D-01, -.1285D-01, -.9924D-02, & + & -.7578D-02, -.5814D-02, -.4489D-02, -.3306D-02, -.2567D-02, & + & -.1975D-02, -.1380D-02, -.1084D-02, -.7864D-03, -.6381D-03, & + & -.4892D-03, -.3400D-03, -.1905D-03, -.1909D-03, -.1912D-03, & + & -.4133D-04/ + + data (calcpts(j,11), j = 1,neta) /-.9579D-09, -.1670D-08, & + & -.2909D-08, -.5063D-08, -.8807D-08, -.1531D-07, -.2660D-07, & + & -.4619D-07, -.8015D-07, -.1390D-06, -.2409D-06, -.4172D-06, & + & -.7221D-06, -.1249D-05, -.2157D-05, -.3724D-05, -.6425D-05, & + & -.1107D-04, -.1905D-04, -.3275D-04, -.5621D-04, -.9635D-04, & + & -.1649D-03, -.2816D-03, -.4796D-03, -.8148D-03, -.1378D-02, & + & -.2320D-02, -.3880D-02, -.6428D-02, -.1051D-01, -.1690D-01, & + & -.2650D-01, -.4027D-01, -.5871D-01, -.8143D-01, -.1067D+00, & + & -.1314D+00, -.1522D+00, -.1662D+00, -.1719D+00, -.1695D+00, & + & -.1604D+00, -.1467D+00, -.1302D+00, -.1128D+00, -.9583D-01, & + & -.8002D-01, -.6590D-01, -.5353D-01, -.4305D-01, -.3442D-01, & + & -.2714D-01, -.2138D-01, -.1660D-01, -.1296D-01, -.9893D-02, & + & -.7696D-02, -.5782D-02, -.4457D-02, -.3424D-02, -.2535D-02, & + & -.1943D-02, -.1498D-02, -.1052D-02, -.7544D-03, -.6061D-03, & + & -.4573D-03, -.3081D-03, -.3086D-03, -.1590D-03, -.1592D-03, & + & -.1594D-03/ + + data (calcpts(j,12), j = 1,neta) /-.9496D-09, -.1655D-08, & + & -.2882D-08, -.5018D-08, -.8732D-08, -.1518D-07, -.2638D-07, & + & -.4581D-07, -.7948D-07, -.1379D-06, -.2389D-06, -.4138D-06, & + & -.7163D-06, -.1239D-05, -.2140D-05, -.3695D-05, -.6374D-05, & + & -.1098D-04, -.1890D-04, -.3250D-04, -.5580D-04, -.9566D-04, & + & -.1637D-03, -.2796D-03, -.4764D-03, -.8092D-03, -.1369D-02, & + & -.2305D-02, -.3856D-02, -.6388D-02, -.1045D-01, -.1680D-01, & + & -.2635D-01, -.4005D-01, -.5842D-01, -.8104D-01, -.1062D+00, & + & -.1309D+00, -.1517D+00, -.1657D+00, -.1714D+00, -.1691D+00, & + & -.1601D+00, -.1464D+00, -.1300D+00, -.1127D+00, -.9571D-01, & + & -.7993D-01, -.6581D-01, -.5358D-01, -.4310D-01, -.3433D-01, & + & -.2719D-01, -.2128D-01, -.1665D-01, -.1286D-01, -.9941D-02, & + & -.7594D-02, -.5830D-02, -.4504D-02, -.3321D-02, -.2583D-02, & + & -.1841D-02, -.1396D-02, -.1099D-02, -.8019D-03, -.6536D-03, & + & -.5047D-03, -.3555D-03, -.2061D-03, -.2064D-03, -.5667D-04, & + & -.5683D-04/ + + data (calcpts(j,13), j = 1,neta) /-.9376D-09, -.1635D-08, & + & -.2848D-08, -.4956D-08, -.8623D-08, -.1499D-07, -.2605D-07, & + & -.4526D-07, -.7853D-07, -.1362D-06, -.2361D-06, -.4090D-06, & + & -.7079D-06, -.1224D-05, -.2116D-05, -.3653D-05, -.6303D-05, & + & -.1086D-04, -.1870D-04, -.3215D-04, -.5520D-04, -.9465D-04, & + & -.1620D-03, -.2768D-03, -.4716D-03, -.8013D-03, -.1356D-02, & + & -.2284D-02, -.3821D-02, -.6331D-02, -.1036D-01, -.1666D-01, & + & -.2614D-01, -.3974D-01, -.5798D-01, -.8048D-01, -.1055D+00, & + & -.1301D+00, -.1509D+00, -.1649D+00, -.1707D+00, -.1685D+00, & + & -.1596D+00, -.1460D+00, -.1297D+00, -.1124D+00, -.9551D-01, & + & -.7983D-01, -.6570D-01, -.5347D-01, -.4298D-01, -.3436D-01, & + & -.2707D-01, -.2131D-01, -.1668D-01, -.1289D-01, -.9969D-02, & + & -.7622D-02, -.5858D-02, -.4383D-02, -.3350D-02, -.2611D-02, & + & -.1869D-02, -.1424D-02, -.1128D-02, -.8301D-03, -.5318D-03, & + & -.3829D-03, -.3837D-03, -.2342D-03, -.2346D-03, -.8482D-04, & + & -.8498D-04/ + + data (calcpts(j,14), j = 1,neta) /-.9204D-09, -.1605D-08, & + & -.2795D-08, -.4866D-08, -.8469D-08, -.1473D-07, -.2560D-07, & + & -.4445D-07, -.7715D-07, -.1338D-06, -.2320D-06, -.4019D-06, & + & -.6958D-06, -.1204D-05, -.2080D-05, -.3592D-05, -.6199D-05, & + & -.1068D-04, -.1840D-04, -.3164D-04, -.5435D-04, -.9320D-04, & + & -.1596D-03, -.2727D-03, -.4649D-03, -.7900D-03, -.1337D-02, & + & -.2253D-02, -.3769D-02, -.6250D-02, -.1023D-01, -.1646D-01, & + & -.2583D-01, -.3929D-01, -.5737D-01, -.7968D-01, -.1046D+00, & + & -.1291D+00, -.1497D+00, -.1638D+00, -.1697D+00, -.1676D+00, & + & -.1588D+00, -.1454D+00, -.1292D+00, -.1121D+00, -.9525D-01, & + & -.7958D-01, -.6559D-01, -.5335D-01, -.4286D-01, -.3424D-01, & + & -.2709D-01, -.2133D-01, -.1655D-01, -.1291D-01, -.9990D-02, & + & -.7643D-02, -.5878D-02, -.4403D-02, -.3369D-02, -.2481D-02, & + & -.1889D-02, -.1444D-02, -.9974D-03, -.8498D-03, -.5515D-03, & + & -.4026D-03, -.2534D-03, -.2539D-03, -.1043D-03, -.1045D-03, & + & -.1047D-03/ + + data (calcpts(j,15), j = 1,neta) /-.8962D-09, -.1563D-08, & + & -.2722D-08, -.4740D-08, -.8250D-08, -.1435D-07, -.2495D-07, & + & -.4333D-07, -.7521D-07, -.1305D-06, -.2262D-06, -.3921D-06, & + & -.6789D-06, -.1175D-05, -.2030D-05, -.3508D-05, -.6055D-05, & + & -.1044D-04, -.1798D-04, -.3094D-04, -.5313D-04, -.9118D-04, & + & -.1562D-03, -.2669D-03, -.4551D-03, -.7740D-03, -.1311D-02, & + & -.2209D-02, -.3699D-02, -.6135D-02, -.1005D-01, -.1617D-01, & + & -.2540D-01, -.3866D-01, -.5649D-01, -.7854D-01, -.1032D+00, & + & -.1275D+00, -.1481D+00, -.1622D+00, -.1683D+00, -.1663D+00, & + & -.1578D+00, -.1445D+00, -.1285D+00, -.1115D+00, -.9485D-01, & + & -.7930D-01, -.6530D-01, -.5320D-01, -.4285D-01, -.3422D-01, & + & -.2707D-01, -.2116D-01, -.1653D-01, -.1289D-01, -.9964D-02, & + & -.7616D-02, -.5851D-02, -.4375D-02, -.3342D-02, -.2603D-02, & + & -.1861D-02, -.1416D-02, -.1120D-02, -.8220D-03, -.5236D-03, & + & -.3747D-03, -.3755D-03, -.2260D-03, -.2264D-03, -.7662D-04, & + & -.7679D-04/ + + data (calcpts(j,16), j = 1,neta) /-.8625D-09, -.1504D-08, & + & -.2621D-08, -.4566D-08, -.7948D-08, -.1382D-07, -.2404D-07, & + & -.4176D-07, -.7252D-07, -.1259D-06, -.2183D-06, -.3784D-06, & + & -.6554D-06, -.1134D-05, -.1961D-05, -.3389D-05, -.5854D-05, & + & -.1010D-04, -.1740D-04, -.2994D-04, -.5146D-04, -.8834D-04, & + & -.1514D-03, -.2589D-03, -.4418D-03, -.7518D-03, -.1274D-02, & + & -.2149D-02, -.3600D-02, -.5975D-02, -.9793D-02, -.1577D-01, & + & -.2479D-01, -.3777D-01, -.5526D-01, -.7694D-01, -.1012D+00, & + & -.1253D+00, -.1458D+00, -.1599D+00, -.1662D+00, -.1645D+00, & + & -.1563D+00, -.1433D+00, -.1275D+00, -.1108D+00, -.9428D-01, & + & -.7886D-01, -.6500D-01, -.5289D-01, -.4268D-01, -.3404D-01, & + & -.2689D-01, -.2113D-01, -.1649D-01, -.1285D-01, -.9927D-02, & + & -.7578D-02, -.5813D-02, -.4487D-02, -.3303D-02, -.2564D-02, & + & -.1972D-02, -.1377D-02, -.1080D-02, -.7829D-03, -.6345D-03, & + & -.4856D-03, -.3363D-03, -.1869D-03, -.1872D-03, -.1874D-03, & + & -.3761D-04/ + + data (calcpts(j,17), j = 1,neta) /-.8172D-09, -.1426D-08, & + & -.2485D-08, -.4329D-08, -.7537D-08, -.1312D-07, -.2281D-07, & + & -.3965D-07, -.6887D-07, -.1196D-06, -.2075D-06, -.3598D-06, & + & -.6235D-06, -.1080D-05, -.1868D-05, -.3230D-05, -.5580D-05, & + & -.9629D-05, -.1660D-04, -.2859D-04, -.4918D-04, -.8450D-04, & + & -.1449D-03, -.2481D-03, -.4236D-03, -.7215D-03, -.1224D-02, & + & -.2066D-02, -.3465D-02, -.5756D-02, -.9444D-02, -.1523D-01, & + & -.2397D-01, -.3657D-01, -.5358D-01, -.7474D-01, -.9852D-01, & + & -.1222D+00, -.1426D+00, -.1568D+00, -.1633D+00, -.1619D+00, & + & -.1541D+00, -.1415D+00, -.1261D+00, -.1097D+00, -.9348D-01, & + & -.7826D-01, -.6453D-01, -.5255D-01, -.4248D-01, -.3383D-01, & + & -.2682D-01, -.2105D-01, -.1641D-01, -.1277D-01, -.9846D-02, & + & -.7497D-02, -.5731D-02, -.4404D-02, -.3370D-02, -.2481D-02, & + & -.1889D-02, -.1444D-02, -.9970D-03, -.8494D-03, -.5510D-03, & + & -.4021D-03, -.2528D-03, -.2533D-03, -.1037D-03, -.1039D-03, & + & -.1040D-03/ + + data (calcpts(j,18), j = 1,neta) /-.7578D-09, -.1323D-08, & + & -.2305D-08, -.4019D-08, -.7001D-08, -.1219D-07, -.2121D-07, & + & -.3688D-07, -.6411D-07, -.1114D-06, -.1933D-06, -.3355D-06, & + & -.5817D-06, -.1008D-05, -.1745D-05, -.3020D-05, -.5221D-05, & + & -.9018D-05, -.1556D-04, -.2683D-04, -.4618D-04, -.7943D-04, & + & -.1364D-03, -.2337D-03, -.3996D-03, -.6815D-03, -.1157D-02, & + & -.1957D-02, -.3286D-02, -.5468D-02, -.8983D-02, -.1451D-01, & + & -.2287D-01, -.3496D-01, -.5134D-01, -.7178D-01, -.9490D-01, & + & -.1181D+00, -.1382D+00, -.1524D+00, -.1592D+00, -.1584D+00, & + & -.1511D+00, -.1391D+00, -.1242D+00, -.1082D+00, -.9234D-01, & + & -.7741D-01, -.6394D-01, -.5208D-01, -.4199D-01, -.3363D-01, & + & -.2661D-01, -.2099D-01, -.1634D-01, -.1270D-01, -.9773D-02, & + & -.7572D-02, -.5805D-02, -.4328D-02, -.3294D-02, -.2554D-02, & + & -.1961D-02, -.1366D-02, -.1070D-02, -.7719D-03, -.6235D-03, & + & -.4745D-03, -.3253D-03, -.1758D-03, -.1761D-03, -.1763D-03, & + & -.2648D-04/ + + data (calcpts(j,19), j = 1,neta) /-.6837D-09, -.1194D-08, & + & -.2083D-08, -.3632D-08, -.6331D-08, -.1103D-07, -.1920D-07, & + & -.3342D-07, -.5811D-07, -.1010D-06, -.1756D-06, -.3049D-06, & + & -.5291D-06, -.9180D-06, -.1591D-05, -.2756D-05, -.4770D-05, & + & -.8247D-05, -.1425D-04, -.2460D-04, -.4242D-04, -.7304D-04, & + & -.1256D-03, -.2156D-03, -.3694D-03, -.6310D-03, -.1073D-02, & + & -.1818D-02, -.3060D-02, -.5101D-02, -.8399D-02, -.1359D-01, & + & -.2148D-01, -.3290D-01, -.4845D-01, -.6795D-01, -.9016D-01, & + & -.1126D+00, -.1323D+00, -.1466D+00, -.1537D+00, -.1536D+00, & + & -.1470D+00, -.1357D+00, -.1216D+00, -.1062D+00, -.9079D-01, & + & -.7624D-01, -.6307D-01, -.5150D-01, -.4153D-01, -.3330D-01, & + & -.2642D-01, -.2079D-01, -.1629D-01, -.1264D-01, -.9713D-02, & + & -.7510D-02, -.5743D-02, -.4415D-02, -.3380D-02, -.2490D-02, & + & -.1897D-02, -.1452D-02, -.1005D-02, -.8569D-03, -.5584D-03, & + & -.4095D-03, -.2602D-03, -.2606D-03, -.1110D-03, -.1112D-03, & + & -.1113D-03/ + + data (calcpts(j,20), j = 1,neta) /-.5962D-09, -.1042D-08, & + & -.1819D-08, -.3174D-08, -.5539D-08, -.9657D-08, -.1683D-07, & + & -.2932D-07, -.5105D-07, -.8884D-07, -.1546D-06, -.2687D-06, & + & -.4670D-06, -.8111D-06, -.1407D-05, -.2442D-05, -.4233D-05, & + & -.7332D-05, -.1269D-04, -.2195D-04, -.3790D-04, -.6541D-04, & + & -.1127D-03, -.1939D-03, -.3329D-03, -.5701D-03, -.9723D-03, & + & -.1651D-02, -.2786D-02, -.4658D-02, -.7690D-02, -.1248D-01, & + & -.1977D-01, -.3039D-01, -.4490D-01, -.6321D-01, -.8422D-01, & + & -.1057D+00, -.1249D+00, -.1390D+00, -.1466D+00, -.1472D+00, & + & -.1416D+00, -.1313D+00, -.1180D+00, -.1034D+00, -.8867D-01, & + & -.7465D-01, -.6189D-01, -.5070D-01, -.4100D-01, -.3275D-01, & + & -.2600D-01, -.2051D-01, -.1600D-01, -.1250D-01, -.9717D-02, & + & -.7362D-02, -.5743D-02, -.4264D-02, -.3228D-02, -.2488D-02, & + & -.1894D-02, -.1449D-02, -.1002D-02, -.8541D-03, -.5555D-03, & + & -.4065D-03, -.2571D-03, -.2576D-03, -.1079D-03, -.1081D-03, & + & -.1082D-03/ + + data (calcpts(j,21), j = 1,neta) /-.5001D-09, -.8748D-09, & + & -.1529D-08, -.2673D-08, -.4668D-08, -.8149D-08, -.1422D-07, & + & -.2481D-07, -.4325D-07, -.7538D-07, -.1314D-06, -.2288D-06, & + & -.3982D-06, -.6928D-06, -.1205D-05, -.2093D-05, -.3636D-05, & + & -.6313D-05, -.1095D-04, -.1898D-04, -.3286D-04, -.5686D-04, & + & -.9827D-04, -.1695D-03, -.2919D-03, -.5014D-03, -.8579D-03, & + & -.1462D-02, -.2475D-02, -.4152D-02, -.6880D-02, -.1120D-01, & + & -.1781D-01, -.2748D-01, -.4076D-01, -.5762D-01, -.7714D-01, & + & -.9737D-01, -.1157D+00, -.1297D+00, -.1376D+00, -.1391D+00, & + & -.1346D+00, -.1255D+00, -.1134D+00, -.9984D-01, -.8594D-01, & + & -.7260D-01, -.6036D-01, -.4950D-01, -.4014D-01, -.3222D-01, & + & -.2560D-01, -.2025D-01, -.1588D-01, -.1237D-01, -.9580D-02, & + & -.7372D-02, -.5601D-02, -.4271D-02, -.3234D-02, -.2493D-02, & + & -.1899D-02, -.1453D-02, -.1006D-02, -.8581D-03, -.5595D-03, & + & -.4104D-03, -.2610D-03, -.2614D-03, -.1117D-03, -.1119D-03, & + & -.1120D-03/ + + data (calcpts(j,22), j = 1,neta) /-.4031D-09, -.7061D-09, & + & -.1236D-08, -.2163D-08, -.3785D-08, -.6618D-08, -.1157D-07, & + & -.2022D-07, -.3532D-07, -.6168D-07, -.1077D-06, -.1879D-06, & + & -.3279D-06, -.5717D-06, -.9962D-06, -.1736D-05, -.3023D-05, & + & -.5262D-05, -.9154D-05, -.1592D-04, -.2764D-04, -.4797D-04, & + & -.8319D-04, -.1440D-03, -.2489D-03, -.4291D-03, -.7372D-03, & + & -.1261D-02, -.2144D-02, -.3612D-02, -.6008D-02, -.9826D-02, & + & -.1569D-01, -.2430D-01, -.3619D-01, -.5140D-01, -.6916D-01, & + & -.8779D-01, -.1050D+00, -.1185D+00, -.1268D+00, -.1292D+00, & + & -.1260D+00, -.1184D+00, -.1077D+00, -.9531D-01, -.8244D-01, & + & -.6995D-01, -.5838D-01, -.4804D-01, -.3906D-01, -.3142D-01, & + & -.2505D-01, -.1975D-01, -.1552D-01, -.1215D-01, -.9361D-02, & + & -.7300D-02, -.5526D-02, -.4194D-02, -.3156D-02, -.2415D-02, & + & -.1820D-02, -.1374D-02, -.1077D-02, -.7786D-03, -.6298D-03, & + & -.4806D-03, -.3312D-03, -.1816D-03, -.1818D-03, -.1820D-03, & + & -.3212D-04/ + + data (calcpts(j,23), j = 1,neta) /-.3134D-09, -.5500D-09, & + & -.9646D-09, -.1691D-08, -.2965D-08, -.5197D-08, -.9103D-08, & + & -.1595D-07, -.2791D-07, -.4887D-07, -.8554D-07, -.1496D-06, & + & -.2617D-06, -.4577D-06, -.7999D-06, -.1398D-05, -.2442D-05, & + & -.4264D-05, -.7442D-05, -.1298D-04, -.2263D-04, -.3942D-04, & + & -.6863D-04, -.1193D-03, -.2070D-03, -.3584D-03, -.6184D-03, & + & -.1063D-02, -.1815D-02, -.3071D-02, -.5132D-02, -.8431D-02, & + & -.1352D-01, -.2103D-01, -.3146D-01, -.4487D-01, -.6066D-01, & + & -.7742D-01, -.9319D-01, -.1060D+00, -.1144D+00, -.1176D+00, & + & -.1158D+00, -.1098D+00, -.1007D+00, -.8980D-01, -.7819D-01, & + & -.6671D-01, -.5595D-01, -.4624D-01, -.3773D-01, -.3045D-01, & + & -.2434D-01, -.1928D-01, -.1516D-01, -.1184D-01, -.9195D-02, & + & -.7100D-02, -.5428D-02, -.4094D-02, -.3205D-02, -.2463D-02, & + & -.1868D-02, -.1421D-02, -.9738D-03, -.8254D-03, -.5265D-03, & + & -.3772D-03, -.3777D-03, -.2281D-03, -.2283D-03, -.7849D-04, & + & -.7860D-04/ + + data (calcpts(j,24), j = 1,neta) /-.2374D-09, -.4175D-09, & + & -.7336D-09, -.1290D-08, -.2266D-08, -.3981D-08, -.6991D-08, & + & -.1228D-07, -.2155D-07, -.3782D-07, -.6639D-07, -.1165D-06, & + & -.2044D-06, -.3585D-06, -.6283D-06, -.1102D-05, -.1931D-05, & + & -.3384D-05, -.5927D-05, -.1038D-04, -.1816D-04, -.3176D-04, & + & -.5551D-04, -.9690D-04, -.1689D-03, -.2937D-03, -.5089D-03, & + & -.8786D-03, -.1507D-02, -.2562D-02, -.4301D-02, -.7096D-02, & + & -.1143D-01, -.1785D-01, -.2680D-01, -.3838D-01, -.5210D-01, & + & -.6683D-01, -.8092D-01, -.9276D-01, -.1010D+00, -.1049D+00, & + & -.1044D+00, -.1000D+00, -.9264D-01, -.8337D-01, -.7319D-01, & + & -.6290D-01, -.5307D-01, -.4410D-01, -.3615D-01, -.2930D-01, & + & -.2349D-01, -.1868D-01, -.1473D-01, -.1154D-01, -.8972D-02, & + & -.6932D-02, -.5333D-02, -.4087D-02, -.3106D-02, -.2363D-02, & + & -.1782D-02, -.1350D-02, -.1007D-02, -.7538D-03, -.5598D-03, & + & -.4254D-03, -.3059D-03, -.2312D-03, -.1714D-03, -.1265D-03, & + & -.9662D-04/ + + data (calcpts(j,25), j = 1,neta) /-.1774D-09, -.3127D-09, & + & -.5509D-09, -.9707D-09, -.1710D-08, -.3011D-08, -.5303D-08, & + & -.9337D-08, -.1643D-07, -.2893D-07, -.5093D-07, -.8963D-07, & + & -.1577D-06, -.2775D-06, -.4880D-06, -.8585D-06, -.1510D-05, & + & -.2655D-05, -.4667D-05, -.8202D-05, -.1440D-04, -.2529D-04, & + & -.4437D-04, -.7774D-04, -.1360D-03, -.2376D-03, -.4134D-03, & + & -.7165D-03, -.1234D-02, -.2107D-02, -.3550D-02, -.5880D-02, & + & -.9503D-02, -.1489D-01, -.2243D-01, -.3223D-01, -.4391D-01, & + & -.5654D-01, -.6882D-01, -.7940D-01, -.8719D-01, -.9148D-01, & + & -.9209D-01, -.8928D-01, -.8370D-01, -.7615D-01, -.6751D-01, & + & -.5853D-01, -.4976D-01, -.4162D-01, -.3432D-01, -.2795D-01, & + & -.2252D-01, -.1797D-01, -.1421D-01, -.1116D-01, -.8697D-02, & + & -.6743D-02, -.5201D-02, -.3983D-02, -.3046D-02, -.2317D-02, & + & -.1751D-02, -.1318D-02, -.9900D-03, -.7512D-03, -.5570D-03, & + & -.4076D-03, -.3029D-03, -.2282D-03, -.1684D-03, -.1235D-03, & + & -.9358D-04/ + + data (calcpts(j,26), j = 1,neta) /-.1325D-09, -.2341D-09, & + & -.4132D-09, -.7299D-09, -.1289D-08, -.2275D-08, -.4017D-08, & + & -.7092D-08, -.1251D-07, -.2209D-07, -.3899D-07, -.6881D-07, & + & -.1214D-06, -.2143D-06, -.3779D-06, -.6668D-06, -.1176D-05, & + & -.2075D-05, -.3658D-05, -.6450D-05, -.1136D-04, -.2001D-04, & + & -.3524D-04, -.6195D-04, -.1088D-03, -.1906D-03, -.3328D-03, & + & -.5788D-03, -.1000D-02, -.1713D-02, -.2896D-02, -.4811D-02, & + & -.7796D-02, -.1225D-01, -.1850D-01, -.2664D-01, -.3638D-01, & + & -.4699D-01, -.5742D-01, -.6661D-01, -.7368D-01, -.7806D-01, & + & -.7950D-01, -.7808D-01, -.7415D-01, -.6833D-01, -.6128D-01, & + & -.5369D-01, -.4608D-01, -.3885D-01, -.3225D-01, -.2642D-01, & + & -.2140D-01, -.1715D-01, -.1363D-01, -.1074D-01, -.8402D-02, & + & -.6534D-02, -.5034D-02, -.3874D-02, -.2966D-02, -.2251D-02, & + & -.1714D-02, -.1281D-02, -.9678D-03, -.7288D-03, -.5345D-03, & + & -.4000D-03, -.2953D-03, -.2205D-03, -.1606D-03, -.1157D-03, & + & -.8582D-04/ + + data (calcpts(j,27), j = 1,neta) /-.9971D-10, -.1765D-09, & + & -.3122D-09, -.5525D-09, -.9778D-09, -.1730D-08, -.3060D-08, & + & -.5415D-08, -.9575D-08, -.1694D-07, -.2997D-07, -.5302D-07, & + & -.9377D-07, -.1659D-06, -.2933D-06, -.5187D-06, -.9174D-06, & + & -.1622D-05, -.2867D-05, -.5068D-05, -.8950D-05, -.1581D-04, & + & -.2790D-04, -.4919D-04, -.8659D-04, -.1521D-03, -.2663D-03, & + & -.4644D-03, -.8047D-03, -.1381D-02, -.2340D-02, -.3896D-02, & + & -.6326D-02, -.9956D-02, -.1506D-01, -.2172D-01, -.2972D-01, & + & -.3847D-01, -.4714D-01, -.5491D-01, -.6110D-01, -.6527D-01, & + & -.6720D-01, -.6685D-01, -.6439D-01, -.6017D-01, -.5472D-01, & + & -.4851D-01, -.4210D-01, -.3585D-01, -.3001D-01, -.2477D-01, & + & -.2020D-01, -.1628D-01, -.1299D-01, -.1028D-01, -.8074D-02, & + & -.6307D-02, -.4880D-02, -.3763D-02, -.2884D-02, -.2213D-02, & + & -.1675D-02, -.1272D-02, -.9585D-03, -.7193D-03, -.5399D-03, & + & -.4053D-03, -.3006D-03, -.2257D-03, -.1659D-03, -.1359D-03, & + & -.9100D-04/ + + data (calcpts(j,28), j = 1,neta) /-.7575D-10, -.1343D-09, & + & -.2379D-09, -.4217D-09, -.7476D-09, -.1325D-08, -.2348D-08, & + & -.4161D-08, -.7371D-08, -.1306D-07, -.2316D-07, -.4103D-07, & + & -.7270D-07, -.1288D-06, -.2282D-06, -.4043D-06, -.7165D-06, & + & -.1269D-05, -.2247D-05, -.3980D-05, -.7042D-05, -.1246D-04, & + & -.2204D-04, -.3892D-04, -.6865D-04, -.1208D-03, -.2119D-03, & + & -.3702D-03, -.6426D-03, -.1105D-02, -.1875D-02, -.3125D-02, & + & -.5081D-02, -.8007D-02, -.1212D-01, -.1750D-01, -.2397D-01, & + & -.3107D-01, -.3814D-01, -.4455D-01, -.4980D-01, -.5355D-01, & + & -.5564D-01, -.5603D-01, -.5474D-01, -.5193D-01, -.4793D-01, & + & -.4311D-01, -.3787D-01, -.3262D-01, -.2758D-01, -.2296D-01, & + & -.1886D-01, -.1530D-01, -.1228D-01, -.9767D-02, -.7703D-02, & + & -.6038D-02, -.4698D-02, -.3625D-02, -.2790D-02, -.2133D-02, & + & -.1625D-02, -.1236D-02, -.9374D-03, -.6981D-03, -.5336D-03, & + & -.3989D-03, -.2941D-03, -.2192D-03, -.1593D-03, -.1294D-03, & + & -.8445D-04/ + + data (calcpts(j,29), j = 1,neta) /-.5802D-10, -.1030D-09, & + & -.1826D-09, -.3241D-09, -.5753D-09, -.1021D-08, -.1811D-08, & + & -.3214D-08, -.5700D-08, -.1011D-07, -.1795D-07, -.3184D-07, & + & -.5649D-07, -.1002D-06, -.1778D-06, -.3154D-06, -.5596D-06, & + & -.9924D-06, -.1760D-05, -.3121D-05, -.5529D-05, -.9797D-05, & + & -.1735D-04, -.3068D-04, -.5418D-04, -.9549D-04, -.1677D-03, & + & -.2933D-03, -.5096D-03, -.8771D-03, -.1490D-02, -.2486D-02, & + & -.4045D-02, -.6378D-02, -.9662D-02, -.1396D-01, -.1912D-01, & + & -.2480D-01, -.3048D-01, -.3568D-01, -.4000D-01, -.4322D-01, & + & -.4524D-01, -.4603D-01, -.4556D-01, -.4389D-01, -.4116D-01, & + & -.3760D-01, -.3353D-01, -.2925D-01, -.2502D-01, -.2105D-01, & + & -.1744D-01, -.1425D-01, -.1151D-01, -.9213D-02, -.7295D-02, & + & -.5747D-02, -.4480D-02, -.3481D-02, -.2674D-02, -.2047D-02, & + & -.1569D-02, -.1195D-02, -.8956D-03, -.6712D-03, -.5065D-03, & + & -.3868D-03, -.2820D-03, -.2071D-03, -.1622D-03, -.1172D-03, & + & -.8727D-04/ + + data (calcpts(j,30), j = 1,neta) /-.4465D-10, -.7931D-10, & + & -.1408D-09, -.2500D-09, -.4441D-09, -.7886D-09, -.1400D-08, & + & -.2487D-08, -.4415D-08, -.7840D-08, -.1393D-07, -.2473D-07, & + & -.4390D-07, -.7797D-07, -.1384D-06, -.2457D-06, -.4364D-06, & + & -.7745D-06, -.1375D-05, -.2440D-05, -.4326D-05, -.7672D-05, & + & -.1360D-04, -.2406D-04, -.4253D-04, -.7503D-04, -.1318D-03, & + & -.2308D-03, -.4013D-03, -.6912D-03, -.1175D-02, -.1961D-02, & + & -.3193D-02, -.5037D-02, -.7633D-02, -.1103D-01, -.1511D-01, & + & -.1961D-01, -.2411D-01, -.2825D-01, -.3174D-01, -.3441D-01, & + & -.3622D-01, -.3714D-01, -.3718D-01, -.3633D-01, -.3462D-01, & + & -.3216D-01, -.2915D-01, -.2581D-01, -.2237D-01, -.1905D-01, & + & -.1595D-01, -.1315D-01, -.1071D-01, -.8630D-02, -.6874D-02, & + & -.5443D-02, -.4264D-02, -.3324D-02, -.2577D-02, -.1979D-02, & + & -.1515D-02, -.1156D-02, -.8717D-03, -.6621D-03, -.4974D-03, & + & -.3776D-03, -.2728D-03, -.2129D-03, -.1529D-03, -.1080D-03, & + & -.7802D-04/ + + data (calcpts(j,31), j = 1,neta) /-.3440D-10, -.6113D-10, & + & -.1086D-09, -.1929D-09, -.3429D-09, -.6091D-09, -.1082D-08, & + & -.1923D-08, -.3415D-08, -.6069D-08, -.1078D-07, -.1916D-07, & + & -.3404D-07, -.6048D-07, -.1074D-06, -.1908D-06, -.3390D-06, & + & -.6021D-06, -.1069D-05, -.1899D-05, -.3368D-05, -.5977D-05, & + & -.1060D-04, -.1877D-04, -.3319D-04, -.5857D-04, -.1030D-03, & + & -.1803D-03, -.3138D-03, -.5406D-03, -.9193D-03, -.1535D-02, & + & -.2500D-02, -.3944D-02, -.5979D-02, -.8639D-02, -.1184D-01, & + & -.1536D-01, -.1890D-01, -.2216D-01, -.2492D-01, -.2709D-01, & + & -.2861D-01, -.2951D-01, -.2980D-01, -.2947D-01, -.2851D-01, & + & -.2694D-01, -.2485D-01, -.2238D-01, -.1970D-01, -.1700D-01, & + & -.1440D-01, -.1200D-01, -.9863D-02, -.8004D-02, -.6424D-02, & + & -.5112D-02, -.4037D-02, -.3155D-02, -.2453D-02, -.1899D-02, & + & -.1450D-02, -.1106D-02, -.8366D-03, -.6419D-03, -.4772D-03, & + & -.3573D-03, -.2674D-03, -.2075D-03, -.1476D-03, -.1176D-03, & + & -.8762D-04/ + + data (calcpts(j,32), j = 1,neta) /-.2646D-10, -.4703D-10, & + & -.8355D-10, -.1485D-09, -.2640D-09, -.4692D-09, -.8339D-09, & + & -.1482D-08, -.2633D-08, -.4681D-08, -.8322D-08, -.1479D-07, & + & -.2628D-07, -.4672D-07, -.8298D-07, -.1475D-06, -.2621D-06, & + & -.4657D-06, -.8273D-06, -.1470D-05, -.2608D-05, -.4629D-05, & + & -.8211D-05, -.1455D-04, -.2573D-04, -.4543D-04, -.7989D-04, & + & -.1399D-03, -.2436D-03, -.4197D-03, -.7140D-03, -.1193D-02, & + & -.1942D-02, -.3065D-02, -.4646D-02, -.6713D-02, -.9201D-02, & + & -.1194D-01, -.1469D-01, -.1723D-01, -.1939D-01, -.2111D-01, & + & -.2235D-01, -.2315D-01, -.2353D-01, -.2348D-01, -.2301D-01, & + & -.2209D-01, -.2074D-01, -.1901D-01, -.1703D-01, -.1492D-01, & + & -.1282D-01, -.1082D-01, -.8980D-02, -.7357D-02, -.5955D-02, & + & -.4776D-02, -.3775D-02, -.2968D-02, -.2325D-02, -.1801D-02, & + & -.1382D-02, -.1067D-02, -.8126D-03, -.6178D-03, -.4680D-03, & + & -.3481D-03, -.2582D-03, -.1983D-03, -.1383D-03, -.1083D-03, & + & -.7837D-04/ + + data (calcpts(j,33), j = 1,neta) /-.2028D-10, -.3607D-10, & + & -.6408D-10, -.1139D-09, -.2026D-09, -.3601D-09, -.6402D-09, & + & -.1138D-08, -.2022D-08, -.3596D-08, -.6394D-08, -.1136D-07, & + & -.2020D-07, -.3592D-07, -.6381D-07, -.1134D-06, -.2017D-06, & + & -.3583D-06, -.6367D-06, -.1131D-05, -.2008D-05, -.3565D-05, & + & -.6325D-05, -.1121D-04, -.1983D-04, -.3501D-04, -.6158D-04, & + & -.1079D-03, -.1878D-03, -.3237D-03, -.5507D-03, -.9200D-03, & + & -.1498D-02, -.2365D-02, -.3585D-02, -.5180D-02, -.7100D-02, & + & -.9213D-02, -.1133D-01, -.1330D-01, -.1497D-01, -.1631D-01, & + & -.1731D-01, -.1798D-01, -.1835D-01, -.1844D-01, -.1825D-01, & + & -.1776D-01, -.1695D-01, -.1583D-01, -.1444D-01, -.1288D-01, & + & -.1124D-01, -.9618D-02, -.8088D-02, -.6698D-02, -.5473D-02, & + & -.4416D-02, -.3534D-02, -.2801D-02, -.2187D-02, -.1708D-02, & + & -.1319D-02, -.1019D-02, -.7796D-03, -.5998D-03, -.4500D-03, & + & -.3451D-03, -.2551D-03, -.1952D-03, -.1502D-03, -.1052D-03, & + & -.7526D-04/ + + data (calcpts(j,34), j = 1,neta) /-.1548D-10, -.2753D-10, & + & -.4892D-10, -.8700D-10, -.1547D-09, -.2750D-09, -.4890D-09, & + & -.8695D-09, -.1545D-08, -.2748D-08, -.4886D-08, -.8686D-08, & + & -.1544D-07, -.2746D-07, -.4879D-07, -.8674D-07, -.1542D-06, & + & -.2741D-06, -.4870D-06, -.8655D-06, -.1536D-05, -.2728D-05, & + & -.4841D-05, -.8578D-05, -.1518D-04, -.2680D-04, -.4715D-04, & + & -.8263D-04, -.1438D-03, -.2480D-03, -.4219D-03, -.7048D-03, & + & -.1148D-02, -.1812D-02, -.2747D-02, -.3969D-02, -.5440D-02, & + & -.7059D-02, -.8685D-02, -.1019D-01, -.1148D-01, -.1251D-01, & + & -.1329D-01, -.1383D-01, -.1416D-01, -.1430D-01, -.1425D-01, & + & -.1401D-01, -.1356D-01, -.1289D-01, -.1198D-01, -.1089D-01, & + & -.9674D-02, -.8414D-02, -.7176D-02, -.6017D-02, -.4969D-02, & + & -.4050D-02, -.3261D-02, -.2598D-02, -.2052D-02, -.1607D-02, & + & -.1251D-02, -.9661D-03, -.7414D-03, -.5675D-03, -.4311D-03, & + & -.3217D-03, -.2468D-03, -.1868D-03, -.1418D-03, -.9683D-04, & + & -.8184D-04/ + + data (calcpts(j,35), j = 1,neta) /-.1176D-10, -.2091D-10, & + & -.3717D-10, -.6610D-10, -.1176D-09, -.2090D-09, -.3716D-09, & + & -.6608D-09, -.1174D-08, -.2089D-08, -.3714D-08, -.6603D-08, & + & -.1174D-07, -.2088D-07, -.3710D-07, -.6597D-07, -.1173D-06, & + & -.2085D-06, -.3705D-06, -.6584D-06, -.1169D-05, -.2076D-05, & + & -.3683D-05, -.6527D-05, -.1155D-04, -.2040D-04, -.3589D-04, & + & -.6290D-04, -.1095D-03, -.1888D-03, -.3212D-03, -.5366D-03, & + & -.8741D-03, -.1379D-02, -.2091D-02, -.3022D-02, -.4142D-02, & + & -.5375D-02, -.6612D-02, -.7758D-02, -.8741D-02, -.9532D-02, & + & -.1013D-01, -.1056D-01, -.1084D-01, -.1098D-01, -.1100D-01, & + & -.1090D-01, -.1066D-01, -.1028D-01, -.9728D-02, -.9012D-02, & + & -.8163D-02, -.7228D-02, -.6268D-02, -.5330D-02, -.4457D-02, & + & -.3671D-02, -.2984D-02, -.2398D-02, -.1906D-02, -.1503D-02, & + & -.1175D-02, -.9116D-03, -.7033D-03, -.5384D-03, -.4110D-03, & + & -.3120D-03, -.2356D-03, -.1771D-03, -.1321D-03, -.9912D-04, & + & -.7362D-04/ + + data (calcpts(j,36), j = 1,neta) /-.8892D-11, -.1581D-10, & + & -.2811D-10, -.4998D-10, -.8890D-10, -.1581D-09, -.2810D-09, & + & -.4998D-09, -.8883D-09, -.1580D-08, -.2810D-08, -.4996D-08, & + & -.8882D-08, -.1580D-07, -.2807D-07, -.4991D-07, -.8876D-07, & + & -.1578D-06, -.2804D-06, -.4983D-06, -.8847D-06, -.1571D-05, & + & -.2788D-05, -.4941D-05, -.8744D-05, -.1544D-04, -.2717D-04, & + & -.4762D-04, -.8290D-04, -.1429D-03, -.2432D-03, -.4063D-03, & + & -.6619D-03, -.1045D-02, -.1584D-02, -.2288D-02, -.3136D-02, & + & -.4070D-02, -.5007D-02, -.5874D-02, -.6620D-02, -.7220D-02, & + & -.7678D-02, -.8011D-02, -.8234D-02, -.8364D-02, -.8411D-02, & + & -.8378D-02, -.8261D-02, -.8053D-02, -.7736D-02, -.7299D-02, & + & -.6743D-02, -.6090D-02, -.5378D-02, -.4650D-02, -.3945D-02, & + & -.3290D-02, -.2705D-02, -.2194D-02, -.1760D-02, -.1396D-02, & + & -.1099D-02, -.8578D-03, -.6645D-03, -.5115D-03, -.3916D-03, & + & -.2986D-03, -.2267D-03, -.1712D-03, -.1277D-03, -.9622D-04, & + & -.7223D-04/ + + data (calcpts(j,37), j = 1,neta) /-.6692D-11, -.1190D-10, & + & -.2115D-10, -.3762D-10, -.6691D-10, -.1190D-09, -.2115D-09, & + & -.3762D-09, -.6687D-09, -.1189D-08, -.2115D-08, -.3761D-08, & + & -.6687D-08, -.1189D-07, -.2113D-07, -.3758D-07, -.6683D-07, & + & -.1188D-06, -.2111D-06, -.3752D-06, -.6662D-06, -.1183D-05, & + & -.2100D-05, -.3721D-05, -.6585D-05, -.1163D-04, -.2046D-04, & + & -.3586D-04, -.6244D-04, -.1077D-03, -.1832D-03, -.3060D-03, & + & -.4985D-03, -.7868D-03, -.1193D-02, -.1724D-02, -.2362D-02, & + & -.3065D-02, -.3771D-02, -.4425D-02, -.4986D-02, -.5439D-02, & + & -.5787D-02, -.6041D-02, -.6216D-02, -.6326D-02, -.6379D-02, & + & -.6379D-02, -.6326D-02, -.6217D-02, -.6042D-02, -.5789D-02, & + & -.5448D-02, -.5021D-02, -.4524D-02, -.3984D-02, -.3437D-02, & + & -.2909D-02, -.2421D-02, -.1985D-02, -.1608D-02, -.1287D-02, & + & -.1020D-02, -.8012D-03, -.6243D-03, -.4834D-03, -.3709D-03, & + & -.2840D-03, -.2165D-03, -.1640D-03, -.1235D-03, -.9201D-04, & + & -.6951D-04/ + + data (calcpts(j,38), j = 1,neta) /-.5013D-11, -.8916D-11, & + & -.1585D-10, -.2818D-10, -.5013D-10, -.8914D-10, -.1585D-09, & + & -.2819D-09, -.5010D-09, -.8911D-09, -.1585D-08, -.2818D-08, & + & -.5011D-08, -.8911D-08, -.1584D-07, -.2816D-07, -.5008D-07, & + & -.8901D-07, -.1582D-06, -.2812D-06, -.4993D-06, -.8866D-06, & + & -.1574D-05, -.2789D-05, -.4935D-05, -.8717D-05, -.1534D-04, & + & -.2688D-04, -.4680D-04, -.8069D-04, -.1373D-03, -.2294D-03, & + & -.3737D-03, -.5898D-03, -.8941D-03, -.1292D-02, -.1771D-02, & + & -.2298D-02, -.2827D-02, -.3317D-02, -.3738D-02, -.4078D-02, & + & -.4339D-02, -.4531D-02, -.4666D-02, -.4755D-02, -.4804D-02, & + & -.4819D-02, -.4799D-02, -.4744D-02, -.4650D-02, -.4508D-02, & + & -.4310D-02, -.4048D-02, -.3721D-02, -.3345D-02, -.2940D-02, & + & -.2530D-02, -.2137D-02, -.1776D-02, -.1453D-02, -.1175D-02, & + & -.9379D-03, -.7415D-03, -.5826D-03, -.4521D-03, -.3501D-03, & + & -.2677D-03, -.2047D-03, -.1552D-03, -.1177D-03, -.8770D-04, & + & -.6671D-04/ + + data (calcpts(j,39), j = 1,neta) /-.3741D-11, -.6654D-11, & + & -.1183D-10, -.2104D-10, -.3742D-10, -.6653D-10, -.1183D-09, & + & -.2104D-09, -.3740D-09, -.6651D-09, -.1183D-08, -.2103D-08, & + & -.3740D-08, -.6652D-08, -.1182D-07, -.2102D-07, -.3738D-07, & + & -.6644D-07, -.1181D-06, -.2099D-06, -.3727D-06, -.6618D-06, & + & -.1175D-05, -.2082D-05, -.3684D-05, -.6508D-05, -.1145D-04, & + & -.2007D-04, -.3494D-04, -.6024D-04, -.1025D-03, -.1713D-03, & + & -.2790D-03, -.4403D-03, -.6675D-03, -.9646D-03, -.1322D-02, & + & -.1715D-02, -.2110D-02, -.2476D-02, -.2791D-02, -.3045D-02, & + & -.3240D-02, -.3385D-02, -.3487D-02, -.3557D-02, -.3599D-02, & + & -.3617D-02, -.3614D-02, -.3589D-02, -.3539D-02, -.3461D-02, & + & -.3349D-02, -.3196D-02, -.2996D-02, -.2749D-02, -.2466D-02, & + & -.2164D-02, -.1858D-02, -.1568D-02, -.1299D-02, -.1062D-02, & + & -.8571D-03, -.6832D-03, -.5408D-03, -.4223D-03, -.3293D-03, & + & -.2543D-03, -.1943D-03, -.1494D-03, -.1134D-03, -.8486D-04, & + & -.6387D-04/ + + data (calcpts(j,40), j = 1,neta) /-.2780D-11, -.4945D-11, & + & -.8790D-11, -.1563D-10, -.2781D-10, -.4944D-10, -.8792D-10, & + & -.1564D-09, -.2779D-09, -.4943D-09, -.8792D-09, -.1563D-08, & + & -.2780D-08, -.4944D-08, -.8786D-08, -.1562D-07, -.2778D-07, & + & -.4939D-07, -.8778D-07, -.1560D-06, -.2770D-06, -.4919D-06, & + & -.8731D-06, -.1547D-05, -.2739D-05, -.4837D-05, -.8511D-05, & + & -.1492D-04, -.2597D-04, -.4478D-04, -.7619D-04, -.1273D-03, & + & -.2074D-03, -.3273D-03, -.4962D-03, -.7170D-03, -.9827D-03, & + & -.1275D-02, -.1569D-02, -.1841D-02, -.2074D-02, -.2263D-02, & + & -.2409D-02, -.2517D-02, -.2594D-02, -.2647D-02, -.2681D-02, & + & -.2699D-02, -.2703D-02, -.2693D-02, -.2668D-02, -.2626D-02, & + & -.2564D-02, -.2477D-02, -.2360D-02, -.2208D-02, -.2023D-02, & + & -.1812D-02, -.1586D-02, -.1360D-02, -.1145D-02, -.9475D-03, & + & -.7736D-03, -.6222D-03, -.4962D-03, -.3913D-03, -.3058D-03, & + & -.2368D-03, -.1828D-03, -.1408D-03, -.1063D-03, -.8082D-04, & + & -.6132D-04/ + + data (calcpts(j,41), j = 1,neta) /-.2059D-11, -.3662D-11, & + & -.6509D-11, -.1158D-10, -.2059D-10, -.3661D-10, -.6510D-10, & + & -.1158D-09, -.2058D-09, -.3660D-09, -.6511D-09, -.1158D-08, & + & -.2058D-08, -.3661D-08, -.6506D-08, -.1157D-07, -.2057D-07, & + & -.3657D-07, -.6500D-07, -.1155D-06, -.2051D-06, -.3643D-06, & + & -.6465D-06, -.1146D-05, -.2028D-05, -.3582D-05, -.6303D-05, & + & -.1105D-04, -.1923D-04, -.3316D-04, -.5642D-04, -.9427D-04, & + & -.1536D-03, -.2424D-03, -.3674D-03, -.5310D-03, -.7278D-03, & + & -.9443D-03, -.1162D-02, -.1363D-02, -.1536D-02, -.1676D-02, & + & -.1784D-02, -.1864D-02, -.1922D-02, -.1962D-02, -.1988D-02, & + & -.2004D-02, -.2011D-02, -.2008D-02, -.1996D-02, -.1974D-02, & + & -.1940D-02, -.1891D-02, -.1825D-02, -.1736D-02, -.1622D-02, & + & -.1484D-02, -.1327D-02, -.1160D-02, -.9928D-03, -.8341D-03, & + & -.6894D-03, -.5615D-03, -.4517D-03, -.3587D-03, -.2823D-03, & + & -.2208D-03, -.1713D-03, -.1323D-03, -.1008D-03, -.7679D-04, & + & -.5729D-04/ + + data (calcpts(j,42), j = 1,neta) /-.1520D-11, -.2703D-11, & + & -.4804D-11, -.8545D-11, -.1520D-10, -.2702D-10, -.4806D-10, & + & -.8547D-10, -.1519D-09, -.2702D-09, -.4806D-09, -.8545D-09, & + & -.1519D-08, -.2702D-08, -.4802D-08, -.8540D-08, -.1519D-07, & + & -.2700D-07, -.4798D-07, -.8528D-07, -.1514D-06, -.2689D-06, & + & -.4773D-06, -.8459D-06, -.1497D-05, -.2644D-05, -.4653D-05, & + & -.8154D-05, -.1420D-04, -.2448D-04, -.4165D-04, -.6959D-04, & + & -.1134D-03, -.1789D-03, -.2712D-03, -.3920D-03, -.5372D-03, & + & -.6971D-03, -.8576D-03, -.1006D-02, -.1134D-02, -.1237D-02, & + & -.1317D-02, -.1376D-02, -.1419D-02, -.1449D-02, -.1469D-02, & + & -.1482D-02, -.1489D-02, -.1490D-02, -.1485D-02, -.1474D-02, & + & -.1455D-02, -.1428D-02, -.1391D-02, -.1340D-02, -.1274D-02, & + & -.1189D-02, -.1086D-02, -.9692D-03, -.8460D-03, -.7231D-03, & + & -.6067D-03, -.5007D-03, -.4073D-03, -.3272D-03, -.2599D-03, & + & -.2045D-03, -.1595D-03, -.1234D-03, -.9489D-04, -.7254D-04, & + & -.5514D-04/ + + data (calcpts(j,43), j = 1,neta) /-.1118D-11, -.1989D-11, & + & -.3535D-11, -.6287D-11, -.1118D-10, -.1988D-10, -.3536D-10, & + & -.6289D-10, -.1118D-09, -.1988D-09, -.3536D-09, -.6287D-09, & + & -.1118D-08, -.1988D-08, -.3534D-08, -.6284D-08, -.1118D-07, & + & -.1986D-07, -.3531D-07, -.6275D-07, -.1114D-06, -.1979D-06, & + & -.3512D-06, -.6224D-06, -.1102D-05, -.1946D-05, -.3424D-05, & + & -.6000D-05, -.1045D-04, -.1801D-04, -.3065D-04, -.5121D-04, & + & -.8342D-04, -.1317D-03, -.1996D-03, -.2884D-03, -.3953D-03, & + & -.5129D-03, -.6310D-03, -.7404D-03, -.8344D-03, -.9105D-03, & + & -.9691D-03, -.1013D-02, -.1044D-02, -.1066D-02, -.1082D-02, & + & -.1092D-02, -.1097D-02, -.1100D-02, -.1098D-02, -.1093D-02, & + & -.1084D-02, -.1069D-02, -.1048D-02, -.1020D-02, -.9815D-03, & + & -.9317D-03, -.8684D-03, -.7922D-03, -.7063D-03, -.6156D-03, & + & -.5255D-03, -.4402D-03, -.3628D-03, -.2947D-03, -.2365D-03, & + & -.1876D-03, -.1474D-03, -.1149D-03, -.8879D-04, -.6824D-04, & + & -.5204D-04/ + + data (calcpts(j,44), j = 1,neta) /-.8203D-12, -.1459D-11, & + & -.2593D-11, -.4612D-11, -.8204D-11, -.1459D-10, -.2594D-10, & + & -.4614D-10, -.8200D-10, -.1458D-09, -.2594D-09, -.4613D-09, & + & -.8202D-09, -.1459D-08, -.2592D-08, -.4610D-08, -.8198D-08, & + & -.1457D-07, -.2590D-07, -.4604D-07, -.8174D-07, -.1452D-06, & + & -.2576D-06, -.4566D-06, -.8081D-06, -.1427D-05, -.2512D-05, & + & -.4402D-05, -.7664D-05, -.1321D-04, -.2248D-04, -.3757D-04, & + & -.6120D-04, -.9659D-04, -.1464D-03, -.2116D-03, -.2900D-03, & + & -.3763D-03, -.4630D-03, -.5432D-03, -.6122D-03, -.6679D-03, & + & -.7110D-03, -.7430D-03, -.7662D-03, -.7826D-03, -.7939D-03, & + & -.8015D-03, -.8062D-03, -.8086D-03, -.8088D-03, -.8068D-03, & + & -.8022D-03, -.7944D-03, -.7828D-03, -.7667D-03, -.7451D-03, & + & -.7161D-03, -.6790D-03, -.6323D-03, -.5761D-03, -.5130D-03, & + & -.4466D-03, -.3806D-03, -.3185D-03, -.2621D-03, -.2128D-03, & + & -.1705D-03, -.1351D-03, -.1060D-03, -.8242D-04, -.6367D-04, & + & -.4882D-04/ + + data (calcpts(j,45), j = 1,neta) /-.6004D-12, -.1068D-11, & + & -.1898D-11, -.3376D-11, -.6005D-11, -.1068D-10, -.1899D-10, & + & -.3377D-10, -.6002D-10, -.1068D-09, -.1899D-09, -.3376D-09, & + & -.6003D-09, -.1068D-08, -.1897D-08, -.3374D-08, -.6001D-08, & + & -.1067D-07, -.1896D-07, -.3370D-07, -.5983D-07, -.1062D-06, & + & -.1886D-06, -.3342D-06, -.5915D-06, -.1045D-05, -.1838D-05, & + & -.3222D-05, -.5610D-05, -.9672D-05, -.1646D-04, -.2750D-04, & + & -.4479D-04, -.7070D-04, -.1072D-03, -.1549D-03, -.2123D-03, & + & -.2754D-03, -.3389D-03, -.3976D-03, -.4481D-03, -.4889D-03, & + & -.5204D-03, -.5439D-03, -.5608D-03, -.5729D-03, -.5812D-03, & + & -.5869D-03, -.5906D-03, -.5927D-03, -.5935D-03, -.5929D-03, & + & -.5908D-03, -.5869D-03, -.5807D-03, -.5718D-03, -.5596D-03, & + & -.5434D-03, -.5222D-03, -.4948D-03, -.4602D-03, -.4188D-03, & + & -.3725D-03, -.3239D-03, -.2758D-03, -.2305D-03, -.1895D-03, & + & -.1537D-03, -.1229D-03, -.9744D-04, -.7629D-04, -.5934D-04, & + & -.4584D-04/ + + data (calcpts(j,46), j = 1,neta) /-.4382D-12, -.7794D-12, & + & -.1385D-11, -.2464D-11, -.4383D-11, -.7793D-11, -.1386D-10, & + & -.2465D-10, -.4381D-10, -.7791D-10, -.1386D-09, -.2464D-09, & + & -.4381D-09, -.7792D-09, -.1385D-08, -.2463D-08, -.4380D-08, & + & -.7785D-08, -.1384D-07, -.2459D-07, -.4367D-07, -.7755D-07, & + & -.1376D-06, -.2439D-06, -.4317D-06, -.7625D-06, -.1342D-05, & + & -.2351D-05, -.4094D-05, -.7059D-05, -.1201D-04, -.2007D-04, & + & -.3269D-04, -.5160D-04, -.7822D-04, -.1130D-03, -.1549D-03, & + & -.2010D-03, -.2473D-03, -.2902D-03, -.3270D-03, -.3568D-03, & + & -.3798D-03, -.3969D-03, -.4093D-03, -.4181D-03, -.4243D-03, & + & -.4285D-03, -.4313D-03, -.4330D-03, -.4338D-03, -.4339D-03, & + & -.4331D-03, -.4312D-03, -.4281D-03, -.4233D-03, -.4165D-03, & + & -.4073D-03, -.3952D-03, -.3795D-03, -.3590D-03, -.3339D-03, & + & -.3036D-03, -.2697D-03, -.2342D-03, -.1992D-03, -.1662D-03, & + & -.1365D-03, -.1106D-03, -.8839D-04, -.6994D-04, -.5479D-04, & + & -.4249D-04/ + + data (calcpts(j,47), j = 1,neta) /-.3191D-12, -.5675D-12, & + & -.1009D-11, -.1794D-11, -.3191D-11, -.5674D-11, -.1009D-10, & + & -.1795D-10, -.3190D-10, -.5673D-10, -.1009D-09, -.1794D-09, & + & -.3190D-09, -.5674D-09, -.1008D-08, -.1793D-08, -.3189D-08, & + & -.5668D-08, -.1007D-07, -.1791D-07, -.3179D-07, -.5646D-07, & + & -.1002D-06, -.1776D-06, -.3143D-06, -.5552D-06, -.9769D-06, & + & -.1712D-05, -.2981D-05, -.5140D-05, -.8745D-05, -.1461D-04, & + & -.2380D-04, -.3757D-04, -.5695D-04, -.8230D-04, -.1128D-03, & + & -.1464D-03, -.1801D-03, -.2113D-03, -.2381D-03, -.2598D-03, & + & -.2765D-03, -.2890D-03, -.2980D-03, -.3045D-03, -.3090D-03, & + & -.3120D-03, -.3141D-03, -.3155D-03, -.3162D-03, -.3165D-03, & + & -.3162D-03, -.3154D-03, -.3139D-03, -.3114D-03, -.3077D-03, & + & -.3026D-03, -.2957D-03, -.2868D-03, -.2752D-03, -.2603D-03, & + & -.2417D-03, -.2195D-03, -.1948D-03, -.1690D-03, -.1435D-03, & + & -.1197D-03, -.9825D-04, -.7935D-04, -.6345D-04, -.5010D-04, & + & -.3915D-04/ + + data (calcpts(j,48), j = 1,neta) /-.2319D-12, -.4124D-12, & + & -.7330D-12, -.1304D-11, -.2319D-11, -.4123D-11, -.7332D-11, & + & -.1304D-10, -.2318D-10, -.4122D-10, -.7332D-10, -.1304D-09, & + & -.2318D-09, -.4123D-09, -.7327D-09, -.1303D-08, -.2317D-08, & + & -.4119D-08, -.7321D-08, -.1301D-07, -.2310D-07, -.4103D-07, & + & -.7282D-07, -.1291D-06, -.2284D-06, -.4035D-06, -.7099D-06, & + & -.1244D-05, -.2166D-05, -.3735D-05, -.6355D-05, -.1062D-04, & + & -.1730D-04, -.2730D-04, -.4139D-04, -.5981D-04, -.8197D-04, & + & -.1064D-03, -.1309D-03, -.1535D-03, -.1730D-03, -.1888D-03, & + & -.2010D-03, -.2100D-03, -.2166D-03, -.2213D-03, -.2245D-03, & + & -.2268D-03, -.2283D-03, -.2293D-03, -.2300D-03, -.2303D-03, & + & -.2303D-03, -.2299D-03, -.2292D-03, -.2280D-03, -.2261D-03, & + & -.2233D-03, -.2195D-03, -.2143D-03, -.2077D-03, -.1992D-03, & + & -.1883D-03, -.1747D-03, -.1585D-03, -.1406D-03, -.1218D-03, & + & -.1034D-03, -.8612D-04, -.7060D-04, -.5695D-04, -.4555D-04, & + & -.3595D-04/ + + data (calcpts(j,49), j = 1,neta) /-.1681D-12, -.2990D-12, & + & -.5315D-12, -.9453D-12, -.1681D-11, -.2990D-11, -.5317D-11, & + & -.9456D-11, -.1681D-10, -.2989D-10, -.5317D-10, -.9454D-10, & + & -.1681D-09, -.2990D-09, -.5313D-09, -.9449D-09, -.1680D-08, & + & -.2987D-08, -.5309D-08, -.9436D-08, -.1675D-07, -.2975D-07, & + & -.5281D-07, -.9359D-07, -.1656D-06, -.2926D-06, -.5148D-06, & + & -.9022D-06, -.1571D-05, -.2708D-05, -.4608D-05, -.7700D-05, & + & -.1254D-04, -.1980D-04, -.3001D-04, -.4337D-04, -.5944D-04, & + & -.7713D-04, -.9489D-04, -.1113D-03, -.1255D-03, -.1369D-03, & + & -.1457D-03, -.1523D-03, -.1571D-03, -.1604D-03, -.1628D-03, & + & -.1645D-03, -.1656D-03, -.1663D-03, -.1668D-03, -.1671D-03, & + & -.1672D-03, -.1671D-03, -.1668D-03, -.1662D-03, -.1652D-03, & + & -.1638D-03, -.1617D-03, -.1588D-03, -.1550D-03, -.1502D-03, & + & -.1439D-03, -.1359D-03, -.1260D-03, -.1143D-03, -.1012D-03, & + & -.8765D-04, -.7430D-04, -.6185D-04, -.5062D-04, -.4087D-04, & + & -.3257D-04/ + + data (dlaeta(j), j = 1,neta) / & + & -6d0, -5.83333333d0, -5.66666667d0, -5.5d0, -5.33333333d0, & + & -5.16666667d0, -5d0, -4.83333333d0, -4.66666667d0, -4.5d0, & + & -4.33333333d0, -4.16666667d0, -4d0, -3.83333333d0, & + & -3.66666667d0, -3.5d0, -3.33333333d0, -3.16666667d0, -3d0, & + & -2.83333333d0, -2.66666667d0, -2.5d0, -2.33333333d0, & + & -2.16666667d0, -2d0, -1.83333333d0, -1.66666667d0, -1.5d0, & + & -1.33333333d0, -1.16666667d0, -1d0, -0.83333333d0, -0.66666667d0,& + & -0.5d0, -0.33333333d0, -0.16666667d0, 0d0, 0.16666667d0, & + & 0.33333333d0, 0.5d0, 0.66666667d0, 0.83333333d0, 1d0, & + & 1.16666667d0, 1.33333333d0, 1.5d0, 1.66666667d0, 1.83333333d0, & + & 2d0, 2.16666667d0, 2.33333333d0, 2.5d0, 2.66666667d0, & + & 2.83333333d0, 3d0, 3.16666667d0, 3.33333333d0, 3.5d0, & + & 3.66666667d0, 3.83333333d0, 4d0, 4.16666667d0, 4.33333333d0, & + & 4.5d0, 4.66666667d0, 4.83333333d0, 5d0, 5.16666667d0, & + & 5.33333333d0, 5.5d0, 5.66666667d0, 5.83333333d0, 6d0/ + + data (dlaxi(j), j = 1,nxi) / & + & -3d0, -2.83333333d0, -2.66666667d0, -2.5d0, -2.33333333d0, & + & -2.16666667d0, -2d0, -1.83333333d0, -1.66666667d0, -1.5d0, & + & -1.33333333d0, -1.16666667d0, -1d0, -0.83333333d0, -0.66666667d0,& + & -0.5d0, -0.33333333d0, -0.16666667d0, 0d0, 0.16666667d0, & + & 0.33333333d0, 0.5d0, 0.66666667d0, 0.83333333d0, 1d0, & + & 1.16666667d0, 1.33333333d0, 1.5d0, 1.66666667d0, 1.83333333d0, & + & 2d0, 2.16666667d0, 2.33333333d0, 2.5d0, 2.66666667d0, & + & 2.83333333d0, 3d0, 3.16666667d0, 3.33333333d0, 3.5d0, & + & 3.66666667d0, 3.83333333d0, 4d0, 4.16666667d0, 4.33333333d0, & + & 4.5d0, 4.66666667d0, 4.83333333d0, 5d0/ + + dleta = dlog10(eta) + dlxi = dlog10(xi) + if (dlxi .le. dlaxi(1)) dlxi = dlaxi(1) + if (dlxi .ge. dlaxi(nxi)) dlxi = dlaxi(nxi) + if (dleta .ge. dlaeta(neta)) dleta = dlaeta(neta) + if (dleta .le. dlaeta(1)) dleta = dlaeta(1) + call locate(dlaeta,neta, dleta, ieta) + call locate(dlaxi, nxi, dlxi, ixi) +! interpolating between the appropriate points + delxi = 1d0/6d0 + deleta = 1d0/6d0 +! lagrange 3-pt. + if (ixi .le. 2) ixi = 2 + if (ixi .ge. 48) ixi = 48 + if (ieta .le. 2) ieta = 2 + if (ieta .ge. 72) ieta = 72 + pxi = (dlxi - dlaxi(ixi))/delxi + f(-1) = pxi*(pxi-1d0)/2d0*calcpts(ieta-1,ixi-1) + & + & (1d0 - pxi**2)*calcpts(ieta-1,ixi) + & + & pxi*(pxi+1d0)/2d0*calcpts(ieta-1,ixi+1) + f(0) = pxi*(pxi-1d0)/2d0*calcpts(ieta,ixi-1) + & + & (1d0 - pxi**2)*calcpts(ieta,ixi) + & + & pxi*(pxi+1d0)/2d0*calcpts(ieta,ixi+1) + f(1) = pxi*(pxi-1d0)/2d0*calcpts(ieta+1,ixi-1) + & + & (1d0 - pxi**2)*calcpts(ieta+1,ixi) + & + & pxi*(pxi+1d0)/2d0*calcpts(ieta+1,ixi+1) + peta = (dleta - dlaeta(ieta))/deleta + h1_HTq = peta*(peta-1d0)/2d0*f(-1) + & + & (1d0 - peta**2)*f(0) + & + & peta*(peta+1d0)/2d0*f(1) +!MB + + peta*(peta+1d0)/2d0*f(1) + return + END + +! =========================================== + double precision function h1bar_HTq(eta,xi) +! =========================================== + +! eq (27) in PLB347 (1995) 143 - 151 for the transverse piece +! MSbar scheme +! This routine is called subcqhtbar in the original code. +! Called sqtbar in updated code (03/06/96). + + implicit none + integer neta, nxi + parameter (neta = 73, nxi = 49) + double precision calcpts(neta, nxi), dlaeta(neta), dlaxi(nxi) + double precision eta, xi, dleta, dlxi + double precision pxi, peta, f(-1:1), delxi, deleta + integer j, ieta, ixi + + data (calcpts(j, 1), j = 1,neta) /0.9803D-10, 0.1739D-09, & + & 0.3086D-09, 0.5482D-09, 0.9743D-09, 0.1731D-08, 0.3078D-08, & + & 0.5473D-08, 0.9724D-08, 0.1729D-07, 0.3076D-07, 0.5469D-07, & + & 0.9724D-07, 0.1729D-06, 0.3073D-06, 0.5465D-06, 0.9718D-06, & + & 0.1727D-05, 0.3070D-05, 0.5455D-05, 0.9683D-05, 0.1719D-04, & + & 0.3050D-04, 0.5401D-04, 0.9550D-04, 0.1684D-03, 0.2957D-03, & + & 0.5166D-03, 0.8955D-03, 0.1534D-02, 0.2586D-02, 0.4266D-02, & + & 0.6826D-02, 0.1052D-01, 0.1546D-01, 0.2147D-01, 0.2798D-01, & + & 0.3406D-01, 0.3874D-01, 0.4130D-01, 0.4150D-01, 0.3958D-01, & + & 0.3613D-01, 0.3180D-01, 0.2716D-01, 0.2264D-01, 0.1849D-01, & + & 0.1485D-01, 0.1178D-01, 0.9225D-02, 0.7162D-02, 0.5499D-02, & + & 0.4200D-02, 0.3187D-02, 0.2403D-02, 0.1803D-02, 0.1348D-02, & + & 0.1000D-02, 0.7489D-03, 0.5516D-03, 0.4103D-03, 0.2962D-03, & + & 0.2103D-03, 0.1530D-03, 0.1099D-03, 0.8117D-04, 0.6703D-04, & + & 0.3763D-04, 0.3803D-04, 0.2330D-04, 0.2349D-04, 0.8619D-05, & + & 0.8705D-05/ + + data (calcpts(j, 2), j = 1,neta) /0.9804D-10, 0.1739D-09, & + & 0.3085D-09, 0.5481D-09, 0.9742D-09, 0.1731D-08, 0.3077D-08, & + & 0.5472D-08, 0.9723D-08, 0.1729D-07, 0.3076D-07, 0.5468D-07, & + & 0.9722D-07, 0.1729D-06, 0.3073D-06, 0.5464D-06, 0.9717D-06, & + & 0.1727D-05, 0.3069D-05, 0.5455D-05, 0.9682D-05, 0.1719D-04, & + & 0.3050D-04, 0.5401D-04, 0.9548D-04, 0.1684D-03, 0.2957D-03, & + & 0.5165D-03, 0.8953D-03, 0.1534D-02, 0.2586D-02, 0.4265D-02, & + & 0.6827D-02, 0.1052D-01, 0.1546D-01, 0.2147D-01, 0.2797D-01, & + & 0.3407D-01, 0.3875D-01, 0.4129D-01, 0.4150D-01, 0.3958D-01, & + & 0.3613D-01, 0.3180D-01, 0.2716D-01, 0.2264D-01, 0.1850D-01, & + & 0.1486D-01, 0.1177D-01, 0.9227D-02, 0.7149D-02, 0.5501D-02, & + & 0.4202D-02, 0.3189D-02, 0.2405D-02, 0.1804D-02, 0.1350D-02, & + & 0.1002D-02, 0.7507D-03, 0.5534D-03, 0.4121D-03, 0.2980D-03, & + & 0.2120D-03, 0.1548D-03, 0.1117D-03, 0.8293D-04, 0.5380D-04, & + & 0.3939D-04, 0.2480D-04, 0.2507D-04, 0.1026D-04, 0.1039D-04, & + & 0.1047D-04/ + + data (calcpts(j, 3), j = 1,neta) /0.9802D-10, 0.1739D-09, & + & 0.3085D-09, 0.5481D-09, 0.9742D-09, 0.1731D-08, 0.3077D-08, & + & 0.5472D-08, 0.9722D-08, 0.1729D-07, 0.3076D-07, 0.5468D-07, & + & 0.9722D-07, 0.1729D-06, 0.3072D-06, 0.5464D-06, 0.9717D-06, & + & 0.1727D-05, 0.3069D-05, 0.5454D-05, 0.9682D-05, 0.1719D-04, & + & 0.3049D-04, 0.5400D-04, 0.9548D-04, 0.1684D-03, 0.2956D-03, & + & 0.5165D-03, 0.8953D-03, 0.1534D-02, 0.2585D-02, 0.4265D-02, & + & 0.6825D-02, 0.1052D-01, 0.1546D-01, 0.2147D-01, 0.2798D-01, & + & 0.3406D-01, 0.3873D-01, 0.4130D-01, 0.4150D-01, 0.3958D-01, & + & 0.3613D-01, 0.3180D-01, 0.2716D-01, 0.2264D-01, 0.1849D-01, & + & 0.1485D-01, 0.1178D-01, 0.9223D-02, 0.7160D-02, 0.5497D-02, & + & 0.4198D-02, 0.3184D-02, 0.2401D-02, 0.1800D-02, 0.1345D-02, & + & 0.9976D-03, 0.7463D-03, 0.5490D-03, 0.4077D-03, 0.2936D-03, & + & 0.2227D-03, 0.1654D-03, 0.1223D-03, 0.7854D-04, 0.6441D-04, & + & 0.5000D-04, 0.3540D-04, 0.2068D-04, 0.2087D-04, 0.5994D-05, & + & 0.6081D-05/ + + data (calcpts(j, 4), j = 1,neta) /0.9800D-10, 0.1739D-09, & + & 0.3085D-09, 0.5480D-09, 0.9740D-09, 0.1731D-08, 0.3077D-08, & + & 0.5471D-08, 0.9721D-08, 0.1729D-07, 0.3075D-07, 0.5467D-07, & + & 0.9720D-07, 0.1729D-06, 0.3072D-06, 0.5463D-06, 0.9715D-06, & + & 0.1727D-05, 0.3069D-05, 0.5454D-05, 0.9680D-05, 0.1718D-04, & + & 0.3049D-04, 0.5399D-04, 0.9547D-04, 0.1684D-03, 0.2956D-03, & + & 0.5164D-03, 0.8952D-03, 0.1533D-02, 0.2585D-02, 0.4264D-02, & + & 0.6824D-02, 0.1052D-01, 0.1546D-01, 0.2147D-01, 0.2797D-01, & + & 0.3407D-01, 0.3873D-01, 0.4129D-01, 0.4149D-01, 0.3959D-01, & + & 0.3613D-01, 0.3181D-01, 0.2716D-01, 0.2264D-01, 0.1850D-01, & + & 0.1485D-01, 0.1178D-01, 0.9225D-02, 0.7161D-02, 0.5498D-02, & + & 0.4199D-02, 0.3186D-02, 0.2402D-02, 0.1801D-02, 0.1347D-02, & + & 0.9991D-03, 0.7478D-03, 0.5506D-03, 0.4092D-03, 0.2951D-03, & + & 0.2242D-03, 0.1519D-03, 0.1088D-03, 0.8006D-04, 0.6593D-04, & + & 0.5152D-04, 0.3692D-04, 0.2220D-04, 0.2239D-04, 0.7513D-05, & + & 0.7599D-05/ + + data (calcpts(j, 5), j = 1,neta) /0.9798D-10, 0.1738D-09, & + & 0.3084D-09, 0.5479D-09, 0.9738D-09, 0.1730D-08, 0.3076D-08, & + & 0.5470D-08, 0.9718D-08, 0.1728D-07, 0.3074D-07, 0.5466D-07, & + & 0.9718D-07, 0.1728D-06, 0.3071D-06, 0.5462D-06, 0.9713D-06, & + & 0.1726D-05, 0.3068D-05, 0.5452D-05, 0.9678D-05, 0.1718D-04, & + & 0.3048D-04, 0.5398D-04, 0.9544D-04, 0.1683D-03, 0.2955D-03, & + & 0.5163D-03, 0.8950D-03, 0.1533D-02, 0.2584D-02, 0.4263D-02, & + & 0.6823D-02, 0.1052D-01, 0.1546D-01, 0.2146D-01, 0.2797D-01, & + & 0.3406D-01, 0.3872D-01, 0.4130D-01, 0.4149D-01, 0.3958D-01, & + & 0.3613D-01, 0.3180D-01, 0.2715D-01, 0.2263D-01, 0.1849D-01, & + & 0.1486D-01, 0.1177D-01, 0.9228D-02, 0.7150D-02, 0.5502D-02, & + & 0.4202D-02, 0.3189D-02, 0.2406D-02, 0.1805D-02, 0.1350D-02, & + & 0.1002D-02, 0.7510D-03, 0.5538D-03, 0.3974D-03, 0.2984D-03, & + & 0.2124D-03, 0.1551D-03, 0.1120D-03, 0.8327D-04, 0.5414D-04, & + & 0.3973D-04, 0.2513D-04, 0.2541D-04, 0.1059D-04, 0.1072D-04, & + & 0.1081D-04/ + + data (calcpts(j, 6), j = 1,neta) /0.9794D-10, 0.1738D-09, & + & 0.3083D-09, 0.5477D-09, 0.9735D-09, 0.1730D-08, 0.3075D-08, & + & 0.5468D-08, 0.9715D-08, 0.1728D-07, 0.3073D-07, 0.5464D-07, & + & 0.9715D-07, 0.1728D-06, 0.3070D-06, 0.5460D-06, 0.9710D-06, & + & 0.1726D-05, 0.3067D-05, 0.5450D-05, 0.9674D-05, 0.1718D-04, & + & 0.3047D-04, 0.5396D-04, 0.9541D-04, 0.1683D-03, 0.2954D-03, & + & 0.5161D-03, 0.8947D-03, 0.1532D-02, 0.2584D-02, 0.4262D-02, & + & 0.6821D-02, 0.1052D-01, 0.1546D-01, 0.2146D-01, 0.2796D-01, & + & 0.3405D-01, 0.3872D-01, 0.4128D-01, 0.4148D-01, 0.3958D-01, & + & 0.3612D-01, 0.3180D-01, 0.2716D-01, 0.2263D-01, 0.1849D-01, & + & 0.1486D-01, 0.1177D-01, 0.9228D-02, 0.7149D-02, 0.5501D-02, & + & 0.4201D-02, 0.3188D-02, 0.2405D-02, 0.1804D-02, 0.1349D-02, & + & 0.1001D-02, 0.7498D-03, 0.5525D-03, 0.4112D-03, 0.2971D-03, & + & 0.2111D-03, 0.1539D-03, 0.1108D-03, 0.8203D-04, 0.6790D-04, & + & 0.3849D-04, 0.3889D-04, 0.2416D-04, 0.9350D-05, 0.9477D-05, & + & 0.9564D-05/ + + data (calcpts(j, 7), j = 1,neta) /0.9790D-10, 0.1737D-09, & + & 0.3081D-09, 0.5474D-09, 0.9730D-09, 0.1729D-08, 0.3073D-08, & + & 0.5465D-08, 0.9711D-08, 0.1727D-07, 0.3072D-07, 0.5461D-07, & + & 0.9710D-07, 0.1727D-06, 0.3069D-06, 0.5457D-06, 0.9705D-06, & + & 0.1725D-05, 0.3065D-05, 0.5448D-05, 0.9670D-05, 0.1717D-04, & + & 0.3046D-04, 0.5394D-04, 0.9537D-04, 0.1682D-03, 0.2953D-03, & + & 0.5159D-03, 0.8943D-03, 0.1532D-02, 0.2582D-02, 0.4260D-02, & + & 0.6819D-02, 0.1051D-01, 0.1545D-01, 0.2145D-01, 0.2795D-01, & + & 0.3404D-01, 0.3871D-01, 0.4127D-01, 0.4147D-01, 0.3956D-01, & + & 0.3612D-01, 0.3180D-01, 0.2715D-01, 0.2263D-01, 0.1849D-01, & + & 0.1486D-01, 0.1177D-01, 0.9229D-02, 0.7150D-02, 0.5501D-02, & + & 0.4202D-02, 0.3189D-02, 0.2405D-02, 0.1804D-02, 0.1349D-02, & + & 0.1001D-02, 0.7501D-03, 0.5528D-03, 0.4114D-03, 0.2973D-03, & + & 0.2114D-03, 0.1541D-03, 0.1110D-03, 0.8225D-04, 0.6811D-04, & + & 0.3871D-04, 0.3911D-04, 0.2438D-04, 0.9568D-05, 0.9695D-05, & + & 0.9782D-05/ + + data (calcpts(j, 8), j = 1,neta) /0.9783D-10, 0.1736D-09, & + & 0.3079D-09, 0.5470D-09, 0.9723D-09, 0.1728D-08, 0.3071D-08, & + & 0.5461D-08, 0.9704D-08, 0.1726D-07, 0.3069D-07, 0.5457D-07, & + & 0.9703D-07, 0.1726D-06, 0.3066D-06, 0.5453D-06, 0.9698D-06, & + & 0.1724D-05, 0.3063D-05, 0.5444D-05, 0.9663D-05, 0.1715D-04, & + & 0.3043D-04, 0.5390D-04, 0.9530D-04, 0.1681D-03, 0.2951D-03, & + & 0.5155D-03, 0.8937D-03, 0.1531D-02, 0.2581D-02, 0.4258D-02, & + & 0.6815D-02, 0.1051D-01, 0.1544D-01, 0.2144D-01, 0.2794D-01, & + & 0.3404D-01, 0.3870D-01, 0.4126D-01, 0.4146D-01, 0.3956D-01, & + & 0.3611D-01, 0.3178D-01, 0.2714D-01, 0.2263D-01, 0.1848D-01, & + & 0.1485D-01, 0.1178D-01, 0.9218D-02, 0.7154D-02, 0.5505D-02, & + & 0.4206D-02, 0.3192D-02, 0.2409D-02, 0.1807D-02, 0.1353D-02, & + & 0.1005D-02, 0.7385D-03, 0.5562D-03, 0.3999D-03, 0.3008D-03, & + & 0.2148D-03, 0.1575D-03, 0.1144D-03, 0.8568D-04, 0.5654D-04, & + & 0.4213D-04, 0.2753D-04, 0.2781D-04, 0.1299D-04, 0.1312D-04, & + & 0.1321D-04/ + + data (calcpts(j, 9), j = 1,neta) /0.9773D-10, 0.1734D-09, & + & 0.3076D-09, 0.5464D-09, 0.9713D-09, 0.1726D-08, 0.3068D-08, & + & 0.5455D-08, 0.9693D-08, 0.1724D-07, 0.3066D-07, 0.5451D-07, & + & 0.9693D-07, 0.1724D-06, 0.3063D-06, 0.5447D-06, 0.9688D-06, & + & 0.1722D-05, 0.3060D-05, 0.5438D-05, 0.9653D-05, 0.1714D-04, & + & 0.3040D-04, 0.5384D-04, 0.9520D-04, 0.1679D-03, 0.2948D-03, & + & 0.5150D-03, 0.8928D-03, 0.1529D-02, 0.2578D-02, 0.4254D-02, & + & 0.6808D-02, 0.1050D-01, 0.1543D-01, 0.2143D-01, 0.2792D-01, & + & 0.3401D-01, 0.3868D-01, 0.4125D-01, 0.4145D-01, 0.3954D-01, & + & 0.3611D-01, 0.3177D-01, 0.2715D-01, 0.2263D-01, 0.1848D-01, & + & 0.1486D-01, 0.1177D-01, 0.9223D-02, 0.7158D-02, 0.5509D-02, & + & 0.4209D-02, 0.3195D-02, 0.2412D-02, 0.1810D-02, 0.1355D-02, & + & 0.1008D-02, 0.7413D-03, 0.5440D-03, 0.4026D-03, 0.3035D-03, & + & 0.2175D-03, 0.1603D-03, 0.1171D-03, 0.8839D-04, 0.5926D-04, & + & 0.4485D-04, 0.3025D-04, 0.3052D-04, 0.1571D-04, 0.1584D-04, & + & 0.1592D-04/ + + data (calcpts(j,10), j = 1,neta) /0.9756D-10, 0.1731D-09, & + & 0.3071D-09, 0.5456D-09, 0.9697D-09, 0.1723D-08, 0.3063D-08, & + & 0.5447D-08, 0.9679D-08, 0.1721D-07, 0.3062D-07, 0.5443D-07, & + & 0.9678D-07, 0.1721D-06, 0.3058D-06, 0.5439D-06, 0.9673D-06, & + & 0.1719D-05, 0.3055D-05, 0.5430D-05, 0.9637D-05, 0.1711D-04, & + & 0.3035D-04, 0.5376D-04, 0.9505D-04, 0.1677D-03, 0.2943D-03, & + & 0.5142D-03, 0.8915D-03, 0.1527D-02, 0.2575D-02, 0.4248D-02, & + & 0.6801D-02, 0.1048D-01, 0.1541D-01, 0.2141D-01, 0.2790D-01, & + & 0.3398D-01, 0.3866D-01, 0.4121D-01, 0.4142D-01, 0.3952D-01, & + & 0.3609D-01, 0.3177D-01, 0.2714D-01, 0.2261D-01, 0.1847D-01, & + & 0.1485D-01, 0.1177D-01, 0.9215D-02, 0.7149D-02, 0.5499D-02, & + & 0.4199D-02, 0.3185D-02, 0.2401D-02, 0.1799D-02, 0.1344D-02, & + & 0.9965D-03, 0.7451D-03, 0.5477D-03, 0.4064D-03, 0.2922D-03, & + & 0.2212D-03, 0.1640D-03, 0.1208D-03, 0.9209D-04, 0.6295D-04, & + & 0.4854D-04, 0.3394D-04, 0.1922D-04, 0.1940D-04, 0.1953D-04, & + & 0.4614D-05/ + + data (calcpts(j,11), j = 1,neta) /0.9733D-10, 0.1727D-09, & + & 0.3064D-09, 0.5443D-09, 0.9675D-09, 0.1719D-08, 0.3056D-08, & + & 0.5434D-08, 0.9656D-08, 0.1717D-07, 0.3055D-07, 0.5431D-07, & + & 0.9657D-07, 0.1717D-06, 0.3052D-06, 0.5427D-06, 0.9650D-06, & + & 0.1715D-05, 0.3048D-05, 0.5417D-05, 0.9615D-05, 0.1707D-04, & + & 0.3029D-04, 0.5364D-04, 0.9484D-04, 0.1673D-03, 0.2937D-03, & + & 0.5131D-03, 0.8895D-03, 0.1524D-02, 0.2570D-02, 0.4240D-02, & + & 0.6788D-02, 0.1047D-01, 0.1539D-01, 0.2138D-01, 0.2786D-01, & + & 0.3395D-01, 0.3862D-01, 0.4118D-01, 0.4139D-01, 0.3949D-01, & + & 0.3606D-01, 0.3175D-01, 0.2711D-01, 0.2261D-01, 0.1847D-01, & + & 0.1484D-01, 0.1176D-01, 0.9213D-02, 0.7146D-02, 0.5496D-02, & + & 0.4195D-02, 0.3180D-02, 0.2411D-02, 0.1809D-02, 0.1354D-02, & + & 0.1006D-02, 0.7398D-03, 0.5425D-03, 0.4010D-03, 0.3019D-03, & + & 0.2159D-03, 0.1586D-03, 0.1155D-03, 0.8672D-04, 0.5758D-04, & + & 0.4316D-04, 0.2856D-04, 0.2883D-04, 0.1402D-04, 0.1415D-04, & + & 0.1423D-04/ + + data (calcpts(j,12), j = 1,neta) /0.9701D-10, 0.1721D-09, & + & 0.3054D-09, 0.5425D-09, 0.9642D-09, 0.1714D-08, 0.3046D-08, & + & 0.5416D-08, 0.9625D-08, 0.1712D-07, 0.3044D-07, 0.5412D-07, & + & 0.9624D-07, 0.1712D-06, 0.3041D-06, 0.5409D-06, 0.9619D-06, & + & 0.1710D-05, 0.3038D-05, 0.5400D-05, 0.9584D-05, 0.1702D-04, & + & 0.3019D-04, 0.5346D-04, 0.9453D-04, 0.1667D-03, 0.2927D-03, & + & 0.5115D-03, 0.8867D-03, 0.1519D-02, 0.2562D-02, 0.4228D-02, & + & 0.6769D-02, 0.1044D-01, 0.1535D-01, 0.2133D-01, 0.2781D-01, & + & 0.3388D-01, 0.3855D-01, 0.4112D-01, 0.4133D-01, 0.3945D-01, & + & 0.3602D-01, 0.3172D-01, 0.2710D-01, 0.2260D-01, 0.1846D-01, & + & 0.1484D-01, 0.1176D-01, 0.9208D-02, 0.7154D-02, 0.5502D-02, & + & 0.4200D-02, 0.3185D-02, 0.2400D-02, 0.1799D-02, 0.1343D-02, & + & 0.1010D-02, 0.7437D-03, 0.5463D-03, 0.4048D-03, 0.2906D-03, & + & 0.2196D-03, 0.1623D-03, 0.1191D-03, 0.9040D-04, 0.6126D-04, & + & 0.4684D-04, 0.3224D-04, 0.1751D-04, 0.1769D-04, 0.1782D-04, & + & 0.2904D-05/ + + data (calcpts(j,13), j = 1,neta) /0.9653D-10, 0.1713D-09, & + & 0.3039D-09, 0.5399D-09, 0.9596D-09, 0.1705D-08, 0.3031D-08, & + & 0.5390D-08, 0.9577D-08, 0.1703D-07, 0.3030D-07, 0.5386D-07, & + & 0.9577D-07, 0.1703D-06, 0.3027D-06, 0.5382D-06, 0.9572D-06, & + & 0.1701D-05, 0.3023D-05, 0.5373D-05, 0.9537D-05, 0.1693D-04, & + & 0.3004D-04, 0.5321D-04, 0.9408D-04, 0.1659D-03, 0.2913D-03, & + & 0.5091D-03, 0.8826D-03, 0.1512D-02, 0.2551D-02, 0.4210D-02, & + & 0.6742D-02, 0.1040D-01, 0.1530D-01, 0.2126D-01, 0.2773D-01, & + & 0.3380D-01, 0.3846D-01, 0.4104D-01, 0.4126D-01, 0.3938D-01, & + & 0.3598D-01, 0.3168D-01, 0.2707D-01, 0.2257D-01, 0.1845D-01, & + & 0.1482D-01, 0.1175D-01, 0.9208D-02, 0.7152D-02, 0.5498D-02, & + & 0.4195D-02, 0.3179D-02, 0.2408D-02, 0.1806D-02, 0.1350D-02, & + & 0.1002D-02, 0.7506D-03, 0.5531D-03, 0.4116D-03, 0.2974D-03, & + & 0.2113D-03, 0.1540D-03, 0.1108D-03, 0.8206D-04, 0.6791D-04, & + & 0.3849D-04, 0.3888D-04, 0.2415D-04, 0.2433D-04, 0.9458D-05, & + & 0.9543D-05/ + + data (calcpts(j,14), j = 1,neta) /0.9585D-10, 0.1701D-09, & + & 0.3017D-09, 0.5360D-09, 0.9528D-09, 0.1693D-08, 0.3010D-08, & + & 0.5352D-08, 0.9510D-08, 0.1691D-07, 0.3008D-07, 0.5348D-07, & + & 0.9509D-07, 0.1691D-06, 0.3005D-06, 0.5344D-06, 0.9504D-06, & + & 0.1689D-05, 0.3002D-05, 0.5335D-05, 0.9470D-05, 0.1681D-04, & + & 0.2983D-04, 0.5283D-04, 0.9341D-04, 0.1648D-03, 0.2893D-03, & + & 0.5056D-03, 0.8766D-03, 0.1502D-02, 0.2534D-02, 0.4184D-02, & + & 0.6704D-02, 0.1034D-01, 0.1522D-01, 0.2116D-01, 0.2761D-01, & + & 0.3367D-01, 0.3833D-01, 0.4091D-01, 0.4114D-01, 0.3930D-01, & + & 0.3591D-01, 0.3162D-01, 0.2703D-01, 0.2253D-01, 0.1843D-01, & + & 0.1481D-01, 0.1174D-01, 0.9207D-02, 0.7131D-02, 0.5490D-02, & + & 0.4200D-02, 0.3182D-02, 0.2396D-02, 0.1808D-02, 0.1352D-02, & + & 0.1004D-02, 0.7369D-03, 0.5542D-03, 0.3976D-03, 0.2983D-03, & + & 0.2122D-03, 0.1549D-03, 0.1117D-03, 0.8293D-04, 0.5377D-04, & + & 0.3935D-04, 0.2474D-04, 0.2500D-04, 0.1018D-04, 0.1031D-04, & + & 0.1039D-04/ + + data (calcpts(j,15), j = 1,neta) /0.9484D-10, 0.1683D-09, & + & 0.2986D-09, 0.5305D-09, 0.9430D-09, 0.1676D-08, 0.2979D-08, & + & 0.5297D-08, 0.9412D-08, 0.1674D-07, 0.2977D-07, 0.5293D-07, & + & 0.9412D-07, 0.1674D-06, 0.2975D-06, 0.5290D-06, 0.9407D-06, & + & 0.1672D-05, 0.2971D-05, 0.5281D-05, 0.9373D-05, 0.1664D-04, & + & 0.2953D-04, 0.5229D-04, 0.9248D-04, 0.1631D-03, 0.2864D-03, & + & 0.5006D-03, 0.8680D-03, 0.1488D-02, 0.2511D-02, 0.4147D-02, & + & 0.6646D-02, 0.1026D-01, 0.1511D-01, 0.2102D-01, 0.2744D-01, & + & 0.3347D-01, 0.3814D-01, 0.4072D-01, 0.4099D-01, 0.3916D-01, & + & 0.3580D-01, 0.3155D-01, 0.2697D-01, 0.2249D-01, 0.1839D-01, & + & 0.1478D-01, 0.1173D-01, 0.9194D-02, 0.7127D-02, 0.5482D-02, & + & 0.4189D-02, 0.3185D-02, 0.2397D-02, 0.1809D-02, 0.1352D-02, & + & 0.1003D-02, 0.7511D-03, 0.5532D-03, 0.4115D-03, 0.2971D-03, & + & 0.2110D-03, 0.1536D-03, 0.1104D-03, 0.8161D-04, 0.6744D-04, & + & 0.3800D-04, 0.3839D-04, 0.2365D-04, 0.2383D-04, 0.8947D-05, & + & 0.9030D-05/ + + data (calcpts(j,16), j = 1,neta) /0.9341D-10, 0.1658D-09, & + & 0.2941D-09, 0.5226D-09, 0.9290D-09, 0.1651D-08, 0.2935D-08, & + & 0.5219D-08, 0.9272D-08, 0.1649D-07, 0.2933D-07, 0.5215D-07, & + & 0.9273D-07, 0.1649D-06, 0.2930D-06, 0.5211D-06, 0.9268D-06, & + & 0.1647D-05, 0.2927D-05, 0.5203D-05, 0.9235D-05, 0.1640D-04, & + & 0.2909D-04, 0.5153D-04, 0.9111D-04, 0.1607D-03, 0.2823D-03, & + & 0.4934D-03, 0.8558D-03, 0.1467D-02, 0.2477D-02, 0.4092D-02, & + & 0.6564D-02, 0.1014D-01, 0.1494D-01, 0.2081D-01, 0.2718D-01, & + & 0.3319D-01, 0.3784D-01, 0.4044D-01, 0.4073D-01, 0.3894D-01, & + & 0.3563D-01, 0.3141D-01, 0.2687D-01, 0.2244D-01, 0.1834D-01, & + & 0.1475D-01, 0.1170D-01, 0.9181D-02, 0.7122D-02, 0.5486D-02, & + & 0.4189D-02, 0.3183D-02, 0.2393D-02, 0.1804D-02, 0.1346D-02, & + & 0.9968D-03, 0.7442D-03, 0.5461D-03, 0.4042D-03, 0.3047D-03, & + & 0.2185D-03, 0.1611D-03, 0.1178D-03, 0.8900D-04, 0.5981D-04, & + & 0.4536D-04, 0.3073D-04, 0.3099D-04, 0.1617D-04, 0.1628D-04, & + & 0.1637D-04/ + + data (calcpts(j,17), j = 1,neta) /0.9140D-10, 0.1622D-09, & + & 0.2878D-09, 0.5114D-09, 0.9091D-09, 0.1616D-08, 0.2872D-08, & + & 0.5107D-08, 0.9075D-08, 0.1614D-07, 0.2871D-07, 0.5104D-07, & + & 0.9076D-07, 0.1614D-06, 0.2868D-06, 0.5100D-06, 0.9071D-06, & + & 0.1612D-05, 0.2865D-05, 0.5092D-05, 0.9038D-05, 0.1605D-04, & + & 0.2847D-04, 0.5044D-04, 0.8919D-04, 0.1574D-03, 0.2764D-03, & + & 0.4832D-03, 0.8382D-03, 0.1438D-02, 0.2428D-02, 0.4014D-02, & + & 0.6444D-02, 0.9965D-02, 0.1470D-01, 0.2049D-01, 0.2681D-01, & + & 0.3278D-01, 0.3741D-01, 0.4002D-01, 0.4037D-01, 0.3863D-01, & + & 0.3538D-01, 0.3122D-01, 0.2673D-01, 0.2233D-01, 0.1826D-01, & + & 0.1470D-01, 0.1167D-01, 0.9149D-02, 0.7108D-02, 0.5465D-02, & + & 0.4178D-02, 0.3168D-02, 0.2391D-02, 0.1800D-02, 0.1341D-02, & + & 0.1006D-02, 0.7379D-03, 0.5545D-03, 0.3973D-03, 0.2977D-03, & + & 0.2113D-03, 0.1538D-03, 0.1105D-03, 0.8168D-04, 0.6746D-04, & + & 0.3800D-04, 0.3836D-04, 0.2361D-04, 0.8782D-05, 0.8897D-05, & + & 0.8976D-05/ + + data (calcpts(j,18), j = 1,neta) /0.8860D-10, 0.1573D-09, & + & 0.2791D-09, 0.4959D-09, 0.8816D-09, 0.1567D-08, 0.2785D-08, & + & 0.4953D-08, 0.8802D-08, 0.1565D-07, 0.2784D-07, 0.4950D-07, & + & 0.8801D-07, 0.1565D-06, 0.2782D-06, 0.4947D-06, 0.8797D-06, & + & 0.1564D-05, 0.2779D-05, 0.4939D-05, 0.8766D-05, 0.1557D-04, & + & 0.2762D-04, 0.4892D-04, 0.8653D-04, 0.1527D-03, 0.2682D-03, & + & 0.4689D-03, 0.8138D-03, 0.1396D-02, 0.2360D-02, 0.3904D-02, & + & 0.6272D-02, 0.9714D-02, 0.1435D-01, 0.2004D-01, 0.2626D-01, & + & 0.3217D-01, 0.3678D-01, 0.3942D-01, 0.3983D-01, 0.3817D-01, & + & 0.3502D-01, 0.3095D-01, 0.2653D-01, 0.2218D-01, 0.1817D-01, & + & 0.1462D-01, 0.1162D-01, 0.9119D-02, 0.7079D-02, 0.5455D-02, & + & 0.4161D-02, 0.3161D-02, 0.2381D-02, 0.1787D-02, 0.1342D-02, & + & 0.9912D-03, 0.7374D-03, 0.5534D-03, 0.3960D-03, 0.2961D-03, & + & 0.2096D-03, 0.1520D-03, 0.1086D-03, 0.7971D-04, 0.6547D-04, & + & 0.5098D-04, 0.3633D-04, 0.2157D-04, 0.2173D-04, 0.6842D-05, & + & 0.6917D-05/ + + data (calcpts(j,19), j = 1,neta) /0.8482D-10, 0.1506D-09, & + & 0.2673D-09, 0.4749D-09, 0.8443D-09, 0.1501D-08, 0.2668D-08, & + & 0.4744D-08, 0.8430D-08, 0.1499D-07, 0.2667D-07, 0.4741D-07, & + & 0.8431D-07, 0.1499D-06, 0.2664D-06, 0.4738D-06, 0.8427D-06, & + & 0.1498D-05, 0.2662D-05, 0.4730D-05, 0.8397D-05, 0.1491D-04, & + & 0.2646D-04, 0.4687D-04, 0.8290D-04, 0.1463D-03, 0.2570D-03, & + & 0.4495D-03, 0.7805D-03, 0.1340D-02, 0.2266D-02, 0.3752D-02, & + & 0.6036D-02, 0.9363D-02, 0.1386D-01, 0.1939D-01, 0.2547D-01, & + & 0.3127D-01, 0.3585D-01, 0.3853D-01, 0.3902D-01, 0.3751D-01, & + & 0.3448D-01, 0.3054D-01, 0.2622D-01, 0.2195D-01, 0.1800D-01, & + & 0.1451D-01, 0.1154D-01, 0.9062D-02, 0.7047D-02, 0.5424D-02, & + & 0.4152D-02, 0.3145D-02, 0.2376D-02, 0.1795D-02, 0.1333D-02, & + & 0.9950D-03, 0.7403D-03, 0.5407D-03, 0.3978D-03, 0.2977D-03, & + & 0.2110D-03, 0.1532D-03, 0.1098D-03, 0.8080D-04, 0.6651D-04, & + & 0.3700D-04, 0.3733D-04, 0.2255D-04, 0.2271D-04, 0.7810D-05, & + & 0.7881D-05/ + + data (calcpts(j,20), j = 1,neta) /0.7986D-10, 0.1418D-09, & + & 0.2517D-09, 0.4474D-09, 0.7953D-09, 0.1414D-08, 0.2513D-08, & + & 0.4469D-08, 0.7942D-08, 0.1413D-07, 0.2512D-07, 0.4467D-07, & + & 0.7942D-07, 0.1413D-06, 0.2510D-06, 0.4464D-06, 0.7938D-06, & + & 0.1411D-05, 0.2508D-05, 0.4457D-05, 0.7912D-05, 0.1405D-04, & + & 0.2493D-04, 0.4416D-04, 0.7812D-04, 0.1379D-03, 0.2423D-03, & + & 0.4239D-03, 0.7362D-03, 0.1265D-02, 0.2140D-02, 0.3548D-02, & + & 0.5716D-02, 0.8883D-02, 0.1318D-01, 0.1849D-01, 0.2436D-01, & + & 0.3002D-01, 0.3454D-01, 0.3727D-01, 0.3788D-01, 0.3654D-01, & + & 0.3370D-01, 0.2993D-01, 0.2577D-01, 0.2163D-01, 0.1777D-01, & + & 0.1435D-01, 0.1142D-01, 0.8980D-02, 0.6985D-02, 0.5391D-02, & + & 0.4121D-02, 0.3137D-02, 0.2363D-02, 0.1778D-02, 0.1328D-02, & + & 0.9888D-03, 0.7330D-03, 0.5476D-03, 0.4042D-03, 0.2886D-03, & + & 0.2167D-03, 0.1588D-03, 0.1152D-03, 0.8615D-04, 0.5680D-04, & + & 0.4225D-04, 0.2756D-04, 0.1276D-04, 0.1290D-04, 0.1300D-04, & + & -.1933D-05/ + + data (calcpts(j,21), j = 1,neta) /0.7364D-10, 0.1308D-09, & + & 0.2322D-09, 0.4128D-09, 0.7339D-09, 0.1304D-08, 0.2319D-08, & + & 0.4124D-08, 0.7329D-08, 0.1304D-07, 0.2318D-07, 0.4122D-07, & + & 0.7330D-07, 0.1304D-06, 0.2317D-06, 0.4120D-06, 0.7326D-06, & + & 0.1302D-05, 0.2314D-05, 0.4113D-05, 0.7302D-05, 0.1297D-04, & + & 0.2301D-04, 0.4076D-04, 0.7211D-04, 0.1273D-03, 0.2237D-03, & + & 0.3915D-03, 0.6803D-03, 0.1169D-02, 0.1980D-02, 0.3287D-02, & + & 0.5304D-02, 0.8258D-02, 0.1229D-01, 0.1729D-01, 0.2287D-01, & + & 0.2830D-01, 0.3273D-01, 0.3549D-01, 0.3628D-01, 0.3517D-01, & + & 0.3260D-01, 0.2908D-01, 0.2514D-01, 0.2116D-01, 0.1744D-01, & + & 0.1412D-01, 0.1126D-01, 0.8865D-02, 0.6916D-02, 0.5332D-02, & + & 0.4094D-02, 0.3115D-02, 0.2349D-02, 0.1775D-02, 0.1322D-02, & + & 0.9960D-03, 0.7388D-03, 0.5525D-03, 0.4084D-03, 0.2924D-03, & + & 0.2202D-03, 0.1621D-03, 0.1184D-03, 0.8922D-04, 0.5982D-04, & + & 0.4522D-04, 0.3049D-04, 0.3068D-04, 0.1581D-04, 0.1590D-04, & + & 0.1596D-04/ + + data (calcpts(j,22), j = 1,neta) /0.6623D-10, 0.1177D-09, & + & 0.2090D-09, 0.3714D-09, 0.6605D-09, 0.1174D-08, 0.2087D-08, & + & 0.3712D-08, 0.6597D-08, 0.1173D-07, 0.2087D-07, 0.3711D-07, & + & 0.6598D-07, 0.1173D-06, 0.2085D-06, 0.3708D-06, 0.6595D-06, & + & 0.1172D-05, 0.2083D-05, 0.3703D-05, 0.6573D-05, 0.1167D-04, & + & 0.2071D-04, 0.3670D-04, 0.6493D-04, 0.1146D-03, 0.2015D-03, & + & 0.3527D-03, 0.6130D-03, 0.1054D-02, 0.1787D-02, 0.2969D-02, & + & 0.4798D-02, 0.7487D-02, 0.1117D-01, 0.1578D-01, 0.2096D-01, & + & 0.2608D-01, 0.3034D-01, 0.3312D-01, 0.3410D-01, 0.3330D-01, & + & 0.3108D-01, 0.2789D-01, 0.2425D-01, 0.2052D-01, 0.1698D-01, & + & 0.1379D-01, 0.1103D-01, 0.8707D-02, 0.6800D-02, 0.5253D-02, & + & 0.4030D-02, 0.3071D-02, 0.2328D-02, 0.1748D-02, 0.1307D-02, & + & 0.9787D-03, 0.7349D-03, 0.5475D-03, 0.4027D-03, 0.3013D-03, & + & 0.2137D-03, 0.1554D-03, 0.1115D-03, 0.8225D-04, 0.6777D-04, & + & 0.5312D-04, 0.3836D-04, 0.2353D-04, 0.2364D-04, 0.8718D-05, & + & 0.8771D-05/ + + data (calcpts(j,23), j = 1,neta) /0.5794D-10, 0.1030D-09, & + & 0.1829D-09, 0.3251D-09, 0.5782D-09, 0.1028D-08, 0.1827D-08, & + & 0.3250D-08, 0.5776D-08, 0.1027D-07, 0.1827D-07, 0.3249D-07, & + & 0.5776D-07, 0.1027D-06, 0.1826D-06, 0.3247D-06, 0.5774D-06, & + & 0.1026D-05, 0.1824D-05, 0.3242D-05, 0.5756D-05, 0.1022D-04, & + & 0.1814D-04, 0.3214D-04, 0.5686D-04, 0.1004D-03, 0.1765D-03, & + & 0.3090D-03, 0.5373D-03, 0.9244D-03, 0.1568D-02, 0.2608D-02, & + & 0.4221D-02, 0.6599D-02, 0.9870D-02, 0.1399D-01, 0.1868D-01, & + & 0.2338D-01, 0.2740D-01, 0.3016D-01, 0.3134D-01, 0.3088D-01, & + & 0.2908D-01, 0.2633D-01, 0.2306D-01, 0.1963D-01, 0.1634D-01, & + & 0.1333D-01, 0.1071D-01, 0.8483D-02, 0.6647D-02, 0.5151D-02, & + & 0.3957D-02, 0.3017D-02, 0.2296D-02, 0.1726D-02, 0.1297D-02, & + & 0.9662D-03, 0.7208D-03, 0.5323D-03, 0.3868D-03, 0.2848D-03, & + & 0.2119D-03, 0.1533D-03, 0.1092D-03, 0.7987D-04, 0.5032D-04, & + & 0.3562D-04, 0.3583D-04, 0.2097D-04, 0.2107D-04, 0.6131D-05, & + & 0.6176D-05/ + + data (calcpts(j,24), j = 1,neta) /0.4927D-10, 0.8757D-10, & + & 0.1556D-09, 0.2766D-09, 0.4919D-09, 0.8745D-09, 0.1555D-08, & + & 0.2765D-08, 0.4915D-08, 0.8741D-08, 0.1555D-07, 0.2764D-07, & + & 0.4915D-07, 0.8742D-07, 0.1554D-06, 0.2763D-06, 0.4913D-06, & + & 0.8733D-06, 0.1552D-05, 0.2759D-05, 0.4898D-05, 0.8697D-05, & + & 0.1543D-04, 0.2735D-04, 0.4839D-04, 0.8545D-04, 0.1503D-03, & + & 0.2631D-03, 0.4576D-03, 0.7877D-03, 0.1337D-02, 0.2226D-02, & + & 0.3607D-02, 0.5649D-02, 0.8470D-02, 0.1205D-01, 0.1616D-01, & + & 0.2035D-01, 0.2403D-01, 0.2670D-01, 0.2803D-01, 0.2794D-01, & + & 0.2662D-01, 0.2436D-01, 0.2154D-01, 0.1851D-01, 0.1552D-01, & + & 0.1275D-01, 0.1029D-01, 0.8201D-02, 0.6450D-02, 0.5021D-02, & + & 0.3871D-02, 0.2965D-02, 0.2252D-02, 0.1692D-02, 0.1274D-02, & + & 0.9557D-03, 0.7087D-03, 0.5191D-03, 0.3878D-03, 0.2854D-03, & + & 0.2121D-03, 0.1532D-03, 0.1090D-03, 0.7959D-04, 0.6496D-04, & + & 0.5021D-04, 0.3538D-04, 0.2050D-04, 0.2058D-04, 0.5633D-05, & + & 0.5670D-05/ + + data (calcpts(j,25), j = 1,neta) /0.4076D-10, 0.7246D-10, & + & 0.1287D-09, 0.2289D-09, 0.4072D-09, 0.7238D-09, 0.1287D-08, & + & 0.2289D-08, 0.4068D-08, 0.7236D-08, 0.1287D-07, 0.2288D-07, & + & 0.4069D-07, 0.7237D-07, 0.1286D-06, 0.2287D-06, 0.4067D-06, & + & 0.7229D-06, 0.1285D-05, 0.2284D-05, 0.4055D-05, 0.7200D-05, & + & 0.1278D-04, 0.2264D-04, 0.4007D-04, 0.7075D-04, 0.1244D-03, & + & 0.2180D-03, 0.3791D-03, 0.6528D-03, 0.1109D-02, 0.1847D-02, & + & 0.2996D-02, 0.4701D-02, 0.7065D-02, 0.1008D-01, 0.1358D-01, & + & 0.1719D-01, 0.2045D-01, 0.2294D-01, 0.2435D-01, 0.2459D-01, & + & 0.2374D-01, 0.2201D-01, 0.1972D-01, 0.1713D-01, 0.1451D-01, & + & 0.1202D-01, 0.9781D-02, 0.7837D-02, 0.6189D-02, 0.4843D-02, & + & 0.3753D-02, 0.2882D-02, 0.2192D-02, 0.1657D-02, 0.1251D-02, & + & 0.9304D-03, 0.6969D-03, 0.5213D-03, 0.3893D-03, 0.2864D-03, & + & 0.2128D-03, 0.1537D-03, 0.1094D-03, 0.7983D-04, 0.6513D-04, & + & 0.3533D-04, 0.3547D-04, 0.2057D-04, 0.2063D-04, 0.5677D-05, & + & 0.5708D-05/ + + data (calcpts(j,26), j = 1,neta) /0.3290D-10, 0.5849D-10, & + & 0.1039D-09, 0.1848D-09, 0.3287D-09, 0.5844D-09, 0.1039D-08, & + & 0.1848D-08, 0.3285D-08, 0.5843D-08, 0.1039D-07, 0.1848D-07, & + & 0.3285D-07, 0.5843D-07, 0.1038D-06, 0.1847D-06, 0.3284D-06, & + & 0.5837D-06, 0.1038D-05, 0.1844D-05, 0.3274D-05, 0.5814D-05, & + & 0.1032D-04, 0.1829D-04, 0.3236D-04, 0.5714D-04, 0.1005D-03, & + & 0.1761D-03, 0.3064D-03, 0.5277D-03, 0.8966D-03, 0.1495D-02, & + & 0.2427D-02, 0.3813D-02, 0.5742D-02, 0.8218D-02, 0.1111D-01, & + & 0.1414D-01, 0.1693D-01, 0.1915D-01, 0.2055D-01, 0.2102D-01, & + & 0.2059D-01, 0.1940D-01, 0.1763D-01, 0.1554D-01, 0.1332D-01, & + & 0.1115D-01, 0.9167D-02, 0.7406D-02, 0.5896D-02, 0.4635D-02, & + & 0.3607D-02, 0.2772D-02, 0.2120D-02, 0.1612D-02, 0.1218D-02, & + & 0.9103D-03, 0.6754D-03, 0.4990D-03, 0.3663D-03, 0.2780D-03, & + & 0.2041D-03, 0.1448D-03, 0.1004D-03, 0.7070D-04, 0.5594D-04, & + & 0.4110D-04, 0.2621D-04, 0.2629D-04, 0.1134D-04, 0.1138D-04, & + & 0.1140D-04/ + + data (calcpts(j,27), j = 1,neta) /0.2600D-10, 0.4624D-10, & + & 0.8217D-10, 0.1461D-09, 0.2599D-09, 0.4621D-09, 0.8217D-09, & + & 0.1462D-08, 0.2598D-08, 0.4620D-08, 0.8218D-08, 0.1461D-07, & + & 0.2598D-07, 0.4621D-07, 0.8212D-07, 0.1460D-06, 0.2597D-06, & + & 0.4616D-06, 0.8204D-06, 0.1458D-05, 0.2589D-05, 0.4598D-05, & + & 0.8160D-05, 0.1446D-04, 0.2559D-04, 0.4520D-04, 0.7950D-04, & + & 0.1393D-03, 0.2424D-03, 0.4176D-03, 0.7099D-03, 0.1184D-02, & + & 0.1925D-02, 0.3027D-02, 0.4566D-02, 0.6551D-02, 0.8883D-02, & + & 0.1135D-01, 0.1367D-01, 0.1558D-01, 0.1688D-01, 0.1748D-01, & + & 0.1738D-01, 0.1664D-01, 0.1539D-01, 0.1378D-01, 0.1200D-01, & + & 0.1019D-01, 0.8465D-02, 0.6910D-02, 0.5540D-02, 0.4384D-02, & + & 0.3434D-02, 0.2666D-02, 0.2040D-02, 0.1558D-02, 0.1176D-02, & + & 0.8971D-03, 0.6761D-03, 0.4989D-03, 0.3657D-03, 0.2770D-03, & + & 0.2029D-03, 0.1435D-03, 0.1139D-03, 0.8413D-04, 0.5432D-04, & + & 0.3945D-04, 0.3954D-04, 0.2459D-04, 0.2463D-04, 0.9662D-05, & + & 0.9681D-05/ + + data (calcpts(j,28), j = 1,neta) /0.2019D-10, 0.3591D-10, & + & 0.6382D-10, 0.1135D-09, 0.2019D-09, 0.3589D-09, 0.6383D-09, & + & 0.1135D-08, 0.2018D-08, 0.3589D-08, 0.6383D-08, 0.1135D-07, & + & 0.2018D-07, 0.3589D-07, 0.6378D-07, 0.1134D-06, 0.2017D-06, & + & 0.3586D-06, 0.6373D-06, 0.1133D-05, 0.2011D-05, 0.3571D-05, & + & 0.6339D-05, 0.1123D-04, 0.1988D-04, 0.3511D-04, 0.6177D-04, & + & 0.1082D-03, 0.1884D-03, 0.3246D-03, 0.5519D-03, 0.9212D-03, & + & 0.1498D-02, 0.2359D-02, 0.3563D-02, 0.5121D-02, 0.6964D-02, & + & 0.8933D-02, 0.1081D-01, 0.1240D-01, 0.1354D-01, 0.1417D-01, & + & 0.1427D-01, 0.1389D-01, 0.1307D-01, 0.1192D-01, 0.1056D-01, & + & 0.9108D-02, 0.7674D-02, 0.6336D-02, 0.5136D-02, 0.4101D-02, & + & 0.3232D-02, 0.2533D-02, 0.1947D-02, 0.1492D-02, 0.1139D-02, & + & 0.8581D-03, 0.6512D-03, 0.4883D-03, 0.3548D-03, 0.2657D-03, & + & 0.1914D-03, 0.1469D-03, 0.1022D-03, 0.7239D-04, 0.5754D-04, & + & 0.4263D-04, 0.2770D-04, 0.2775D-04, 0.1278D-04, 0.1280D-04, & + & 0.1281D-04/ + + data (calcpts(j,29), j = 1,neta) /0.1546D-10, 0.2749D-10, & + & 0.4886D-10, 0.8690D-10, 0.1546D-09, 0.2748D-09, 0.4887D-09, & + & 0.8692D-09, 0.1545D-08, 0.2748D-08, 0.4887D-08, 0.8689D-08, & + & 0.1545D-07, 0.2748D-07, 0.4884D-07, 0.8685D-07, 0.1544D-06, & + & 0.2745D-06, 0.4879D-06, 0.8673D-06, 0.1540D-05, 0.2735D-05, & + & 0.4853D-05, 0.8601D-05, 0.1522D-04, 0.2689D-04, 0.4730D-04, & + & 0.8288D-04, 0.1443D-03, 0.2487D-03, 0.4229D-03, 0.7061D-03, & + & 0.1149D-02, 0.1810D-02, 0.2737D-02, 0.3941D-02, 0.5371D-02, & + & 0.6910D-02, 0.8397D-02, 0.9680D-02, 0.1065D-01, 0.1124D-01, & + & 0.1145D-01, 0.1129D-01, 0.1081D-01, 0.1005D-01, 0.9070D-02, & + & 0.7967D-02, 0.6826D-02, 0.5717D-02, 0.4696D-02, 0.3793D-02, & + & 0.3020D-02, 0.2373D-02, 0.1845D-02, 0.1422D-02, 0.1087D-02, & + & 0.8231D-03, 0.6214D-03, 0.4670D-03, 0.3481D-03, 0.2589D-03, & + & 0.1844D-03, 0.1397D-03, 0.1100D-03, 0.8011D-04, 0.5022D-04, & + & 0.3530D-04, 0.3535D-04, 0.2038D-04, 0.2041D-04, 0.5425D-05, & + & 0.5435D-05/ + + data (calcpts(j,30), j = 1,neta) /0.1170D-10, 0.2081D-10, & + & 0.3698D-10, 0.6577D-10, 0.1170D-09, 0.2080D-09, 0.3699D-09, & + & 0.6579D-09, 0.1169D-08, 0.2080D-08, 0.3699D-08, 0.6577D-08, & + & 0.1169D-07, 0.2080D-07, 0.3696D-07, 0.6573D-07, 0.1169D-06, & + & 0.2078D-06, 0.3693D-06, 0.6564D-06, 0.1166D-05, 0.2070D-05, & + & 0.3673D-05, 0.6510D-05, 0.1152D-04, 0.2035D-04, 0.3581D-04, & + & 0.6274D-04, 0.1092D-03, 0.1883D-03, 0.3203D-03, 0.5349D-03, & + & 0.8706D-03, 0.1372D-02, 0.2077D-02, 0.2994D-02, 0.4087D-02, & + & 0.5271D-02, 0.6427D-02, 0.7443D-02, 0.8232D-02, 0.8751D-02, & + & 0.8997D-02, 0.8982D-02, 0.8728D-02, 0.8257D-02, 0.7602D-02, & + & 0.6810D-02, 0.5944D-02, 0.5065D-02, 0.4224D-02, 0.3456D-02, & + & 0.2782D-02, 0.2208D-02, 0.1731D-02, 0.1343D-02, 0.1033D-02, & + & 0.7865D-03, 0.5963D-03, 0.4490D-03, 0.3358D-03, 0.2494D-03, & + & 0.1853D-03, 0.1375D-03, 0.1002D-03, 0.7333D-04, 0.5391D-04, & + & 0.3897D-04, 0.2851D-04, 0.2103D-04, 0.1505D-04, 0.1056D-04, & + & 0.7572D-05/ + + data (calcpts(j,31), j = 1,neta) /0.8769D-11, 0.1560D-10, & + & 0.2772D-10, 0.4930D-10, 0.8769D-10, 0.1559D-09, 0.2773D-09, & + & 0.4931D-09, 0.8765D-09, 0.1559D-08, 0.2773D-08, 0.4930D-08, & + & 0.8766D-08, 0.1559D-07, 0.2771D-07, 0.4927D-07, 0.8763D-07, & + & 0.1558D-06, 0.2768D-06, 0.4921D-06, 0.8737D-06, 0.1552D-05, & + & 0.2754D-05, 0.4880D-05, 0.8637D-05, 0.1526D-04, 0.2684D-04, & + & 0.4704D-04, 0.8189D-04, 0.1412D-03, 0.2402D-03, 0.4011D-03, & + & 0.6531D-03, 0.1030D-02, 0.1560D-02, 0.2250D-02, 0.3076D-02, & + & 0.3974D-02, 0.4858D-02, 0.5647D-02, 0.6275D-02, 0.6712D-02, & + & 0.6952D-02, 0.7007D-02, 0.6892D-02, 0.6622D-02, 0.6211D-02, & + & 0.5678D-02, 0.5058D-02, 0.4395D-02, 0.3728D-02, 0.3098D-02, & + & 0.2526D-02, 0.2029D-02, 0.1606D-02, 0.1256D-02, 0.9722D-03, & + & 0.7462D-03, 0.5675D-03, 0.4289D-03, 0.3231D-03, 0.2410D-03, & + & 0.1798D-03, 0.1335D-03, 0.9759D-04, 0.7218D-04, 0.5274D-04, & + & 0.3928D-04, 0.2881D-04, 0.1983D-04, 0.1535D-04, 0.1085D-04, & + & 0.7861D-05/ + + data (calcpts(j,32), j = 1,neta) /0.6519D-11, 0.1160D-10, & + & 0.2061D-10, 0.3665D-10, 0.6520D-10, 0.1159D-09, 0.2061D-09, & + & 0.3666D-09, 0.6517D-09, 0.1159D-08, 0.2062D-08, 0.3665D-08, & + & 0.6518D-08, 0.1159D-07, 0.2060D-07, 0.3664D-07, 0.6515D-07, & + & 0.1158D-06, 0.2058D-06, 0.3658D-06, 0.6496D-06, 0.1154D-05, & + & 0.2047D-05, 0.3629D-05, 0.6422D-05, 0.1134D-04, 0.1996D-04, & + & 0.3498D-04, 0.6089D-04, 0.1050D-03, 0.1786D-03, 0.2984D-03, & + & 0.4859D-03, 0.7664D-03, 0.1161D-02, 0.1676D-02, 0.2293D-02, & + & 0.2967D-02, 0.3634D-02, 0.4235D-02, 0.4725D-02, 0.5080D-02, & + & 0.5296D-02, 0.5379D-02, 0.5342D-02, 0.5198D-02, 0.4954D-02, & + & 0.4617D-02, 0.4200D-02, 0.3725D-02, 0.3224D-02, 0.2727D-02, & + & 0.2258D-02, 0.1837D-02, 0.1471D-02, 0.1162D-02, 0.9064D-03, & + & 0.7009D-03, 0.5369D-03, 0.4070D-03, 0.3070D-03, 0.2308D-03, & + & 0.1725D-03, 0.1277D-03, 0.9475D-04, 0.6932D-04, 0.5137D-04, & + & 0.3640D-04, 0.2742D-04, 0.1993D-04, 0.1394D-04, 0.9449D-05, & + & 0.6453D-05/ + + data (calcpts(j,33), j = 1,neta) /0.4816D-11, 0.8566D-11, & + & 0.1522D-10, 0.2708D-10, 0.4816D-10, 0.8564D-10, 0.1523D-09, & + & 0.2709D-09, 0.4814D-09, 0.8562D-09, 0.1523D-08, 0.2708D-08, & + & 0.4815D-08, 0.8564D-08, 0.1522D-07, 0.2706D-07, 0.4813D-07, & + & 0.8555D-07, 0.1521D-06, 0.2703D-06, 0.4799D-06, 0.8522D-06, & + & 0.1513D-05, 0.2681D-05, 0.4744D-05, 0.8380D-05, 0.1474D-04, & + & 0.2584D-04, 0.4499D-04, 0.7756D-04, 0.1320D-03, 0.2205D-03, & + & 0.3591D-03, 0.5665D-03, 0.8584D-03, 0.1239D-02, 0.1697D-02, & + & 0.2198D-02, 0.2696D-02, 0.3149D-02, 0.3523D-02, 0.3804D-02, & + & 0.3986D-02, 0.4076D-02, 0.4081D-02, 0.4010D-02, 0.3872D-02, & + & 0.3668D-02, 0.3403D-02, 0.3084D-02, 0.2726D-02, 0.2352D-02, & + & 0.1984D-02, 0.1640D-02, 0.1331D-02, 0.1065D-02, 0.8402D-03, & + & 0.6552D-03, 0.5045D-03, 0.3865D-03, 0.2938D-03, 0.2220D-03, & + & 0.1667D-03, 0.1248D-03, 0.9188D-04, 0.6793D-04, 0.4996D-04, & + & 0.3798D-04, 0.2750D-04, 0.2001D-04, 0.1552D-04, 0.1102D-04, & + & 0.8025D-05/ + + data (calcpts(j,34), j = 1,neta) /0.3536D-11, 0.6289D-11, & + & 0.1118D-10, 0.1988D-10, 0.3536D-10, 0.6287D-10, 0.1118D-09, & + & 0.1989D-09, 0.3534D-09, 0.6286D-09, 0.1118D-08, 0.1988D-08, & + & 0.3535D-08, 0.6287D-08, 0.1117D-07, 0.1987D-07, 0.3534D-07, & + & 0.6281D-07, 0.1116D-06, 0.1984D-06, 0.3523D-06, 0.6257D-06, & + & 0.1110D-05, 0.1968D-05, 0.3483D-05, 0.6152D-05, 0.1083D-04, & + & 0.1897D-04, 0.3303D-04, 0.5695D-04, 0.9689D-04, 0.1619D-03, & + & 0.2637D-03, 0.4161D-03, 0.6305D-03, 0.9107D-03, 0.1247D-02, & + & 0.1616D-02, 0.1985D-02, 0.2322D-02, 0.2604D-02, 0.2820D-02, & + & 0.2968D-02, 0.3052D-02, 0.3076D-02, 0.3048D-02, 0.2973D-02, & + & 0.2854D-02, 0.2692D-02, 0.2489D-02, 0.2249D-02, 0.1983D-02, & + & 0.1707D-02, 0.1436D-02, 0.1185D-02, 0.9606D-03, 0.7668D-03, & + & 0.6041D-03, 0.4696D-03, 0.3620D-03, 0.2767D-03, 0.2094D-03, & + & 0.1585D-03, 0.1181D-03, 0.8813D-04, 0.6567D-04, 0.4769D-04, & + & 0.3571D-04, 0.2672D-04, 0.1923D-04, 0.1473D-04, 0.1024D-04, & + & 0.7239D-05/ + + data (calcpts(j,35), j = 1,neta) /0.2583D-11, 0.4593D-11, & + & 0.8164D-11, 0.1452D-10, 0.2583D-10, 0.4592D-10, 0.8167D-10, & + & 0.1453D-09, 0.2582D-09, 0.4592D-09, 0.8167D-09, 0.1452D-08, & + & 0.2582D-08, 0.4592D-08, 0.8162D-08, 0.1451D-07, 0.2581D-07, & + & 0.4588D-07, 0.8154D-07, 0.1449D-06, 0.2573D-06, 0.4570D-06, & + & 0.8111D-06, 0.1438D-05, 0.2544D-05, 0.4494D-05, 0.7907D-05, & + & 0.1386D-04, 0.2413D-04, 0.4160D-04, 0.7078D-04, 0.1183D-03, & + & 0.1926D-03, 0.3040D-03, 0.4607D-03, 0.6655D-03, 0.9118D-03, & + & 0.1182D-02, 0.1452D-02, 0.1701D-02, 0.1910D-02, 0.2074D-02, & + & 0.2190D-02, 0.2262D-02, 0.2293D-02, 0.2288D-02, 0.2250D-02, & + & 0.2183D-02, 0.2087D-02, 0.1963D-02, 0.1810D-02, 0.1631D-02, & + & 0.1435D-02, 0.1233D-02, 0.1036D-02, 0.8523D-03, 0.6897D-03, & + & 0.5492D-03, 0.4326D-03, 0.3354D-03, 0.2591D-03, 0.1977D-03, & + & 0.1498D-03, 0.1123D-03, 0.8387D-04, 0.6289D-04, 0.4641D-04, & + & 0.3442D-04, 0.2543D-04, 0.1794D-04, 0.1344D-04, 0.8945D-05, & + & 0.7447D-05/ + + data (calcpts(j,36), j = 1,neta) /0.1878D-11, 0.3341D-11, & + & 0.5938D-11, 0.1056D-10, 0.1879D-10, 0.3340D-10, 0.5940D-10, & + & 0.1056D-09, 0.1878D-09, 0.3340D-09, 0.5940D-09, 0.1056D-08, & + & 0.1878D-08, 0.3340D-08, 0.5936D-08, 0.1056D-07, 0.1877D-07, & + & 0.3337D-07, 0.5931D-07, 0.1054D-06, 0.1872D-06, 0.3324D-06, & + & 0.5900D-06, 0.1046D-05, 0.1851D-05, 0.3269D-05, 0.5751D-05, & + & 0.1008D-04, 0.1755D-04, 0.3026D-04, 0.5148D-04, 0.8602D-04, & + & 0.1401D-03, 0.2211D-03, 0.3352D-03, 0.4842D-03, 0.6635D-03, & + & 0.8605D-03, 0.1058D-02, 0.1239D-02, 0.1394D-02, 0.1516D-02, & + & 0.1604D-02, 0.1663D-02, 0.1694D-02, 0.1700D-02, 0.1684D-02, & + & 0.1647D-02, 0.1591D-02, 0.1517D-02, 0.1423D-02, 0.1310D-02, & + & 0.1178D-02, 0.1035D-02, 0.8878D-03, 0.7447D-03, 0.6124D-03, & + & 0.4948D-03, 0.3937D-03, 0.3099D-03, 0.2395D-03, 0.1841D-03, & + & 0.1407D-03, 0.1062D-03, 0.7922D-04, 0.5974D-04, 0.4476D-04, & + & 0.3277D-04, 0.2377D-04, 0.1778D-04, 0.1328D-04, 0.8780D-05, & + & 0.7282D-05/ + + data (calcpts(j,37), j = 1,neta) /0.1361D-11, 0.2420D-11, & + & 0.4302D-11, 0.7651D-11, 0.1361D-10, 0.2420D-10, 0.4303D-10, & + & 0.7654D-10, 0.1360D-09, 0.2419D-09, 0.4304D-09, 0.7652D-09, & + & 0.1361D-08, 0.2420D-08, 0.4301D-08, 0.7648D-08, 0.1360D-07, & + & 0.2417D-07, 0.4297D-07, 0.7637D-07, 0.1356D-06, 0.2408D-06, & + & 0.4274D-06, 0.7575D-06, 0.1341D-05, 0.2368D-05, 0.4167D-05, & + & 0.7302D-05, 0.1271D-04, 0.2192D-04, 0.3730D-04, 0.6232D-04, & + & 0.1015D-03, 0.1602D-03, 0.2429D-03, 0.3509D-03, 0.4808D-03, & + & 0.6237D-03, 0.7669D-03, 0.8990D-03, 0.1012D-02, 0.1101D-02, & + & 0.1168D-02, 0.1214D-02, 0.1241D-02, 0.1252D-02, 0.1247D-02, & + & 0.1229D-02, 0.1197D-02, 0.1153D-02, 0.1097D-02, 0.1027D-02, & + & 0.9440D-03, 0.8481D-03, 0.7439D-03, 0.6371D-03, 0.5338D-03, & + & 0.4384D-03, 0.3538D-03, 0.2812D-03, 0.2206D-03, 0.1710D-03, & + & 0.1314D-03, 0.9996D-04, 0.7554D-04, 0.5680D-04, 0.4241D-04, & + & 0.3147D-04, 0.2322D-04, 0.1722D-04, 0.1258D-04, 0.9276D-05, & + & 0.6727D-05/ + + data (calcpts(j,38), j = 1,neta) /0.9823D-12, 0.1747D-11, & + & 0.3105D-11, 0.5523D-11, 0.9824D-11, 0.1747D-10, 0.3106D-10, & + & 0.5525D-10, 0.9820D-10, 0.1746D-09, 0.3106D-09, 0.5523D-09, & + & 0.9821D-09, 0.1747D-08, 0.3104D-08, 0.5520D-08, 0.9817D-08, & + & 0.1745D-07, 0.3102D-07, 0.5513D-07, 0.9788D-07, 0.1738D-06, & + & 0.3085D-06, 0.5468D-06, 0.9677D-06, 0.1709D-05, 0.3008D-05, & + & 0.5271D-05, 0.9178D-05, 0.1582D-04, 0.2692D-04, 0.4499D-04, & + & 0.7328D-04, 0.1157D-03, 0.1753D-03, 0.2533D-03, 0.3472D-03, & + & 0.4503D-03, 0.5539D-03, 0.6495D-03, 0.7313D-03, 0.7967D-03, & + & 0.8460D-03, 0.8807D-03, 0.9029D-03, 0.9140D-03, 0.9153D-03, & + & 0.9074D-03, 0.8906D-03, 0.8654D-03, 0.8319D-03, 0.7900D-03, & + & 0.7389D-03, 0.6781D-03, 0.6084D-03, 0.5330D-03, 0.4559D-03, & + & 0.3816D-03, 0.3129D-03, 0.2522D-03, 0.2002D-03, 0.1569D-03, & + & 0.1216D-03, 0.9324D-04, 0.7090D-04, 0.5351D-04, 0.4017D-04, & + & 0.2997D-04, 0.2218D-04, 0.1633D-04, 0.1198D-04, 0.8832D-05, & + & 0.6432D-05/ + + data (calcpts(j,39), j = 1,neta) /0.7071D-12, 0.1258D-11, & + & 0.2235D-11, 0.3976D-11, 0.7072D-11, 0.1257D-10, 0.2236D-10, & + & 0.3977D-10, 0.7069D-10, 0.1257D-09, 0.2236D-09, 0.3976D-09, & + & 0.7070D-09, 0.1257D-08, 0.2235D-08, 0.3974D-08, 0.7067D-08, & + & 0.1256D-07, 0.2233D-07, 0.3969D-07, 0.7046D-07, 0.1251D-06, & + & 0.2221D-06, 0.3936D-06, 0.6967D-06, 0.1231D-05, 0.2165D-05, & + & 0.3795D-05, 0.6607D-05, 0.1139D-04, 0.1938D-04, 0.3238D-04, & + & 0.5276D-04, 0.8326D-04, 0.1262D-03, 0.1824D-03, 0.2499D-03, & + & 0.3243D-03, 0.3988D-03, 0.4678D-03, 0.5269D-03, 0.5743D-03, & + & 0.6104D-03, 0.6362D-03, 0.6535D-03, 0.6634D-03, 0.6670D-03, & + & 0.6646D-03, 0.6564D-03, 0.6425D-03, 0.6230D-03, 0.5980D-03, & + & 0.5672D-03, 0.5300D-03, 0.4858D-03, 0.4354D-03, 0.3811D-03, & + & 0.3257D-03, 0.2723D-03, 0.2232D-03, 0.1797D-03, 0.1427D-03, & + & 0.1117D-03, 0.8649D-04, 0.6640D-04, 0.5051D-04, 0.3806D-04, & + & 0.2861D-04, 0.2142D-04, 0.1587D-04, 0.1182D-04, 0.8670D-05, & + & 0.6420D-05/ + + data (calcpts(j,40), j = 1,neta) /0.5074D-12, 0.9025D-12, & + & 0.1604D-11, 0.2853D-11, 0.5075D-11, 0.9023D-11, 0.1605D-10, & + & 0.2854D-10, 0.5073D-10, 0.9022D-10, 0.1605D-09, 0.2853D-09, & + & 0.5073D-09, 0.9023D-09, 0.1604D-08, 0.2852D-08, 0.5071D-08, & + & 0.9014D-08, 0.1602D-07, 0.2848D-07, 0.5056D-07, 0.8980D-07, & + & 0.1594D-06, 0.2825D-06, 0.4999D-06, 0.8830D-06, 0.1554D-05, & + & 0.2723D-05, 0.4741D-05, 0.8174D-05, 0.1391D-04, 0.2324D-04, & + & 0.3786D-04, 0.5975D-04, 0.9057D-04, 0.1309D-03, 0.1794D-03, & + & 0.2327D-03, 0.2863D-03, 0.3358D-03, 0.3783D-03, 0.4125D-03, & + & 0.4386D-03, 0.4576D-03, 0.4706D-03, 0.4788D-03, 0.4827D-03, & + & 0.4829D-03, 0.4794D-03, 0.4723D-03, 0.4614D-03, 0.4467D-03, & + & 0.4283D-03, 0.4058D-03, 0.3789D-03, 0.3470D-03, 0.3108D-03, & + & 0.2717D-03, 0.2321D-03, 0.1939D-03, 0.1586D-03, 0.1276D-03, & + & 0.1012D-03, 0.7919D-04, 0.6120D-04, 0.4695D-04, 0.3571D-04, & + & 0.2686D-04, 0.2011D-04, 0.1501D-04, 0.1111D-04, 0.8263D-05, & + & 0.6013D-05/ + + data (calcpts(j,41), j = 1,neta) /0.3632D-12, 0.6459D-12, & + & 0.1148D-11, 0.2042D-11, 0.3632D-11, 0.6458D-11, 0.1148D-10, & + & 0.2043D-10, 0.3630D-10, 0.6457D-10, 0.1149D-09, 0.2042D-09, & + & 0.3631D-09, 0.6458D-09, 0.1148D-08, 0.2041D-08, 0.3630D-08, & + & 0.6452D-08, 0.1147D-07, 0.2038D-07, 0.3619D-07, 0.6427D-07, & + & 0.1141D-06, 0.2022D-06, 0.3578D-06, 0.6320D-06, 0.1112D-05, & + & 0.1949D-05, 0.3393D-05, 0.5850D-05, 0.9954D-05, 0.1663D-04, & + & 0.2710D-04, 0.4276D-04, 0.6483D-04, 0.9367D-04, 0.1284D-03, & + & 0.1666D-03, 0.2049D-03, 0.2404D-03, 0.2708D-03, 0.2954D-03, & + & 0.3142D-03, 0.3280D-03, 0.3377D-03, 0.3440D-03, 0.3475D-03, & + & 0.3487D-03, 0.3476D-03, 0.3443D-03, 0.3385D-03, 0.3302D-03, & + & 0.3193D-03, 0.3059D-03, 0.2896D-03, 0.2702D-03, 0.2473D-03, & + & 0.2213D-03, 0.1933D-03, 0.1650D-03, 0.1377D-03, 0.1127D-03, & + & 0.9046D-04, 0.7172D-04, 0.5598D-04, 0.4323D-04, 0.3318D-04, & + & 0.2508D-04, 0.1894D-04, 0.1414D-04, 0.1054D-04, 0.7838D-05, & + & 0.5738D-05/ + + data (calcpts(j,42), j = 1,neta) /0.2594D-12, 0.4613D-12, & + & 0.8200D-12, 0.1458D-11, 0.2594D-11, 0.4613D-11, 0.8202D-11, & + & 0.1459D-10, 0.2593D-10, 0.4612D-10, 0.8203D-10, 0.1458D-09, & + & 0.2593D-09, 0.4612D-09, 0.8197D-09, 0.1458D-08, 0.2592D-08, & + & 0.4608D-08, 0.8190D-08, 0.1456D-07, 0.2585D-07, 0.4590D-07, & + & 0.8147D-07, 0.1444D-06, 0.2555D-06, 0.4514D-06, 0.7942D-06, & + & 0.1392D-05, 0.2423D-05, 0.4178D-05, 0.7110D-05, 0.1188D-04, & + & 0.1935D-04, 0.3054D-04, 0.4630D-04, 0.6691D-04, 0.9170D-04, & + & 0.1190D-03, 0.1464D-03, 0.1717D-03, 0.1935D-03, 0.2111D-03, & + & 0.2246D-03, 0.2345D-03, 0.2416D-03, 0.2463D-03, 0.2492D-03, & + & 0.2506D-03, 0.2506D-03, 0.2492D-03, 0.2463D-03, 0.2418D-03, & + & 0.2356D-03, 0.2277D-03, 0.2179D-03, 0.2063D-03, 0.1923D-03, & + & 0.1759D-03, 0.1573D-03, 0.1373D-03, 0.1171D-03, 0.9766D-04, & + & 0.7982D-04, 0.6408D-04, 0.5073D-04, 0.3964D-04, 0.3064D-04, & + & 0.2344D-04, 0.1774D-04, 0.1339D-04, 0.1009D-04, 0.7391D-05, & + & 0.5591D-05/ + + data (calcpts(j,43), j = 1,neta) /0.1849D-12, 0.3288D-12, & + & 0.5844D-12, 0.1039D-11, 0.1849D-11, 0.3287D-11, 0.5846D-11, & + & 0.1040D-10, 0.1848D-10, 0.3287D-10, 0.5846D-10, 0.1039D-09, & + & 0.1848D-09, 0.3287D-09, 0.5842D-09, 0.1039D-08, 0.1848D-08, & + & 0.3284D-08, 0.5837D-08, 0.1037D-07, 0.1842D-07, 0.3271D-07, & + & 0.5806D-07, 0.1029D-06, 0.1821D-06, 0.3217D-06, 0.5660D-06, & + & 0.9920D-06, 0.1727D-05, 0.2978D-05, 0.5067D-05, 0.8466D-05, & + & 0.1379D-04, 0.2177D-04, 0.3300D-04, 0.4768D-04, 0.6535D-04, & + & 0.8480D-04, 0.1043D-03, 0.1224D-03, 0.1379D-03, 0.1505D-03, & + & 0.1601D-03, 0.1672D-03, 0.1723D-03, 0.1758D-03, 0.1781D-03, & + & 0.1793D-03, 0.1797D-03, 0.1793D-03, 0.1780D-03, 0.1757D-03, & + & 0.1723D-03, 0.1678D-03, 0.1620D-03, 0.1550D-03, 0.1466D-03, & + & 0.1366D-03, 0.1249D-03, 0.1116D-03, 0.9738D-04, 0.8296D-04, & + & 0.6912D-04, 0.5646D-04, 0.4534D-04, 0.3586D-04, 0.2796D-04, & + & 0.2166D-04, 0.1656D-04, 0.1251D-04, 0.9358D-05, 0.7108D-05, & + & 0.5308D-05/ + + data (calcpts(j,44), j = 1,neta) /0.1315D-12, 0.2338D-12, & + & 0.4156D-12, 0.7392D-12, 0.1315D-11, 0.2338D-11, 0.4157D-11, & + & 0.7394D-11, 0.1314D-10, 0.2337D-10, 0.4158D-10, 0.7392D-10, & + & 0.1314D-09, 0.2338D-09, 0.4155D-09, 0.7389D-09, 0.1314D-08, & + & 0.2336D-08, 0.4151D-08, 0.7378D-08, 0.1310D-07, 0.2327D-07, & + & 0.4129D-07, 0.7318D-07, 0.1295D-06, 0.2288D-06, 0.4025D-06, & + & 0.7055D-06, 0.1228D-05, 0.2118D-05, 0.3604D-05, 0.6021D-05, & + & 0.9809D-05, 0.1548D-04, 0.2347D-04, 0.3391D-04, 0.4648D-04, & + & 0.6031D-04, 0.7419D-04, 0.8705D-04, 0.9810D-04, 0.1070D-03, & + & 0.1139D-03, 0.1190D-03, 0.1227D-03, 0.1252D-03, 0.1269D-03, & + & 0.1279D-03, 0.1284D-03, 0.1284D-03, 0.1278D-03, 0.1267D-03, & + & 0.1250D-03, 0.1225D-03, 0.1192D-03, 0.1150D-03, 0.1100D-03, & + & 0.1040D-03, 0.9684D-04, 0.8850D-04, 0.7906D-04, 0.6892D-04, & + & 0.5868D-04, 0.4886D-04, 0.3989D-04, 0.3200D-04, 0.2530D-04, & + & 0.1973D-04, 0.1522D-04, 0.1162D-04, 0.8801D-05, 0.6626D-05, & + & 0.4946D-05/ + + data (calcpts(j,45), j = 1,neta) /0.9338D-13, 0.1661D-12, & + & 0.2952D-12, 0.5250D-12, 0.9339D-12, 0.1660D-11, 0.2953D-11, & + & 0.5252D-11, 0.9334D-11, 0.1660D-10, 0.2953D-10, 0.5250D-10, & + & 0.9336D-10, 0.1660D-09, 0.2951D-09, 0.5248D-09, 0.9332D-09, & + & 0.1659D-08, 0.2948D-08, 0.5240D-08, 0.9305D-08, 0.1652D-07, & + & 0.2933D-07, 0.5198D-07, 0.9199D-07, 0.1625D-06, 0.2859D-06, & + & 0.5011D-06, 0.8724D-06, 0.1504D-05, 0.2559D-05, 0.4276D-05, & + & 0.6967D-05, 0.1099D-04, 0.1667D-04, 0.2409D-04, 0.3301D-04, & + & 0.4283D-04, 0.5270D-04, 0.6183D-04, 0.6968D-04, 0.7602D-04, & + & 0.8091D-04, 0.8454D-04, 0.8715D-04, 0.8899D-04, 0.9023D-04, & + & 0.9102D-04, 0.9146D-04, 0.9159D-04, 0.9142D-04, 0.9093D-04, & + & 0.9007D-04, 0.8875D-04, 0.8693D-04, 0.8453D-04, 0.8154D-04, & + & 0.7794D-04, 0.7367D-04, 0.6859D-04, 0.6266D-04, 0.5594D-04, & + & 0.4876D-04, 0.4149D-04, 0.3453D-04, 0.2818D-04, 0.2260D-04, & + & 0.1785D-04, 0.1394D-04, 0.1074D-04, 0.8206D-05, 0.6226D-05, & + & 0.4681D-05/ + + data (calcpts(j,46), j = 1,neta) /0.6618D-13, 0.1177D-12, & + & 0.2092D-12, 0.3721D-12, 0.6619D-12, 0.1177D-11, 0.2093D-11, & + & 0.3722D-11, 0.6616D-11, 0.1177D-10, 0.2093D-10, 0.3721D-10, & + & 0.6617D-10, 0.1177D-09, 0.2092D-09, 0.3720D-09, 0.6615D-09, & + & 0.1176D-08, 0.2090D-08, 0.3714D-08, 0.6595D-08, 0.1171D-07, & + & 0.2079D-07, 0.3684D-07, 0.6520D-07, 0.1152D-06, 0.2026D-06, & + & 0.3552D-06, 0.6184D-06, 0.1066D-05, 0.1814D-05, 0.3031D-05, & + & 0.4938D-05, 0.7793D-05, 0.1181D-04, 0.1707D-04, 0.2340D-04, & + & 0.3036D-04, 0.3735D-04, 0.4382D-04, 0.4939D-04, 0.5389D-04, & + & 0.5735D-04, 0.5993D-04, 0.6179D-04, 0.6311D-04, 0.6400D-04, & + & 0.6460D-04, 0.6495D-04, 0.6512D-04, 0.6510D-04, 0.6491D-04, & + & 0.6451D-04, 0.6385D-04, 0.6288D-04, 0.6156D-04, 0.5983D-04, & + & 0.5770D-04, 0.5513D-04, 0.5209D-04, 0.4849D-04, 0.4426D-04, & + & 0.3951D-04, 0.3441D-04, 0.2927D-04, 0.2435D-04, 0.1985D-04, & + & 0.1592D-04, 0.1257D-04, 0.9799D-05, 0.7549D-05, 0.5764D-05, & + & 0.4369D-05/ + + data (calcpts(j,47), j = 1,neta) /0.4684D-13, 0.8331D-13, & + & 0.1481D-12, 0.2634D-12, 0.4684D-12, 0.8329D-12, 0.1481D-11, & + & 0.2634D-11, 0.4682D-11, 0.8328D-11, 0.1481D-10, 0.2634D-10, & + & 0.4683D-10, 0.8329D-10, 0.1480D-09, 0.2632D-09, 0.4681D-09, & + & 0.8321D-09, 0.1479D-08, 0.2629D-08, 0.4667D-08, 0.8289D-08, & + & 0.1471D-07, 0.2607D-07, 0.4614D-07, 0.8151D-07, 0.1434D-06, & + & 0.2513D-06, 0.4376D-06, 0.7545D-06, 0.1284D-05, 0.2145D-05, & + & 0.3494D-05, 0.5515D-05, 0.8361D-05, 0.1208D-04, 0.1656D-04, & + & 0.2149D-04, 0.2643D-04, 0.3101D-04, 0.3495D-04, 0.3814D-04, & + & 0.4059D-04, 0.4242D-04, 0.4374D-04, 0.4467D-04, 0.4532D-04, & + & 0.4575D-04, 0.4603D-04, 0.4618D-04, 0.4622D-04, 0.4616D-04, & + & 0.4598D-04, 0.4567D-04, 0.4518D-04, 0.4448D-04, 0.4352D-04, & + & 0.4229D-04, 0.4076D-04, 0.3894D-04, 0.3678D-04, 0.3422D-04, & + & 0.3123D-04, 0.2786D-04, 0.2426D-04, 0.2062D-04, 0.1714D-04, & + & 0.1397D-04, 0.1120D-04, 0.8828D-05, 0.6878D-05, 0.5303D-05, & + & 0.4043D-05/ + + data (calcpts(j,48), j = 1,neta) /0.3311D-13, 0.5889D-13, & + & 0.1047D-12, 0.1862D-12, 0.3311D-12, 0.5887D-12, 0.1047D-11, & + & 0.1862D-11, 0.3310D-11, 0.5886D-11, 0.1047D-10, 0.1862D-10, & + & 0.3310D-10, 0.5887D-10, 0.1046D-09, 0.1861D-09, 0.3309D-09, & + & 0.5882D-09, 0.1045D-08, 0.1858D-08, 0.3299D-08, 0.5859D-08, & + & 0.1040D-07, 0.1843D-07, 0.3262D-07, 0.5761D-07, 0.1014D-06, & + & 0.1777D-06, 0.3093D-06, 0.5333D-06, 0.9075D-06, 0.1516D-05, & + & 0.2470D-05, 0.3898D-05, 0.5910D-05, 0.8540D-05, 0.1171D-04, & + & 0.1519D-04, 0.1869D-04, 0.2192D-04, 0.2471D-04, 0.2696D-04, & + & 0.2869D-04, 0.2999D-04, 0.3092D-04, 0.3158D-04, 0.3204D-04, & + & 0.3236D-04, 0.3256D-04, 0.3268D-04, 0.3274D-04, 0.3274D-04, & + & 0.3267D-04, 0.3252D-04, 0.3228D-04, 0.3193D-04, 0.3142D-04, & + & 0.3073D-04, 0.2985D-04, 0.2877D-04, 0.2747D-04, 0.2594D-04, & + & 0.2413D-04, 0.2202D-04, 0.1964D-04, 0.1709D-04, 0.1452D-04, & + & 0.1206D-04, 0.9827D-05, 0.7877D-05, 0.6212D-05, 0.4832D-05, & + & 0.3722D-05/ + + data (calcpts(j,49), j = 1,neta) /0.2337D-13, 0.4157D-13, & + & 0.7388D-13, 0.1314D-12, 0.2337D-12, 0.4156D-12, 0.7390D-12, & + & 0.1314D-11, 0.2336D-11, 0.4155D-11, 0.7391D-11, 0.1314D-10, & + & 0.2337D-10, 0.4156D-10, 0.7386D-10, 0.1313D-09, 0.2336D-09, & + & 0.4152D-09, 0.7379D-09, 0.1312D-08, 0.2329D-08, 0.4136D-08, & + & 0.7340D-08, 0.1301D-07, 0.2302D-07, 0.4067D-07, 0.7156D-07, & + & 0.1254D-06, 0.2184D-06, 0.3765D-06, 0.6406D-06, 0.1070D-05, & + & 0.1744D-05, 0.2752D-05, 0.4172D-05, 0.6028D-05, 0.8263D-05, & + & 0.1072D-04, 0.1319D-04, 0.1548D-04, 0.1744D-04, 0.1903D-04, & + & 0.2026D-04, 0.2117D-04, 0.2183D-04, 0.2230D-04, 0.2263D-04, & + & 0.2285D-04, 0.2300D-04, 0.2309D-04, 0.2314D-04, 0.2316D-04, & + & 0.2314D-04, 0.2308D-04, 0.2296D-04, 0.2279D-04, 0.2253D-04, & + & 0.2216D-04, 0.2167D-04, 0.2104D-04, 0.2028D-04, 0.1936D-04, & + & 0.1828D-04, 0.1700D-04, 0.1550D-04, 0.1382D-04, 0.1202D-04, & + & 0.1021D-04, 0.8483D-05, 0.6900D-05, 0.5535D-05, 0.4365D-05, & + & 0.3390D-05/ + + data (dlaeta(j), j = 1,neta) / & + & -6d0, -5.83333333d0, -5.66666667d0, -5.5d0, -5.33333333d0, & + & -5.16666667d0, -5d0, -4.83333333d0, -4.66666667d0, -4.5d0, & + & -4.33333333d0, -4.16666667d0, -4d0, -3.83333333d0, & + & -3.66666667d0, -3.5d0, -3.33333333d0, -3.16666667d0, -3d0, & + & -2.83333333d0, -2.66666667d0, -2.5d0, -2.33333333d0, & + & -2.16666667d0, -2d0, -1.83333333d0, -1.66666667d0, -1.5d0, & + & -1.33333333d0, -1.16666667d0, -1d0, -0.83333333d0, -0.66666667d0,& + & -0.5d0, -0.33333333d0, -0.16666667d0, 0d0, 0.16666667d0, & + & 0.33333333d0, 0.5d0, 0.66666667d0, 0.83333333d0, 1d0, & + & 1.16666667d0, 1.33333333d0, 1.5d0, 1.66666667d0, 1.83333333d0, & + & 2d0, 2.16666667d0, 2.33333333d0, 2.5d0, 2.66666667d0, & + & 2.83333333d0, 3d0, 3.16666667d0, 3.33333333d0, 3.5d0, & + & 3.66666667d0, 3.83333333d0, 4d0, 4.16666667d0, 4.33333333d0, & + & 4.5d0, 4.66666667d0, 4.83333333d0, 5d0, 5.16666667d0, & + & 5.33333333d0, 5.5d0, 5.66666667d0, 5.83333333d0, 6d0/ + + data (dlaxi(j), j = 1,nxi) / & + & -3d0, -2.83333333d0, -2.66666667d0, -2.5d0, -2.33333333d0, & + & -2.16666667d0, -2d0, -1.83333333d0, -1.66666667d0, -1.5d0, & + & -1.33333333d0, -1.16666667d0, -1d0, -0.83333333d0, -0.66666667d0,& + & -0.5d0, -0.33333333d0, -0.16666667d0, 0d0, 0.16666667d0, & + & 0.33333333d0, 0.5d0, 0.66666667d0, 0.83333333d0, 1d0, & + & 1.16666667d0, 1.33333333d0, 1.5d0, 1.66666667d0, 1.83333333d0, & + & 2d0, 2.16666667d0, 2.33333333d0, 2.5d0, 2.66666667d0, & + & 2.83333333d0, 3d0, 3.16666667d0, 3.33333333d0, 3.5d0, & + & 3.66666667d0, 3.83333333d0, 4d0, 4.16666667d0, 4.33333333d0, & + & 4.5d0, 4.66666667d0, 4.83333333d0, 5d0/ + + dleta = dlog10(eta) + dlxi = dlog10(xi) + if (dlxi .le. dlaxi(1)) dlxi = dlaxi(1) + if (dlxi .ge. dlaxi(nxi)) dlxi = dlaxi(nxi) + if (dleta .ge. dlaeta(neta)) dleta = dlaeta(neta) + if (dleta .le. dlaeta(1)) dleta = dlaeta(1) + call locate(dlaeta,neta, dleta, ieta) + call locate(dlaxi, nxi, dlxi, ixi) +! interpolating between the appropriate points + delxi = 1d0/6d0 + deleta = 1d0/6d0 +! lagrange 3-pt. + if (ixi .le. 2) ixi = 2 + if (ixi .ge. 48) ixi = 48 + if (ieta .le. 2) ieta = 2 + if (ieta .ge. 72) ieta = 72 + pxi = (dlxi - dlaxi(ixi))/delxi + f(-1) = pxi*(pxi-1d0)/2d0*calcpts(ieta-1,ixi-1) + & + & (1d0 - pxi**2)*calcpts(ieta-1,ixi) + & + & pxi*(pxi+1d0)/2d0*calcpts(ieta-1,ixi+1) + f(0) = pxi*(pxi-1d0)/2d0*calcpts(ieta,ixi-1) + & + & (1d0 - pxi**2)*calcpts(ieta,ixi) + & + & pxi*(pxi+1d0)/2d0*calcpts(ieta,ixi+1) + f(1) = pxi*(pxi-1d0)/2d0*calcpts(ieta+1,ixi-1) + & + & (1d0 - pxi**2)*calcpts(ieta+1,ixi) + & + & pxi*(pxi+1d0)/2d0*calcpts(ieta+1,ixi+1) + peta = (dleta - dlaeta(ieta))/deleta + h1bar_HTq = peta*(peta-1d0)/2d0*f(-1) + & + & (1d0 - peta**2)*f(0) + & + & peta*(peta+1d0)/2d0*f(1) +!MB + + peta*(peta+1d0)/2d0*f(1) + return + END + +! ========================================= + double precision function h1f_LTq(eta,xi) +! ========================================= + +! eq (28) in PLB347 (1995) 143 - 151 for the transverse piece +! This also takes into account the additional mass factorizations +! necessary from a low Q^2 photon coupling to the light quark. +! MSbar scheme +! This routine is called subd1tqf in the original code. +! Gives h1_LTq for Q2 < 1.5 GeV2 (use h1_LTq for Q2 > 1.5 GeV2) + + implicit none + integer neta, nxi + parameter (neta = 45, nxi = 15) + double precision calcpts(neta,nxi), aeta(neta), axi(nxi) + double precision eta, xi, huge, small + double precision t, u, y1, y2, y3, y4 + parameter (small = 1.d-8, huge = 1.d10) + integer j, ieta, ixi + + data (calcpts(j, 1), j=1,neta) /0.d0, 0.4019D-05, 0.1896D-04, & + & 0.3899D-04, 0.6269D-04, 0.8935D-04, 0.1037D-03, 0.4849D-03, & + & 0.9762D-03, 0.1525D-02, 0.2108D-02, 0.2406D-02, 0.5362D-02, & + & 0.7965D-02, 0.1012D-01, 0.1186D-01, 0.1328D-01, 0.1443D-01, & + & 0.1537D-01, 0.1616D-01, 0.1682D-01, 0.1986D-01, 0.2073D-01, & + & 0.2096D-01, 0.2088D-01, 0.2067D-01, 0.2037D-01, 0.2001D-01, & + & 0.1965D-01, 0.1929D-01, 0.1370D-01, 0.1084D-01, 0.9107D-02, & + & 0.7934D-02, 0.7464D-02, 0.4891D-02, 0.3756D-02, 0.2645D-02, & + & 0.2090D-02, 0.1746D-02, 0.1617D-02, 0.4779D-03, 0.2775D-03, & + & 0.4104D-04, 0.d0/ +! + data (calcpts(j, 2), j=1,neta) /0.d0, 0.2321D-05, 0.1077D-04, & + & 0.2190D-04, 0.3488D-04, 0.4935D-04, 0.5706D-04, 0.2585D-03, & + & 0.5173D-03, 0.8102D-03, 0.1125D-02, 0.1287D-02, 0.2955D-02, & + & 0.4511D-02, 0.5861D-02, 0.7013D-02, 0.7984D-02, 0.8813D-02, & + & 0.9516D-02, 0.1012D-01, 0.1065D-01, 0.1352D-01, 0.1463D-01, & + & 0.1512D-01, 0.1529D-01, 0.1529D-01, 0.1518D-01, 0.1502D-01, & + & 0.1482D-01, 0.1460D-01, 0.1073D-01, 0.8586D-02, 0.7261D-02, & + & 0.6349D-02, 0.5983D-02, 0.3966D-02, 0.3061D-02, 0.2178D-02, & + & 0.1718D-02, 0.1440D-02, 0.1337D-02, 0.3998D-03, 0.2339D-03, & + & 0.3529D-04, 0.d0/ +! + data (calcpts(j, 3), j=1,neta) /0.d0, 0.5064D-06, 0.2317D-05, & + & 0.4667D-05, 0.7383D-05, 0.1040D-04, 0.1200D-04, 0.5411D-04, & + & 0.1119D-03, 0.1832D-03, 0.2663D-03, 0.3119D-03, 0.8727D-03, & + & 0.1533D-02, 0.2214D-02, 0.2874D-02, 0.3495D-02, 0.4073D-02, & + & 0.4602D-02, 0.5091D-02, 0.5538D-02, 0.8424D-02, 0.9777D-02, & + & 0.1046D-01, 0.1080D-01, 0.1095D-01, 0.1098D-01, 0.1094D-01, & + & 0.1086D-01, 0.1075D-01, 0.8148D-02, 0.6592D-02, 0.5609D-02, & + & 0.4921D-02, 0.4650D-02, 0.3110D-02, 0.2411D-02, 0.1722D-02, & + & 0.1371D-02, 0.1150D-02, 0.1067D-02, 0.3261D-03, 0.1892D-03, & + & 0.2870D-04, 0.d0/ +! + data (calcpts(j, 4), j=1,neta) /0.d0, 0.5228D-08, 0.2381D-07, & + & 0.4875D-07, 0.7962D-07, 0.1172D-06, 0.1388D-06, 0.1292D-05, & + & 0.4892D-05, 0.1220D-04, 0.2403D-04, 0.3177D-04, 0.1790D-03, & + & 0.4347D-03, 0.7627D-03, 0.1131D-02, 0.1518D-02, 0.1906D-02, & + & 0.2291D-02, 0.2660D-02, 0.3014D-02, 0.5617D-02, 0.7014D-02, & + & 0.7787D-02, 0.8220D-02, 0.8455D-02, 0.8574D-02, 0.8612D-02, & + & 0.8603D-02, 0.8558D-02, 0.6753D-02, 0.5525D-02, 0.4737D-02, & + & 0.4176D-02, 0.3954D-02, 0.2678D-02, 0.2087D-02, 0.1502D-02, & + & 0.1196D-02, 0.1007D-02, 0.9338D-03, 0.2877D-03, 0.1692D-03, & + & 0.2625D-04, 0.d0/ +! + data (calcpts(j, 5), j=1,neta) /0.d0, 0.9101D-12, 0.4199D-10, & + & 0.2486D-09, 0.7987D-09, 0.1908D-08, 0.2745D-08, 0.1169D-06, & + & 0.6378D-06, 0.1896D-05, 0.4197D-05, 0.5822D-05, 0.4473D-04, & + & 0.1310D-03, 0.2623D-03, 0.4305D-03, 0.6257D-03, 0.8389D-03, & + & 0.1064D-02, 0.1294D-02, 0.1525D-02, 0.3522D-02, 0.4800D-02, & + & 0.5585D-02, 0.6078D-02, 0.6383D-02, 0.6571D-02, 0.6681D-02, & + & 0.6738D-02, 0.6764D-02, 0.5665D-02, 0.4725D-02, 0.4088D-02, & + & 0.3632D-02, 0.3446D-02, 0.2369D-02, 0.1861D-02, 0.1347D-02, & + & 0.1081D-02, 0.9132D-03, 0.8487D-03, 0.2657D-03, 0.1563D-03, & + & 0.2511D-04, 0.d0/ +! + data (calcpts(j, 6), j=1,neta) /0.d0, 0.2657D-12, 0.1234D-10, & + & 0.7333D-10, 0.2366D-09, 0.5664D-09, 0.8165D-09, 0.3585D-07, & + & 0.2016D-06, 0.6159D-06, 0.1399D-05, 0.1963D-05, 0.1675D-04, & + & 0.5327D-04, 0.1141D-03, 0.1979D-03, 0.3015D-03, 0.4212D-03, & + & 0.5532D-03, 0.6942D-03, 0.8411D-03, 0.2292D-02, 0.3371D-02, & + & 0.4096D-02, 0.4583D-02, 0.4909D-02, 0.5129D-02, 0.5277D-02, & + & 0.5371D-02, 0.5431D-02, 0.4823D-02, 0.4098D-02, 0.3584D-02, & + & 0.3204D-02, 0.3046D-02, 0.2125D-02, 0.1683D-02, 0.1229D-02, & + & 0.9890D-03, 0.8394D-03, 0.7798D-03, 0.2471D-03, 0.1470D-03, & + & 0.2343D-04, 0.d0/ +! + data (calcpts(j, 7), j=1,neta) /0.d0, 0.2199D-12, 0.1022D-10, & + & 0.6069D-10, 0.1959D-09, 0.4690D-09, 0.6762D-09, 0.2974D-07, & + & 0.1674D-06, 0.5122D-06, 0.1165D-05, 0.1637D-05, 0.1405D-04, & + & 0.4497D-04, 0.9692D-04, 0.1690D-03, 0.2589D-03, 0.3633D-03, & + & 0.4793D-03, 0.6040D-03, 0.7347D-03, 0.2058D-02, 0.3074D-02, & + & 0.3776D-02, 0.4248D-02, 0.4574D-02, 0.4796D-02, 0.4949D-02, & + & 0.5048D-02, 0.5115D-02, 0.4613D-02, 0.3939D-02, 0.3453D-02, & + & 0.3095D-02, 0.2944D-02, 0.2064D-02, 0.1636D-02, 0.1198D-02, & + & 0.9665D-03, 0.8193D-03, 0.7636D-03, 0.2445D-03, 0.1445D-03, & + & 0.2312D-04, 0.d0/ +! + data (calcpts(j, 8), j=1,neta) /0.d0, 0.1569D-12, 0.7293D-11, & + & 0.4330D-10, 0.1397D-09, 0.3345D-09, 0.4823D-09, 0.2118D-07, & + & 0.1189D-06, 0.3635D-06, 0.8253D-06, 0.1158D-05, 0.9902D-05, & + & 0.3158D-04, 0.6792D-04, 0.1184D-03, 0.1815D-03, 0.2548D-03, & + & 0.3369D-03, 0.4252D-03, 0.5186D-03, 0.1495D-02, 0.2288D-02, & + & 0.2862D-02, 0.3269D-02, 0.3558D-02, 0.3766D-02, 0.3914D-02, & + & 0.4020D-02, 0.4095D-02, 0.3882D-02, 0.3377D-02, 0.2991D-02, & + & 0.2703D-02, 0.2580D-02, 0.1839D-02, 0.1469D-02, 0.1086D-02, & + & 0.8801D-03, 0.7482D-03, 0.6992D-03, 0.2261D-03, 0.1353D-03, & + & 0.2217D-04, 0.d0/ +! + data (calcpts(j, 9), j=1,neta) /0.d0, 0.1509D-12, 0.7016D-11, & + & 0.4166D-10, 0.1344D-09, 0.3218D-09, 0.4636D-09, 0.2035D-07, & + & 0.1142D-06, 0.3489D-06, 0.7914D-06, 0.1111D-05, 0.9461D-05, & + & 0.3008D-04, 0.6453D-04, 0.1122D-03, 0.1716D-03, 0.2406D-03, & + & 0.3174D-03, 0.4000D-03, 0.4874D-03, 0.1394D-02, 0.2127D-02, & + & 0.2660D-02, 0.3038D-02, 0.3311D-02, 0.3506D-02, 0.3646D-02, & + & 0.3748D-02, 0.3820D-02, 0.3657D-02, 0.3196D-02, 0.2844D-02, & + & 0.2571D-02, 0.2460D-02, 0.1764D-02, 0.1415D-02, 0.1049D-02, & + & 0.8515D-03, 0.7264D-03, 0.6773D-03, 0.2231D-03, 0.1328D-03, & + & 0.2174D-04, 0.d0/ +! + data (calcpts(j,10), j=1,neta) /0.d0, 0.1441D-12, 0.6693D-11, & + & 0.3978D-10, 0.1282D-09, 0.3069D-09, 0.4423D-09, 0.1938D-07, & + & 0.1087D-06, 0.3317D-06, 0.7515D-06, 0.1054D-05, 0.8930D-05, & + & 0.2825D-04, 0.6027D-04, 0.1043D-03, 0.1588D-03, 0.2217D-03, & + & 0.2913D-03, 0.3657D-03, 0.4437D-03, 0.1233D-02, 0.1845D-02, & + & 0.2274D-02, 0.2570D-02, 0.2775D-02, 0.2918D-02, 0.3018D-02, & + & 0.3085D-02, 0.3134D-02, 0.2930D-02, 0.2574D-02, 0.2306D-02, & + & 0.2102D-02, 0.2018D-02, 0.1478D-02, 0.1200D-02, 0.9031D-03, & + & 0.7391D-03, 0.6339D-03, 0.5926D-03, 0.1992D-03, 0.1202D-03, & + & 0.2022D-04, 0.d0/ +! + data (calcpts(j,11), j=1,neta) /0.d0, 0.1434D-12, 0.6663D-11, & + & 0.3955D-10, 0.1276D-09, 0.3054D-09, 0.4402D-09, 0.1929D-07, & + & 0.1082D-06, 0.3299D-06, 0.7475D-06, 0.1048D-05, 0.8874D-05, & + & 0.2804D-04, 0.5983D-04, 0.1035D-03, 0.1574D-03, 0.2197D-03, & + & 0.2885D-03, 0.3621D-03, 0.4391D-03, 0.1215D-02, 0.1814D-02, & + & 0.2226D-02, 0.2508D-02, 0.2697D-02, 0.2825D-02, 0.2909D-02, & + & 0.2961D-02, 0.2994D-02, 0.2604D-02, 0.2208D-02, 0.1946D-02, & + & 0.1758D-02, 0.1681D-02, 0.1229D-02, 0.1005D-02, 0.7642D-03, & + & 0.6311D-03, 0.5433D-03, 0.5108D-03, 0.1779D-03, 0.1087D-03, & + & 0.1860D-04, 0.d0/ +! + data (calcpts(j,12), j=1,neta) /0.d0, 0.1433D-12, 0.6657D-11, & + & 0.3953D-10, 0.1275D-09, 0.3053D-09, 0.4401D-09, 0.1929D-07, & + & 0.1081D-06, 0.3297D-06, 0.7470D-06, 0.1048D-05, 0.8868D-05, & + & 0.2804D-04, 0.5979D-04, 0.1034D-03, 0.1574D-03, 0.2196D-03, & + & 0.2883D-03, 0.3619D-03, 0.4391D-03, 0.1216D-02, 0.1818D-02, & + & 0.2238D-02, 0.2525D-02, 0.2720D-02, 0.2855D-02, 0.2943D-02, & + & 0.3000D-02, 0.3036D-02, 0.2630D-02, 0.2171D-02, 0.1860D-02, & + & 0.1643D-02, 0.1555D-02, 0.1076D-02, 0.8619D-03, 0.6490D-03, & + & 0.5361D-03, 0.4630D-03, 0.4353D-03, 0.1560D-03, 0.9623D-04, & + & 0.1727D-04, 0.d0/ +! + data (calcpts(j,13), j=1,neta) /0.d0, 0.1401D-12, 0.6668D-11, & + & 0.3954D-10, 0.1275D-09, 0.3053D-09, 0.4398D-09, 0.1928D-07, & + & 0.1081D-06, 0.3296D-06, 0.7470D-06, 0.1048D-05, 0.8868D-05, & + & 0.2804D-04, 0.5979D-04, 0.1034D-03, 0.1574D-03, 0.2196D-03, & + & 0.2883D-03, 0.3621D-03, 0.4389D-03, 0.1217D-02, 0.1821D-02, & + & 0.2244D-02, 0.2535D-02, 0.2736D-02, 0.2876D-02, 0.2970D-02, & + & 0.3035D-02, 0.3074D-02, 0.2727D-02, 0.2277D-02, 0.1956D-02, & + & 0.1722D-02, 0.1625D-02, 0.1073D-02, 0.8265D-03, 0.5928D-03, & + & 0.4775D-03, 0.4067D-03, 0.3804D-03, 0.1358D-03, 0.8456D-04, & + & 0.1560D-04, 0.d0/ +! + data (calcpts(j,14), j=1,neta) /0.d0, 0.4279D-12, 0.7533D-11, & + & 0.4041D-10, 0.1273D-09, 0.3024D-09, 0.4428D-09, 0.1926D-07, & + & 0.1081D-06, 0.3296D-06, 0.7469D-06, 0.1048D-05, 0.8865D-05, & + & 0.2804D-04, 0.5978D-04, 0.1034D-03, 0.1574D-03, 0.2196D-03, & + & 0.2885D-03, 0.3621D-03, 0.4392D-03, 0.1218D-02, 0.1824D-02, & + & 0.2249D-02, 0.2541D-02, 0.2744D-02, 0.2886D-02, 0.2982D-02, & + & 0.3050D-02, 0.3091D-02, 0.2793D-02, 0.2369D-02, 0.2064D-02, & + & 0.1838D-02, 0.1744D-02, 0.1188D-02, 0.9171D-03, 0.6428D-03, & + & 0.5015D-03, 0.4140D-03, 0.3816D-03, 0.1146D-03, 0.7074D-04, & + & 0.1332D-04, 0.d0/ +! + data (calcpts(j,15), j=1,neta) /0.d0, 0.0000D+00, 0.8481D-11, & + & 0.1250D-10, 0.1173D-09, 0.3631D-09, 0.4731D-09, 0.1937D-07, & + & 0.1080D-06, 0.3296D-06, 0.7471D-06, 0.1048D-05, 0.8865D-05, & + & 0.2802D-04, 0.5976D-04, 0.1034D-03, 0.1574D-03, 0.2196D-03, & + & 0.2885D-03, 0.3619D-03, 0.4391D-03, 0.1218D-02, 0.1824D-02, & + & 0.2249D-02, 0.2543D-02, 0.2745D-02, 0.2888D-02, 0.2985D-02, & + & 0.3051D-02, 0.3095D-02, 0.2802D-02, 0.2385D-02, 0.2084D-02, & + & 0.1860D-02, 0.1769D-02, 0.1219D-02, 0.9522D-03, 0.6765D-03, & + & 0.5313D-03, 0.4398D-03, 0.4059D-03, 0.1124D-03, 0.6680D-04, & + & 0.1251D-04, 0.d0/ +! + data (aeta(j), j = 1,neta) /small, 0.1000d-02, 0.3000d-02, & + & 0.5000d-02, 0.7000d-02, 0.9000d-02, 0.1000d-01, 0.3000d-01, & + & 0.5000d-01, 0.7000d-01, 0.9000d-01, 0.1000d+00, 0.2000d+00, & + & 0.3000d+00, 0.4000d+00, 0.5000d+00, 0.6000d+00, 0.7000d+00, & + & 0.8000d+00, 0.9000d+00, 0.1000d+01, 0.2000d+01, 0.3000d+01, & + & 0.4000d+01, 0.5000d+01, 0.6000d+01, 0.7000d+01, 0.8000d+01, & + & 0.9000d+01, 0.1000d+02, 0.3000d+02, 0.5000d+02, 0.7000d+02, & + & 0.9000d+02, 0.1000d+03, 0.2000d+03, 0.3000d+03, 0.5000d+03, & + & 0.7000d+03, 0.9000d+03, 0.1000d+04, 0.5000d+04, 0.1000d+05, & + & 0.1000d+06, huge/ +! + data (axi(j), j = 1,nxi) /0.1000d-01, 0.3162d-01, 0.1000d+00, & + & 0.3162d+00, 0.1000d+01, 0.2500d+01, 0.3162d+01, 0.7500d+01, & + & 0.1000d+02, 0.3162d+02, 0.1000d+03, 0.3162d+03, 0.1000d+04, & + & 0.5000d+04, 0.1000d+05/ +! +! here we have to choose the array elements that will go into the +! interpolation. + call locate(aeta, neta, eta, ieta) + call locate(axi, nxi, xi, ixi) + if (ieta .le. 1) ieta = 1 + if (ieta .gt. (neta - 1)) ieta = neta - 1 + if (ixi .le. 1) ixi = 1 + if (ixi .gt. (nxi - 1)) ixi = nxi - 1 + y1 = calcpts(ieta,ixi) + y2 = calcpts(ieta+1,ixi) + y3 = calcpts(ieta+1,ixi+1) + y4 = calcpts(ieta,ixi+1) +! interpolating between the points + t = (eta - aeta(ieta))/(aeta(ieta + 1) - aeta(ieta)) + u = (xi - axi(ixi))/(axi(ixi + 1) - axi(ixi)) + h1f_LTq = (1.d0 - t)*(1.d0 - u)*y1 + t*(1.d0 - u)*y2 + & + & t*u*y3 + (1.d0 - t)*u*y4 + + return + END + +! ========================================= + double precision function h1_LTq(eta,xi) +! ========================================= + +! eq (28) in PLB347 (1995) 143 - 151 for the transverse piece +! MSbar scheme +! This routine is called subd1tq in the original code. +! Gives h1_LTq for Q2 > 1.5 GeV2 (use h1f_LTq for Q2 < 1.5 GeV2) +! Called sclqt in updated code (03/06/96). + + implicit none + integer neta, nxi + parameter (neta = 73, nxi = 49) + double precision calcpts(neta, nxi), dlaeta(neta), dlaxi(nxi) + double precision eta, xi, dleta, dlxi + double precision pxi, peta, f(-1:1), delxi, deleta + integer j, ieta, ixi + + data (calcpts(j, 1), j = 1,neta) /0.2418D-16, 0.9248D-16, & + & 0.3534D-15, 0.1349D-14, 0.5144D-14, 0.1956D-13, 0.7412D-13, & + & 0.2795D-12, 0.1046D-11, 0.3876D-11, 0.1417D-10, 0.5081D-10, & + & 0.1778D-09, 0.6021D-09, 0.1964D-08, 0.6116D-08, 0.1817D-07, & + & 0.5128D-07, 0.1377D-06, 0.3524D-06, 0.8631D-06, 0.2031D-05, & + & 0.4617D-05, 0.1017D-04, 0.2177D-04, 0.4545D-04, 0.9263D-04, & + & 0.1844D-03, 0.3577D-03, 0.6750D-03, 0.1232D-02, 0.2160D-02, & + & 0.3605D-02, 0.5666D-02, 0.8313D-02, 0.1131D-01, 0.1428D-01, & + & 0.1683D-01, 0.1868D-01, 0.1970D-01, 0.1988D-01, 0.1925D-01, & + & 0.1794D-01, 0.1616D-01, 0.1410D-01, 0.1198D-01, 0.9952D-02, & + & 0.8106D-02, 0.6494D-02, 0.5132D-02, 0.4007D-02, 0.3097D-02, & + & 0.2373D-02, 0.1806D-02, 0.1364D-02, 0.1025D-02, 0.7660D-03, & + & 0.5700D-03, 0.4222D-03, 0.3117D-03, 0.2294D-03, 0.1682D-03, & + & 0.1230D-03, 0.8970D-04, 0.6527D-04, 0.4739D-04, 0.3434D-04, & + & 0.2483D-04, 0.1791D-04, 0.1291D-04, 0.9285D-05, 0.6669D-05, & + & 0.4784D-05/ + + data (calcpts(j, 2), j = 1,neta) /0.1123D-16, 0.4299D-16, & + & 0.1644D-15, 0.6287D-15, 0.2400D-14, 0.9147D-14, 0.3479D-13, & + & 0.1318D-12, 0.4970D-12, 0.1860D-11, 0.6894D-11, 0.2520D-10, & + & 0.9034D-10, 0.3161D-09, 0.1071D-08, 0.3488D-08, 0.1087D-07, & + & 0.3229D-07, 0.9114D-07, 0.2447D-06, 0.6258D-06, 0.1532D-05, & + & 0.3602D-05, 0.8169D-05, 0.1794D-04, 0.3830D-04, 0.7952D-04, & + & 0.1608D-03, 0.3164D-03, 0.6040D-03, 0.1114D-02, 0.1971D-02, & + & 0.3317D-02, 0.5253D-02, 0.7759D-02, 0.1063D-01, 0.1349D-01, & + & 0.1597D-01, 0.1781D-01, 0.1886D-01, 0.1908D-01, 0.1852D-01, & + & 0.1731D-01, 0.1561D-01, 0.1366D-01, 0.1163D-01, 0.9669D-02, & + & 0.7886D-02, 0.6324D-02, 0.5003D-02, 0.3910D-02, 0.3025D-02, & + & 0.2321D-02, 0.1767D-02, 0.1336D-02, 0.1004D-02, 0.7509D-03, & + & 0.5590D-03, 0.4145D-03, 0.3060D-03, 0.2253D-03, 0.1653D-03, & + & 0.1209D-03, 0.8825D-04, 0.6423D-04, 0.4665D-04, 0.3381D-04, & + & 0.2445D-04, 0.1765D-04, 0.1272D-04, 0.9156D-05, 0.6579D-05, & + & 0.4719D-05/ + + data (calcpts(j, 3), j = 1,neta) /0.5218D-17, 0.1998D-16, & + & 0.7647D-16, 0.2925D-15, 0.1118D-14, 0.4268D-14, 0.1626D-13, & + & 0.6185D-13, 0.2343D-12, 0.8836D-12, 0.3308D-11, 0.1226D-10, & + & 0.4481D-10, 0.1607D-09, 0.5619D-09, 0.1904D-08, 0.6199D-08, & + & 0.1932D-07, 0.5739D-07, 0.1619D-06, 0.4344D-06, 0.1110D-05, & + & 0.2715D-05, 0.6374D-05, 0.1442D-04, 0.3158D-04, 0.6700D-04, & + & 0.1381D-03, 0.2762D-03, 0.5346D-03, 0.9981D-03, 0.1785D-02, & + & 0.3032D-02, 0.4842D-02, 0.7208D-02, 0.9939D-02, 0.1270D-01, & + & 0.1512D-01, 0.1694D-01, 0.1800D-01, 0.1828D-01, 0.1781D-01, & + & 0.1668D-01, 0.1509D-01, 0.1322D-01, 0.1127D-01, 0.9386D-02, & + & 0.7664D-02, 0.6155D-02, 0.4874D-02, 0.3813D-02, 0.2953D-02, & + & 0.2267D-02, 0.1726D-02, 0.1307D-02, 0.9832D-03, 0.7359D-03, & + & 0.5481D-03, 0.4065D-03, 0.3005D-03, 0.2212D-03, 0.1624D-03, & + & 0.1189D-03, 0.8678D-04, 0.6320D-04, 0.4592D-04, 0.3329D-04, & + & 0.2409D-04, 0.1740D-04, 0.1254D-04, 0.9027D-05, 0.6488D-05, & + & 0.4656D-05/ + + data (calcpts(j, 4), j = 1,neta) /0.2424D-17, 0.9281D-17, & + & 0.3554D-16, 0.1360D-15, 0.5202D-15, 0.1988D-14, 0.7590D-14, & + & 0.2893D-13, 0.1100D-12, 0.4168D-12, 0.1572D-11, 0.5883D-11, & + & 0.2180D-10, 0.7967D-10, 0.2858D-09, 0.9992D-09, 0.3381D-08, & + & 0.1102D-07, 0.3435D-07, 0.1020D-06, 0.2876D-06, 0.7709D-06, & + & 0.1968D-05, 0.4806D-05, 0.1125D-04, 0.2538D-04, 0.5526D-04, & + & 0.1164D-03, 0.2373D-03, 0.4670D-03, 0.8841D-03, 0.1601D-02, & + & 0.2748D-02, 0.4434D-02, 0.6657D-02, 0.9254D-02, 0.1191D-01, & + & 0.1426D-01, 0.1607D-01, 0.1716D-01, 0.1749D-01, 0.1710D-01, & + & 0.1605D-01, 0.1455D-01, 0.1278D-01, 0.1091D-01, 0.9102D-02, & + & 0.7443D-02, 0.5985D-02, 0.4745D-02, 0.3717D-02, 0.2881D-02, & + & 0.2214D-02, 0.1688D-02, 0.1278D-02, 0.9624D-03, 0.7208D-03, & + & 0.5372D-03, 0.3987D-03, 0.2948D-03, 0.2172D-03, 0.1595D-03, & + & 0.1168D-03, 0.8532D-04, 0.6216D-04, 0.4518D-04, 0.3276D-04, & + & 0.2371D-04, 0.1713D-04, 0.1236D-04, 0.8898D-05, 0.6398D-05, & + & 0.4592D-05/ + + data (calcpts(j, 5), j = 1,neta) /0.1125D-17, 0.4310D-17, & + & 0.1650D-16, 0.6320D-16, 0.2418D-15, 0.9251D-15, 0.3535D-14, & + & 0.1350D-13, 0.5145D-13, 0.1956D-12, 0.7412D-12, 0.2795D-11, & + & 0.1046D-10, 0.3878D-10, 0.1417D-09, 0.5081D-09, 0.1776D-08, & + & 0.6011D-08, 0.1959D-07, 0.6104D-07, 0.1810D-06, 0.5103D-06, & + & 0.1367D-05, 0.3486D-05, 0.8489D-05, 0.1981D-04, 0.4444D-04, & + & 0.9606D-04, 0.2001D-03, 0.4016D-03, 0.7731D-03, 0.1420D-02, & + & 0.2469D-02, 0.4028D-02, 0.6110D-02, 0.8570D-02, 0.1111D-01, & + & 0.1341D-01, 0.1520D-01, 0.1631D-01, 0.1670D-01, 0.1638D-01, & + & 0.1544D-01, 0.1402D-01, 0.1233D-01, 0.1055D-01, 0.8818D-02, & + & 0.7222D-02, 0.5816D-02, 0.4617D-02, 0.3619D-02, 0.2809D-02, & + & 0.2160D-02, 0.1649D-02, 0.1250D-02, 0.9416D-03, 0.7056D-03, & + & 0.5263D-03, 0.3909D-03, 0.2892D-03, 0.2132D-03, 0.1566D-03, & + & 0.1148D-03, 0.8385D-04, 0.6111D-04, 0.4444D-04, 0.3225D-04, & + & 0.2336D-04, 0.1688D-04, 0.1217D-04, 0.8769D-05, 0.6306D-05, & + & 0.4528D-05/ + + data (calcpts(j, 6), j = 1,neta) /0.5224D-18, 0.2001D-17, & + & 0.7665D-17, 0.2936D-16, 0.1124D-15, 0.4301D-15, 0.1646D-14, & + & 0.6288D-14, 0.2400D-13, 0.9149D-13, 0.3479D-12, 0.1318D-11, & + & 0.4969D-11, 0.1860D-10, 0.6894D-10, 0.2519D-09, 0.9032D-09, & + & 0.3154D-08, 0.1068D-07, 0.3480D-07, 0.1084D-06, 0.3215D-06, & + & 0.9049D-06, 0.2420D-05, 0.6157D-05, 0.1495D-04, 0.3471D-04, & + & 0.7731D-04, 0.1653D-03, 0.3392D-03, 0.6657D-03, 0.1244D-02, & + & 0.2195D-02, 0.3627D-02, 0.5567D-02, 0.7890D-02, 0.1033D-01, & + & 0.1256D-01, 0.1432D-01, 0.1546D-01, 0.1592D-01, 0.1566D-01, & + & 0.1480D-01, 0.1348D-01, 0.1189D-01, 0.1020D-01, 0.8535D-02, & + & 0.7002D-02, 0.5646D-02, 0.4488D-02, 0.3524D-02, 0.2738D-02, & + & 0.2108D-02, 0.1610D-02, 0.1221D-02, 0.9207D-03, 0.6905D-03, & + & 0.5154D-03, 0.3830D-03, 0.2835D-03, 0.2091D-03, 0.1537D-03, & + & 0.1127D-03, 0.8240D-04, 0.6008D-04, 0.4371D-04, 0.3172D-04, & + & 0.2298D-04, 0.1662D-04, 0.1199D-04, 0.8640D-05, 0.6216D-05, & + & 0.4464D-05/ + + data (calcpts(j, 7), j = 1,neta) /0.2426D-18, 0.9293D-18, & + & 0.3560D-17, 0.1363D-16, 0.5220D-16, 0.1998D-15, 0.7649D-15, & + & 0.2925D-14, 0.1118D-13, 0.4269D-13, 0.1628D-12, 0.6186D-12, & + & 0.2344D-11, 0.8837D-11, 0.3308D-10, 0.1226D-09, 0.4479D-09, & + & 0.1605D-08, 0.5606D-08, 0.1898D-07, 0.6182D-07, 0.1925D-06, & + & 0.5700D-06, 0.1602D-05, 0.4277D-05, 0.1085D-04, 0.2621D-04, & + & 0.6041D-04, 0.1331D-03, 0.2804D-03, 0.5631D-03, 0.1073D-02, & + & 0.1928D-02, 0.3234D-02, 0.5030D-02, 0.7214D-02, 0.9542D-02, & + & 0.1171D-01, 0.1346D-01, 0.1462D-01, 0.1512D-01, 0.1494D-01, & + & 0.1417D-01, 0.1295D-01, 0.1145D-01, 0.9839D-02, 0.8252D-02, & + & 0.6782D-02, 0.5476D-02, 0.4359D-02, 0.3428D-02, 0.2665D-02, & + & 0.2054D-02, 0.1571D-02, 0.1193D-02, 0.8998D-03, 0.6755D-03, & + & 0.5045D-03, 0.3752D-03, 0.2780D-03, 0.2050D-03, 0.1509D-03, & + & 0.1107D-03, 0.8093D-04, 0.5904D-04, 0.4298D-04, 0.3120D-04, & + & 0.2261D-04, 0.1635D-04, 0.1181D-04, 0.8511D-05, 0.6124D-05, & + & 0.4401D-05/ + + data (calcpts(j, 8), j = 1,neta) /0.1126D-18, 0.4314D-18, & + & 0.1653D-17, 0.6330D-17, 0.2424D-16, 0.9284D-16, 0.3554D-15, & + & 0.1360D-14, 0.5202D-14, 0.1989D-13, 0.7591D-13, 0.2894D-12, & + & 0.1100D-11, 0.4169D-11, 0.1572D-10, 0.5882D-10, 0.2180D-09, & + & 0.7962D-09, 0.2850D-08, 0.9960D-08, 0.3371D-07, 0.1097D-06, & + & 0.3413D-06, 0.1010D-05, 0.2832D-05, 0.7536D-05, 0.1902D-04, & + & 0.4563D-04, 0.1041D-03, 0.2262D-03, 0.4664D-03, 0.9094D-03, & + & 0.1667D-02, 0.2847D-02, 0.4498D-02, 0.6543D-02, 0.8759D-02, & + & 0.1086D-01, 0.1259D-01, 0.1378D-01, 0.1432D-01, 0.1422D-01, & + & 0.1354D-01, 0.1241D-01, 0.1101D-01, 0.9482D-02, 0.7970D-02, & + & 0.6561D-02, 0.5307D-02, 0.4230D-02, 0.3330D-02, 0.2594D-02, & + & 0.2001D-02, 0.1532D-02, 0.1164D-02, 0.8790D-03, 0.6603D-03, & + & 0.4935D-03, 0.3674D-03, 0.2723D-03, 0.2010D-03, 0.1480D-03, & + & 0.1086D-03, 0.7947D-04, 0.5801D-04, 0.4224D-04, 0.3068D-04, & + & 0.2224D-04, 0.1610D-04, 0.1163D-04, 0.8382D-05, 0.6033D-05, & + & 0.4337D-05/ + + data (calcpts(j, 9), j = 1,neta) /0.5227D-19, 0.2003D-18, & + & 0.7671D-18, 0.2938D-17, 0.1126D-16, 0.4311D-16, 0.1652D-15, & + & 0.6321D-15, 0.2419D-14, 0.9252D-14, 0.3537D-13, 0.1350D-12, & + & 0.5145D-12, 0.1956D-11, 0.7413D-11, 0.2794D-10, 0.1046D-09, & + & 0.3874D-09, 0.1415D-08, 0.5064D-08, 0.1770D-07, 0.5985D-07, & + & 0.1946D-06, 0.6045D-06, 0.1785D-05, 0.4993D-05, 0.1322D-04, & + & 0.3315D-04, 0.7875D-04, 0.1771D-03, 0.3768D-03, 0.7551D-03, & + & 0.1417D-02, 0.2472D-02, 0.3978D-02, 0.5880D-02, 0.7983D-02, & + & 0.1002D-01, 0.1173D-01, 0.1293D-01, 0.1353D-01, 0.1351D-01, & + & 0.1291D-01, 0.1188D-01, 0.1056D-01, 0.9123D-02, 0.7686D-02, & + & 0.6340D-02, 0.5138D-02, 0.4103D-02, 0.3234D-02, 0.2522D-02, & + & 0.1947D-02, 0.1492D-02, 0.1135D-02, 0.8582D-03, 0.6452D-03, & + & 0.4827D-03, 0.3594D-03, 0.2666D-03, 0.1969D-03, 0.1451D-03, & + & 0.1065D-03, 0.7800D-04, 0.5697D-04, 0.4149D-04, 0.3017D-04, & + & 0.2187D-04, 0.1584D-04, 0.1144D-04, 0.8253D-05, 0.5943D-05, & + & 0.4273D-05/ + + data (calcpts(j,10), j = 1,neta) /0.2427D-19, 0.9297D-19, & + & 0.3561D-18, 0.1364D-17, 0.5227D-17, 0.2003D-16, 0.7668D-16, & + & 0.2937D-15, 0.1124D-14, 0.4302D-14, 0.1646D-13, 0.6290D-13, & + & 0.2401D-12, 0.9151D-12, 0.3479D-11, 0.1318D-10, 0.4970D-10, & + & 0.1860D-09, 0.6888D-09, 0.2511D-08, 0.8997D-08, 0.3141D-07, & + & 0.1062D-06, 0.3449D-06, 0.1069D-05, 0.3147D-05, 0.8768D-05, & + & 0.2307D-04, 0.5728D-04, 0.1342D-03, 0.2958D-03, 0.6119D-03, & + & 0.1181D-02, 0.2110D-02, 0.3471D-02, 0.5228D-02, 0.7215D-02, & + & 0.9179D-02, 0.1087D-01, 0.1209D-01, 0.1275D-01, 0.1279D-01, & + & 0.1229D-01, 0.1135D-01, 0.1012D-01, 0.8766D-02, 0.7403D-02, & + & 0.6120D-02, 0.4968D-02, 0.3974D-02, 0.3136D-02, 0.2449D-02, & + & 0.1895D-02, 0.1453D-02, 0.1107D-02, 0.8375D-03, 0.6302D-03, & + & 0.4718D-03, 0.3516D-03, 0.2610D-03, 0.1931D-03, 0.1422D-03, & + & 0.1045D-03, 0.7655D-04, 0.5592D-04, 0.4075D-04, 0.2964D-04, & + & 0.2151D-04, 0.1557D-04, 0.1126D-04, 0.8124D-05, 0.5852D-05, & + & 0.4209D-05/ + + data (calcpts(j,11), j = 1,neta) /0.1127D-19, 0.4317D-19, & + & 0.1653D-18, 0.6334D-18, 0.2427D-17, 0.9297D-17, 0.3561D-16, & + & 0.1364D-15, 0.5223D-15, 0.2000D-14, 0.7653D-14, 0.2927D-13, & + & 0.1119D-12, 0.4270D-12, 0.1627D-11, 0.6187D-11, 0.2344D-10, & + & 0.8835D-10, 0.3306D-09, 0.1224D-08, 0.4463D-08, 0.1597D-07, & + & 0.5574D-07, 0.1881D-06, 0.6101D-06, 0.1885D-05, 0.5529D-05, & + & 0.1531D-04, 0.3992D-04, 0.9777D-04, 0.2246D-03, 0.4818D-03, & + & 0.9605D-03, 0.1767D-02, 0.2981D-02, 0.4590D-02, 0.6457D-02, & + & 0.8346D-02, 0.1001D-01, 0.1125D-01, 0.1196D-01, 0.1208D-01, & + & 0.1166D-01, 0.1081D-01, 0.9681D-02, 0.8409D-02, 0.7119D-02, & + & 0.5898D-02, 0.4799D-02, 0.3844D-02, 0.3040D-02, 0.2378D-02, & + & 0.1841D-02, 0.1414D-02, 0.1078D-02, 0.8166D-03, 0.6150D-03, & + & 0.4608D-03, 0.3438D-03, 0.2553D-03, 0.1890D-03, 0.1393D-03, & + & 0.1024D-03, 0.7509D-04, 0.5489D-04, 0.4002D-04, 0.2911D-04, & + & 0.2114D-04, 0.1531D-04, 0.1108D-04, 0.7995D-05, 0.5762D-05, & + & 0.4146D-05/ + + data (calcpts(j,12), j = 1,neta) /0.5232D-20, 0.2004D-19, & + & 0.7680D-19, 0.2941D-18, 0.1127D-17, 0.4318D-17, 0.1654D-16, & + & 0.6336D-16, 0.2427D-15, 0.9293D-15, 0.3558D-14, 0.1361D-13, & + & 0.5208D-13, 0.1991D-12, 0.7597D-12, 0.2895D-11, 0.1101D-10, & + & 0.4170D-10, 0.1571D-09, 0.5877D-09, 0.2175D-08, 0.7928D-08, & + & 0.2835D-07, 0.9882D-07, 0.3330D-06, 0.1077D-05, 0.3317D-05, & + & 0.9666D-05, 0.2652D-04, 0.6827D-04, 0.1641D-03, 0.3672D-03, & + & 0.7601D-03, 0.1446D-02, 0.2514D-02, 0.3972D-02, 0.5714D-02, & + & 0.7524D-02, 0.9161D-02, 0.1042D-01, 0.1117D-01, 0.1137D-01, & + & 0.1104D-01, 0.1028D-01, 0.9240D-02, 0.8052D-02, 0.6837D-02, & + & 0.5678D-02, 0.4629D-02, 0.3716D-02, 0.2943D-02, 0.2306D-02, & + & 0.1788D-02, 0.1375D-02, 0.1049D-02, 0.7957D-03, 0.5998D-03, & + & 0.4500D-03, 0.3359D-03, 0.2498D-03, 0.1850D-03, 0.1365D-03, & + & 0.1004D-03, 0.7362D-04, 0.5385D-04, 0.3929D-04, 0.2861D-04, & + & 0.2078D-04, 0.1506D-04, 0.1089D-04, 0.7866D-05, 0.5670D-05, & + & 0.4082D-05/ + + data (calcpts(j,13), j = 1,neta) /0.2432D-20, 0.9314D-20, & + & 0.3569D-19, 0.1367D-18, 0.5238D-18, 0.2007D-17, 0.7688D-17, & + & 0.2945D-16, 0.1128D-15, 0.4320D-15, 0.1654D-14, 0.6333D-14, & + & 0.2424D-13, 0.9270D-13, 0.3543D-12, 0.1352D-11, 0.5153D-11, & + & 0.1959D-10, 0.7419D-10, 0.2795D-09, 0.1045D-08, 0.3861D-08, & + & 0.1408D-07, 0.5031D-07, 0.1750D-06, 0.5883D-06, 0.1896D-05, & + & 0.5805D-05, 0.1678D-04, 0.4548D-04, 0.1150D-03, 0.2696D-03, & + & 0.5826D-03, 0.1153D-02, 0.2075D-02, 0.3379D-02, 0.4991D-02, & + & 0.6716D-02, 0.8320D-02, 0.9593D-02, 0.1039D-01, 0.1066D-01, & + & 0.1041D-01, 0.9750D-02, 0.8799D-02, 0.7695D-02, 0.6554D-02, & + & 0.5457D-02, 0.4459D-02, 0.3588D-02, 0.2847D-02, 0.2234D-02, & + & 0.1734D-02, 0.1336D-02, 0.1021D-02, 0.7749D-03, 0.5849D-03, & + & 0.4391D-03, 0.3281D-03, 0.2441D-03, 0.1809D-03, 0.1336D-03, & + & 0.9832D-04, 0.7217D-04, 0.5282D-04, 0.3855D-04, 0.2808D-04, & + & 0.2040D-04, 0.1480D-04, 0.1071D-04, 0.7737D-05, 0.5580D-05, & + & 0.4019D-05/ + + data (calcpts(j,14), j = 1,neta) /0.1131D-20, 0.4332D-20, & + & 0.1661D-19, 0.6360D-19, 0.2436D-18, 0.9334D-18, 0.3576D-17, & + & 0.1370D-16, 0.5248D-16, 0.2010D-15, 0.7700D-15, 0.2948D-14, & + & 0.1129D-13, 0.4318D-13, 0.1652D-12, 0.6312D-12, 0.2409D-11, & + & 0.9181D-11, 0.3489D-10, 0.1321D-09, 0.4977D-09, 0.1860D-08, & + & 0.6866D-08, 0.2501D-07, 0.8922D-07, 0.3097D-06, 0.1037D-05, & + & 0.3326D-05, 0.1010D-04, 0.2886D-04, 0.7695D-04, 0.1899D-03, & + & 0.4307D-03, 0.8910D-03, 0.1670D-02, 0.2820D-02, 0.4293D-02, & + & 0.5926D-02, 0.7491D-02, 0.8774D-02, 0.9617D-02, 0.9952D-02, & + & 0.9792D-02, 0.9219D-02, 0.8360D-02, 0.7339D-02, 0.6272D-02, & + & 0.5238D-02, 0.4292D-02, 0.3459D-02, 0.2751D-02, 0.2162D-02, & + & 0.1682D-02, 0.1296D-02, 0.9921D-03, 0.7541D-03, 0.5697D-03, & + & 0.4281D-03, 0.3203D-03, 0.2384D-03, 0.1769D-03, 0.1307D-03, & + & 0.9627D-04, 0.7069D-04, 0.5178D-04, 0.3781D-04, 0.2755D-04, & + & 0.2004D-04, 0.1454D-04, 0.1053D-04, 0.7608D-05, 0.5489D-05, & + & 0.3954D-05/ + + data (calcpts(j,15), j = 1,neta) /0.5274D-21, 0.2020D-20, & + & 0.7740D-20, 0.2965D-19, 0.1136D-18, 0.4353D-18, 0.1668D-17, & + & 0.6389D-17, 0.2448D-16, 0.9377D-16, 0.3591D-15, 0.1376D-14, & + & 0.5267D-14, 0.2016D-13, 0.7716D-13, 0.2951D-12, 0.1128D-11, & + & 0.4303D-11, 0.1640D-10, 0.6230D-10, 0.2358D-09, 0.8878D-09, & + & 0.3311D-08, 0.1223D-07, 0.4447D-07, 0.1583D-06, 0.5478D-06, & + & 0.1825D-05, 0.5810D-05, 0.1746D-04, 0.4913D-04, 0.1280D-03, & + & 0.3062D-03, 0.6659D-03, 0.1307D-02, 0.2299D-02, 0.3630D-02, & + & 0.5162D-02, 0.6679D-02, 0.7965D-02, 0.8849D-02, 0.9251D-02, & + & 0.9173D-02, 0.8691D-02, 0.7920D-02, 0.6984D-02, 0.5990D-02, & + & 0.5018D-02, 0.4122D-02, 0.3330D-02, 0.2654D-02, 0.2090D-02, & + & 0.1628D-02, 0.1257D-02, 0.9634D-03, 0.7332D-03, 0.5546D-03, & + & 0.4172D-03, 0.3123D-03, 0.2328D-03, 0.1728D-03, 0.1278D-03, & + & 0.9422D-04, 0.6924D-04, 0.5073D-04, 0.3708D-04, 0.2703D-04, & + & 0.1967D-04, 0.1428D-04, 0.1034D-04, 0.7479D-05, 0.5399D-05, & + & 0.3889D-05/ + + data (calcpts(j,16), j = 1,neta) /0.2473D-21, 0.9471D-21, & + & 0.3629D-20, 0.1390D-19, 0.5327D-19, 0.2040D-18, 0.7818D-18, & + & 0.2995D-17, 0.1148D-16, 0.4397D-16, 0.1685D-15, 0.6450D-15, & + & 0.2471D-14, 0.9459D-14, 0.3621D-13, 0.1386D-12, 0.5300D-12, & + & 0.2025D-11, 0.7727D-11, 0.2943D-10, 0.1118D-09, 0.4230D-09, & + & 0.1591D-08, 0.5928D-08, 0.2187D-07, 0.7937D-07, 0.2817D-06, & + & 0.9701D-06, 0.3212D-05, 0.1012D-04, 0.2997D-04, 0.8255D-04, & + & 0.2088D-03, 0.4799D-03, 0.9918D-03, 0.1830D-02, 0.3011D-02, & + & 0.4431D-02, 0.5892D-02, 0.7172D-02, 0.8091D-02, 0.8556D-02, & + & 0.8559D-02, 0.8166D-02, 0.7484D-02, 0.6629D-02, 0.5708D-02, & + & 0.4797D-02, 0.3953D-02, 0.3202D-02, 0.2558D-02, 0.2018D-02, & + & 0.1575D-02, 0.1218D-02, 0.9348D-03, 0.7124D-03, 0.5396D-03, & + & 0.4063D-03, 0.3045D-03, 0.2271D-03, 0.1688D-03, 0.1249D-03, & + & 0.9216D-04, 0.6777D-04, 0.4969D-04, 0.3635D-04, 0.2652D-04, & + & 0.1931D-04, 0.1402D-04, 0.1016D-04, 0.7350D-05, 0.5307D-05, & + & 0.3826D-05/ + + data (calcpts(j,17), j = 1,neta) /0.1173D-21, 0.4490D-21, & + & 0.1721D-20, 0.6589D-20, 0.2525D-19, 0.9674D-19, 0.3706D-18, & + & 0.1420D-17, 0.5441D-17, 0.2084D-16, 0.7985D-16, 0.3059D-15, & + & 0.1172D-14, 0.4486D-14, 0.1718D-13, 0.6576D-13, 0.2515D-12, & + & 0.9621D-12, 0.3677D-11, 0.1403D-10, 0.5340D-10, 0.2028D-09, & + & 0.7668D-09, 0.2877D-08, 0.1072D-07, 0.3948D-07, 0.1429D-06, & + & 0.5049D-06, 0.1728D-05, 0.5670D-05, 0.1761D-04, 0.5118D-04, & + & 0.1370D-03, 0.3338D-03, 0.7298D-03, 0.1420D-02, 0.2446D-02, & + & 0.3744D-02, 0.5136D-02, 0.6400D-02, 0.7347D-02, 0.7871D-02, & + & 0.7950D-02, 0.7644D-02, 0.7049D-02, 0.6275D-02, 0.5426D-02, & + & 0.4578D-02, 0.3783D-02, 0.3074D-02, 0.2460D-02, 0.1946D-02, & + & 0.1521D-02, 0.1179D-02, 0.9061D-03, 0.6915D-03, 0.5244D-03, & + & 0.3954D-03, 0.2965D-03, 0.2215D-03, 0.1647D-03, 0.1220D-03, & + & 0.9011D-04, 0.6632D-04, 0.4866D-04, 0.3561D-04, 0.2600D-04, & + & 0.1893D-04, 0.1376D-04, 0.9977D-05, 0.7221D-05, 0.5217D-05, & + & 0.3762D-05/ + + data (calcpts(j,18), j = 1,neta) /0.5694D-22, 0.2178D-21, & + & 0.8340D-21, 0.3197D-20, 0.1224D-19, 0.4692D-19, 0.1797D-18, & + & 0.6886D-18, 0.2639D-17, 0.1011D-16, 0.3873D-16, 0.1484D-15, & + & 0.5682D-15, 0.2177D-14, 0.8335D-14, 0.3192D-13, 0.1222D-12, & + & 0.4674D-12, 0.1787D-11, 0.6827D-11, 0.2604D-10, 0.9911D-10, & + & 0.3760D-09, 0.1421D-08, 0.5325D-08, 0.1981D-07, 0.7272D-07, & + & 0.2622D-06, 0.9210D-06, 0.3125D-05, 0.1012D-04, 0.3086D-04, & + & 0.8726D-04, 0.2252D-03, 0.5222D-03, 0.1074D-02, 0.1948D-02, & + & 0.3114D-02, 0.4422D-02, 0.5658D-02, 0.6624D-02, 0.7197D-02, & + & 0.7350D-02, 0.7127D-02, 0.6615D-02, 0.5923D-02, 0.5145D-02, & + & 0.4359D-02, 0.3615D-02, 0.2946D-02, 0.2364D-02, 0.1873D-02, & + & 0.1468D-02, 0.1140D-02, 0.8775D-03, 0.6706D-03, 0.5093D-03, & + & 0.3844D-03, 0.2888D-03, 0.2159D-03, 0.1607D-03, 0.1192D-03, & + & 0.8805D-04, 0.6485D-04, 0.4762D-04, 0.3488D-04, 0.2547D-04, & + & 0.1857D-04, 0.1350D-04, 0.9792D-05, 0.7092D-05, 0.5126D-05, & + & 0.3699D-05/ + + data (calcpts(j,19), j = 1,neta) /0.2892D-22, 0.1104D-21, & + & 0.4228D-21, 0.1620D-20, 0.6209D-20, 0.2379D-19, 0.9114D-19, & + & 0.3492D-18, 0.1338D-17, 0.5126D-17, 0.1964D-16, 0.7522D-16, & + & 0.2882D-15, 0.1104D-14, 0.4228D-14, 0.1618D-13, 0.6200D-13, & + & 0.2373D-12, 0.9077D-12, 0.3470D-11, 0.1325D-10, 0.5052D-10, & + & 0.1922D-09, 0.7287D-09, 0.2744D-08, 0.1028D-07, 0.3815D-07, & + & 0.1394D-06, 0.4995D-06, 0.1739D-05, 0.5822D-05, 0.1850D-04, & + & 0.5489D-04, 0.1494D-03, 0.3666D-03, 0.7981D-03, 0.1525D-02, & + & 0.2552D-02, 0.3762D-02, 0.4955D-02, 0.5926D-02, 0.6543D-02, & + & 0.6762D-02, 0.6616D-02, 0.6188D-02, 0.5574D-02, 0.4866D-02, & + & 0.4140D-02, 0.3447D-02, 0.2817D-02, 0.2268D-02, 0.1802D-02, & + & 0.1415D-02, 0.1101D-02, 0.8490D-03, 0.6498D-03, 0.4941D-03, & + & 0.3735D-03, 0.2810D-03, 0.2103D-03, 0.1566D-03, 0.1163D-03, & + & 0.8600D-04, 0.6339D-04, 0.4659D-04, 0.3414D-04, 0.2496D-04, & + & 0.1820D-04, 0.1324D-04, 0.9609D-05, 0.6963D-05, 0.5036D-05, & + & 0.3635D-05/ + + data (calcpts(j,20), j = 1,neta) /0.1592D-22, 0.6060D-22, & + & 0.2321D-21, 0.8892D-21, 0.3408D-20, 0.1305D-19, 0.5001D-19, & + & 0.1916D-18, 0.7341D-18, 0.2813D-17, 0.1078D-16, 0.4128D-16, & + & 0.1581D-15, 0.6058D-15, 0.2321D-14, 0.8889D-14, 0.3404D-13, & + & 0.1303D-12, 0.4986D-12, 0.1907D-11, 0.7287D-11, 0.2781D-10, & + & 0.1060D-09, 0.4028D-09, 0.1524D-08, 0.5727D-08, 0.2139D-07, & + & 0.7892D-07, 0.2864D-06, 0.1015D-05, 0.3480D-05, 0.1140D-04, & + & 0.3512D-04, 0.9989D-04, 0.2573D-03, 0.5892D-03, 0.1183D-02, & + & 0.2070D-02, 0.3171D-02, 0.4304D-02, 0.5265D-02, 0.5913D-02, & + & 0.6189D-02, 0.6116D-02, 0.5766D-02, 0.5228D-02, 0.4590D-02, & + & 0.3923D-02, 0.3279D-02, 0.2690D-02, 0.2172D-02, 0.1729D-02, & + & 0.1362D-02, 0.1062D-02, 0.8204D-03, 0.6291D-03, 0.4791D-03, & + & 0.3627D-03, 0.2730D-03, 0.2046D-03, 0.1526D-03, 0.1134D-03, & + & 0.8394D-04, 0.6194D-04, 0.4556D-04, 0.3341D-04, 0.2443D-04, & + & 0.1782D-04, 0.1298D-04, 0.9426D-05, 0.6834D-05, 0.4944D-05, & + & 0.3572D-05/ + + data (calcpts(j,21), j = 1,neta) /0.9878D-23, 0.3747D-22, & + & 0.1434D-21, 0.5498D-21, 0.2108D-20, 0.8071D-20, 0.3093D-19, & + & 0.1185D-18, 0.4539D-18, 0.1740D-17, 0.6663D-17, 0.2553D-16, & + & 0.9780D-16, 0.3747D-15, 0.1435D-14, 0.5498D-14, 0.2105D-13, & + & 0.8060D-13, 0.3086D-12, 0.1180D-11, 0.4512D-11, 0.1724D-10, & + & 0.6569D-10, 0.2499D-09, 0.9476D-09, 0.3569D-08, 0.1337D-07, & + & 0.4960D-07, 0.1814D-06, 0.6490D-06, 0.2256D-05, 0.7524D-05, & + & 0.2373D-04, 0.6951D-04, 0.1854D-03, 0.4410D-03, 0.9218D-03, & + & 0.1677D-02, 0.2660D-02, 0.3717D-02, 0.4652D-02, 0.5315D-02, & + & 0.5637D-02, 0.5630D-02, 0.5352D-02, 0.4886D-02, 0.4316D-02, & + & 0.3706D-02, 0.3113D-02, 0.2562D-02, 0.2076D-02, 0.1658D-02, & + & 0.1309D-02, 0.1023D-02, 0.7917D-03, 0.6083D-03, 0.4640D-03, & + & 0.3518D-03, 0.2652D-03, 0.1989D-03, 0.1486D-03, 0.1105D-03, & + & 0.8189D-04, 0.6046D-04, 0.4451D-04, 0.3267D-04, 0.2391D-04, & + & 0.1746D-04, 0.1272D-04, 0.9243D-05, 0.6705D-05, 0.4854D-05, & + & 0.3507D-05/ + + data (calcpts(j,22), j = 1,neta) /0.7062D-23, 0.2674D-22, & + & 0.1023D-21, 0.3922D-21, 0.1503D-20, 0.5758D-20, 0.2206D-19, & + & 0.8454D-19, 0.3239D-18, 0.1241D-17, 0.4755D-17, 0.1821D-16, & + & 0.6978D-16, 0.2673D-15, 0.1024D-14, 0.3923D-14, 0.1501D-13, & + & 0.5751D-13, 0.2202D-12, 0.8422D-12, 0.3221D-11, 0.1230D-10, & + & 0.4690D-10, 0.1785D-09, 0.6773D-09, 0.2553D-08, 0.9576D-08, & + & 0.3558D-07, 0.1304D-06, 0.4683D-06, 0.1637D-05, 0.5496D-05, & + & 0.1751D-04, 0.5196D-04, 0.1410D-03, 0.3428D-03, 0.7349D-03, & + & 0.1374D-02, 0.2240D-02, 0.3207D-02, 0.4098D-02, 0.4761D-02, & + & 0.5115D-02, 0.5162D-02, 0.4949D-02, 0.4551D-02, 0.4044D-02, & + & 0.3494D-02, 0.2946D-02, 0.2436D-02, 0.1980D-02, 0.1587D-02, & + & 0.1256D-02, 0.9835D-03, 0.7632D-03, 0.5874D-03, 0.4490D-03, & + & 0.3408D-03, 0.2574D-03, 0.1933D-03, 0.1446D-03, 0.1076D-03, & + & 0.7983D-04, 0.5901D-04, 0.4347D-04, 0.3194D-04, 0.2339D-04, & + & 0.1708D-04, 0.1246D-04, 0.9060D-05, 0.6576D-05, 0.4763D-05, & + & 0.3444D-05/ + + data (calcpts(j,23), j = 1,neta) /0.5736D-23, 0.2175D-22, & + & 0.8327D-22, 0.3192D-21, 0.1223D-20, 0.4686D-20, 0.1796D-19, & + & 0.6879D-19, 0.2635D-18, 0.1010D-17, 0.3869D-17, 0.1482D-16, & + & 0.5678D-16, 0.2175D-15, 0.8331D-15, 0.3191D-14, 0.1222D-13, & + & 0.4680D-13, 0.1791D-12, 0.6852D-12, 0.2620D-11, 0.1001D-10, & + & 0.3816D-10, 0.1452D-09, 0.5510D-09, 0.2081D-08, 0.7790D-08, & + & 0.2894D-07, 0.1060D-06, 0.3809D-06, 0.1330D-05, 0.4469D-05, & + & 0.1424D-04, 0.4233D-04, 0.1152D-03, 0.2819D-03, 0.6101D-03, & + & 0.1156D-02, 0.1914D-02, 0.2787D-02, 0.3618D-02, 0.4260D-02, & + & 0.4631D-02, 0.4718D-02, 0.4562D-02, 0.4226D-02, 0.3779D-02, & + & 0.3282D-02, 0.2781D-02, 0.2310D-02, 0.1884D-02, 0.1515D-02, & + & 0.1203D-02, 0.9446D-03, 0.7346D-03, 0.5665D-03, 0.4338D-03, & + & 0.3300D-03, 0.2495D-03, 0.1876D-03, 0.1405D-03, 0.1047D-03, & + & 0.7777D-04, 0.5754D-04, 0.4244D-04, 0.3120D-04, 0.2288D-04, & + & 0.1672D-04, 0.1220D-04, 0.8877D-05, 0.6446D-05, 0.4672D-05, & + & 0.3380D-05/ + + data (calcpts(j,24), j = 1,neta) /0.5089D-23, 0.1944D-22, & + & 0.7445D-22, 0.2853D-21, 0.1093D-20, 0.4188D-20, 0.1605D-19, & + & 0.6147D-19, 0.2355D-18, 0.9023D-18, 0.3458D-17, 0.1325D-16, & + & 0.5074D-16, 0.1944D-15, 0.7446D-15, 0.2851D-14, 0.1092D-13, & + & 0.4182D-13, 0.1601D-12, 0.6123D-12, 0.2342D-11, 0.8940D-11, & + & 0.3409D-10, 0.1297D-09, 0.4920D-09, 0.1857D-08, 0.6951D-08, & + & 0.2581D-07, 0.9449D-07, 0.3390D-06, 0.1182D-05, 0.3962D-05, & + & 0.1259D-04, 0.3729D-04, 0.1011D-03, 0.2465D-03, 0.5325D-03, & + & 0.1010D-02, 0.1679D-02, 0.2462D-02, 0.3223D-02, 0.3828D-02, & + & 0.4196D-02, 0.4308D-02, 0.4196D-02, 0.3912D-02, 0.3521D-02, & + & 0.3075D-02, 0.2619D-02, 0.2184D-02, 0.1790D-02, 0.1444D-02, & + & 0.1150D-02, 0.9055D-03, 0.7061D-03, 0.5459D-03, 0.4188D-03, & + & 0.3191D-03, 0.2416D-03, 0.1821D-03, 0.1365D-03, 0.1019D-03, & + & 0.7572D-04, 0.5609D-04, 0.4140D-04, 0.3047D-04, 0.2235D-04, & + & 0.1635D-04, 0.1194D-04, 0.8694D-05, 0.6317D-05, 0.4581D-05, & + & 0.3317D-05/ + + data (calcpts(j,25), j = 1,neta) /0.4752D-23, 0.1836D-22, & + & 0.7038D-22, 0.2695D-21, 0.1032D-20, 0.3957D-20, 0.1516D-19, & + & 0.5808D-19, 0.2225D-18, 0.8525D-18, 0.3266D-17, 0.1251D-16, & + & 0.4794D-16, 0.1836D-15, 0.7035D-15, 0.2694D-14, 0.1032D-13, & + & 0.3951D-13, 0.1512D-12, 0.5784D-12, 0.2211D-11, 0.8445D-11, & + & 0.3221D-10, 0.1225D-09, 0.4647D-09, 0.1753D-08, 0.6560D-08, & + & 0.2435D-07, 0.8906D-07, 0.3190D-06, 0.1111D-05, 0.3716D-05, & + & 0.1177D-04, 0.3473D-04, 0.9371D-04, 0.2271D-03, 0.4874D-03, & + & 0.9189D-03, 0.1521D-02, 0.2228D-02, 0.2918D-02, 0.3474D-02, & + & 0.3820D-02, 0.3941D-02, 0.3857D-02, 0.3616D-02, 0.3271D-02, & + & 0.2874D-02, 0.2460D-02, 0.2061D-02, 0.1697D-02, 0.1374D-02, & + & 0.1098D-02, 0.8669D-03, 0.6777D-03, 0.5250D-03, 0.4036D-03, & + & 0.3082D-03, 0.2339D-03, 0.1764D-03, 0.1325D-03, 0.9899D-04, & + & 0.7366D-04, 0.5461D-04, 0.4037D-04, 0.2973D-04, 0.2183D-04, & + & 0.1599D-04, 0.1168D-04, 0.8510D-05, 0.6187D-05, 0.4491D-05, & + & 0.3252D-05/ + + data (calcpts(j,26), j = 1,neta) /0.4554D-23, 0.1785D-22, & + & 0.6852D-22, 0.2624D-21, 0.1004D-20, 0.3849D-20, 0.1475D-19, & + & 0.5651D-19, 0.2165D-18, 0.8293D-18, 0.3177D-17, 0.1217D-16, & + & 0.4664D-16, 0.1787D-15, 0.6843D-15, 0.2621D-14, 0.1004D-13, & + & 0.3843D-13, 0.1471D-12, 0.5628D-12, 0.2151D-11, 0.8216D-11, & + & 0.3132D-10, 0.1192D-09, 0.4520D-09, 0.1705D-08, 0.6378D-08, & + & 0.2366D-07, 0.8651D-07, 0.3097D-06, 0.1077D-05, 0.3598D-05, & + & 0.1137D-04, 0.3346D-04, 0.8996D-04, 0.2169D-03, 0.4628D-03, & + & 0.8664D-03, 0.1424D-02, 0.2072D-02, 0.2699D-02, 0.3202D-02, & + & 0.3516D-02, 0.3627D-02, 0.3555D-02, 0.3344D-02, 0.3038D-02, & + & 0.2681D-02, 0.2306D-02, 0.1941D-02, 0.1603D-02, 0.1304D-02, & + & 0.1045D-02, 0.8282D-03, 0.6494D-03, 0.5043D-03, 0.3887D-03, & + & 0.2973D-03, 0.2261D-03, 0.1709D-03, 0.1284D-03, 0.9611D-04, & + & 0.7161D-04, 0.5316D-04, 0.3932D-04, 0.2899D-04, 0.2132D-04, & + & 0.1562D-04, 0.1142D-04, 0.8327D-05, 0.6058D-05, 0.4400D-05, & + & 0.3189D-05/ + + data (calcpts(j,27), j = 1,neta) /0.4428D-23, 0.1761D-22, & + & 0.6771D-22, 0.2590D-21, 0.9912D-21, 0.3800D-20, 0.1455D-19, & + & 0.5577D-19, 0.2136D-18, 0.8187D-18, 0.3136D-17, 0.1202D-16, & + & 0.4603D-16, 0.1764D-15, 0.6754D-15, 0.2587D-14, 0.9908D-14, & + & 0.3794D-13, 0.1452D-12, 0.5555D-12, 0.2124D-11, 0.8109D-11, & + & 0.3092D-10, 0.1176D-09, 0.4459D-09, 0.1683D-08, 0.6292D-08, & + & 0.2334D-07, 0.8531D-07, 0.3054D-06, 0.1062D-05, 0.3543D-05, & + & 0.1119D-04, 0.3286D-04, 0.8811D-04, 0.2118D-03, 0.4500D-03, & + & 0.8382D-03, 0.1369D-02, 0.1977D-02, 0.2558D-02, 0.3014D-02, & + & 0.3288D-02, 0.3373D-02, 0.3299D-02, 0.3102D-02, 0.2821D-02, & + & 0.2498D-02, 0.2157D-02, 0.1822D-02, 0.1512D-02, 0.1234D-02, & + & 0.9936D-03, 0.7897D-03, 0.6210D-03, 0.4838D-03, 0.3737D-03, & + & 0.2865D-03, 0.2181D-03, 0.1652D-03, 0.1244D-03, 0.9323D-04, & + & 0.6956D-04, 0.5171D-04, 0.3828D-04, 0.2826D-04, 0.2079D-04, & + & 0.1525D-04, 0.1116D-04, 0.8144D-05, 0.5930D-05, 0.4309D-05, & + & 0.3125D-05/ + + data (calcpts(j,28), j = 1,neta) /0.4341D-23, 0.1749D-22, & + & 0.6735D-22, 0.2576D-21, 0.9849D-21, 0.3777D-20, 0.1447D-19, & + & 0.5542D-19, 0.2124D-18, 0.8136D-18, 0.3117D-17, 0.1194D-16, & + & 0.4575D-16, 0.1752D-15, 0.6714D-15, 0.2571D-14, 0.9848D-14, & + & 0.3771D-13, 0.1443D-12, 0.5520D-12, 0.2110D-11, 0.8059D-11, & + & 0.3072D-10, 0.1169D-09, 0.4432D-09, 0.1672D-08, 0.6254D-08, & + & 0.2319D-07, 0.8475D-07, 0.3033D-06, 0.1054D-05, 0.3516D-05, & + & 0.1110D-04, 0.3256D-04, 0.8724D-04, 0.2094D-03, 0.4437D-03, & + & 0.8241D-03, 0.1341D-02, 0.1926D-02, 0.2476D-02, 0.2895D-02, & + & 0.3132D-02, 0.3189D-02, 0.3096D-02, 0.2897D-02, 0.2631D-02, & + & 0.2329D-02, 0.2016D-02, 0.1710D-02, 0.1424D-02, 0.1167D-02, & + & 0.9424D-03, 0.7516D-03, 0.5929D-03, 0.4632D-03, 0.3587D-03, & + & 0.2756D-03, 0.2103D-03, 0.1596D-03, 0.1204D-03, 0.9035D-04, & + & 0.6752D-04, 0.5024D-04, 0.3725D-04, 0.2752D-04, 0.2026D-04, & + & 0.1488D-04, 0.1090D-04, 0.7960D-05, 0.5800D-05, 0.4218D-05, & + & 0.3062D-05/ + + data (calcpts(j,29), j = 1,neta) /0.4268D-23, 0.1743D-22, & + & 0.6717D-22, 0.2568D-21, 0.9821D-21, 0.3767D-20, 0.1443D-19, & + & 0.5527D-19, 0.2118D-18, 0.8114D-18, 0.3108D-17, 0.1191D-16, & + & 0.4561D-16, 0.1748D-15, 0.6694D-15, 0.2563D-14, 0.9819D-14, & + & 0.3759D-13, 0.1439D-12, 0.5505D-12, 0.2105D-11, 0.8036D-11, & + & 0.3065D-10, 0.1166D-09, 0.4419D-09, 0.1668D-08, 0.6236D-08, & + & 0.2312D-07, 0.8450D-07, 0.3024D-06, 0.1051D-05, 0.3504D-05, & + & 0.1106D-04, 0.3243D-04, 0.8684D-04, 0.2082D-03, 0.4409D-03, & + & 0.8175D-03, 0.1328D-02, 0.1902D-02, 0.2436D-02, 0.2834D-02, & + & 0.3042D-02, 0.3069D-02, 0.2950D-02, 0.2738D-02, 0.2472D-02, & + & 0.2181D-02, 0.1887D-02, 0.1603D-02, 0.1339D-02, 0.1101D-02, & + & 0.8922D-03, 0.7140D-03, 0.5650D-03, 0.4426D-03, 0.3436D-03, & + & 0.2648D-03, 0.2025D-03, 0.1539D-03, 0.1163D-03, 0.8747D-04, & + & 0.6546D-04, 0.4878D-04, 0.3621D-04, 0.2678D-04, 0.1974D-04, & + & 0.1451D-04, 0.1064D-04, 0.7777D-05, 0.5671D-05, 0.4128D-05, & + & 0.2997D-05/ + + data (calcpts(j,30), j = 1,neta) /0.4237D-23, 0.1740D-22, & + & 0.6711D-22, 0.2565D-21, 0.9807D-21, 0.3762D-20, 0.1441D-19, & + & 0.5520D-19, 0.2115D-18, 0.8103D-18, 0.3105D-17, 0.1189D-16, & + & 0.4556D-16, 0.1746D-15, 0.6686D-15, 0.2561D-14, 0.9807D-14, & + & 0.3755D-13, 0.1437D-12, 0.5498D-12, 0.2102D-11, 0.8025D-11, & + & 0.3060D-10, 0.1164D-09, 0.4413D-09, 0.1665D-08, 0.6227D-08, & + & 0.2309D-07, 0.8437D-07, 0.3020D-06, 0.1049D-05, 0.3498D-05, & + & 0.1104D-04, 0.3237D-04, 0.8664D-04, 0.2078D-03, 0.4397D-03, & + & 0.8148D-03, 0.1323D-02, 0.1893D-02, 0.2421D-02, 0.2808D-02, & + & 0.3002D-02, 0.3006D-02, 0.2862D-02, 0.2626D-02, 0.2349D-02, & + & 0.2058D-02, 0.1775D-02, 0.1506D-02, 0.1259D-02, 0.1037D-02, & + & 0.8433D-03, 0.6771D-03, 0.5374D-03, 0.4224D-03, 0.3289D-03, & + & 0.2540D-03, 0.1947D-03, 0.1483D-03, 0.1123D-03, 0.8458D-04, & + & 0.6341D-04, 0.4733D-04, 0.3518D-04, 0.2604D-04, 0.1923D-04, & + & 0.1414D-04, 0.1038D-04, 0.7594D-05, 0.5542D-05, 0.4037D-05, & + & 0.2932D-05/ + + data (calcpts(j,31), j = 1,neta) /0.4208D-23, 0.1743D-22, & + & 0.6705D-22, 0.2565D-21, 0.9801D-21, 0.3759D-20, 0.1440D-19, & + & 0.5517D-19, 0.2113D-18, 0.8097D-18, 0.3102D-17, 0.1189D-16, & + & 0.4554D-16, 0.1745D-15, 0.6681D-15, 0.2559D-14, 0.9801D-14, & + & 0.3753D-13, 0.1436D-12, 0.5495D-12, 0.2100D-11, 0.8020D-11, & + & 0.3059D-10, 0.1163D-09, 0.4410D-09, 0.1664D-08, 0.6222D-08, & + & 0.2307D-07, 0.8433D-07, 0.3018D-06, 0.1048D-05, 0.3495D-05, & + & 0.1103D-04, 0.3234D-04, 0.8656D-04, 0.2075D-03, 0.4392D-03, & + & 0.8139D-03, 0.1321D-02, 0.1891D-02, 0.2420D-02, 0.2805D-02, & + & 0.2994D-02, 0.2985D-02, 0.2823D-02, 0.2565D-02, 0.2267D-02, & + & 0.1966D-02, 0.1682D-02, 0.1420D-02, 0.1185D-02, 0.9775D-03, & + & 0.7964D-03, 0.6411D-03, 0.5104D-03, 0.4023D-03, 0.3143D-03, & + & 0.2433D-03, 0.1870D-03, 0.1427D-03, 0.1083D-03, 0.8172D-04, & + & 0.6135D-04, 0.4586D-04, 0.3414D-04, 0.2530D-04, 0.1871D-04, & + & 0.1378D-04, 0.1012D-04, 0.7412D-05, 0.5414D-05, 0.3947D-05, & + & 0.2870D-05/ + + data (calcpts(j,32), j = 1,neta) /0.4152D-23, 0.1735D-22, & + & 0.6717D-22, 0.2562D-21, 0.9799D-21, 0.3757D-20, 0.1439D-19, & + & 0.5514D-19, 0.2113D-18, 0.8095D-18, 0.3102D-17, 0.1188D-16, & + & 0.4552D-16, 0.1745D-15, 0.6679D-15, 0.2559D-14, 0.9798D-14, & + & 0.3751D-13, 0.1436D-12, 0.5493D-12, 0.2100D-11, 0.8017D-11, & + & 0.3057D-10, 0.1163D-09, 0.4410D-09, 0.1664D-08, 0.6221D-08, & + & 0.2307D-07, 0.8430D-07, 0.3017D-06, 0.1048D-05, 0.3495D-05, & + & 0.1102D-04, 0.3234D-04, 0.8652D-04, 0.2075D-03, 0.4389D-03, & + & 0.8138D-03, 0.1321D-02, 0.1893D-02, 0.2423D-02, 0.2812D-02, & + & 0.3003D-02, 0.2994D-02, 0.2821D-02, 0.2546D-02, 0.2226D-02, & + & 0.1906D-02, 0.1613D-02, 0.1350D-02, 0.1121D-02, 0.9229D-03, & + & 0.7521D-03, 0.6066D-03, 0.4842D-03, 0.3826D-03, 0.2997D-03, & + & 0.2326D-03, 0.1792D-03, 0.1372D-03, 0.1043D-03, 0.7885D-04, & + & 0.5931D-04, 0.4440D-04, 0.3311D-04, 0.2457D-04, 0.1818D-04, & + & 0.1341D-04, 0.9858D-05, 0.7227D-05, 0.5284D-05, 0.3855D-05, & + & 0.2805D-05/ + + data (calcpts(j,33), j = 1,neta) /0.4175D-23, 0.1735D-22, & + & 0.6707D-22, 0.2565D-21, 0.9798D-21, 0.3757D-20, 0.1439D-19, & + & 0.5514D-19, 0.2112D-18, 0.8094D-18, 0.3100D-17, 0.1188D-16, & + & 0.4551D-16, 0.1743D-15, 0.6679D-15, 0.2558D-14, 0.9797D-14, & + & 0.3751D-13, 0.1436D-12, 0.5492D-12, 0.2100D-11, 0.8017D-11, & + & 0.3057D-10, 0.1163D-09, 0.4408D-09, 0.1664D-08, 0.6219D-08, & + & 0.2307D-07, 0.8429D-07, 0.3017D-06, 0.1048D-05, 0.3494D-05, & + & 0.1102D-04, 0.3232D-04, 0.8651D-04, 0.2075D-03, 0.4389D-03, & + & 0.8139D-03, 0.1322D-02, 0.1895D-02, 0.2428D-02, 0.2823D-02, & + & 0.3020D-02, 0.3015D-02, 0.2841D-02, 0.2556D-02, 0.2220D-02, & + & 0.1881D-02, 0.1571D-02, 0.1300D-02, 0.1070D-02, 0.8756D-03, & + & 0.7119D-03, 0.5740D-03, 0.4589D-03, 0.3634D-03, 0.2853D-03, & + & 0.2222D-03, 0.1716D-03, 0.1316D-03, 0.1003D-03, 0.7599D-04, & + & 0.5727D-04, 0.4295D-04, 0.3207D-04, 0.2385D-04, 0.1767D-04, & + & 0.1304D-04, 0.9599D-05, 0.7044D-05, 0.5156D-05, 0.3764D-05, & + & 0.2742D-05/ + + data (calcpts(j,34), j = 1,neta) /0.4158D-23, 0.1734D-22, & + & 0.6731D-22, 0.2564D-21, 0.9796D-21, 0.3757D-20, 0.1439D-19, & + & 0.5514D-19, 0.2112D-18, 0.8094D-18, 0.3100D-17, 0.1188D-16, & + & 0.4551D-16, 0.1743D-15, 0.6678D-15, 0.2558D-14, 0.9797D-14, & + & 0.3750D-13, 0.1436D-12, 0.5492D-12, 0.2100D-11, 0.8016D-11, & + & 0.3057D-10, 0.1163D-09, 0.4408D-09, 0.1664D-08, 0.6219D-08, & + & 0.2307D-07, 0.8429D-07, 0.3017D-06, 0.1048D-05, 0.3494D-05, & + & 0.1102D-04, 0.3232D-04, 0.8651D-04, 0.2075D-03, 0.4391D-03, & + & 0.8140D-03, 0.1323D-02, 0.1898D-02, 0.2433D-02, 0.2834D-02, & + & 0.3038D-02, 0.3039D-02, 0.2871D-02, 0.2585D-02, 0.2240D-02, & + & 0.1886D-02, 0.1556D-02, 0.1271D-02, 0.1033D-02, 0.8375D-03, & + & 0.6769D-03, 0.5445D-03, 0.4352D-03, 0.3452D-03, 0.2715D-03, & + & 0.2118D-03, 0.1641D-03, 0.1261D-03, 0.9634D-04, 0.7314D-04, & + & 0.5523D-04, 0.4149D-04, 0.3104D-04, 0.2312D-04, 0.1715D-04, & + & 0.1267D-04, 0.9339D-05, 0.6861D-05, 0.5027D-05, 0.3674D-05, & + & 0.2677D-05/ + + data (calcpts(j,35), j = 1,neta) /0.4069D-23, 0.1734D-22, & + & 0.6731D-22, 0.2564D-21, 0.9805D-21, 0.3757D-20, 0.1439D-19, & + & 0.5514D-19, 0.2112D-18, 0.8094D-18, 0.3100D-17, 0.1188D-16, & + & 0.4551D-16, 0.1743D-15, 0.6678D-15, 0.2558D-14, 0.9795D-14, & + & 0.3750D-13, 0.1436D-12, 0.5492D-12, 0.2098D-11, 0.8016D-11, & + & 0.3057D-10, 0.1163D-09, 0.4408D-09, 0.1664D-08, 0.6219D-08, & + & 0.2307D-07, 0.8427D-07, 0.3017D-06, 0.1048D-05, 0.3494D-05, & + & 0.1102D-04, 0.3232D-04, 0.8651D-04, 0.2075D-03, 0.4391D-03, & + & 0.8142D-03, 0.1323D-02, 0.1899D-02, 0.2438D-02, 0.2841D-02, & + & 0.3053D-02, 0.3063D-02, 0.2903D-02, 0.2620D-02, 0.2272D-02, & + & 0.1910D-02, 0.1565D-02, 0.1264D-02, 0.1013D-02, 0.8111D-03, & + & 0.6492D-03, 0.5190D-03, 0.4135D-03, 0.3278D-03, 0.2582D-03, & + & 0.2018D-03, 0.1566D-03, 0.1207D-03, 0.9242D-04, 0.7031D-04, & + & 0.5321D-04, 0.4004D-04, 0.3000D-04, 0.2238D-04, 0.1662D-04, & + & 0.1231D-04, 0.9080D-05, 0.6678D-05, 0.4898D-05, 0.3582D-05, & + & 0.2615D-05/ + + data (calcpts(j,36), j = 1,neta) /0.4145D-23, 0.1776D-22, & + & 0.6732D-22, 0.2571D-21, 0.9791D-21, 0.3755D-20, 0.1439D-19, & + & 0.5514D-19, 0.2112D-18, 0.8094D-18, 0.3100D-17, 0.1188D-16, & + & 0.4551D-16, 0.1743D-15, 0.6678D-15, 0.2558D-14, 0.9795D-14, & + & 0.3750D-13, 0.1435D-12, 0.5492D-12, 0.2098D-11, 0.8016D-11, & + & 0.3057D-10, 0.1163D-09, 0.4408D-09, 0.1664D-08, 0.6219D-08, & + & 0.2306D-07, 0.8427D-07, 0.3015D-06, 0.1048D-05, 0.3494D-05, & + & 0.1102D-04, 0.3232D-04, 0.8651D-04, 0.2075D-03, 0.4391D-03, & + & 0.8144D-03, 0.1324D-02, 0.1901D-02, 0.2441D-02, 0.2849D-02, & + & 0.3065D-02, 0.3083D-02, 0.2930D-02, 0.2655D-02, 0.2311D-02, & + & 0.1944D-02, 0.1590D-02, 0.1275D-02, 0.1011D-02, 0.7981D-03, & + & 0.6305D-03, 0.4989D-03, 0.3950D-03, 0.3122D-03, 0.2456D-03, & + & 0.1922D-03, 0.1494D-03, 0.1154D-03, 0.8852D-04, 0.6750D-04, & + & 0.5118D-04, 0.3859D-04, 0.2897D-04, 0.2165D-04, 0.1611D-04, & + & 0.1194D-04, 0.8820D-05, 0.6495D-05, 0.4769D-05, 0.3492D-05, & + & 0.2550D-05/ + + data (calcpts(j,37), j = 1,neta) /0.4138D-23, 0.1734D-22, & + & 0.6732D-22, 0.2570D-21, 0.9789D-21, 0.3757D-20, 0.1439D-19, & + & 0.5514D-19, 0.2112D-18, 0.8094D-18, 0.3100D-17, 0.1188D-16, & + & 0.4551D-16, 0.1743D-15, 0.6678D-15, 0.2558D-14, 0.9795D-14, & + & 0.3750D-13, 0.1435D-12, 0.5492D-12, 0.2098D-11, 0.8016D-11, & + & 0.3057D-10, 0.1163D-09, 0.4408D-09, 0.1664D-08, 0.6219D-08, & + & 0.2306D-07, 0.8427D-07, 0.3015D-06, 0.1048D-05, 0.3494D-05, & + & 0.1102D-04, 0.3232D-04, 0.8651D-04, 0.2075D-03, 0.4391D-03, & + & 0.8145D-03, 0.1324D-02, 0.1902D-02, 0.2443D-02, 0.2853D-02, & + & 0.3074D-02, 0.3097D-02, 0.2952D-02, 0.2685D-02, 0.2348D-02, & + & 0.1982D-02, 0.1625D-02, 0.1301D-02, 0.1024D-02, 0.7987D-03, & + & 0.6221D-03, 0.4856D-03, 0.3806D-03, 0.2987D-03, 0.2343D-03, & + & 0.1832D-03, 0.1425D-03, 0.1102D-03, 0.8471D-04, 0.6473D-04, & + & 0.4917D-04, 0.3716D-04, 0.2795D-04, 0.2091D-04, 0.1559D-04, & + & 0.1157D-04, 0.8561D-05, 0.6312D-05, 0.4640D-05, 0.3402D-05, & + & 0.2487D-05/ + + data (calcpts(j,38), j = 1,neta) /0.3888D-23, 0.1774D-22, & + & 0.6732D-22, 0.2554D-21, 0.9805D-21, 0.3757D-20, 0.1439D-19, & + & 0.5514D-19, 0.2112D-18, 0.8094D-18, 0.3100D-17, 0.1188D-16, & + & 0.4551D-16, 0.1743D-15, 0.6678D-15, 0.2558D-14, 0.9795D-14, & + & 0.3750D-13, 0.1435D-12, 0.5492D-12, 0.2098D-11, 0.8016D-11, & + & 0.3057D-10, 0.1163D-09, 0.4408D-09, 0.1664D-08, 0.6219D-08, & + & 0.2306D-07, 0.8427D-07, 0.3015D-06, 0.1048D-05, 0.3494D-05, & + & 0.1102D-04, 0.3232D-04, 0.8651D-04, 0.2075D-03, 0.4391D-03, & + & 0.8145D-03, 0.1324D-02, 0.1902D-02, 0.2445D-02, 0.2858D-02, & + & 0.3081D-02, 0.3110D-02, 0.2970D-02, 0.2709D-02, 0.2378D-02, & + & 0.2016D-02, 0.1661D-02, 0.1332D-02, 0.1047D-02, 0.8111D-03, & + & 0.6242D-03, 0.4803D-03, 0.3712D-03, 0.2883D-03, 0.2246D-03, & + & 0.1749D-03, 0.1360D-03, 0.1052D-03, 0.8099D-04, 0.6200D-04, & + & 0.4719D-04, 0.3573D-04, 0.2693D-04, 0.2019D-04, 0.1508D-04, & + & 0.1121D-04, 0.8303D-05, 0.6129D-05, 0.4512D-05, 0.3311D-05, & + & 0.2423D-05/ + + data (calcpts(j,39), j = 1,neta) /0.3883D-23, 0.1724D-22, & + & 0.6732D-22, 0.2544D-21, 0.9805D-21, 0.3756D-20, 0.1439D-19, & + & 0.5514D-19, 0.2112D-18, 0.8094D-18, 0.3100D-17, 0.1188D-16, & + & 0.4551D-16, 0.1743D-15, 0.6678D-15, 0.2558D-14, 0.9795D-14, & + & 0.3750D-13, 0.1435D-12, 0.5492D-12, 0.2098D-11, 0.8016D-11, & + & 0.3057D-10, 0.1163D-09, 0.4408D-09, 0.1664D-08, 0.6219D-08, & + & 0.2306D-07, 0.8427D-07, 0.3015D-06, 0.1048D-05, 0.3494D-05, & + & 0.1102D-04, 0.3232D-04, 0.8651D-04, 0.2075D-03, 0.4391D-03, & + & 0.8147D-03, 0.1325D-02, 0.1904D-02, 0.2446D-02, 0.2859D-02, & + & 0.3085D-02, 0.3117D-02, 0.2982D-02, 0.2729D-02, 0.2401D-02, & + & 0.2046D-02, 0.1694D-02, 0.1365D-02, 0.1075D-02, 0.8318D-03, & + & 0.6356D-03, 0.4832D-03, 0.3680D-03, 0.2819D-03, 0.2172D-03, & + & 0.1680D-03, 0.1301D-03, 0.1005D-03, 0.7742D-04, 0.5934D-04, & + & 0.4526D-04, 0.3432D-04, 0.2591D-04, 0.1947D-04, 0.1456D-04, & + & 0.1084D-04, 0.8043D-05, 0.5948D-05, 0.4383D-05, 0.3220D-05, & + & 0.2360D-05/ + + data (calcpts(j,40), j = 1,neta) /0.4569D-23, 0.1774D-22, & + & 0.6616D-22, 0.2544D-21, 0.9809D-21, 0.3756D-20, 0.1439D-19, & + & 0.5514D-19, 0.2112D-18, 0.8094D-18, 0.3100D-17, 0.1188D-16, & + & 0.4551D-16, 0.1743D-15, 0.6678D-15, 0.2558D-14, 0.9795D-14, & + & 0.3750D-13, 0.1435D-12, 0.5492D-12, 0.2098D-11, 0.8016D-11, & + & 0.3057D-10, 0.1163D-09, 0.4408D-09, 0.1664D-08, 0.6219D-08, & + & 0.2306D-07, 0.8427D-07, 0.3015D-06, 0.1048D-05, 0.3494D-05, & + & 0.1102D-04, 0.3232D-04, 0.8651D-04, 0.2075D-03, 0.4391D-03, & + & 0.8147D-03, 0.1325D-02, 0.1904D-02, 0.2448D-02, 0.2862D-02, & + & 0.3089D-02, 0.3123D-02, 0.2993D-02, 0.2742D-02, 0.2420D-02, & + & 0.2069D-02, 0.1721D-02, 0.1394D-02, 0.1104D-02, 0.8562D-03, & + & 0.6533D-03, 0.4932D-03, 0.3709D-03, 0.2799D-03, 0.2127D-03, & + & 0.1627D-03, 0.1251D-03, 0.9633D-04, 0.7409D-04, 0.5679D-04, & + & 0.4335D-04, 0.3294D-04, 0.2491D-04, 0.1875D-04, 0.1404D-04, & + & 0.1048D-04, 0.7787D-05, 0.5764D-05, 0.4254D-05, 0.3129D-05, & + & 0.2295D-05/ + + data (calcpts(j,41), j = 1,neta) /0.4535D-23, 0.1701D-22, & + & 0.6738D-22, 0.2558D-21, 0.9793D-21, 0.3755D-20, 0.1439D-19, & + & 0.5514D-19, 0.2112D-18, 0.8094D-18, 0.3100D-17, 0.1188D-16, & + & 0.4551D-16, 0.1743D-15, 0.6678D-15, 0.2558D-14, 0.9795D-14, & + & 0.3750D-13, 0.1435D-12, 0.5492D-12, 0.2098D-11, 0.8016D-11, & + & 0.3057D-10, 0.1163D-09, 0.4408D-09, 0.1664D-08, 0.6219D-08, & + & 0.2306D-07, 0.8427D-07, 0.3015D-06, 0.1048D-05, 0.3494D-05, & + & 0.1102D-04, 0.3232D-04, 0.8651D-04, 0.2075D-03, 0.4392D-03, & + & 0.8147D-03, 0.1325D-02, 0.1904D-02, 0.2448D-02, 0.2862D-02, & + & 0.3092D-02, 0.3128D-02, 0.2998D-02, 0.2751D-02, 0.2433D-02, & + & 0.2087D-02, 0.1741D-02, 0.1418D-02, 0.1129D-02, 0.8806D-03, & + & 0.6739D-03, 0.5081D-03, 0.3795D-03, 0.2829D-03, 0.2117D-03, & + & 0.1596D-03, 0.1214D-03, 0.9278D-04, 0.7107D-04, 0.5441D-04, & + & 0.4154D-04, 0.3159D-04, 0.2393D-04, 0.1803D-04, 0.1354D-04, & + & 0.1011D-04, 0.7529D-05, 0.5583D-05, 0.4125D-05, 0.3039D-05, & + & 0.2232D-05/ + + data (calcpts(j,42), j = 1,neta) /0.5008D-23, 0.1776D-22, & + & 0.6751D-22, 0.2558D-21, 0.9809D-21, 0.3755D-20, 0.1439D-19, & + & 0.5514D-19, 0.2112D-18, 0.8092D-18, 0.3100D-17, 0.1188D-16, & + & 0.4551D-16, 0.1743D-15, 0.6678D-15, 0.2558D-14, 0.9795D-14, & + & 0.3750D-13, 0.1435D-12, 0.5492D-12, 0.2098D-11, 0.8016D-11, & + & 0.3057D-10, 0.1163D-09, 0.4408D-09, 0.1664D-08, 0.6219D-08, & + & 0.2306D-07, 0.8427D-07, 0.3015D-06, 0.1048D-05, 0.3494D-05, & + & 0.1102D-04, 0.3232D-04, 0.8651D-04, 0.2075D-03, 0.4392D-03, & + & 0.8147D-03, 0.1325D-02, 0.1904D-02, 0.2448D-02, 0.2864D-02, & + & 0.3093D-02, 0.3131D-02, 0.3003D-02, 0.2757D-02, 0.2443D-02, & + & 0.2100D-02, 0.1758D-02, 0.1437D-02, 0.1151D-02, 0.9024D-03, & + & 0.6945D-03, 0.5253D-03, 0.3918D-03, 0.2900D-03, 0.2144D-03, & + & 0.1592D-03, 0.1193D-03, 0.9015D-04, 0.6855D-04, 0.5228D-04, & + & 0.3984D-04, 0.3030D-04, 0.2297D-04, 0.1734D-04, 0.1303D-04, & + & 0.9756D-05, 0.7273D-05, 0.5401D-05, 0.3998D-05, 0.2949D-05, & + & 0.2169D-05/ + + data (calcpts(j,43), j = 1,neta) /0.4451D-23, 0.1773D-22, & + & 0.6620D-22, 0.2545D-21, 0.9812D-21, 0.3755D-20, 0.1439D-19, & + & 0.5513D-19, 0.2112D-18, 0.8094D-18, 0.3100D-17, 0.1188D-16, & + & 0.4551D-16, 0.1743D-15, 0.6678D-15, 0.2558D-14, 0.9795D-14, & + & 0.3750D-13, 0.1435D-12, 0.5492D-12, 0.2098D-11, 0.8016D-11, & + & 0.3057D-10, 0.1163D-09, 0.4408D-09, 0.1664D-08, 0.6219D-08, & + & 0.2306D-07, 0.8427D-07, 0.3015D-06, 0.1048D-05, 0.3494D-05, & + & 0.1102D-04, 0.3232D-04, 0.8651D-04, 0.2075D-03, 0.4392D-03, & + & 0.8147D-03, 0.1325D-02, 0.1904D-02, 0.2448D-02, 0.2864D-02, & + & 0.3095D-02, 0.3132D-02, 0.3006D-02, 0.2763D-02, 0.2449D-02, & + & 0.2109D-02, 0.1769D-02, 0.1451D-02, 0.1167D-02, 0.9204D-03, & + & 0.7127D-03, 0.5421D-03, 0.4059D-03, 0.3000D-03, 0.2200D-03, & + & 0.1614D-03, 0.1191D-03, 0.8873D-04, 0.6671D-04, 0.5048D-04, & + & 0.3833D-04, 0.2910D-04, 0.2205D-04, 0.1667D-04, 0.1254D-04, & + & 0.9401D-05, 0.7020D-05, 0.5222D-05, 0.3870D-05, 0.2859D-05, & + & 0.2105D-05/ + + data (calcpts(j,44), j = 1,neta) /0.4536D-23, 0.1766D-22, & + & 0.6613D-22, 0.2562D-21, 0.9802D-21, 0.3755D-20, 0.1439D-19, & + & 0.5513D-19, 0.2112D-18, 0.8095D-18, 0.3102D-17, 0.1188D-16, & + & 0.4551D-16, 0.1743D-15, 0.6678D-15, 0.2558D-14, 0.9795D-14, & + & 0.3750D-13, 0.1435D-12, 0.5492D-12, 0.2098D-11, 0.8016D-11, & + & 0.3057D-10, 0.1163D-09, 0.4408D-09, 0.1664D-08, 0.6219D-08, & + & 0.2306D-07, 0.8427D-07, 0.3015D-06, 0.1048D-05, 0.3494D-05, & + & 0.1102D-04, 0.3232D-04, 0.8651D-04, 0.2075D-03, 0.4392D-03, & + & 0.8148D-03, 0.1325D-02, 0.1904D-02, 0.2449D-02, 0.2865D-02, & + & 0.3095D-02, 0.3134D-02, 0.3008D-02, 0.2766D-02, 0.2454D-02, & + & 0.2115D-02, 0.1777D-02, 0.1462D-02, 0.1179D-02, 0.9344D-03, & + & 0.7277D-03, 0.5571D-03, 0.4196D-03, 0.3113D-03, 0.2282D-03, & + & 0.1661D-03, 0.1210D-03, 0.8875D-04, 0.6575D-04, 0.4919D-04, & + & 0.3705D-04, 0.2802D-04, 0.2120D-04, 0.1601D-04, 0.1206D-04, & + & 0.9053D-05, 0.6770D-05, 0.5043D-05, 0.3742D-05, 0.2769D-05, & + & 0.2042D-05/ + + data (calcpts(j,45), j = 1,neta) /0.4531D-23, 0.1743D-22, & + & 0.6650D-22, 0.2545D-21, 0.9850D-21, 0.3771D-20, 0.1438D-19, & + & 0.5526D-19, 0.2116D-18, 0.8094D-18, 0.3104D-17, 0.1188D-16, & + & 0.4551D-16, 0.1743D-15, 0.6679D-15, 0.2558D-14, 0.9795D-14, & + & 0.3750D-13, 0.1435D-12, 0.5492D-12, 0.2098D-11, 0.8016D-11, & + & 0.3057D-10, 0.1163D-09, 0.4408D-09, 0.1664D-08, 0.6219D-08, & + & 0.2306D-07, 0.8427D-07, 0.3015D-06, 0.1048D-05, 0.3494D-05, & + & 0.1102D-04, 0.3232D-04, 0.8651D-04, 0.2075D-03, 0.4392D-03, & + & 0.8148D-03, 0.1325D-02, 0.1904D-02, 0.2449D-02, 0.2865D-02, & + & 0.3096D-02, 0.3135D-02, 0.3009D-02, 0.2768D-02, 0.2457D-02, & + & 0.2120D-02, 0.1783D-02, 0.1469D-02, 0.1188D-02, 0.9449D-03, & + & 0.7394D-03, 0.5694D-03, 0.4317D-03, 0.3222D-03, 0.2370D-03, & + & 0.1725D-03, 0.1247D-03, 0.9030D-04, 0.6587D-04, 0.4854D-04, & + & 0.3615D-04, 0.2712D-04, 0.2043D-04, 0.1541D-04, 0.1160D-04, & + & 0.8714D-05, 0.6524D-05, 0.4866D-05, 0.3617D-05, 0.2679D-05, & + & 0.1979D-05/ + + data (calcpts(j,46), j = 1,neta) /0.4427D-23, 0.1749D-22, & + & 0.6682D-22, 0.2549D-21, 0.9752D-21, 0.3768D-20, 0.1432D-19, & + & 0.5490D-19, 0.2113D-18, 0.8091D-18, 0.3100D-17, 0.1188D-16, & + & 0.4550D-16, 0.1743D-15, 0.6677D-15, 0.2558D-14, 0.9795D-14, & + & 0.3750D-13, 0.1435D-12, 0.5492D-12, 0.2098D-11, 0.8016D-11, & + & 0.3057D-10, 0.1163D-09, 0.4408D-09, 0.1664D-08, 0.6219D-08, & + & 0.2306D-07, 0.8427D-07, 0.3015D-06, 0.1048D-05, 0.3494D-05, & + & 0.1102D-04, 0.3232D-04, 0.8651D-04, 0.2075D-03, 0.4392D-03, & + & 0.8148D-03, 0.1325D-02, 0.1904D-02, 0.2449D-02, 0.2865D-02, & + & 0.3096D-02, 0.3135D-02, 0.3011D-02, 0.2769D-02, 0.2460D-02, & + & 0.2122D-02, 0.1787D-02, 0.1474D-02, 0.1195D-02, 0.9525D-03, & + & 0.7480D-03, 0.5790D-03, 0.4416D-03, 0.3318D-03, 0.2457D-03, & + & 0.1794D-03, 0.1297D-03, 0.9321D-04, 0.6711D-04, 0.4869D-04, & + & 0.3573D-04, 0.2649D-04, 0.1980D-04, 0.1487D-04, 0.1117D-04, & + & 0.8388D-05, 0.6284D-05, 0.4692D-05, 0.3492D-05, 0.2591D-05, & + & 0.1916D-05/ + + data (calcpts(j,47), j = 1,neta) /0.4376D-23, 0.1851D-22, & + & 0.6717D-22, 0.2583D-21, 0.1000D-20, 0.3750D-20, 0.1439D-19, & + & 0.5514D-19, 0.2121D-18, 0.8097D-18, 0.3111D-17, 0.1190D-16, & + & 0.4551D-16, 0.1743D-15, 0.6681D-15, 0.2559D-14, 0.9798D-14, & + & 0.3750D-13, 0.1435D-12, 0.5492D-12, 0.2098D-11, 0.8016D-11, & + & 0.3057D-10, 0.1163D-09, 0.4408D-09, 0.1664D-08, 0.6219D-08, & + & 0.2306D-07, 0.8427D-07, 0.3015D-06, 0.1048D-05, 0.3494D-05, & + & 0.1102D-04, 0.3232D-04, 0.8651D-04, 0.2075D-03, 0.4392D-03, & + & 0.8148D-03, 0.1325D-02, 0.1904D-02, 0.2449D-02, 0.2865D-02, & + & 0.3096D-02, 0.3135D-02, 0.3012D-02, 0.2771D-02, 0.2462D-02, & + & 0.2124D-02, 0.1790D-02, 0.1478D-02, 0.1199D-02, 0.9579D-03, & + & 0.7544D-03, 0.5861D-03, 0.4492D-03, 0.3398D-03, 0.2534D-03, & + & 0.1863D-03, 0.1351D-03, 0.9705D-04, 0.6938D-04, 0.4968D-04, & + & 0.3588D-04, 0.2621D-04, 0.1937D-04, 0.1442D-04, 0.1079D-04, & + & 0.8087D-05, 0.6054D-05, 0.4524D-05, 0.3371D-05, 0.2504D-05, & + & 0.1854D-05/ + + data (calcpts(j,48), j = 1,neta) /0.5678D-23, 0.1891D-22, & + & 0.7606D-22, 0.2568D-21, 0.9618D-21, 0.3826D-20, 0.1455D-19, & + & 0.5600D-19, 0.2135D-18, 0.8070D-18, 0.3093D-17, 0.1190D-16, & + & 0.4561D-16, 0.1745D-15, 0.6681D-15, 0.2561D-14, 0.9801D-14, & + & 0.3751D-13, 0.1436D-12, 0.5492D-12, 0.2098D-11, 0.8016D-11, & + & 0.3057D-10, 0.1163D-09, 0.4408D-09, 0.1664D-08, 0.6219D-08, & + & 0.2306D-07, 0.8427D-07, 0.3015D-06, 0.1048D-05, 0.3494D-05, & + & 0.1102D-04, 0.3232D-04, 0.8651D-04, 0.2075D-03, 0.4392D-03, & + & 0.8148D-03, 0.1325D-02, 0.1904D-02, 0.2449D-02, 0.2865D-02, & + & 0.3096D-02, 0.3135D-02, 0.3012D-02, 0.2772D-02, 0.2463D-02, & + & 0.2125D-02, 0.1792D-02, 0.1481D-02, 0.1202D-02, 0.9617D-03, & + & 0.7589D-03, 0.5913D-03, 0.4551D-03, 0.3459D-03, 0.2597D-03, & + & 0.1923D-03, 0.1404D-03, 0.1013D-03, 0.7233D-04, 0.5142D-04, & + & 0.3666D-04, 0.2636D-04, 0.1919D-04, 0.1412D-04, 0.1048D-04, & + & 0.7817D-05, 0.5841D-05, 0.4362D-05, 0.3252D-05, 0.2418D-05, & + & 0.1792D-05/ + + data (calcpts(j,49), j = 1,neta) /0.3773D-23, 0.1720D-22, & + & 0.6603D-22, 0.2522D-21, 0.1040D-20, 0.3992D-20, 0.1503D-19, & + & 0.5605D-19, 0.2113D-18, 0.8140D-18, 0.3115D-17, 0.1187D-16, & + & 0.4551D-16, 0.1745D-15, 0.6692D-15, 0.2561D-14, 0.9800D-14, & + & 0.3749D-13, 0.1435D-12, 0.5492D-12, 0.2098D-11, 0.8016D-11, & + & 0.3057D-10, 0.1163D-09, 0.4408D-09, 0.1664D-08, 0.6219D-08, & + & 0.2306D-07, 0.8427D-07, 0.3015D-06, 0.1048D-05, 0.3494D-05, & + & 0.1102D-04, 0.3232D-04, 0.8651D-04, 0.2075D-03, 0.4392D-03, & + & 0.8148D-03, 0.1325D-02, 0.1904D-02, 0.2449D-02, 0.2865D-02, & + & 0.3096D-02, 0.3136D-02, 0.3012D-02, 0.2772D-02, 0.2463D-02, & + & 0.2127D-02, 0.1792D-02, 0.1482D-02, 0.1204D-02, 0.9644D-03, & + & 0.7620D-03, 0.5949D-03, 0.4593D-03, 0.3505D-03, 0.2645D-03, & + & 0.1971D-03, 0.1451D-03, 0.1054D-03, 0.7557D-04, 0.5369D-04, & + & 0.3800D-04, 0.2695D-04, 0.1931D-04, 0.1400D-04, 0.1027D-04, & + & 0.7599D-05, 0.5652D-05, 0.4212D-05, 0.3138D-05, 0.2334D-05, & + & 0.1731D-05/ + + data (dlaeta(j), j = 1,neta) / & + & -6d0, -5.83333333d0, -5.66666667d0, -5.5d0, -5.33333333d0, & + & -5.16666667d0, -5d0, -4.83333333d0, -4.66666667d0, -4.5d0, & + & -4.33333333d0, -4.16666667d0, -4d0, -3.83333333d0, & + & -3.66666667d0, -3.5d0, -3.33333333d0, -3.16666667d0, -3d0, & + & -2.83333333d0, -2.66666667d0, -2.5d0, -2.33333333d0, & + & -2.16666667d0, -2d0, -1.83333333d0, -1.66666667d0, -1.5d0, & + & -1.33333333d0, -1.16666667d0, -1d0, -0.83333333d0, -0.66666667d0,& + & -0.5d0, -0.33333333d0, -0.16666667d0, 0d0, 0.16666667d0, & + & 0.33333333d0, 0.5d0, 0.66666667d0, 0.83333333d0, 1d0, & + & 1.16666667d0, 1.33333333d0, 1.5d0, 1.66666667d0, 1.83333333d0, & + & 2d0, 2.16666667d0, 2.33333333d0, 2.5d0, 2.66666667d0, & + & 2.83333333d0, 3d0, 3.16666667d0, 3.33333333d0, 3.5d0, & + & 3.66666667d0, 3.83333333d0, 4d0, 4.16666667d0, 4.33333333d0, & + & 4.5d0, 4.66666667d0, 4.83333333d0, 5d0, 5.16666667d0, & + & 5.33333333d0, 5.5d0, 5.66666667d0, 5.83333333d0, 6d0/ + + data (dlaxi(j), j = 1,nxi) / & + & -3d0, -2.83333333d0, -2.66666667d0, -2.5d0, -2.33333333d0, & + & -2.16666667d0, -2d0, -1.83333333d0, -1.66666667d0, -1.5d0, & + & -1.33333333d0, -1.16666667d0, -1d0, -0.83333333d0, -0.66666667d0,& + & -0.5d0, -0.33333333d0, -0.16666667d0, 0d0, 0.16666667d0, & + & 0.33333333d0, 0.5d0, 0.66666667d0, 0.83333333d0, 1d0, & + & 1.16666667d0, 1.33333333d0, 1.5d0, 1.66666667d0, 1.83333333d0, & + & 2d0, 2.16666667d0, 2.33333333d0, 2.5d0, 2.66666667d0, & + & 2.83333333d0, 3d0, 3.16666667d0, 3.33333333d0, 3.5d0, & + & 3.66666667d0, 3.83333333d0, 4d0, 4.16666667d0, 4.33333333d0, & + & 4.5d0, 4.66666667d0, 4.83333333d0, 5d0/ + + dleta = dlog10(eta) + dlxi = dlog10(xi) + if (dlxi .le. dlaxi(1)) dlxi = dlaxi(1) + if (dlxi .ge. dlaxi(nxi)) dlxi = dlaxi(nxi) + if (dleta .ge. dlaeta(neta)) dleta = dlaeta(neta) + if (dleta .le. dlaeta(1)) dleta = dlaeta(1) + call locate(dlaeta,neta, dleta, ieta) + call locate(dlaxi, nxi, dlxi, ixi) +! interpolating between the appropriate points + delxi = 1d0/6d0 + deleta = 1d0/6d0 +! lagrange 3-pt. + if (ixi .le. 2) ixi = 2 + if (ixi .ge. 48) ixi = 48 + if (ieta .le. 2) ieta = 2 + if (ieta .ge. 72) ieta = 72 + pxi = (dlxi - dlaxi(ixi))/delxi + f(-1) = pxi*(pxi-1d0)/2d0*calcpts(ieta-1,ixi-1) + & + & (1d0 - pxi**2)*calcpts(ieta-1,ixi) + & + & pxi*(pxi+1d0)/2d0*calcpts(ieta-1,ixi+1) + f(0) = pxi*(pxi-1d0)/2d0*calcpts(ieta,ixi-1) + & + & (1d0 - pxi**2)*calcpts(ieta,ixi) + & + & pxi*(pxi+1d0)/2d0*calcpts(ieta,ixi+1) + f(1) = pxi*(pxi-1d0)/2d0*calcpts(ieta+1,ixi-1) + & + & (1d0 - pxi**2)*calcpts(ieta+1,ixi) + & + & pxi*(pxi+1d0)/2d0*calcpts(ieta+1,ixi+1) + peta = (dleta - dlaeta(ieta))/deleta + h1_LTq = peta*(peta-1d0)/2d0*f(-1) + & + & (1d0 - peta**2)*f(0) + & + & peta*(peta+1d0)/2d0*f(1) +!MB + + peta*(peta+1d0)/2d0*f(1) + return + END + +! =========================================== + double precision function h1bar_LTq(eta,xi) +! =========================================== + +! eq (29) in PLB347 (1995) 143 - 151 only necessary for the +! transverse piece +! MSbar scheme +! This routine is called subd1bar in the original code. +! Gives h1bar_LTq for Q2 < 1.5 GeV2 ( = 0 for Q2 > 1.5 GeV2) + + implicit none + integer neta, nxi + parameter (neta = 45, nxi = 15) + double precision calcpts(neta,nxi), aeta(neta), axi(nxi) + double precision t, u, y1, y2, y3, y4 + double precision eta, xi, huge, small + parameter (small = 1.d-8, huge = 1.d10) + integer j, ieta, ixi + + data (calcpts(j, 1), j=1,neta) /0.d0, -.3403d-06, -.1758d-05, & + & -.3760d-05, -.6194d-05, -.8975d-05, -.1049d-04, -.5149d-04, & + & -.1049d-03, -.1646d-03, -.2276d-03, -.2598d-03, -.5753d-03, & + & -.8478d-03, -.1068d-02, -.1242d-02, -.1380d-02, -.1488d-02, & + & -.1572d-02, -.1640d-02, -.1694d-02, -.1856d-02, -.1816d-02, & + & -.1742d-02, -.1662d-02, -.1589d-02, -.1518d-02, -.1453d-02, & + & -.1395d-02, -.1342d-02, -.7865d-03, -.5766d-03, -.4622d-03, & + & -.3897d-03, -.3617d-03, -.2181d-03, -.1602d-03, -.1070d-03, & + & -.8177d-04, -.6665d-04, -.6109d-04, -.1574d-04, -.8655d-05, & + & -.1086d-05, 0.d0/ +! + data (calcpts(j, 2), j=1,neta) /0.d0, -.2178d-06, -.1125d-05, & + & -.2409d-05, -.3966d-05, -.5751d-05, -.6717d-05, -.3299d-04, & + & -.6719d-04, -.1055d-03, -.1459d-03, -.1665d-03, -.3694d-03, & + & -.5449d-03, -.6870d-03, -.8000d-03, -.8888d-03, -.9588d-03, & + & -.1014d-02, -.1057d-02, -.1091d-02, -.1199d-02, -.1175d-02, & + & -.1127d-02, -.1077d-02, -.1028d-02, -.9830d-03, -.9422d-03, & + & -.9041d-03, -.8688d-03, -.5103d-03, -.3741d-03, -.3000d-03, & + & -.2528d-03, -.2346d-03, -.1416d-03, -.1039d-03, -.6963d-04, & + & -.5295d-04, -.4317d-04, -.3972d-04, -.1017d-04, -.5610d-05, & + & -.7188d-06, 0.d0/ +! + data (calcpts(j, 3), j=1,neta) /0.d0, -.5322d-07, -.2750d-06, & + & -.5883d-06, -.9690d-06, -.1405d-05, -.1641d-05, -.8070d-05, & + & -.1646d-04, -.2586d-04, -.3580d-04, -.4088d-04, -.9104d-04, & + & -.1346d-03, -.1703d-03, -.1986d-03, -.2209d-03, -.2388d-03, & + & -.2528d-03, -.2639d-03, -.2727d-03, -.3014d-03, -.2961d-03, & + & -.2847d-03, -.2724d-03, -.2604d-03, -.2490d-03, -.2386d-03, & + & -.2292d-03, -.2205d-03, -.1297d-03, -.9522d-04, -.7638d-04, & + & -.6429d-04, -.5973d-04, -.3603d-04, -.2641d-04, -.1768d-04, & + & -.1350d-04, -.1100d-04, -.1009d-04, -.2613d-05, -.1420d-05, & + & -.1778d-06, 0.d0/ +! + data (calcpts(j, 4), j=1,neta) /0.d0, -.6204d-09, -.3207d-08, & + & -.6865d-08, -.1131d-07, -.1639d-07, -.1916d-07, -.9449d-07, & + & -.1932d-06, -.3045d-06, -.4228d-06, -.4833d-06, -.1088d-05, & + & -.1624d-05, -.2069d-05, -.2429d-05, -.2718d-05, -.2949d-05, & + & -.3135d-05, -.3284d-05, -.3403d-05, -.3831d-05, -.3800d-05, & + & -.3674d-05, -.3528d-05, -.3381d-05, -.3245d-05, -.3114d-05, & + & -.2995d-05, -.2883d-05, -.1710d-05, -.1256d-05, -.1010d-05, & + & -.8503d-06, -.7902d-06, -.4776d-06, -.3498d-06, -.2352d-06, & + & -.1790d-06, -.1461d-06, -.1337d-06, -.3444d-07, -.1883d-07, & + & -.2382d-08, 0.d0/ +! + data (calcpts(j, 5), j=1,neta) /0.d0, -.4968d-15, -.2571d-14, & + & -.5505d-14, -.9076d-14, -.1318d-13, -.1541d-13, -.7657d-13, & + & -.1578d-12, -.2505d-12, -.3500d-12, -.4016d-12, -.9316d-12, & + & -.1425d-11, -.1853d-11, -.2212d-11, -.2511d-11, -.2759d-11, & + & -.2965d-11, -.3137d-11, -.3279d-11, -.3888d-11, -.3960d-11, & + & -.3893d-11, -.3784d-11, -.3660d-11, -.3535d-11, -.3412d-11, & + & -.3296d-11, -.3187d-11, -.1940d-11, -.1433d-11, -.1153d-11, & + & -.9740d-12, -.9041d-12, -.5475d-12, -.4023d-12, -.2694d-12, & + & -.2056d-12, -.1677d-12, -.1536d-12, -.3957d-13, -.2160d-13, & + & -.2823d-14, 0.d0/ +! + data (calcpts(j, 6), j=1,neta) /0.d0, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.d0/ +! + data (calcpts(j, 7), j=1,neta) /0.d0, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.d0/ +! + data (calcpts(j, 8), j=1,neta) /0.d0, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.d0/ +! + data (calcpts(j, 9), j=1,neta) /0.d0, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.d0/ +! + data (calcpts(j,10), j=1,neta) /0.d0, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.d0/ +! + data (calcpts(j,11), j=1,neta) /0.d0, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.d0/ +! + data (calcpts(j,12), j=1,neta) /0.d0, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.d0/ +! + data (calcpts(j,13), j=1,neta) /0.d0, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.d0/ +! + data (calcpts(j,14), j=1,neta) /0.d0, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.d0/ +! + data (calcpts(j,15), j=1,neta) /0.d0, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.d0/ +! + data (aeta(j), j = 1,neta) /small, 0.1000d-02, 0.3000d-02, & + & 0.5000d-02, 0.7000d-02, 0.9000d-02, 0.1000d-01, 0.3000d-01, & + & 0.5000d-01, 0.7000d-01, 0.9000d-01, 0.1000d+00, 0.2000d+00, & + & 0.3000d+00, 0.4000d+00, 0.5000d+00, 0.6000d+00, 0.7000d+00, & + & 0.8000d+00, 0.9000d+00, 0.1000d+01, 0.2000d+01, 0.3000d+01, & + & 0.4000d+01, 0.5000d+01, 0.6000d+01, 0.7000d+01, 0.8000d+01, & + & 0.9000d+01, 0.1000d+02, 0.3000d+02, 0.5000d+02, 0.7000d+02, & + & 0.9000d+02, 0.1000d+03, 0.2000d+03, 0.3000d+03, 0.5000d+03, & + & 0.7000d+03, 0.9000d+03, 0.1000d+04, 0.5000d+04, 0.1000d+05, & + & 0.1000d+06, huge/ +! + data (axi(j), j = 1,nxi) /0.1000d-01, 0.3162d-01, 0.1000d+00, & + & 0.3162d+00, 0.1000d+01, 0.2500d+01, 0.3162d+01, 0.7500d+01, & + & 0.1000d+02, 0.3162d+02, 0.1000d+03, 0.3162d+03, 0.1000d+04, & + & 0.5000d+04, 0.1000d+05/ +! +! here we have to choose the array elements that will go into the +! interpolation. + call locate(aeta, neta, eta, ieta) + call locate(axi, nxi, xi, ixi) + if (ieta .le. 1) ieta = 1 + if (ieta .gt. (neta - 1)) ieta = neta - 1 + if (ixi .le. 1) ixi = 1 + if (ixi .gt. (nxi - 1)) ixi = nxi - 1 + y1 = calcpts(ieta,ixi) + y2 = calcpts(ieta+1,ixi) + y3 = calcpts(ieta+1,ixi+1) + y4 = calcpts(ieta,ixi+1) +! interpolating between the points + t = (eta - aeta(ieta))/(aeta(ieta + 1) - aeta(ieta)) + u = (xi - axi(ixi))/(axi(ixi + 1) - axi(ixi)) + h1bar_LTq = (1.d0 - t)*(1.d0 - u)*y1 + t*(1.d0 - u)*y2 + & + & t*u*y3 + (1.d0 - t)*u*y4 + + return + END + +!DECK ID>, QCORRL. + +! =========================================== + double precision function h1_HLq(eta,xi) +! =========================================== + +! eq (26) in PLB347 (1995) 143 - 151 for the transverse piece +! MSbar scheme +! This routine is called subcqhl in the original code. +! Called schql in updated code (03/06/96). + + implicit none + integer neta, nxi + parameter (neta = 73, nxi = 49) + double precision calcpts(neta, nxi), dlaeta(neta), dlaxi(nxi) + double precision eta, xi, dleta, dlxi + double precision pxi, peta, f(-1:1), delxi, deleta + integer j, ieta, ixi + + data (calcpts(j, 1), j = 1,neta) /-.2062D-13, -.3668D-13, & + & -.6520D-13, -.1160D-12, -.2063D-12, -.3668D-12, -.6522D-12, & + & -.1160D-11, -.2062D-11, -.3668D-11, -.6525D-11, -.1160D-10, & + & -.2064D-10, -.3672D-10, -.6530D-10, -.1162D-09, -.2069D-09, & + & -.3684D-09, -.6561D-09, -.1170D-08, -.2085D-08, -.3723D-08, & + & -.6657D-08, -.1192D-07, -.2137D-07, -.3838D-07, -.6900D-07, & + & -.1242D-06, -.2233D-06, -.3993D-06, -.7067D-06, -.1227D-05, & + & -.2066D-05, -.3329D-05, -.5057D-05, -.7154D-05, -.9369D-05, & + & -.1137D-04, -.1288D-04, -.1379D-04, -.1414D-04, -.1402D-04, & + & -.1358D-04, -.1296D-04, -.1228D-04, -.1162D-04, -.1103D-04, & + & -.1052D-04, -.1012D-04, -.9794D-05, -.9545D-05, -.9356D-05, & + & -.9215D-05, -.9111D-05, -.9034D-05, -.8980D-05, -.8938D-05, & + & -.8910D-05, -.8889D-05, -.8873D-05, -.8863D-05, -.8856D-05, & + & -.8851D-05, -.8847D-05, -.8844D-05, -.8841D-05, -.8840D-05, & + & -.8840D-05, -.8839D-05, -.8839D-05, -.8837D-05, -.8837D-05, & + & -.8837D-05/ + + data (calcpts(j, 2), j = 1,neta) /-.3027D-13, -.5384D-13, & + & -.9569D-13, -.1702D-12, -.3027D-12, -.5383D-12, -.9573D-12, & + & -.1703D-11, -.3027D-11, -.5384D-11, -.9577D-11, -.1703D-10, & + & -.3029D-10, -.5390D-10, -.9585D-10, -.1706D-09, -.3037D-09, & + & -.5406D-09, -.9630D-09, -.1717D-08, -.3060D-08, -.5465D-08, & + & -.9771D-08, -.1749D-07, -.3136D-07, -.5633D-07, -.1013D-06, & + & -.1823D-06, -.3277D-06, -.5860D-06, -.1037D-05, -.1801D-05, & + & -.3032D-05, -.4886D-05, -.7422D-05, -.1050D-04, -.1375D-04, & + & -.1668D-04, -.1890D-04, -.2024D-04, -.2075D-04, -.2058D-04, & + & -.1993D-04, -.1903D-04, -.1803D-04, -.1705D-04, -.1619D-04, & + & -.1545D-04, -.1485D-04, -.1438D-04, -.1401D-04, -.1373D-04, & + & -.1352D-04, -.1337D-04, -.1326D-04, -.1318D-04, -.1312D-04, & + & -.1308D-04, -.1305D-04, -.1303D-04, -.1301D-04, -.1300D-04, & + & -.1299D-04, -.1299D-04, -.1299D-04, -.1297D-04, -.1297D-04, & + & -.1297D-04, -.1297D-04, -.1297D-04, -.1297D-04, -.1297D-04, & + & -.1297D-04/ + + data (calcpts(j, 3), j = 1,neta) /-.4440D-13, -.7897D-13, & + & -.1404D-12, -.2497D-12, -.4441D-12, -.7896D-12, -.1404D-11, & + & -.2498D-11, -.4440D-11, -.7897D-11, -.1405D-10, -.2498D-10, & + & -.4444D-10, -.7907D-10, -.1406D-09, -.2502D-09, -.4455D-09, & + & -.7931D-09, -.1413D-08, -.2518D-08, -.4489D-08, -.8016D-08, & + & -.1433D-07, -.2565D-07, -.4600D-07, -.8263D-07, -.1486D-06, & + & -.2674D-06, -.4807D-06, -.8596D-06, -.1521D-05, -.2642D-05, & + & -.4448D-05, -.7166D-05, -.1089D-04, -.1540D-04, -.2017D-04, & + & -.2447D-04, -.2772D-04, -.2970D-04, -.3044D-04, -.3018D-04, & + & -.2924D-04, -.2791D-04, -.2643D-04, -.2500D-04, -.2373D-04, & + & -.2265D-04, -.2177D-04, -.2108D-04, -.2054D-04, -.2013D-04, & + & -.1984D-04, -.1961D-04, -.1945D-04, -.1932D-04, -.1923D-04, & + & -.1918D-04, -.1913D-04, -.1910D-04, -.1907D-04, -.1906D-04, & + & -.1905D-04, -.1903D-04, -.1903D-04, -.1903D-04, -.1902D-04, & + & -.1902D-04, -.1902D-04, -.1902D-04, -.1902D-04, -.1902D-04, & + & -.1902D-04/ + + data (calcpts(j, 4), j = 1,neta) /-.6515D-13, -.1159D-12, & + & -.2060D-12, -.3663D-12, -.6516D-12, -.1159D-11, -.2061D-11, & + & -.3665D-11, -.6515D-11, -.1159D-10, -.2061D-10, -.3666D-10, & + & -.6521D-10, -.1160D-09, -.2063D-09, -.3672D-09, -.6537D-09, & + & -.1164D-08, -.2073D-08, -.3695D-08, -.6587D-08, -.1176D-07, & + & -.2103D-07, -.3764D-07, -.6749D-07, -.1212D-06, -.2180D-06, & + & -.3924D-06, -.7053D-06, -.1261D-05, -.2232D-05, -.3876D-05, & + & -.6526D-05, -.1051D-04, -.1597D-04, -.2260D-04, -.2959D-04, & + & -.3590D-04, -.4068D-04, -.4358D-04, -.4466D-04, -.4429D-04, & + & -.4290D-04, -.4094D-04, -.3878D-04, -.3669D-04, -.3483D-04, & + & -.3323D-04, -.3195D-04, -.3094D-04, -.3014D-04, -.2955D-04, & + & -.2911D-04, -.2877D-04, -.2853D-04, -.2835D-04, -.2822D-04, & + & -.2813D-04, -.2807D-04, -.2803D-04, -.2799D-04, -.2796D-04, & + & -.2795D-04, -.2793D-04, -.2792D-04, -.2792D-04, -.2792D-04, & + & -.2791D-04, -.2791D-04, -.2791D-04, -.2791D-04, -.2791D-04, & + & -.2791D-04/ + + data (calcpts(j, 5), j = 1,neta) /-.9559D-13, -.1700D-12, & + & -.3022D-12, -.5375D-12, -.9561D-12, -.1700D-11, -.3023D-11, & + & -.5377D-11, -.9558D-11, -.1700D-10, -.3024D-10, -.5379D-10, & + & -.9567D-10, -.1702D-09, -.3027D-09, -.5387D-09, -.9591D-09, & + & -.1707D-08, -.3041D-08, -.5421D-08, -.9664D-08, -.1726D-07, & + & -.3085D-07, -.5523D-07, -.9902D-07, -.1779D-06, -.3198D-06, & + & -.5756D-06, -.1035D-05, -.1850D-05, -.3274D-05, -.5686D-05, & + & -.9572D-05, -.1542D-04, -.2343D-04, -.3315D-04, -.4341D-04, & + & -.5267D-04, -.5968D-04, -.6393D-04, -.6553D-04, -.6498D-04, & + & -.6295D-04, -.6007D-04, -.5691D-04, -.5385D-04, -.5111D-04, & + & -.4878D-04, -.4688D-04, -.4538D-04, -.4423D-04, -.4336D-04, & + & -.4271D-04, -.4222D-04, -.4187D-04, -.4160D-04, -.4142D-04, & + & -.4127D-04, -.4118D-04, -.4112D-04, -.4106D-04, -.4102D-04, & + & -.4100D-04, -.4098D-04, -.4097D-04, -.4097D-04, -.4096D-04, & + & -.4096D-04, -.4096D-04, -.4094D-04, -.4094D-04, -.4094D-04, & + & -.4094D-04/ + + data (calcpts(j, 6), j = 1,neta) /-.1402D-12, -.2493D-12, & + & -.4431D-12, -.7882D-12, -.1402D-11, -.2493D-11, -.4433D-11, & + & -.7885D-11, -.1402D-10, -.2493D-10, -.4435D-10, -.7887D-10, & + & -.1403D-09, -.2496D-09, -.4439D-09, -.7899D-09, -.1406D-08, & + & -.2504D-08, -.4459D-08, -.7949D-08, -.1417D-07, -.2530D-07, & + & -.4524D-07, -.8098D-07, -.1452D-06, -.2608D-06, -.4689D-06, & + & -.8439D-06, -.1517D-05, -.2713D-05, -.4800D-05, -.8335D-05, & + & -.1403D-04, -.2261D-04, -.3435D-04, -.4861D-04, -.6365D-04, & + & -.7724D-04, -.8752D-04, -.9375D-04, -.9609D-04, -.9529D-04, & + & -.9229D-04, -.8810D-04, -.8346D-04, -.7895D-04, -.7492D-04, & + & -.7150D-04, -.6872D-04, -.6653D-04, -.6483D-04, -.6355D-04, & + & -.6259D-04, -.6188D-04, -.6136D-04, -.6098D-04, -.6071D-04, & + & -.6051D-04, -.6037D-04, -.6027D-04, -.6020D-04, -.6015D-04, & + & -.6011D-04, -.6008D-04, -.6007D-04, -.6005D-04, -.6004D-04, & + & -.6002D-04, -.6003D-04, -.6003D-04, -.6003D-04, -.6003D-04, & + & -.6001D-04/ + + data (calcpts(j, 7), j = 1,neta) /-.2055D-12, -.3655D-12, & + & -.6496D-12, -.1155D-11, -.2055D-11, -.3654D-11, -.6498D-11, & + & -.1156D-10, -.2055D-10, -.3655D-10, -.6501D-10, -.1156D-09, & + & -.2056D-09, -.3659D-09, -.6506D-09, -.1158D-08, -.2062D-08, & + & -.3670D-08, -.6537D-08, -.1165D-07, -.2077D-07, -.3709D-07, & + & -.6632D-07, -.1187D-06, -.2128D-06, -.3823D-06, -.6872D-06, & + & -.1237D-05, -.2223D-05, -.3975D-05, -.7034D-05, -.1222D-04, & + & -.2056D-04, -.3313D-04, -.5034D-04, -.7123D-04, -.9329D-04, & + & -.1132D-03, -.1283D-03, -.1374D-03, -.1409D-03, -.1397D-03, & + & -.1353D-03, -.1291D-03, -.1223D-03, -.1157D-03, -.1098D-03, & + & -.1048D-03, -.1007D-03, -.9748D-04, -.9500D-04, -.9311D-04, & + & -.9171D-04, -.9068D-04, -.8991D-04, -.8936D-04, -.8895D-04, & + & -.8866D-04, -.8845D-04, -.8829D-04, -.8819D-04, -.8812D-04, & + & -.8807D-04, -.8803D-04, -.8800D-04, -.8797D-04, -.8796D-04, & + & -.8796D-04, -.8795D-04, -.8795D-04, -.8795D-04, -.8793D-04, & + & -.8793D-04/ + + data (calcpts(j, 8), j = 1,neta) /-.3011D-12, -.5355D-12, & + & -.9518D-12, -.1693D-11, -.3011D-11, -.5354D-11, -.9521D-11, & + & -.1694D-10, -.3010D-10, -.5355D-10, -.9526D-10, -.1694D-09, & + & -.3013D-09, -.5361D-09, -.9533D-09, -.1697D-08, -.3021D-08, & + & -.5377D-08, -.9578D-08, -.1707D-07, -.3044D-07, -.5435D-07, & + & -.9716D-07, -.1739D-06, -.3118D-06, -.5600D-06, -.1007D-05, & + & -.1812D-05, -.3256D-05, -.5822D-05, -.1030D-04, -.1789D-04, & + & -.3011D-04, -.4852D-04, -.7372D-04, -.1043D-03, -.1367D-03, & + & -.1658D-03, -.1879D-03, -.2013D-03, -.2064D-03, -.2046D-03, & + & -.1982D-03, -.1892D-03, -.1792D-03, -.1695D-03, -.1608D-03, & + & -.1535D-03, -.1475D-03, -.1428D-03, -.1391D-03, -.1364D-03, & + & -.1343D-03, -.1329D-03, -.1317D-03, -.1308D-03, -.1303D-03, & + & -.1298D-03, -.1295D-03, -.1292D-03, -.1291D-03, -.1290D-03, & + & -.1290D-03, -.1288D-03, -.1289D-03, -.1289D-03, -.1289D-03, & + & -.1289D-03, -.1289D-03, -.1289D-03, -.1289D-03, -.1289D-03, & + & -.1287D-03/ + + data (calcpts(j, 9), j = 1,neta) /-.4405D-12, -.7835D-12, & + & -.1393D-11, -.2477D-11, -.4406D-11, -.7834D-11, -.1393D-10, & + & -.2478D-10, -.4405D-10, -.7835D-10, -.1394D-09, -.2479D-09, & + & -.4409D-09, -.7844D-09, -.1395D-08, -.2483D-08, -.4420D-08, & + & -.7868D-08, -.1401D-07, -.2498D-07, -.4453D-07, -.7951D-07, & + & -.1422D-06, -.2544D-06, -.4561D-06, -.8192D-06, -.1473D-05, & + & -.2650D-05, -.4762D-05, -.8514D-05, -.1506D-04, -.2615D-04, & + & -.4403D-04, -.7095D-04, -.1078D-03, -.1526D-03, -.1999D-03, & + & -.2426D-03, -.2750D-03, -.2946D-03, -.3020D-03, -.2994D-03, & + & -.2900D-03, -.2767D-03, -.2621D-03, -.2479D-03, -.2351D-03, & + & -.2244D-03, -.2156D-03, -.2087D-03, -.2033D-03, -.1993D-03, & + & -.1963D-03, -.1940D-03, -.1924D-03, -.1912D-03, -.1903D-03, & + & -.1897D-03, -.1893D-03, -.1890D-03, -.1888D-03, -.1886D-03, & + & -.1885D-03, -.1884D-03, -.1884D-03, -.1882D-03, -.1882D-03, & + & -.1882D-03, -.1882D-03, -.1882D-03, -.1882D-03, -.1882D-03, & + & -.1882D-03/ + + data (calcpts(j,10), j = 1,neta) /-.6440D-12, -.1146D-11, & + & -.2036D-11, -.3621D-11, -.6442D-11, -.1145D-10, -.2037D-10, & + & -.3623D-10, -.6440D-10, -.1145D-09, -.2038D-09, -.3624D-09, & + & -.6446D-09, -.1147D-08, -.2039D-08, -.3629D-08, -.6461D-08, & + & -.1150D-07, -.2049D-07, -.3652D-07, -.6510D-07, -.1162D-06, & + & -.2078D-06, -.3719D-06, -.6666D-06, -.1197D-05, -.2152D-05, & + & -.3872D-05, -.6957D-05, -.1244D-04, -.2200D-04, -.3819D-04, & + & -.6430D-04, -.1036D-03, -.1575D-03, -.2229D-03, -.2921D-03, & + & -.3546D-03, -.4019D-03, -.4306D-03, -.4414D-03, -.4377D-03, & + & -.4239D-03, -.4045D-03, -.3831D-03, -.3622D-03, -.3436D-03, & + & -.3279D-03, -.3150D-03, -.3048D-03, -.2970D-03, -.2910D-03, & + & -.2866D-03, -.2834D-03, -.2810D-03, -.2792D-03, -.2779D-03, & + & -.2770D-03, -.2763D-03, -.2759D-03, -.2755D-03, -.2753D-03, & + & -.2751D-03, -.2750D-03, -.2750D-03, -.2749D-03, -.2749D-03, & + & -.2749D-03, -.2747D-03, -.2747D-03, -.2747D-03, -.2747D-03, & + & -.2747D-03/ + + data (calcpts(j,11), j = 1,neta) /-.9398D-12, -.1672D-11, & + & -.2971D-11, -.5285D-11, -.9400D-11, -.1671D-10, -.2972D-10, & + & -.5287D-10, -.9397D-10, -.1672D-09, -.2974D-09, -.5288D-09, & + & -.9406D-09, -.1674D-08, -.2976D-08, -.5296D-08, -.9429D-08, & + & -.1678D-07, -.2989D-07, -.5329D-07, -.9499D-07, -.1696D-06, & + & -.3032D-06, -.5425D-06, -.9724D-06, -.1746D-05, -.3138D-05, & + & -.5645D-05, -.1014D-04, -.1812D-04, -.3205D-04, -.5564D-04, & + & -.9365D-04, -.1509D-03, -.2294D-03, -.3249D-03, -.4258D-03, & + & -.5171D-03, -.5863D-03, -.6283D-03, -.6441D-03, -.6386D-03, & + & -.6184D-03, -.5901D-03, -.5586D-03, -.5282D-03, -.5009D-03, & + & -.4779D-03, -.4591D-03, -.4442D-03, -.4328D-03, -.4240D-03, & + & -.4177D-03, -.4128D-03, -.4092D-03, -.4067D-03, -.4049D-03, & + & -.4034D-03, -.4025D-03, -.4019D-03, -.4013D-03, -.4009D-03, & + & -.4008D-03, -.4005D-03, -.4004D-03, -.4004D-03, -.4003D-03, & + & -.4003D-03, -.4003D-03, -.4003D-03, -.4001D-03, -.4001D-03, & + & -.4001D-03/ + + data (calcpts(j,12), j = 1,neta) /-.1367D-11, -.2432D-11, & + & -.4323D-11, -.7688D-11, -.1368D-10, -.2432D-10, -.4324D-10, & + & -.7692D-10, -.1367D-09, -.2432D-09, -.4326D-09, -.7694D-09, & + & -.1368D-08, -.2435D-08, -.4329D-08, -.7705D-08, -.1372D-07, & + & -.2442D-07, -.4349D-07, -.7752D-07, -.1382D-06, -.2467D-06, & + & -.4409D-06, -.7889D-06, -.1414D-05, -.2539D-05, -.4561D-05, & + & -.8202D-05, -.1473D-04, -.2632D-04, -.4653D-04, -.8076D-04, & + & -.1359D-03, -.2191D-03, -.3331D-03, -.4719D-03, -.6188D-03, & + & -.7518D-03, -.8527D-03, -.9139D-03, -.9369D-03, -.9289D-03, & + & -.8994D-03, -.8579D-03, -.8121D-03, -.7676D-03, -.7278D-03, & + & -.6940D-03, -.6664D-03, -.6447D-03, -.6280D-03, -.6152D-03, & + & -.6057D-03, -.5987D-03, -.5935D-03, -.5898D-03, -.5871D-03, & + & -.5852D-03, -.5837D-03, -.5828D-03, -.5820D-03, -.5815D-03, & + & -.5812D-03, -.5810D-03, -.5807D-03, -.5806D-03, -.5806D-03, & + & -.5804D-03, -.5804D-03, -.5804D-03, -.5803D-03, -.5803D-03, & + & -.5803D-03/ + + data (calcpts(j,13), j = 1,neta) /-.1981D-11, -.3524D-11, & + & -.6264D-11, -.1114D-10, -.1982D-10, -.3524D-10, -.6266D-10, & + & -.1115D-09, -.1981D-09, -.3524D-09, -.6269D-09, -.1115D-08, & + & -.1983D-08, -.3528D-08, -.6273D-08, -.1116D-07, -.1988D-07, & + & -.3538D-07, -.6301D-07, -.1123D-06, -.2002D-06, -.3573D-06, & + & -.6386D-06, -.1142D-05, -.2047D-05, -.3674D-05, -.6599D-05, & + & -.1186D-04, -.2130D-04, -.3803D-04, -.6722D-04, -.1166D-03, & + & -.1963D-03, -.3164D-03, -.4812D-03, -.6821D-03, -.8951D-03, & + & -.1088D-02, -.1235D-02, -.1324D-02, -.1357D-02, -.1346D-02, & + & -.1303D-02, -.1242D-02, -.1175D-02, -.1110D-02, -.1052D-02, & + & -.1003D-02, -.9628D-03, -.9311D-03, -.9066D-03, -.8881D-03, & + & -.8742D-03, -.8640D-03, -.8564D-03, -.8509D-03, -.8471D-03, & + & -.8442D-03, -.8421D-03, -.8406D-03, -.8396D-03, -.8388D-03, & + & -.8382D-03, -.8378D-03, -.8376D-03, -.8374D-03, -.8373D-03, & + & -.8372D-03, -.8372D-03, -.8372D-03, -.8370D-03, -.8370D-03, & + & -.8370D-03/ + + data (calcpts(j,14), j = 1,neta) /-.1657D-11, -.2947D-11, & + & -.5239D-11, -.9317D-11, -.1657D-10, -.2947D-10, -.5241D-10, & + & -.9322D-10, -.1657D-09, -.2948D-09, -.5244D-09, -.9328D-09, & + & -.1659D-08, -.2953D-08, -.5253D-08, -.9353D-08, -.1666D-07, & + & -.2969D-07, -.5295D-07, -.9455D-07, -.1689D-06, -.3026D-06, & + & -.5433D-06, -.9779D-06, -.1766D-05, -.3201D-05, -.5821D-05, & + & -.1062D-04, -.1939D-04, -.3528D-04, -.6357D-04, -.1123D-03, & + & -.1920D-03, -.3125D-03, -.4764D-03, -.6703D-03, -.8629D-03, & + & -.1016D-02, -.1102D-02, -.1114D-02, -.1061D-02, -.9629D-03, & + & -.8376D-03, -.7028D-03, -.5715D-03, -.4530D-03, -.3513D-03, & + & -.2678D-03, -.2010D-03, -.1494D-03, -.1096D-03, -.8020D-04, & + & -.5869D-04, -.4239D-04, -.3005D-04, -.2184D-04, -.1487D-04, & + & -.1074D-04, -.7992D-05, -.5163D-05, -.3779D-05, -.2358D-05, & + & -.2412D-05, -.9490D-06, -.9740D-06, -.9911D-06, -.1003D-05, & + & -.1011D-05, -.1016D-05, -.1020D-05, -.1022D-05, -.1024D-05, & + & 0.4749D-06/ + + data (calcpts(j,15), j = 1,neta) /-.2383D-11, -.4239D-11, & + & -.7535D-11, -.1340D-10, -.2384D-10, -.4239D-10, -.7538D-10, & + & -.1341D-09, -.2383D-09, -.4240D-09, -.7543D-09, -.1342D-08, & + & -.2387D-08, -.4247D-08, -.7555D-08, -.1345D-07, -.2396D-07, & + & -.4269D-07, -.7612D-07, -.1359D-06, -.2428D-06, -.4347D-06, & + & -.7800D-06, -.1403D-05, -.2531D-05, -.4584D-05, -.8325D-05, & + & -.1517D-04, -.2765D-04, -.5023D-04, -.9038D-04, -.1595D-03, & + & -.2725D-03, -.4437D-03, -.6773D-03, -.9547D-03, -.1232D-02, & + & -.1454D-02, -.1580D-02, -.1600D-02, -.1527D-02, -.1387D-02, & + & -.1208D-02, -.1014D-02, -.8254D-03, -.6546D-03, -.5069D-03, & + & -.3863D-03, -.2900D-03, -.2157D-03, -.1589D-03, -.1161D-03, & + & -.8367D-04, -.6062D-04, -.4279D-04, -.3042D-04, -.2220D-04, & + & -.1523D-04, -.1109D-04, -.6831D-05, -.5498D-05, -.4112D-05, & + & -.2690D-05, -.1243D-05, -.1279D-05, 0.1969D-06, 0.1801D-06, & + & 0.1688D-06, 0.1610D-06, 0.1557D-06, 0.1521D-06, 0.1496D-06, & + & 0.1480D-06/ + + data (calcpts(j,16), j = 1,neta) /-.3399D-11, -.6046D-11, & + & -.1075D-10, -.1911D-10, -.3400D-10, -.6045D-10, -.1075D-09, & + & -.1912D-09, -.3399D-09, -.6046D-09, -.1076D-08, -.1913D-08, & + & -.3403D-08, -.6056D-08, -.1077D-07, -.1918D-07, -.3416D-07, & + & -.6085D-07, -.1085D-06, -.1936D-06, -.3457D-06, -.6187D-06, & + & -.1110D-05, -.1994D-05, -.3594D-05, -.6499D-05, -.1178D-04, & + & -.2142D-04, -.3897D-04, -.7064D-04, -.1268D-03, -.2235D-03, & + & -.3815D-03, -.6215D-03, -.9500D-03, -.1343D-02, -.1738D-02, & + & -.2058D-02, -.2244D-02, -.2278D-02, -.2180D-02, -.1984D-02, & + & -.1730D-02, -.1455D-02, -.1185D-02, -.9400D-03, -.7301D-03, & + & -.5566D-03, -.4177D-03, -.3106D-03, -.2286D-03, -.1670D-03, & + & -.1211D-03, -.8712D-04, -.6249D-04, -.4462D-04, -.3222D-04, & + & -.2247D-04, -.1549D-04, -.1134D-04, -.8576D-05, -.5738D-05, & + & -.4349D-05, -.2924D-05, -.1475D-05, -.1510D-05, -.3433D-07, & + & -.5058D-07, -.6164D-07, -.6919D-07, -.7433D-07, -.7783D-07, & + & -.8021D-07/ + + data (calcpts(j,17), j = 1,neta) /-.4787D-11, -.8515D-11, & + & -.1513D-10, -.2692D-10, -.4788D-10, -.8514D-10, -.1514D-09, & + & -.2693D-09, -.4787D-09, -.8515D-09, -.1515D-08, -.2694D-08, & + & -.4793D-08, -.8528D-08, -.1517D-07, -.2700D-07, -.4808D-07, & + & -.8564D-07, -.1526D-06, -.2723D-06, -.4860D-06, -.8692D-06, & + & -.1557D-05, -.2796D-05, -.5031D-05, -.9081D-05, -.1642D-04, & + & -.2978D-04, -.5401D-04, -.9761D-04, -.1747D-03, -.3072D-03, & + & -.5238D-03, -.8536D-03, -.1307D-02, -.1854D-02, -.2411D-02, & + & -.2869D-02, -.3142D-02, -.3202D-02, -.3074D-02, -.2805D-02, & + & -.2451D-02, -.2066D-02, -.1687D-02, -.1339D-02, -.1041D-02, & + & -.7941D-03, -.5972D-03, -.4441D-03, -.3274D-03, -.2390D-03, & + & -.1742D-03, -.1251D-03, -.8941D-04, -.6469D-04, -.4675D-04, & + & -.3281D-04, -.2303D-04, -.1752D-04, -.1186D-04, -.9089D-05, & + & -.6244D-05, -.4851D-05, -.3423D-05, -.1972D-05, -.2006D-05, & + & -.2029D-05, -.5445D-06, -.5551D-06, -.5624D-06, -.5673D-06, & + & -.5706D-06/ + + data (calcpts(j,18), j = 1,neta) /-.6623D-11, -.1178D-10, & + & -.2094D-10, -.3724D-10, -.6624D-10, -.1178D-09, -.2095D-09, & + & -.3726D-09, -.6622D-09, -.1178D-08, -.2096D-08, -.3727D-08, & + & -.6629D-08, -.1180D-07, -.2098D-07, -.3734D-07, -.6648D-07, & + & -.1184D-06, -.2109D-06, -.3761D-06, -.6709D-06, -.1199D-05, & + & -.2146D-05, -.3845D-05, -.6907D-05, -.1244D-04, -.2243D-04, & + & -.4053D-04, -.7321D-04, -.1317D-03, -.2350D-03, -.4118D-03, & + & -.7008D-03, -.1142D-02, -.1754D-02, -.2498D-02, -.3268D-02, & + & -.3914D-02, -.4313D-02, -.4420D-02, -.4261D-02, -.3903D-02, & + & -.3423D-02, -.2891D-02, -.2365D-02, -.1883D-02, -.1466D-02, & + & -.1120D-02, -.8425D-03, -.6260D-03, -.4613D-03, -.3363D-03, & + & -.2443D-03, -.1761D-03, -.1267D-03, -.9088D-04, -.6453D-04, & + & -.4650D-04, -.3250D-04, -.2268D-04, -.1715D-04, -.1147D-04, & + & -.8681D-05, -.5828D-05, -.4428D-05, -.2996D-05, -.1543D-05, & + & -.1574D-05, -.1596D-05, -.1106D-06, -.1206D-06, -.1274D-06, & + & -.1321D-06/ + + data (calcpts(j,19), j = 1,neta) /-.8945D-11, -.1591D-10, & + & -.2828D-10, -.5030D-10, -.8947D-10, -.1591D-09, -.2829D-09, & + & -.5032D-09, -.8944D-09, -.1591D-08, -.2830D-08, -.5033D-08, & + & -.8952D-08, -.1593D-07, -.2832D-07, -.5040D-07, -.8973D-07, & + & -.1597D-06, -.2845D-06, -.5070D-06, -.9037D-06, -.1613D-05, & + & -.2883D-05, -.5159D-05, -.9244D-05, -.1660D-04, -.2982D-04, & + & -.5365D-04, -.9645D-04, -.1727D-03, -.3063D-03, -.5346D-03, & + & -.9074D-03, -.1478D-02, -.2276D-02, -.3259D-02, -.4296D-02, & + & -.5189D-02, -.5766D-02, -.5952D-02, -.5774D-02, -.5317D-02, & + & -.4683D-02, -.3972D-02, -.3259D-02, -.2601D-02, -.2029D-02, & + & -.1552D-02, -.1170D-02, -.8699D-03, -.6406D-03, -.4682D-03, & + & -.3407D-03, -.2463D-03, -.1761D-03, -.1264D-03, -.9026D-04, & + & -.6374D-04, -.4560D-04, -.3302D-04, -.2314D-04, -.1607D-04, & + & -.1186D-04, -.7561D-05, -.6196D-05, -.3288D-05, -.3351D-05, & + & -.1894D-05, -.1923D-05, -.4426D-06, -.4561D-06, -.4653D-06, & + & -.4716D-06/ + + data (calcpts(j,20), j = 1,neta) /-.1170D-10, -.2082D-10, & + & -.3700D-10, -.6581D-10, -.1171D-09, -.2082D-09, -.3702D-09, & + & -.6584D-09, -.1170D-08, -.2082D-08, -.3703D-08, -.6585D-08, & + & -.1171D-07, -.2083D-07, -.3704D-07, -.6591D-07, -.1173D-06, & + & -.2088D-06, -.3717D-06, -.6620D-06, -.1179D-05, -.2102D-05, & + & -.3752D-05, -.6700D-05, -.1198D-04, -.2143D-04, -.3835D-04, & + & -.6864D-04, -.1227D-03, -.2182D-03, -.3847D-03, -.6677D-03, & + & -.1129D-02, -.1837D-02, -.2835D-02, -.4084D-02, -.5432D-02, & + & -.6633D-02, -.7450D-02, -.7765D-02, -.7596D-02, -.7044D-02, & + & -.6242D-02, -.5321D-02, -.4385D-02, -.3514D-02, -.2749D-02, & + & -.2108D-02, -.1592D-02, -.1186D-02, -.8758D-03, -.6405D-03, & + & -.4661D-03, -.3371D-03, -.2418D-03, -.1739D-03, -.1252D-03, & + & -.8880D-04, -.6357D-04, -.4528D-04, -.3260D-04, -.2266D-04, & + & -.1704D-04, -.1280D-04, -.8476D-05, -.7097D-05, -.4179D-05, & + & -.4235D-05, -.2773D-05, -.2799D-05, -.1316D-05, -.1328D-05, & + & -.1337D-05/ + + data (calcpts(j,21), j = 1,neta) /-.1470D-10, -.2615D-10, & + & -.4648D-10, -.8267D-10, -.1470D-09, -.2615D-09, -.4650D-09, & + & -.8270D-09, -.1470D-08, -.2615D-08, -.4651D-08, -.8270D-08, & + & -.1471D-07, -.2616D-07, -.4651D-07, -.8275D-07, -.1472D-06, & + & -.2620D-06, -.4661D-06, -.8298D-06, -.1477D-05, -.2630D-05, & + & -.4687D-05, -.8353D-05, -.1489D-04, -.2656D-04, -.4732D-04, & + & -.8427D-04, -.1497D-03, -.2644D-03, -.4628D-03, -.7976D-03, & + & -.1341D-02, -.2177D-02, -.3364D-02, -.4877D-02, -.6552D-02, & + & -.8101D-02, -.9219D-02, -.9729D-02, -.9619D-02, -.9002D-02, & + & -.8041D-02, -.6903D-02, -.5723D-02, -.4607D-02, -.3618D-02, & + & -.2783D-02, -.2107D-02, -.1572D-02, -.1161D-02, -.8494D-03, & + & -.6165D-03, -.4455D-03, -.3193D-03, -.2288D-03, -.1631D-03, & + & -.1154D-03, -.8159D-04, -.5760D-04, -.4064D-04, -.2784D-04, & + & -.1932D-04, -.1364D-04, -.9365D-05, -.5017D-05, -.3620D-05, & + & -.2190D-05, -.7378D-06, -.7705D-06, 0.7073D-06, 0.6922D-06, & + & 0.6819D-06/ + + data (calcpts(j,22), j = 1,neta) /-.1759D-10, -.3128D-10, & + & -.5560D-10, -.9889D-10, -.1759D-09, -.3128D-09, -.5562D-09, & + & -.9892D-09, -.1758D-08, -.3127D-08, -.5563D-08, -.9892D-08, & + & -.1759D-07, -.3129D-07, -.5562D-07, -.9894D-07, -.1760D-06, & + & -.3130D-06, -.5568D-06, -.9908D-06, -.1762D-05, -.3135D-05, & + & -.5579D-05, -.9925D-05, -.1765D-04, -.3139D-04, -.5570D-04, & + & -.9871D-04, -.1743D-03, -.3058D-03, -.5311D-03, -.9085D-03, & + & -.1518D-02, -.2454D-02, -.3791D-02, -.5520D-02, -.7489D-02, & + & -.9386D-02, -.1085D-01, -.1162D-01, -.1164D-01, -.1102D-01, & + & -.9949D-02, -.8618D-02, -.7203D-02, -.5839D-02, -.4611D-02, & + & -.3563D-02, -.2706D-02, -.2019D-02, -.1505D-02, -.1094D-02, & + & -.8054D-03, -.5835D-03, -.4158D-03, -.3041D-03, -.2199D-03, & + & -.1488D-03, -.1064D-03, -.7823D-04, -.4947D-04, -.3531D-04, & + & -.2088D-04, -.2127D-04, -.6535D-05, -.6716D-05, -.6839D-05, & + & -.6923D-05, -.6980D-05, -.7019D-05, -.7046D-05, -.7064D-05, & + & -.7077D-05/ + + data (calcpts(j,23), j = 1,neta) /-.1989D-10, -.3537D-10, & + & -.6287D-10, -.1118D-09, -.1989D-09, -.3536D-09, -.6289D-09, & + & -.1119D-08, -.1988D-08, -.3536D-08, -.6290D-08, -.1118D-07, & + & -.1989D-07, -.3537D-07, -.6287D-07, -.1118D-06, -.1989D-06, & + & -.3537D-06, -.6290D-06, -.1119D-05, -.1988D-05, -.3535D-05, & + & -.6285D-05, -.1116D-04, -.1982D-04, -.3515D-04, -.6218D-04, & + & -.1097D-03, -.1928D-03, -.3362D-03, -.5800D-03, -.9849D-03, & + & -.1634D-02, -.2628D-02, -.4050D-02, -.5913D-02, -.8084D-02, & + & -.1026D-01, -.1205D-01, -.1313D-01, -.1336D-01, -.1284D-01, & + & -.1174D-01, -.1028D-01, -.8684D-02, -.7102D-02, -.5651D-02, & + & -.4397D-02, -.3347D-02, -.2525D-02, -.1869D-02, -.1373D-02, & + & -.9974D-03, -.7178D-03, -.5217D-03, -.3812D-03, -.2677D-03, & + & -.1971D-03, -.1401D-03, -.9716D-04, -.6856D-04, -.5451D-04, & + & -.4015D-04, -.2559D-04, -.1090D-04, -.1110D-04, -.1124D-04, & + & -.1133D-04, -.1140D-04, 0.3557D-05, 0.3526D-05, 0.3506D-05, & + & 0.3492D-05/ + + data (calcpts(j,24), j = 1,neta) /-.2117D-10, -.3765D-10, & + & -.6691D-10, -.1190D-09, -.2117D-09, -.3764D-09, -.6693D-09, & + & -.1191D-08, -.2116D-08, -.3763D-08, -.6694D-08, -.1190D-07, & + & -.2117D-07, -.3765D-07, -.6691D-07, -.1190D-06, -.2116D-06, & + & -.3763D-06, -.6690D-06, -.1189D-05, -.2113D-05, -.3755D-05, & + & -.6671D-05, -.1184D-04, -.2099D-04, -.3716D-04, -.6559D-04, & + & -.1154D-03, -.2020D-03, -.3506D-03, -.6016D-03, -.1015D-02, & + & -.1674D-02, -.2677D-02, -.4111D-02, -.6001D-02, -.8245D-02, & + & -.1058D-01, -.1261D-01, -.1398D-01, -.1449D-01, -.1415D-01, & + & -.1313D-01, -.1167D-01, -.9981D-02, -.8257D-02, -.6636D-02, & + & -.5198D-02, -.3993D-02, -.3012D-02, -.2240D-02, -.1656D-02, & + & -.1208D-02, -.8696D-03, -.6294D-03, -.4595D-03, -.3314D-03, & + & -.2311D-03, -.1593D-03, -.1164D-03, -.8792D-04, -.5893D-04, & + & -.4462D-04, -.3009D-04, -.1541D-04, -.1563D-04, -.1578D-04, & + & -.8765D-06, -.9453D-06, -.9923D-06, -.1024D-05, -.1046D-05, & + & -.1061D-05/ + + data (calcpts(j,25), j = 1,neta) /-.2120D-10, -.3770D-10, & + & -.6701D-10, -.1192D-09, -.2120D-09, -.3770D-09, -.6703D-09, & + & -.1192D-08, -.2119D-08, -.3769D-08, -.6704D-08, -.1192D-07, & + & -.2120D-07, -.3770D-07, -.6700D-07, -.1192D-06, -.2119D-06, & + & -.3767D-06, -.6697D-06, -.1190D-05, -.2114D-05, -.3756D-05, & + & -.6670D-05, -.1183D-04, -.2096D-04, -.3706D-04, -.6531D-04, & + & -.1147D-03, -.2003D-03, -.3466D-03, -.5925D-03, -.9958D-03, & + & -.1634D-02, -.2600D-02, -.3976D-02, -.5792D-02, -.7973D-02, & + & -.1030D-01, -.1244D-01, -.1402D-01, -.1480D-01, -.1472D-01, & + & -.1390D-01, -.1256D-01, -.1091D-01, -.9150D-02, -.7443D-02, & + & -.5897D-02, -.4564D-02, -.3478D-02, -.2601D-02, -.1928D-02, & + & -.1405D-02, -.1021D-02, -.7362D-03, -.5363D-03, -.3782D-03, & + & -.2779D-03, -.1911D-03, -.1333D-03, -.8977D-04, -.7579D-04, & + & -.4648D-04, -.3195D-04, -.1727D-04, -.1749D-04, -.1763D-04, & + & -.2736D-05, -.2805D-05, -.2852D-05, -.2884D-05, -.2906D-05, & + & -.2921D-05/ + + data (calcpts(j,26), j = 1,neta) /-.2004D-10, -.3564D-10, & + & -.6335D-10, -.1127D-09, -.2004D-09, -.3564D-09, -.6337D-09, & + & -.1127D-08, -.2003D-08, -.3563D-08, -.6337D-08, -.1127D-07, & + & -.2004D-07, -.3564D-07, -.6333D-07, -.1126D-06, -.2003D-06, & + & -.3561D-06, -.6329D-06, -.1125D-05, -.1998D-05, -.3548D-05, & + & -.6299D-05, -.1117D-04, -.1978D-04, -.3495D-04, -.6155D-04, & + & -.1080D-03, -.1883D-03, -.3252D-03, -.5547D-03, -.9297D-03, & + & -.1520D-02, -.2411D-02, -.3674D-02, -.5339D-02, -.7347D-02, & + & -.9529D-02, -.1161D-01, -.1327D-01, -.1426D-01, -.1446D-01, & + & -.1392D-01, -.1280D-01, -.1132D-01, -.9654D-02, -.7973D-02, & + & -.6401D-02, -.5014D-02, -.3846D-02, -.2905D-02, -.2154D-02, & + & -.1584D-02, -.1155D-02, -.8390D-03, -.6086D-03, -.4351D-03, & + & -.3045D-03, -.2176D-03, -.1596D-03, -.1160D-03, -.7199D-04, & + & -.5764D-04, -.4309D-04, -.2839D-04, -.1359D-04, -.1374D-04, & + & -.1383D-04, 0.1103D-05, 0.1059D-05, 0.1029D-05, 0.1008D-05, & + & 0.9939D-06/ + + data (calcpts(j,27), j = 1,neta) /-.1799D-10, -.3199D-10, & + & -.5687D-10, -.1011D-09, -.1799D-09, -.3199D-09, -.5688D-09, & + & -.1012D-08, -.1798D-08, -.3198D-08, -.5689D-08, -.1011D-07, & + & -.1799D-07, -.3199D-07, -.5685D-07, -.1011D-06, -.1798D-06, & + & -.3196D-06, -.5680D-06, -.1010D-05, -.1793D-05, -.3184D-05, & + & -.5652D-05, -.1002D-04, -.1774D-04, -.3134D-04, -.5516D-04, & + & -.9672D-04, -.1685D-03, -.2908D-03, -.4954D-03, -.8290D-03, & + & -.1353D-02, -.2141D-02, -.3255D-02, -.4719D-02, -.6487D-02, & + & -.8424D-02, -.1032D-01, -.1192D-01, -.1301D-01, -.1344D-01, & + & -.1320D-01, -.1239D-01, -.1116D-01, -.9702D-02, -.8158D-02, & + & -.6655D-02, -.5287D-02, -.4105D-02, -.3126D-02, -.2348D-02, & + & -.1730D-02, -.1269D-02, -.9212D-03, -.6598D-03, -.4856D-03, & + & -.3396D-03, -.2373D-03, -.1792D-03, -.1204D-03, -.9128D-04, & + & -.6187D-04, -.4727D-04, -.3254D-04, -.1772D-04, -.1785D-04, & + & -.1794D-04, -.2994D-05, -.3034D-05, -.3061D-05, -.3079D-05, & + & -.3092D-05/ + + data (calcpts(j,28), j = 1,neta) /-.1544D-10, -.2746D-10, & + & -.4881D-10, -.8681D-10, -.1544D-09, -.2746D-09, -.4882D-09, & + & -.8684D-09, -.1543D-08, -.2745D-08, -.4883D-08, -.8681D-08, & + & -.1544D-07, -.2746D-07, -.4879D-07, -.8677D-07, -.1543D-06, & + & -.2743D-06, -.4875D-06, -.8665D-06, -.1539D-05, -.2733D-05, & + & -.4850D-05, -.8597D-05, -.1522D-04, -.2688D-04, -.4730D-04, & + & -.8292D-04, -.1444D-03, -.2491D-03, -.4241D-03, -.7091D-03, & + & -.1156D-02, -.1827D-02, -.2774D-02, -.4016D-02, -.5514D-02, & + & -.7162D-02, -.8795D-02, -.1023D-01, -.1131D-01, -.1188D-01, & + & -.1190D-01, -.1140D-01, -.1049D-01, -.9302D-02, -.7977D-02, & + & -.6632D-02, -.5359D-02, -.4220D-02, -.3253D-02, -.2462D-02, & + & -.1836D-02, -.1352D-02, -.9877D-03, -.7146D-03, -.5141D-03, & + & -.3720D-03, -.2693D-03, -.1809D-03, -.1370D-03, -.9274D-04, & + & -.6324D-04, -.4859D-04, -.3382D-04, -.1898D-04, -.1909D-04, & + & -.1916D-04, -.4212D-05, -.4247D-05, -.4270D-05, -.4286D-05, & + & -.4297D-05/ + + data (calcpts(j,29), j = 1,neta) /-.1277D-10, -.2271D-10, & + & -.4036D-10, -.7178D-10, -.1277D-09, -.2270D-09, -.4037D-09, & + & -.7180D-09, -.1276D-08, -.2270D-08, -.4037D-08, -.7178D-08, & + & -.1276D-07, -.2270D-07, -.4034D-07, -.7175D-07, -.1276D-06, & + & -.2268D-06, -.4031D-06, -.7165D-06, -.1272D-05, -.2259D-05, & + & -.4010D-05, -.7107D-05, -.1258D-04, -.2222D-04, -.3910D-04, & + & -.6853D-04, -.1193D-03, -.2058D-03, -.3503D-03, -.5854D-03, & + & -.9541D-03, -.1507D-02, -.2286D-02, -.3306D-02, -.4536D-02, & + & -.5889D-02, -.7241D-02, -.8461D-02, -.9428D-02, -.1004D-01, & + & -.1024D-01, -.1001D-01, -.9412D-02, -.8529D-02, -.7474D-02, & + & -.6343D-02, -.5227D-02, -.4190D-02, -.3279D-02, -.2512D-02, & + & -.1892D-02, -.1404D-02, -.1030D-02, -.7499D-03, -.5410D-03, & + & -.3879D-03, -.2773D-03, -.1976D-03, -.1400D-03, -.9860D-04, & + & -.6902D-04, -.4830D-04, -.3499D-04, -.2462D-04, -.1721D-04, & + & -.1127D-04, -.8316D-05, -.5345D-05, -.3864D-05, -.2377D-05, & + & -.8862D-06/ + + data (calcpts(j,30), j = 1,neta) /-.1024D-10, -.1821D-10, & + & -.3237D-10, -.5758D-10, -.1024D-09, -.1821D-09, -.3238D-09, & + & -.5760D-09, -.1024D-08, -.1821D-08, -.3239D-08, -.5758D-08, & + & -.1024D-07, -.1821D-07, -.3236D-07, -.5755D-07, -.1023D-06, & + & -.1819D-06, -.3234D-06, -.5747D-06, -.1020D-05, -.1812D-05, & + & -.3216D-05, -.5701D-05, -.1009D-04, -.1782D-04, -.3136D-04, & + & -.5496D-04, -.9570D-04, -.1650D-03, -.2808D-03, -.4693D-03, & + & -.7646D-03, -.1207D-02, -.1830D-02, -.2646D-02, -.3629D-02, & + & -.4710D-02, -.5794D-02, -.6785D-02, -.7601D-02, -.8176D-02, & + & -.8465D-02, -.8438D-02, -.8102D-02, -.7507D-02, -.6725D-02, & + & -.5836D-02, -.4914D-02, -.4020D-02, -.3202D-02, -.2493D-02, & + & -.1900D-02, -.1425D-02, -.1054D-02, -.7710D-03, -.5599D-03, & + & -.4031D-03, -.2892D-03, -.2062D-03, -.1470D-03, -.1040D-03, & + & -.7278D-04, -.5201D-04, -.3717D-04, -.2527D-04, -.1784D-04, & + & -.1189D-04, -.8925D-05, -.5948D-05, -.4463D-05, -.2974D-05, & + & -.1481D-05/ + + data (calcpts(j,31), j = 1,neta) /-.8016D-11, -.1426D-10, & + & -.2534D-10, -.4507D-10, -.8017D-10, -.1425D-09, -.2535D-09, & + & -.4509D-09, -.8013D-09, -.1425D-08, -.2535D-08, -.4507D-08, & + & -.8015D-08, -.1425D-07, -.2533D-07, -.4505D-07, -.8011D-07, & + & -.1424D-06, -.2531D-06, -.4499D-06, -.7988D-06, -.1419D-05, & + & -.2518D-05, -.4462D-05, -.7897D-05, -.1395D-04, -.2455D-04, & + & -.4302D-04, -.7490D-04, -.1291D-03, -.2198D-03, -.3672D-03, & + & -.5983D-03, -.9443D-03, -.1432D-02, -.2069D-02, -.2837D-02, & + & -.3682D-02, -.4530D-02, -.5310D-02, -.5966D-02, -.6459D-02, & + & -.6762D-02, -.6850D-02, -.6712D-02, -.6358D-02, -.5827D-02, & + & -.5174D-02, -.4456D-02, -.3729D-02, -.3033D-02, -.2404D-02, & + & -.1863D-02, -.1415D-02, -.1057D-02, -.7793D-03, -.5689D-03, & + & -.4116D-03, -.2959D-03, -.2112D-03, -.1502D-03, -.1071D-03, & + & -.7589D-04, -.5357D-04, -.3719D-04, -.2677D-04, -.1933D-04, & + & -.1336D-04, -.8891D-05, -.5909D-05, -.4421D-05, -.2929D-05, & + & -.2935D-05/ + + data (calcpts(j,32), j = 1,neta) /-.6153D-11, -.1094D-10, & + & -.1945D-10, -.3459D-10, -.6154D-10, -.1094D-09, -.1946D-09, & + & -.3461D-09, -.6151D-09, -.1094D-08, -.1946D-08, -.3460D-08, & + & -.6152D-08, -.1094D-07, -.1944D-07, -.3458D-07, -.6149D-07, & + & -.1093D-06, -.1943D-06, -.3453D-06, -.6131D-06, -.1089D-05, & + & -.1932D-05, -.3425D-05, -.6062D-05, -.1071D-04, -.1884D-04, & + & -.3302D-04, -.5749D-04, -.9912D-04, -.1687D-03, -.2818D-03, & + & -.4591D-03, -.7246D-03, -.1099D-02, -.1588D-02, -.2176D-02, & + & -.2824D-02, -.3475D-02, -.4075D-02, -.4586D-02, -.4984D-02, & + & -.5256D-02, -.5390D-02, -.5373D-02, -.5197D-02, -.4872D-02, & + & -.4428D-02, -.3905D-02, -.3344D-02, -.2783D-02, -.2254D-02, & + & -.1778D-02, -.1372D-02, -.1039D-02, -.7750D-03, -.5700D-03, & + & -.4138D-03, -.2993D-03, -.2144D-03, -.1533D-03, -.1086D-03, & + & -.7733D-04, -.5347D-04, -.3856D-04, -.2663D-04, -.1917D-04, & + & -.1320D-04, -.8719D-05, -.5733D-05, -.4242D-05, -.2749D-05, & + & -.1253D-05/ + + data (calcpts(j,33), j = 1,neta) /-.4651D-11, -.8273D-11, & + & -.1470D-10, -.2615D-10, -.4652D-10, -.8272D-10, -.1471D-09, & + & -.2616D-09, -.4650D-09, -.8270D-09, -.1471D-08, -.2616D-08, & + & -.4651D-08, -.8272D-08, -.1470D-07, -.2614D-07, -.4649D-07, & + & -.8263D-07, -.1469D-06, -.2611D-06, -.4635D-06, -.8232D-06, & + & -.1461D-05, -.2589D-05, -.4583D-05, -.8095D-05, -.1424D-04, & + & -.2496D-04, -.4346D-04, -.7493D-04, -.1275D-03, -.2130D-03, & + & -.3471D-03, -.5478D-03, -.8304D-03, -.1200D-02, -.1645D-02, & + & -.2134D-02, -.2626D-02, -.3081D-02, -.3469D-02, -.3778D-02, & + & -.4002D-02, -.4138D-02, -.4179D-02, -.4117D-02, -.3944D-02, & + & -.3669D-02, -.3314D-02, -.2906D-02, -.2477D-02, -.2054D-02, & + & -.1656D-02, -.1304D-02, -.1003D-02, -.7573D-03, -.5638D-03, & + & -.4133D-03, -.3015D-03, -.2165D-03, -.1553D-03, -.1105D-03, & + & -.7918D-04, -.5679D-04, -.4036D-04, -.2840D-04, -.1944D-04, & + & -.1496D-04, -.1047D-04, -.7485D-05, -.5992D-05, -.4496D-05, & + & -.3000D-05/ + + data (calcpts(j,34), j = 1,neta) /-.3472D-11, -.6176D-11, & + & -.1098D-10, -.1952D-10, -.3473D-10, -.6175D-10, -.1098D-09, & + & -.1953D-09, -.3471D-09, -.6173D-09, -.1098D-08, -.1952D-08, & + & -.3472D-08, -.6174D-08, -.1097D-07, -.1951D-07, -.3470D-07, & + & -.6168D-07, -.1096D-06, -.1949D-06, -.3460D-06, -.6145D-06, & + & -.1091D-05, -.1933D-05, -.3421D-05, -.6042D-05, -.1063D-04, & + & -.1863D-04, -.3244D-04, -.5593D-04, -.9517D-04, -.1590D-03, & + & -.2591D-03, -.4089D-03, -.6198D-03, -.8957D-03, -.1228D-02, & + & -.1593D-02, -.1960D-02, -.2299D-02, -.2591D-02, -.2824D-02, & + & -.2999D-02, -.3116D-02, -.3176D-02, -.3172D-02, -.3097D-02, & + & -.2946D-02, -.2724D-02, -.2448D-02, -.2138D-02, -.1816D-02, & + & -.1499D-02, -.1206D-02, -.9455D-03, -.7251D-03, -.5463D-03, & + & -.4060D-03, -.2971D-03, -.2164D-03, -.1552D-03, -.1118D-03, & + & -.7894D-04, -.5651D-04, -.4007D-04, -.2810D-04, -.2063D-04, & + & -.1464D-04, -.1015D-04, -.7162D-05, -.5667D-05, -.4171D-05, & + & -.2673D-05/ + + data (calcpts(j,35), j = 1,neta) /-.2566D-11, -.4564D-11, & + & -.8112D-11, -.1443D-10, -.2566D-10, -.4563D-10, -.8115D-10, & + & -.1443D-09, -.2565D-09, -.4563D-09, -.8115D-09, -.1443D-08, & + & -.2566D-08, -.4563D-08, -.8110D-08, -.1442D-07, -.2565D-07, & + & -.4559D-07, -.8103D-07, -.1440D-06, -.2557D-06, -.4541D-06, & + & -.8060D-06, -.1428D-05, -.2528D-05, -.4466D-05, -.7857D-05, & + & -.1377D-04, -.2398D-04, -.4134D-04, -.7034D-04, -.1175D-03, & + & -.1915D-03, -.3022D-03, -.4581D-03, -.6620D-03, -.9073D-03, & + & -.1177D-02, -.1448D-02, -.1699D-02, -.1915D-02, -.2088D-02, & + & -.2220D-02, -.2314D-02, -.2371D-02, -.2391D-02, -.2369D-02, & + & -.2298D-02, -.2174D-02, -.2002D-02, -.1791D-02, -.1559D-02, & + & -.1320D-02, -.1086D-02, -.8718D-03, -.6811D-03, -.5214D-03, & + & -.3915D-03, -.2898D-03, -.2121D-03, -.1538D-03, -.1104D-03, & + & -.7900D-04, -.5655D-04, -.4009D-04, -.2812D-04, -.1914D-04, & + & -.1315D-04, -.1016D-04, -.7162D-05, -.4166D-05, -.2669D-05, & + & -.2670D-05/ + + data (calcpts(j,36), j = 1,neta) /-.1882D-11, -.3347D-11, & + & -.5949D-11, -.1058D-10, -.1882D-10, -.3347D-10, -.5951D-10, & + & -.1058D-09, -.1881D-09, -.3346D-09, -.5951D-09, -.1058D-08, & + & -.1882D-08, -.3346D-08, -.5947D-08, -.1058D-07, -.1881D-07, & + & -.3343D-07, -.5942D-07, -.1056D-06, -.1875D-06, -.3330D-06, & + & -.5911D-06, -.1048D-05, -.1854D-05, -.3275D-05, -.5762D-05, & + & -.1010D-04, -.1758D-04, -.3032D-04, -.5158D-04, -.8619D-04, & + & -.1404D-03, -.2216D-03, -.3359D-03, -.4854D-03, -.6654D-03, & + & -.8633D-03, -.1062D-02, -.1246D-02, -.1404D-02, -.1532D-02, & + & -.1630D-02, -.1701D-02, -.1749D-02, -.1774D-02, -.1776D-02, & + & -.1749D-02, -.1688D-02, -.1590D-02, -.1459D-02, -.1301D-02, & + & -.1129D-02, -.9534D-03, -.7830D-03, -.6264D-03, -.4890D-03, & + & -.3735D-03, -.2808D-03, -.2075D-03, -.1506D-03, -.1102D-03, & + & -.7874D-04, -.5628D-04, -.3981D-04, -.2783D-04, -.2034D-04, & + & -.1435D-04, -.9859D-05, -.6863D-05, -.5366D-05, -.3868D-05, & + & -.2369D-05/ + + data (calcpts(j,37), j = 1,neta) /-.1371D-11, -.2439D-11, & + & -.4334D-11, -.7709D-11, -.1371D-10, -.2438D-10, -.4336D-10, & + & -.7711D-10, -.1371D-09, -.2438D-09, -.4336D-09, -.7709D-09, & + & -.1371D-08, -.2438D-08, -.4333D-08, -.7705D-08, -.1370D-07, & + & -.2436D-07, -.4329D-07, -.7695D-07, -.1366D-06, -.2426D-06, & + & -.4306D-06, -.7632D-06, -.1351D-05, -.2386D-05, -.4198D-05, & + & -.7357D-05, -.1281D-04, -.2209D-04, -.3758D-04, -.6279D-04, & + & -.1023D-03, -.1614D-03, -.2447D-03, -.3537D-03, -.4847D-03, & + & -.6290D-03, -.7738D-03, -.9079D-03, -.1023D-02, -.1116D-02, & + & -.1188D-02, -.1241D-02, -.1278D-02, -.1300D-02, -.1310D-02, & + & -.1304D-02, -.1279D-02, -.1230D-02, -.1155D-02, -.1056D-02, & + & -.9399D-03, -.8136D-03, -.6854D-03, -.5616D-03, -.4483D-03, & + & -.3493D-03, -.2664D-03, -.1995D-03, -.1473D-03, -.1075D-03, & + & -.7764D-04, -.5563D-04, -.3960D-04, -.2821D-04, -.1997D-04, & + & -.1398D-04, -.9931D-05, -.6934D-05, -.4836D-05, -.3337D-05, & + & -.2438D-05/ + + data (calcpts(j,38), j = 1,neta) /-.9934D-12, -.1767D-11, & + & -.3141D-11, -.5586D-11, -.9935D-11, -.1767D-10, -.3141D-10, & + & -.5587D-10, -.9931D-10, -.1766D-09, -.3142D-09, -.5586D-09, & + & -.9933D-09, -.1767D-08, -.3140D-08, -.5583D-08, -.9929D-08, & + & -.1765D-07, -.3137D-07, -.5575D-07, -.9899D-07, -.1758D-06, & + & -.3120D-06, -.5530D-06, -.9787D-06, -.1729D-05, -.3042D-05, & + & -.5331D-05, -.9282D-05, -.1600D-04, -.2723D-04, -.4550D-04, & + & -.7412D-04, -.1170D-03, -.1773D-03, -.2563D-03, -.3512D-03, & + & -.4557D-03, -.5607D-03, -.6578D-03, -.7414D-03, -.8089D-03, & + & -.8609D-03, -.8995D-03, -.9269D-03, -.9453D-03, -.9557D-03, & + & -.9577D-03, -.9496D-03, -.9282D-03, -.8901D-03, -.8338D-03, & + & -.7607D-03, -.6755D-03, -.5835D-03, -.4905D-03, -.4011D-03, & + & -.3196D-03, -.2487D-03, -.1892D-03, -.1416D-03, -.1043D-03, & + & -.7596D-04, -.5468D-04, -.3924D-04, -.2785D-04, -.1976D-04, & + & -.1391D-04, -.9717D-05, -.6869D-05, -.4771D-05, -.3272D-05, & + & -.2223D-05/ + + data (calcpts(j,39), j = 1,neta) /-.7169D-12, -.1275D-11, & + & -.2266D-11, -.4031D-11, -.7170D-11, -.1275D-10, -.2267D-10, & + & -.4032D-10, -.7167D-10, -.1275D-09, -.2267D-09, -.4031D-09, & + & -.7168D-09, -.1275D-08, -.2266D-08, -.4029D-08, -.7165D-08, & + & -.1274D-07, -.2264D-07, -.4023D-07, -.7144D-07, -.1269D-06, & + & -.2252D-06, -.3991D-06, -.7063D-06, -.1248D-05, -.2195D-05, & + & -.3847D-05, -.6698D-05, -.1155D-04, -.1965D-04, -.3283D-04, & + & -.5349D-04, -.8442D-04, -.1280D-03, -.1849D-03, -.2535D-03, & + & -.3289D-03, -.4046D-03, -.4747D-03, -.5350D-03, -.5838D-03, & + & -.6214D-03, -.6493D-03, -.6694D-03, -.6833D-03, -.6921D-03, & + & -.6963D-03, -.6953D-03, -.6874D-03, -.6703D-03, -.6414D-03, & + & -.5995D-03, -.5460D-03, -.4838D-03, -.4172D-03, -.3501D-03, & + & -.2859D-03, -.2275D-03, -.1767D-03, -.1343D-03, -.1003D-03, & + & -.7396D-04, -.5387D-04, -.3888D-04, -.2779D-04, -.1985D-04, & + & -.1415D-04, -.9951D-05, -.7103D-05, -.5004D-05, -.3504D-05, & + & -.2455D-05/ + + data (calcpts(j,40), j = 1,neta) /-.5152D-12, -.9164D-12, & + & -.1629D-11, -.2897D-11, -.5153D-11, -.9162D-11, -.1629D-10, & + & -.2898D-10, -.5150D-10, -.9160D-10, -.1629D-09, -.2897D-09, & + & -.5151D-09, -.9162D-09, -.1628D-08, -.2896D-08, -.5149D-08, & + & -.9153D-08, -.1627D-07, -.2892D-07, -.5134D-07, -.9118D-07, & + & -.1618D-06, -.2868D-06, -.5076D-06, -.8966D-06, -.1578D-05, & + & -.2765D-05, -.4814D-05, -.8300D-05, -.1412D-04, -.2360D-04, & + & -.3844D-04, -.6067D-04, -.9197D-04, -.1329D-03, -.1822D-03, & + & -.2364D-03, -.2908D-03, -.3412D-03, -.3845D-03, -.4195D-03, & + & -.4466D-03, -.4667D-03, -.4812D-03, -.4914D-03, -.4982D-03, & + & -.5023D-03, -.5036D-03, -.5016D-03, -.4949D-03, -.4816D-03, & + & -.4601D-03, -.4293D-03, -.3903D-03, -.3453D-03, -.2974D-03, & + & -.2490D-03, -.2031D-03, -.1614D-03, -.1251D-03, -.9502D-04, & + & -.7088D-04, -.5215D-04, -.3790D-04, -.2726D-04, -.1946D-04, & + & -.1392D-04, -.9867D-05, -.7018D-05, -.4919D-05, -.3420D-05, & + & -.2520D-05/ + + data (calcpts(j,41), j = 1,neta) /-.3691D-12, -.6564D-12, & + & -.1167D-11, -.2075D-11, -.3691D-11, -.6563D-11, -.1167D-10, & + & -.2076D-10, -.3689D-10, -.6562D-10, -.1167D-09, -.2075D-09, & + & -.3690D-09, -.6563D-09, -.1166D-08, -.2074D-08, -.3689D-08, & + & -.6557D-08, -.1165D-07, -.2071D-07, -.3678D-07, -.6531D-07, & + & -.1159D-06, -.2054D-06, -.3636D-06, -.6423D-06, -.1130D-05, & + & -.1980D-05, -.3448D-05, -.5945D-05, -.1012D-04, -.1690D-04, & + & -.2754D-04, -.4346D-04, -.6588D-04, -.9520D-04, -.1305D-03, & + & -.1693D-03, -.2083D-03, -.2444D-03, -.2754D-03, -.3005D-03, & + & -.3199D-03, -.3343D-03, -.3447D-03, -.3521D-03, -.3572D-03, & + & -.3605D-03, -.3622D-03, -.3623D-03, -.3602D-03, -.3548D-03, & + & -.3448D-03, -.3289D-03, -.3064D-03, -.2782D-03, -.2458D-03, & + & -.2112D-03, -.1768D-03, -.1440D-03, -.1142D-03, -.8838D-04, & + & -.6709D-04, -.5000D-04, -.3666D-04, -.2661D-04, -.1911D-04, & + & -.1372D-04, -.9668D-05, -.6819D-05, -.4869D-05, -.3370D-05, & + & -.2320D-05/ + + data (calcpts(j,42), j = 1,neta) /-.2637D-12, -.4690D-12, & + & -.8337D-12, -.1483D-11, -.2637D-11, -.4689D-11, -.8339D-11, & + & -.1483D-10, -.2636D-10, -.4689D-10, -.8340D-10, -.1483D-09, & + & -.2637D-09, -.4689D-09, -.8334D-09, -.1482D-08, -.2636D-08, & + & -.4685D-08, -.8327D-08, -.1480D-07, -.2628D-07, -.4667D-07, & + & -.8282D-07, -.1468D-06, -.2598D-06, -.4589D-06, -.8074D-06, & + & -.1415D-05, -.2464D-05, -.4248D-05, -.7228D-05, -.1208D-04, & + & -.1967D-04, -.3105D-04, -.4707D-04, -.6802D-04, -.9323D-04, & + & -.1210D-03, -.1488D-03, -.1746D-03, -.1968D-03, -.2147D-03, & + & -.2286D-03, -.2389D-03, -.2463D-03, -.2516D-03, -.2553D-03, & + & -.2578D-03, -.2593D-03, -.2600D-03, -.2596D-03, -.2577D-03, & + & -.2536D-03, -.2462D-03, -.2345D-03, -.2182D-03, -.1978D-03, & + & -.1746D-03, -.1499D-03, -.1253D-03, -.1018D-03, -.8068D-04, & + & -.6239D-04, -.4724D-04, -.3525D-04, -.2580D-04, -.1875D-04, & + & -.1350D-04, -.9603D-05, -.6754D-05, -.4804D-05, -.3455D-05, & + & -.2405D-05/ + + data (calcpts(j,43), j = 1,neta) /-.1880D-12, -.3343D-12, & + & -.5942D-12, -.1057D-11, -.1880D-11, -.3342D-11, -.5944D-11, & + & -.1057D-10, -.1879D-10, -.3342D-10, -.5944D-10, -.1057D-09, & + & -.1879D-09, -.3342D-09, -.5940D-09, -.1056D-08, -.1878D-08, & + & -.3339D-08, -.5935D-08, -.1055D-07, -.1873D-07, -.3326D-07, & + & -.5903D-07, -.1046D-06, -.1852D-06, -.3271D-06, -.5755D-06, & + & -.1009D-05, -.1756D-05, -.3028D-05, -.5152D-05, -.8608D-05, & + & -.1402D-04, -.2213D-04, -.3355D-04, -.4848D-04, -.6645D-04, & + & -.8622D-04, -.1061D-03, -.1245D-03, -.1403D-03, -.1530D-03, & + & -.1629D-03, -.1703D-03, -.1756D-03, -.1794D-03, -.1820D-03, & + & -.1838D-03, -.1850D-03, -.1857D-03, -.1859D-03, -.1854D-03, & + & -.1838D-03, -.1807D-03, -.1753D-03, -.1668D-03, -.1550D-03, & + & -.1404D-03, -.1238D-03, -.1061D-03, -.8858D-04, -.7196D-04, & + & -.5695D-04, -.4401D-04, -.3330D-04, -.2475D-04, -.1815D-04, & + & -.1320D-04, -.9453D-05, -.6753D-05, -.4804D-05, -.3304D-05, & + & -.2404D-05/ + + data (calcpts(j,44), j = 1,neta) /-.1337D-12, -.2377D-12, & + & -.4225D-12, -.7515D-12, -.1337D-11, -.2377D-11, -.4227D-11, & + & -.7518D-11, -.1336D-10, -.2376D-10, -.4227D-10, -.7516D-10, & + & -.1336D-09, -.2377D-09, -.4224D-09, -.7512D-09, -.1336D-08, & + & -.2374D-08, -.4220D-08, -.7501D-08, -.1332D-07, -.2365D-07, & + & -.4198D-07, -.7440D-07, -.1317D-06, -.2326D-06, -.4092D-06, & + & -.7172D-06, -.1249D-05, -.2153D-05, -.3664D-05, -.6121D-05, & + & -.9972D-05, -.1574D-04, -.2386D-04, -.3448D-04, -.4726D-04, & + & -.6132D-04, -.7544D-04, -.8851D-04, -.9975D-04, -.1088D-03, & + & -.1159D-03, -.1211D-03, -.1249D-03, -.1276D-03, -.1294D-03, & + & -.1307D-03, -.1316D-03, -.1322D-03, -.1325D-03, -.1324D-03, & + & -.1320D-03, -.1308D-03, -.1285D-03, -.1245D-03, -.1184D-03, & + & -.1099D-03, -.9945D-04, -.8755D-04, -.7500D-04, -.6253D-04, & + & -.5075D-04, -.4011D-04, -.3097D-04, -.2341D-04, -.1738D-04, & + & -.1273D-04, -.9203D-05, -.6594D-05, -.4704D-05, -.3324D-05, & + & -.2349D-05/ + + data (calcpts(j,45), j = 1,neta) /-.9491D-13, -.1688D-12, & + & -.3000D-12, -.5336D-12, -.9492D-12, -.1688D-11, -.3001D-11, & + & -.5338D-11, -.9488D-11, -.1687D-10, -.3001D-10, -.5337D-10, & + & -.9489D-10, -.1688D-09, -.2999D-09, -.5334D-09, -.9485D-09, & + & -.1686D-08, -.2997D-08, -.5326D-08, -.9457D-08, -.1680D-07, & + & -.2981D-07, -.5283D-07, -.9350D-07, -.1652D-06, -.2906D-06, & + & -.5093D-06, -.8867D-06, -.1529D-05, -.2601D-05, -.4347D-05, & + & -.7081D-05, -.1118D-04, -.1694D-04, -.2448D-04, -.3355D-04, & + & -.4354D-04, -.5356D-04, -.6285D-04, -.7083D-04, -.7728D-04, & + & -.8226D-04, -.8597D-04, -.8866D-04, -.9058D-04, -.9192D-04, & + & -.9285D-04, -.9349D-04, -.9391D-04, -.9416D-04, -.9426D-04, & + & -.9416D-04, -.9377D-04, -.9288D-04, -.9118D-04, -.8830D-04, & + & -.8390D-04, -.7785D-04, -.7036D-04, -.6189D-04, -.5297D-04, & + & -.4413D-04, -.3577D-04, -.2826D-04, -.2180D-04, -.1647D-04, & + & -.1223D-04, -.8957D-05, -.6482D-05, -.4652D-05, -.3317D-05, & + & -.2357D-05/ + + data (calcpts(j,46), j = 1,neta) /-.6725D-13, -.1196D-12, & + & -.2126D-12, -.3781D-12, -.6726D-12, -.1196D-11, -.2127D-11, & + & -.3782D-11, -.6723D-11, -.1196D-10, -.2127D-10, -.3781D-10, & + & -.6724D-10, -.1196D-09, -.2125D-09, -.3779D-09, -.6721D-09, & + & -.1195D-08, -.2123D-08, -.3774D-08, -.6701D-08, -.1190D-07, & + & -.2112D-07, -.3743D-07, -.6625D-07, -.1170D-06, -.2059D-06, & + & -.3609D-06, -.6283D-06, -.1083D-05, -.1843D-05, -.3080D-05, & + & -.5017D-05, -.7918D-05, -.1200D-04, -.1735D-04, -.2378D-04, & + & -.3085D-04, -.3795D-04, -.4453D-04, -.5019D-04, -.5476D-04, & + & -.5829D-04, -.6092D-04, -.6282D-04, -.6418D-04, -.6513D-04, & + & -.6579D-04, -.6625D-04, -.6655D-04, -.6675D-04, -.6686D-04, & + & -.6688D-04, -.6678D-04, -.6647D-04, -.6581D-04, -.6457D-04, & + & -.6250D-04, -.5934D-04, -.5502D-04, -.4969D-04, -.4366D-04, & + & -.3733D-04, -.3106D-04, -.2517D-04, -.1986D-04, -.1530D-04, & + & -.1155D-04, -.8567D-05, -.6258D-05, -.4533D-05, -.3243D-05, & + & -.2313D-05/ + + data (calcpts(j,47), j = 1,neta) /-.4757D-13, -.8461D-13, & + & -.1504D-12, -.2675D-12, -.4758D-12, -.8460D-12, -.1504D-11, & + & -.2676D-11, -.4756D-11, -.8458D-11, -.1504D-10, -.2675D-10, & + & -.4757D-10, -.8460D-10, -.1503D-09, -.2674D-09, -.4755D-09, & + & -.8451D-09, -.1502D-08, -.2670D-08, -.4740D-08, -.8419D-08, & + & -.1494D-07, -.2648D-07, -.4687D-07, -.8278D-07, -.1457D-06, & + & -.2553D-06, -.4445D-06, -.7663D-06, -.1304D-05, -.2179D-05, & + & -.3549D-05, -.5602D-05, -.8492D-05, -.1227D-04, -.1682D-04, & + & -.2182D-04, -.2685D-04, -.3150D-04, -.3550D-04, -.3874D-04, & + & -.4123D-04, -.4309D-04, -.4444D-04, -.4540D-04, -.4608D-04, & + & -.4654D-04, -.4687D-04, -.4709D-04, -.4723D-04, -.4733D-04, & + & -.4737D-04, -.4736D-04, -.4726D-04, -.4703D-04, -.4654D-04, & + & -.4565D-04, -.4416D-04, -.4190D-04, -.3882D-04, -.3503D-04, & + & -.3075D-04, -.2629D-04, -.2185D-04, -.1768D-04, -.1394D-04, & + & -.1073D-04, -.8092D-05, -.5992D-05, -.4372D-05, -.3157D-05, & + & -.2257D-05/ + + data (calcpts(j,48), j = 1,neta) /-.3361D-13, -.5979D-13, & + & -.1063D-12, -.1890D-12, -.3362D-12, -.5977D-12, -.1063D-11, & + & -.1891D-11, -.3360D-11, -.5976D-11, -.1063D-10, -.1890D-10, & + & -.3361D-10, -.5977D-10, -.1062D-09, -.1889D-09, -.3359D-09, & + & -.5971D-09, -.1061D-08, -.1886D-08, -.3349D-08, -.5948D-08, & + & -.1056D-07, -.1871D-07, -.3312D-07, -.5849D-07, -.1029D-06, & + & -.1804D-06, -.3141D-06, -.5415D-06, -.9213D-06, -.1539D-05, & + & -.2508D-05, -.3958D-05, -.6000D-05, -.8671D-05, -.1188D-04, & + & -.1542D-04, -.1897D-04, -.2226D-04, -.2509D-04, -.2737D-04, & + & -.2914D-04, -.3045D-04, -.3140D-04, -.3208D-04, -.3256D-04, & + & -.3289D-04, -.3311D-04, -.3327D-04, -.3338D-04, -.3345D-04, & + & -.3349D-04, -.3350D-04, -.3348D-04, -.3341D-04, -.3323D-04, & + & -.3288D-04, -.3224D-04, -.3117D-04, -.2956D-04, -.2737D-04, & + & -.2468D-04, -.2165D-04, -.1849D-04, -.1536D-04, -.1242D-04, & + & -.9778D-05, -.7528D-05, -.5668D-05, -.4198D-05, -.3058D-05, & + & -.2218D-05/ + + data (calcpts(j,49), j = 1,neta) /-.2372D-13, -.4218D-13, & + & -.7498D-13, -.1334D-12, -.2372D-12, -.4218D-12, -.7500D-12, & + & -.1334D-11, -.2371D-11, -.4217D-11, -.7501D-11, -.1334D-10, & + & -.2371D-10, -.4218D-10, -.7495D-10, -.1333D-09, -.2370D-09, & + & -.4213D-09, -.7489D-09, -.1331D-08, -.2363D-08, -.4197D-08, & + & -.7449D-08, -.1320D-07, -.2337D-07, -.4127D-07, -.7262D-07, & + & -.1273D-06, -.2216D-06, -.3821D-06, -.6501D-06, -.1086D-05, & + & -.1770D-05, -.2793D-05, -.4234D-05, -.6118D-05, -.8385D-05, & + & -.1088D-04, -.1339D-04, -.1571D-04, -.1770D-04, -.1931D-04, & + & -.2056D-04, -.2149D-04, -.2216D-04, -.2264D-04, -.2297D-04, & + & -.2320D-04, -.2337D-04, -.2348D-04, -.2355D-04, -.2360D-04, & + & -.2364D-04, -.2365D-04, -.2366D-04, -.2363D-04, -.2358D-04, & + & -.2345D-04, -.2319D-04, -.2273D-04, -.2197D-04, -.2083D-04, & + & -.1927D-04, -.1737D-04, -.1523D-04, -.1299D-04, -.1078D-04, & + & -.8717D-05, -.6857D-05, -.5267D-05, -.3962D-05, -.2942D-05, & + & -.2147D-05/ + + data (dlaeta(j), j = 1,neta) / & + & -6d0, -5.83333333d0, -5.66666667d0, -5.5d0, -5.33333333d0, & + & -5.16666667d0, -5d0, -4.83333333d0, -4.66666667d0, -4.5d0, & + & -4.33333333d0, -4.16666667d0, -4d0, -3.83333333d0, & + & -3.66666667d0, -3.5d0, -3.33333333d0, -3.16666667d0, -3d0, & + & -2.83333333d0, -2.66666667d0, -2.5d0, -2.33333333d0, & + & -2.16666667d0, -2d0, -1.83333333d0, -1.66666667d0, -1.5d0, & + & -1.33333333d0, -1.16666667d0, -1d0, -0.83333333d0, -0.66666667d0,& + & -0.5d0, -0.33333333d0, -0.16666667d0, 0d0, 0.16666667d0, & + & 0.33333333d0, 0.5d0, 0.66666667d0, 0.83333333d0, 1d0, & + & 1.16666667d0, 1.33333333d0, 1.5d0, 1.66666667d0, 1.83333333d0, & + & 2d0, 2.16666667d0, 2.33333333d0, 2.5d0, 2.66666667d0, & + & 2.83333333d0, 3d0, 3.16666667d0, 3.33333333d0, 3.5d0, & + & 3.66666667d0, 3.83333333d0, 4d0, 4.16666667d0, 4.33333333d0, & + & 4.5d0, 4.66666667d0, 4.83333333d0, 5d0, 5.16666667d0, & + & 5.33333333d0, 5.5d0, 5.66666667d0, 5.83333333d0, 6d0/ + + data (dlaxi(j), j = 1,nxi) / & + & -3d0, -2.83333333d0, -2.66666667d0, -2.5d0, -2.33333333d0, & + & -2.16666667d0, -2d0, -1.83333333d0, -1.66666667d0, -1.5d0, & + & -1.33333333d0, -1.16666667d0, -1d0, -0.83333333d0, -0.66666667d0,& + & -0.5d0, -0.33333333d0, -0.16666667d0, 0d0, 0.16666667d0, & + & 0.33333333d0, 0.5d0, 0.66666667d0, 0.83333333d0, 1d0, & + & 1.16666667d0, 1.33333333d0, 1.5d0, 1.66666667d0, 1.83333333d0, & + & 2d0, 2.16666667d0, 2.33333333d0, 2.5d0, 2.66666667d0, & + & 2.83333333d0, 3d0, 3.16666667d0, 3.33333333d0, 3.5d0, & + & 3.66666667d0, 3.83333333d0, 4d0, 4.16666667d0, 4.33333333d0, & + & 4.5d0, 4.66666667d0, 4.83333333d0, 5d0/ + + dleta = dlog10(eta) + dlxi = dlog10(xi) + if (dlxi .le. dlaxi(1)) dlxi = dlaxi(1) + if (dlxi .ge. dlaxi(nxi)) dlxi = dlaxi(nxi) + if (dleta .ge. dlaeta(neta)) dleta = dlaeta(neta) + if (dleta .le. dlaeta(1)) dleta = dlaeta(1) + call locate(dlaeta,neta, dleta, ieta) + call locate(dlaxi, nxi, dlxi, ixi) +! interpolating between the appropriate points + delxi = 1d0/6d0 + deleta = 1d0/6d0 +! lagrange 3-pt. + if (ixi .le. 2) ixi = 2 + if (ixi .ge. 48) ixi = 48 + if (ieta .le. 2) ieta = 2 + if (ieta .ge. 72) ieta = 72 + pxi = (dlxi - dlaxi(ixi))/delxi + f(-1) = pxi*(pxi-1d0)/2d0*calcpts(ieta-1,ixi-1) + & + & (1d0 - pxi**2)*calcpts(ieta-1,ixi) + & + & pxi*(pxi+1d0)/2d0*calcpts(ieta-1,ixi+1) + f(0) = pxi*(pxi-1d0)/2d0*calcpts(ieta,ixi-1) + & + & (1d0 - pxi**2)*calcpts(ieta,ixi) + & + & pxi*(pxi+1d0)/2d0*calcpts(ieta,ixi+1) + f(1) = pxi*(pxi-1d0)/2d0*calcpts(ieta+1,ixi-1) + & + & (1d0 - pxi**2)*calcpts(ieta+1,ixi) + & + & pxi*(pxi+1d0)/2d0*calcpts(ieta+1,ixi+1) + peta = (dleta - dlaeta(ieta))/deleta + h1_HLq = peta*(peta-1d0)/2d0*f(-1) + & + & (1d0 - peta**2)*f(0) + & + & peta*(peta+1d0)/2d0*f(1) +!MB + + peta*(peta+1d0)/2d0*f(1) + return + END + +! =========================================== + double precision function h1bar_HLq(eta,xi) +! =========================================== + +! eq (27) in PLB347 (1995) 143 - 151 for the transverse piece +! MSbar scheme +! This routine is called subcqhlbar in the original code. +! Called sqlbar in updated code (03/06/96). + + implicit none + integer neta, nxi + parameter (neta = 73, nxi = 49) + double precision calcpts(neta, nxi), dlaeta(neta), dlaxi(nxi) + double precision eta, xi, dleta, dlxi + double precision pxi, peta, f(-1:1), delxi, deleta + integer j, ieta, ixi + + data (calcpts(j, 1), j = 1,neta) /0.7071D-14, 0.1258D-13, & + & 0.2235D-13, 0.3975D-13, 0.7071D-13, 0.1257D-12, 0.2236D-12, & + & 0.3977D-12, 0.7068D-12, 0.1257D-11, 0.2236D-11, 0.3975D-11, & + & 0.7068D-11, 0.1257D-10, 0.2234D-10, 0.3972D-10, 0.7062D-10, & + & 0.1255D-09, 0.2229D-09, 0.3959D-09, 0.7023D-09, 0.1245D-08, & + & 0.2205D-08, 0.3896D-08, 0.6863D-08, 0.1204D-07, 0.2097D-07, & + & 0.3623D-07, 0.6178D-07, 0.1034D-06, 0.1688D-06, 0.2662D-06, & + & 0.4012D-06, 0.5725D-06, 0.7658D-06, 0.9555D-06, 0.1113D-05, & + & 0.1217D-05, 0.1255D-05, 0.1223D-05, 0.1129D-05, 0.9890D-06, & + & 0.8246D-06, 0.6585D-06, 0.5077D-06, 0.3804D-06, 0.2780D-06, & + & 0.2007D-06, 0.1423D-06, 0.1004D-06, 0.6907D-07, 0.4861D-07, & + & 0.3374D-07, 0.2298D-07, 0.1593D-07, 0.1030D-07, 0.8102D-08, & + & 0.5170D-08, 0.3239D-08, 0.2466D-08, 0.1462D-08, 0.1800D-08, & + & 0.5305D-09, 0.6874D-09, 0.7944D-09, 0.8672D-09, 0.9168D-09, & + & -.5494D-09, -.5264D-09, -.5107D-09, -.5000D-09, -.4927D-09, & + & -.4878D-09/ + + data (calcpts(j, 2), j = 1,neta) /0.1038D-13, 0.1846D-13, & + & 0.3281D-13, 0.5835D-13, 0.1038D-12, 0.1845D-12, 0.3282D-12, & + & 0.5837D-12, 0.1037D-11, 0.1845D-11, 0.3282D-11, 0.5835D-11, & + & 0.1037D-10, 0.1845D-10, 0.3279D-10, 0.5829D-10, 0.1036D-09, & + & 0.1842D-09, 0.3272D-09, 0.5811D-09, 0.1031D-08, 0.1828D-08, & + & 0.3237D-08, 0.5718D-08, 0.1007D-07, 0.1767D-07, 0.3078D-07, & + & 0.5317D-07, 0.9068D-07, 0.1518D-06, 0.2477D-06, 0.3907D-06, & + & 0.5888D-06, 0.8403D-06, 0.1124D-05, 0.1403D-05, 0.1635D-05, & + & 0.1788D-05, 0.1841D-05, 0.1796D-05, 0.1658D-05, 0.1451D-05, & + & 0.1210D-05, 0.9677D-06, 0.7471D-06, 0.5589D-06, 0.4104D-06, & + & 0.2951D-06, 0.2097D-06, 0.1473D-06, 0.1041D-06, 0.7141D-07, & + & 0.4950D-07, 0.3464D-07, 0.2390D-07, 0.1685D-07, 0.1272D-07, & + & 0.9026D-08, 0.6095D-08, 0.5663D-08, 0.3391D-08, 0.3887D-08, & + & 0.2724D-08, 0.2955D-08, 0.1612D-08, 0.1719D-08, 0.1791D-08, & + & 0.1841D-08, 0.1875D-08, 0.1898D-08, 0.1913D-08, 0.1924D-08, & + & 0.1931D-08/ + + data (calcpts(j, 3), j = 1,neta) /0.1522D-13, 0.2708D-13, & + & 0.4812D-13, 0.8559D-13, 0.1522D-12, 0.2707D-12, 0.4814D-12, & + & 0.8562D-12, 0.1522D-11, 0.2706D-11, 0.4814D-11, 0.8559D-11, & + & 0.1522D-10, 0.2706D-10, 0.4809D-10, 0.8551D-10, 0.1520D-09, & + & 0.2701D-09, 0.4799D-09, 0.8524D-09, 0.1512D-08, 0.2681D-08, & + & 0.4748D-08, 0.8388D-08, 0.1478D-07, 0.2592D-07, 0.4515D-07, & + & 0.7800D-07, 0.1330D-06, 0.2226D-06, 0.3633D-06, 0.5731D-06, & + & 0.8638D-06, 0.1233D-05, 0.1649D-05, 0.2058D-05, 0.2397D-05, & + & 0.2621D-05, 0.2701D-05, 0.2633D-05, 0.2429D-05, 0.2126D-05, & + & 0.1772D-05, 0.1416D-05, 0.1091D-05, 0.8163D-06, 0.5969D-06, & + & 0.4288D-06, 0.3029D-06, 0.2122D-06, 0.1470D-06, 0.1055D-06, & + & 0.6832D-07, 0.3893D-07, 0.3458D-07, 0.2684D-07, 0.1679D-07, & + & 0.5163D-08, 0.7463D-08, 0.9030D-08, -.4902D-08, -.4174D-08, & + & -.3679D-08, -.3341D-08, -.3111D-08, -.2954D-08, -.2847D-08, & + & -.2774D-08, -.2725D-08, -.2691D-08, -.2668D-08, -.2652D-08, & + & -.2642D-08/ + + data (calcpts(j, 4), j = 1,neta) /0.2234D-13, 0.3973D-13, & + & 0.7061D-13, 0.1256D-12, 0.2234D-12, 0.3972D-12, 0.7063D-12, & + & 0.1256D-11, 0.2233D-11, 0.3971D-11, 0.7063D-11, 0.1256D-10, & + & 0.2233D-10, 0.3971D-10, 0.7057D-10, 0.1255D-09, 0.2231D-09, & + & 0.3964D-09, 0.7042D-09, 0.1251D-08, 0.2219D-08, 0.3934D-08, & + & 0.6967D-08, 0.1231D-07, 0.2168D-07, 0.3803D-07, 0.6626D-07, & + & 0.1145D-06, 0.1952D-06, 0.3267D-06, 0.5332D-06, 0.8410D-06, & + & 0.1268D-05, 0.1809D-05, 0.2420D-05, 0.3020D-05, 0.3519D-05, & + & 0.3848D-05, 0.3965D-05, 0.3865D-05, 0.3568D-05, 0.3128D-05, & + & 0.2606D-05, 0.2084D-05, 0.1606D-05, 0.1202D-05, 0.8735D-06, & + & 0.6284D-06, 0.4504D-06, 0.3150D-06, 0.2217D-06, 0.1508D-06, & + & 0.1093D-06, 0.7222D-07, 0.4284D-07, 0.3850D-07, 0.1576D-07, & + & 0.2071D-07, 0.9091D-08, 0.1139D-07, -.2043D-08, -.9755D-09, & + & -.2487D-09, 0.2471D-09, 0.5849D-09, 0.8149D-09, 0.9716D-09, & + & 0.1078D-08, 0.1151D-08, 0.1201D-08, 0.1234D-08, 0.1257D-08, & + & 0.1273D-08/ + + data (calcpts(j, 5), j = 1,neta) /0.3277D-13, 0.5829D-13, & + & 0.1036D-12, 0.1843D-12, 0.3277D-12, 0.5827D-12, 0.1036D-11, & + & 0.1843D-11, 0.3276D-11, 0.5826D-11, 0.1036D-10, 0.1842D-10, & + & 0.3276D-10, 0.5826D-10, 0.1035D-09, 0.1841D-09, 0.3273D-09, & + & 0.5816D-09, 0.1033D-08, 0.1835D-08, 0.3255D-08, 0.5772D-08, & + & 0.1022D-07, 0.1806D-07, 0.3181D-07, 0.5580D-07, 0.9721D-07, & + & 0.1679D-06, 0.2864D-06, 0.4793D-06, 0.7823D-06, 0.1234D-05, & + & 0.1860D-05, 0.2655D-05, 0.3553D-05, 0.4433D-05, 0.5166D-05, & + & 0.5649D-05, 0.5822D-05, 0.5680D-05, 0.5241D-05, 0.4590D-05, & + & 0.3820D-05, 0.3061D-05, 0.2354D-05, 0.1770D-05, 0.1289D-05, & + & 0.9368D-06, 0.6648D-06, 0.4732D-06, 0.3234D-06, 0.2304D-06, & + & 0.1596D-06, 0.1032D-06, 0.8115D-07, 0.5179D-07, 0.3243D-07, & + & 0.2470D-07, 0.1466D-07, 0.1803D-07, 0.5327D-08, 0.6894D-08, & + & 0.7960D-08, 0.8687D-08, 0.9183D-08, 0.9520D-08, 0.9750D-08, & + & 0.9907D-08, 0.1001D-07, 0.1009D-07, 0.1014D-07, 0.1017D-07, & + & 0.1019D-07/ + + data (calcpts(j, 6), j = 1,neta) /0.4805D-13, 0.8547D-13, & + & 0.1519D-12, 0.2702D-12, 0.4806D-12, 0.8545D-12, 0.1519D-11, & + & 0.2703D-11, 0.4803D-11, 0.8543D-11, 0.1520D-10, 0.2702D-10, & + & 0.4804D-10, 0.8543D-10, 0.1518D-09, 0.2699D-09, 0.4799D-09, & + & 0.8528D-09, 0.1515D-08, 0.2691D-08, 0.4773D-08, 0.8463D-08, & + & 0.1499D-07, 0.2648D-07, 0.4664D-07, 0.8183D-07, 0.1425D-06, & + & 0.2462D-06, 0.4200D-06, 0.7029D-06, 0.1147D-05, 0.1810D-05, & + & 0.2729D-05, 0.3894D-05, 0.5212D-05, 0.6505D-05, 0.7579D-05, & + & 0.8289D-05, 0.8535D-05, 0.8330D-05, 0.7691D-05, 0.6728D-05, & + & 0.5606D-05, 0.4484D-05, 0.3460D-05, 0.2584D-05, 0.1900D-05, & + & 0.1368D-05, 0.9749D-06, 0.6750D-06, 0.4691D-06, 0.3348D-06, & + & 0.2270D-06, 0.1562D-06, 0.9983D-07, 0.7776D-07, 0.4838D-07, & + & 0.2904D-07, 0.2130D-07, 0.1124D-07, 0.1461D-07, 0.1912D-08, & + & 0.3475D-08, 0.4542D-08, 0.5269D-08, 0.5763D-08, 0.6101D-08, & + & 0.6330D-08, 0.6487D-08, 0.6593D-08, 0.6666D-08, 0.6716D-08, & + & 0.6749D-08/ + + data (calcpts(j, 7), j = 1,neta) /0.7043D-13, 0.1253D-12, & + & 0.2227D-12, 0.3960D-12, 0.7044D-12, 0.1253D-11, 0.2227D-11, & + & 0.3961D-11, 0.7041D-11, 0.1252D-10, 0.2227D-10, 0.3960D-10, & + & 0.7041D-10, 0.1252D-09, 0.2225D-09, 0.3957D-09, 0.7035D-09, & + & 0.1250D-08, 0.2221D-08, 0.3944D-08, 0.6996D-08, 0.1241D-07, & + & 0.2197D-07, 0.3881D-07, 0.6837D-07, 0.1199D-06, 0.2090D-06, & + & 0.3610D-06, 0.6156D-06, 0.1031D-05, 0.1682D-05, 0.2654D-05, & + & 0.4001D-05, 0.5712D-05, 0.7645D-05, 0.9542D-05, 0.1112D-04, & + & 0.1217D-04, 0.1253D-04, 0.1222D-04, 0.1128D-04, 0.9879D-05, & + & 0.8236D-05, 0.6579D-05, 0.5079D-05, 0.3800D-05, 0.2788D-05, & + & 0.1996D-05, 0.1425D-05, 0.1005D-05, 0.6910D-06, 0.4859D-06, & + & 0.3367D-06, 0.2289D-06, 0.1582D-06, 0.1018D-06, 0.7968D-07, & + & 0.5030D-07, 0.3095D-07, 0.2320D-07, 0.1314D-07, 0.1650D-07, & + & 0.3796D-08, 0.5360D-08, 0.6425D-08, 0.7150D-08, 0.7644D-08, & + & 0.7981D-08, 0.8210D-08, 0.8367D-08, -.6527D-08, -.6454D-08, & + & -.6405D-08/ + + data (calcpts(j, 8), j = 1,neta) /0.1032D-12, 0.1835D-12, & + & 0.3262D-12, 0.5802D-12, 0.1032D-11, 0.1835D-11, 0.3263D-11, & + & 0.5804D-11, 0.1032D-10, 0.1835D-10, 0.3263D-10, 0.5802D-10, & + & 0.1032D-09, 0.1835D-09, 0.3260D-09, 0.5797D-09, 0.1031D-08, & + & 0.1831D-08, 0.3253D-08, 0.5779D-08, 0.1025D-07, 0.1818D-07, & + & 0.3219D-07, 0.5687D-07, 0.1002D-06, 0.1757D-06, 0.3062D-06, & + & 0.5289D-06, 0.9021D-06, 0.1510D-05, 0.2465D-05, 0.3890D-05, & + & 0.5866D-05, 0.8377D-05, 0.1121D-04, 0.1400D-04, 0.1632D-04, & + & 0.1785D-04, 0.1840D-04, 0.1795D-04, 0.1656D-04, 0.1450D-04, & + & 0.1209D-04, 0.9673D-05, 0.7465D-05, 0.5587D-05, 0.4094D-05, & + & 0.2950D-05, 0.2092D-05, 0.1480D-05, 0.1031D-05, 0.7180D-06, & + & 0.4981D-06, 0.3489D-06, 0.2410D-06, 0.1703D-06, 0.1288D-06, & + & 0.9171D-07, 0.6230D-07, 0.4292D-07, 0.3516D-07, 0.2510D-07, & + & 0.2845D-07, 0.1574D-07, 0.1730D-07, 0.1837D-07, 0.1909D-07, & + & 0.1958D-07, 0.1992D-07, 0.2015D-07, 0.2031D-07, 0.2041D-07, & + & 0.2048D-07/ + + data (calcpts(j, 9), j = 1,neta) /0.1510D-12, 0.2685D-12, & + & 0.4773D-12, 0.8489D-12, 0.1510D-11, 0.2685D-11, 0.4774D-11, & + & 0.8491D-11, 0.1509D-10, 0.2684D-10, 0.4774D-10, 0.8488D-10, & + & 0.1509D-09, 0.2684D-09, 0.4770D-09, 0.8481D-09, 0.1508D-08, & + & 0.2679D-08, 0.4760D-08, 0.8454D-08, 0.1500D-07, 0.2659D-07, & + & 0.4709D-07, 0.8320D-07, 0.1466D-06, 0.2571D-06, 0.4480D-06, & + & 0.7740D-06, 0.1320D-05, 0.2210D-05, 0.3608D-05, 0.5695D-05, & + & 0.8591D-05, 0.1227D-04, 0.1643D-04, 0.2051D-04, 0.2392D-04, & + & 0.2616D-04, 0.2696D-04, 0.2628D-04, 0.2426D-04, 0.2123D-04, & + & 0.1770D-04, 0.1414D-04, 0.1090D-04, 0.8152D-05, 0.5971D-05, & + & 0.4277D-05, 0.3024D-05, 0.2126D-05, 0.1471D-05, 0.1008D-05, & + & 0.6944D-06, 0.4892D-06, 0.2948D-06, 0.2168D-06, 0.1159D-06, & + & 0.1494D-06, 0.2220D-07, 0.3774D-07, 0.4833D-07, 0.5555D-07, & + & 0.6046D-07, -.8619D-07, -.8390D-07, -.8235D-07, -.8129D-07, & + & -.8057D-07, -.8008D-07, -.7974D-07, -.7951D-07, -.7936D-07, & + & -.7925D-07/ + + data (calcpts(j,10), j = 1,neta) /0.2207D-12, 0.3925D-12, & + & 0.6976D-12, 0.1241D-11, 0.2207D-11, 0.3924D-11, 0.6978D-11, & + & 0.1241D-10, 0.2206D-10, 0.3923D-10, 0.6978D-10, 0.1241D-09, & + & 0.2206D-09, 0.3923D-09, 0.6972D-09, 0.1240D-08, 0.2204D-08, & + & 0.3916D-08, 0.6958D-08, 0.1236D-07, 0.2192D-07, 0.3887D-07, & + & 0.6884D-07, 0.1216D-06, 0.2143D-06, 0.3759D-06, 0.6549D-06, & + & 0.1132D-05, 0.1930D-05, 0.3232D-05, 0.5279D-05, 0.8334D-05, & + & 0.1257D-04, 0.1797D-04, 0.2406D-04, 0.3007D-04, 0.3508D-04, & + & 0.3837D-04, 0.3956D-04, 0.3857D-04, 0.3560D-04, 0.3117D-04, & + & 0.2598D-04, 0.2081D-04, 0.1595D-04, 0.1201D-04, 0.8833D-05, & + & 0.6355D-05, 0.4407D-05, 0.3191D-05, 0.2248D-05, 0.1534D-05, & + & 0.9652D-06, 0.7414D-06, 0.4458D-06, 0.4011D-06, 0.1728D-06, & + & 0.2217D-06, 0.1051D-06, 0.1278D-06, -.6740D-08, 0.3811D-08, & + & 0.1099D-07, 0.1589D-07, 0.1923D-07, 0.2150D-07, 0.2305D-07, & + & 0.2410D-07, 0.2482D-07, 0.2531D-07, 0.2564D-07, 0.2587D-07, & + & 0.2603D-07/ + + data (calcpts(j,11), j = 1,neta) /0.3220D-12, 0.5726D-12, & + & 0.1018D-11, 0.1810D-11, 0.3220D-11, 0.5725D-11, 0.1018D-10, & + & 0.1811D-10, 0.3218D-10, 0.5724D-10, 0.1018D-09, 0.1810D-09, & + & 0.3219D-09, 0.5724D-09, 0.1017D-08, 0.1809D-08, 0.3216D-08, & + & 0.5714D-08, 0.1015D-07, 0.1803D-07, 0.3198D-07, 0.5671D-07, & + & 0.1004D-06, 0.1775D-06, 0.3126D-06, 0.5485D-06, 0.9557D-06, & + & 0.1652D-05, 0.2818D-05, 0.4720D-05, 0.7710D-05, 0.1218D-04, & + & 0.1838D-04, 0.2628D-04, 0.3524D-04, 0.4405D-04, 0.5141D-04, & + & 0.5627D-04, 0.5802D-04, 0.5660D-04, 0.5232D-04, 0.4571D-04, & + & 0.3816D-04, 0.3050D-04, 0.2357D-04, 0.1761D-04, 0.1302D-04, & + & 0.9293D-05, 0.6683D-05, 0.4741D-05, 0.3224D-05, 0.2282D-05, & + & 0.1566D-05, 0.1146D-05, 0.7708D-06, 0.6244D-06, 0.4290D-06, & + & 0.3504D-06, 0.2491D-06, 0.1322D-06, 0.1548D-06, 0.1702D-06, & + & 0.3068D-07, 0.3783D-07, 0.4270D-07, 0.4601D-07, 0.4827D-07, & + & 0.4981D-07, 0.5086D-07, 0.5157D-07, 0.5206D-07, 0.5239D-07, & + & 0.5262D-07/ + + data (calcpts(j,12), j = 1,neta) /0.4683D-12, 0.8329D-12, & + & 0.1480D-11, 0.2633D-11, 0.4683D-11, 0.8327D-11, 0.1481D-10, & + & 0.2634D-10, 0.4681D-10, 0.8325D-10, 0.1481D-09, 0.2633D-09, & + & 0.4681D-09, 0.8325D-09, 0.1479D-08, 0.2630D-08, 0.4677D-08, & + & 0.8310D-08, 0.1476D-07, 0.2622D-07, 0.4652D-07, 0.8249D-07, & + & 0.1461D-06, 0.2581D-06, 0.4548D-06, 0.7980D-06, 0.1391D-05, & + & 0.2403D-05, 0.4102D-05, 0.6872D-05, 0.1123D-04, 0.1775D-04, & + & 0.2682D-04, 0.3838D-04, 0.5150D-04, 0.6445D-04, 0.7526D-04, & + & 0.8242D-04, 0.8503D-04, 0.8298D-04, 0.7661D-04, 0.6705D-04, & + & 0.5593D-04, 0.4469D-04, 0.3455D-04, 0.2585D-04, 0.1898D-04, & + & 0.1369D-04, 0.9675D-05, 0.6918D-05, 0.4820D-05, 0.3300D-05, & + & 0.2353D-05, 0.1633D-05, 0.1211D-05, 0.8341D-06, 0.5363D-06, & + & 0.4901D-06, 0.4109D-06, 0.3091D-06, 0.1919D-06, 0.2143D-06, & + & 0.2296D-06, 0.8995D-07, 0.9703D-07, 0.1018D-06, 0.1051D-06, & + & 0.1074D-06, 0.1089D-06, 0.1099D-06, 0.1106D-06, 0.1111D-06, & + & 0.1115D-06/ + + data (calcpts(j,13), j = 1,neta) /0.6783D-12, 0.1207D-11, & + & 0.2144D-11, 0.3814D-11, 0.6784D-11, 0.1206D-10, 0.2145D-10, & + & 0.3815D-10, 0.6781D-10, 0.1206D-09, 0.2145D-09, 0.3814D-09, & + & 0.6781D-09, 0.1206D-08, 0.2143D-08, 0.3811D-08, 0.6775D-08, & + & 0.1204D-07, 0.2139D-07, 0.3799D-07, 0.6739D-07, 0.1195D-06, & + & 0.2117D-06, 0.3740D-06, 0.6590D-06, 0.1156D-05, 0.2016D-05, & + & 0.3484D-05, 0.5948D-05, 0.9971D-05, 0.1631D-04, 0.2579D-04, & + & 0.3901D-04, 0.5590D-04, 0.7514D-04, 0.9416D-04, 0.1101D-03, & + & 0.1207D-03, 0.1245D-03, 0.1214D-03, 0.1122D-03, 0.9831D-04, & + & 0.8202D-04, 0.6564D-04, 0.5065D-04, 0.3808D-04, 0.2804D-04, & + & 0.2017D-04, 0.1443D-04, 0.1026D-04, 0.7188D-05, 0.5079D-05, & + & 0.3548D-05, 0.2593D-05, 0.1868D-05, 0.1441D-05, 0.1062D-05, & + & 0.7624D-06, 0.7149D-06, 0.4847D-06, 0.5323D-06, 0.4147D-06, & + & 0.4368D-06, 0.3018D-06, 0.3121D-06, 0.3191D-06, 0.3238D-06, & + & 0.3271D-06, 0.3293D-06, 0.3308D-06, 0.3318D-06, 0.3325D-06, & + & 0.3330D-06/ + + data (calcpts(j,14), j = 1,neta) /0.9761D-12, 0.1736D-11, & + & 0.3086D-11, 0.5488D-11, 0.9762D-11, 0.1736D-10, 0.3087D-10, & + & 0.5490D-10, 0.9758D-10, 0.1735D-09, 0.3087D-09, 0.5488D-09, & + & 0.9758D-09, 0.1735D-08, 0.3084D-08, 0.5483D-08, 0.9750D-08, & + & 0.1732D-07, 0.3078D-07, 0.5467D-07, 0.9698D-07, 0.1720D-06, & + & 0.3046D-06, 0.5383D-06, 0.9486D-06, 0.1665D-05, 0.2903D-05, & + & 0.5020D-05, 0.8573D-05, 0.1438D-04, 0.2354D-04, 0.3728D-04, & + & 0.5648D-04, 0.8107D-04, 0.1092D-03, 0.1371D-03, 0.1605D-03, & + & 0.1760D-03, 0.1816D-03, 0.1773D-03, 0.1637D-03, 0.1434D-03, & + & 0.1196D-03, 0.9570D-04, 0.7384D-04, 0.5544D-04, 0.4061D-04, & + & 0.2922D-04, 0.2087D-04, 0.1464D-04, 0.1027D-04, 0.7166D-05, & + & 0.5032D-05, 0.3483D-05, 0.2366D-05, 0.1631D-05, 0.1199D-05, & + & 0.8151D-06, 0.6626D-06, 0.4631D-06, 0.3815D-06, 0.2782D-06, & + & 0.1600D-06, 0.1816D-06, 0.1964D-06, 0.2064D-06, 0.2133D-06, & + & 0.6796D-07, 0.7114D-07, 0.7330D-07, 0.7478D-07, 0.7578D-07, & + & 0.7647D-07/ + + data (calcpts(j,15), j = 1,neta) /0.1392D-11, 0.2477D-11, & + & 0.4402D-11, 0.7829D-11, 0.1393D-10, 0.2476D-10, 0.4403D-10, & + & 0.7832D-10, 0.1392D-09, 0.2476D-09, 0.4403D-09, 0.7829D-09, & + & 0.1392D-08, 0.2476D-08, 0.4399D-08, 0.7822D-08, 0.1391D-07, & + & 0.2471D-07, 0.4391D-07, 0.7800D-07, 0.1384D-06, 0.2454D-06, & + & 0.4347D-06, 0.7682D-06, 0.1354D-05, 0.2377D-05, 0.4145D-05, & + & 0.7171D-05, 0.1226D-04, 0.2058D-04, 0.3373D-04, 0.5351D-04, & + & 0.8124D-04, 0.1169D-03, 0.1579D-03, 0.1988D-03, 0.2333D-03, & + & 0.2561D-03, 0.2645D-03, 0.2582D-03, 0.2385D-03, 0.2088D-03, & + & 0.1742D-03, 0.1394D-03, 0.1074D-03, 0.8048D-04, 0.5895D-04, & + & 0.4236D-04, 0.2994D-04, 0.2101D-04, 0.1453D-04, 0.9938D-05, & + & 0.6780D-05, 0.4608D-05, 0.3032D-05, 0.2046D-05, 0.1299D-05, & + & 0.8574D-06, 0.4678D-06, 0.3112D-06, 0.1088D-06, 0.2541D-07, & + & -.7929D-07, -.1984D-06, -.1773D-06, -.1630D-06, -.1532D-06, & + & -.2966D-06, -.2920D-06, -.2889D-06, -.2868D-06, -.2854D-06, & + & -.2844D-06/ + + data (calcpts(j,16), j = 1,neta) /0.1963D-11, 0.3491D-11, & + & 0.6205D-11, 0.1104D-10, 0.1963D-10, 0.3490D-10, 0.6206D-10, & + & 0.1104D-09, 0.1962D-09, 0.3489D-09, 0.6207D-09, 0.1104D-08, & + & 0.1962D-08, 0.3490D-08, 0.6201D-08, 0.1103D-07, 0.1960D-07, & + & 0.3484D-07, 0.6190D-07, 0.1099D-06, 0.1950D-06, 0.3459D-06, & + & 0.6129D-06, 0.1083D-05, 0.1910D-05, 0.3353D-05, 0.5851D-05, & + & 0.1013D-04, 0.1733D-04, 0.2913D-04, 0.4784D-04, 0.7607D-04, & + & 0.1158D-03, 0.1673D-03, 0.2269D-03, 0.2867D-03, 0.3375D-03, & + & 0.3716D-03, 0.3841D-03, 0.3753D-03, 0.3466D-03, 0.3039D-03, & + & 0.2537D-03, 0.2030D-03, 0.1565D-03, 0.1181D-03, 0.8594D-04, & + & 0.6177D-04, 0.4362D-04, 0.3032D-04, 0.2161D-04, 0.1543D-04, & + & 0.1088D-04, 0.6887D-05, 0.5260D-05, 0.3197D-05, 0.2334D-05, & + & 0.1270D-05, 0.1566D-05, 0.2684D-06, 0.4061D-06, 0.4999D-06, & + & 0.5638D-06, 0.6074D-06, 0.6370D-06, 0.6572D-06, -.8290D-06, & + & -.8196D-06, -.8132D-06, -.8089D-06, -.8059D-06, -.8039D-06, & + & -.8025D-06/ + + data (calcpts(j,17), j = 1,neta) /0.2719D-11, 0.4836D-11, & + & 0.8595D-11, 0.1529D-10, 0.2719D-10, 0.4835D-10, 0.8598D-10, & + & 0.1529D-09, 0.2718D-09, 0.4834D-09, 0.8598D-09, 0.1529D-08, & + & 0.2718D-08, 0.4834D-08, 0.8590D-08, 0.1527D-07, 0.2716D-07, & + & 0.4826D-07, 0.8575D-07, 0.1523D-06, 0.2702D-06, 0.4794D-06, & + & 0.8493D-06, 0.1502D-05, 0.2648D-05, 0.4652D-05, 0.8121D-05, & + & 0.1407D-04, 0.2410D-04, 0.4059D-04, 0.6682D-04, 0.1066D-03, & + & 0.1630D-03, 0.2366D-03, 0.3226D-03, 0.4099D-03, 0.4847D-03, & + & 0.5352D-03, 0.5545D-03, 0.5421D-03, 0.5006D-03, 0.4394D-03, & + & 0.3677D-03, 0.2939D-03, 0.2269D-03, 0.1708D-03, 0.1253D-03, & + & 0.9057D-04, 0.6407D-04, 0.4530D-04, 0.3153D-04, 0.2250D-04, & + & 0.1459D-04, 0.9875D-05, 0.7276D-05, 0.5574D-05, 0.3457D-05, & + & 0.2560D-05, 0.1471D-05, 0.1751D-05, 0.4418D-06, 0.5718D-06, & + & 0.6603D-06, 0.7206D-06, 0.7618D-06, 0.7898D-06, 0.8088D-06, & + & 0.8218D-06, 0.8307D-06, 0.8367D-06, 0.8408D-06, 0.8436D-06, & + & 0.8455D-06/ + + data (calcpts(j,18), j = 1,neta) /0.3677D-11, 0.6539D-11, & + & 0.1162D-10, 0.2067D-10, 0.3677D-10, 0.6538D-10, 0.1163D-09, & + & 0.2068D-09, 0.3675D-09, 0.6537D-09, 0.1163D-08, 0.2067D-08, & + & 0.3676D-08, 0.6537D-08, 0.1162D-07, 0.2066D-07, 0.3673D-07, & + & 0.6527D-07, 0.1160D-06, 0.2060D-06, 0.3655D-06, 0.6485D-06, & + & 0.1149D-05, 0.2032D-05, 0.3585D-05, 0.6301D-05, 0.1101D-04, & + & 0.1910D-04, 0.3277D-04, 0.5531D-04, 0.9132D-04, 0.1463D-03, & + & 0.2249D-03, 0.3286D-03, 0.4512D-03, 0.5776D-03, 0.6873D-03, & + & 0.7621D-03, 0.7917D-03, 0.7756D-03, 0.7173D-03, 0.6298D-03, & + & 0.5273D-03, 0.4235D-03, 0.3281D-03, 0.2463D-03, 0.1814D-03, & + & 0.1306D-03, 0.9257D-04, 0.6479D-04, 0.4509D-04, 0.3217D-04, & + & 0.2119D-04, 0.1446D-04, 0.9533D-05, 0.6787D-05, 0.4982D-05, & + & 0.2797D-05, 0.1853D-05, 0.2231D-05, 0.9891D-06, 0.1165D-05, & + & -.2155D-06, -.1339D-06, -.7834D-07, -.4048D-07, -.1468D-07, & + & 0.2897D-08, 0.1486D-07, 0.2302D-07, 0.2858D-07, 0.3237D-07, & + & 0.3495D-07/ + + data (calcpts(j,19), j = 1,neta) /0.4815D-11, 0.8565D-11, & + & 0.1522D-10, 0.2707D-10, 0.4816D-10, 0.8563D-10, 0.1523D-09, & + & 0.2708D-09, 0.4814D-09, 0.8561D-09, 0.1523D-08, 0.2707D-08, & + & 0.4814D-08, 0.8562D-08, 0.1521D-07, 0.2705D-07, 0.4811D-07, & + & 0.8549D-07, 0.1519D-06, 0.2699D-06, 0.4789D-06, 0.8497D-06, & + & 0.1506D-05, 0.2664D-05, 0.4702D-05, 0.8270D-05, 0.1446D-04, & + & 0.2512D-04, 0.4319D-04, 0.7311D-04, 0.1212D-03, 0.1951D-03, & + & 0.3020D-03, 0.4449D-03, 0.6166D-03, 0.7966D-03, 0.9558D-03, & + & 0.1067D-02, 0.1113D-02, 0.1092D-02, 0.1014D-02, 0.8925D-03, & + & 0.7478D-03, 0.6015D-03, 0.4664D-03, 0.3505D-03, 0.2583D-03, & + & 0.1857D-03, 0.1329D-03, 0.9248D-04, 0.6442D-04, 0.4501D-04, & + & 0.3124D-04, 0.2118D-04, 0.1405D-04, 0.1035D-04, 0.7411D-05, & + & 0.3979D-05, 0.3207D-05, 0.2202D-05, 0.1040D-05, 0.1270D-05, & + & 0.1427D-05, 0.3386D-07, 0.1067D-06, 0.1563D-06, 0.1901D-06, & + & 0.2131D-06, 0.2287D-06, 0.2394D-06, 0.2467D-06, 0.2517D-06, & + & 0.2551D-06/ + + data (calcpts(j,20), j = 1,neta) /0.6052D-11, 0.1076D-10, & + & 0.1913D-10, 0.3403D-10, 0.6052D-10, 0.1076D-09, 0.1914D-09, & + & 0.3404D-09, 0.6050D-09, 0.1076D-08, 0.1914D-08, 0.3403D-08, & + & 0.6050D-08, 0.1076D-07, 0.1912D-07, 0.3400D-07, 0.6046D-07, & + & 0.1075D-06, 0.1909D-06, 0.3393D-06, 0.6021D-06, 0.1068D-05, & + & 0.1894D-05, 0.3352D-05, 0.5918D-05, 0.1042D-04, 0.1824D-04, & + & 0.3174D-04, 0.5468D-04, 0.9285D-04, 0.1546D-03, 0.2504D-03, & + & 0.3906D-03, 0.5811D-03, 0.8145D-03, 0.1065D-02, 0.1291D-02, & + & 0.1454D-02, 0.1525D-02, 0.1504D-02, 0.1401D-02, 0.1236D-02, & + & 0.1041D-02, 0.8396D-03, 0.6525D-03, 0.4925D-03, 0.3638D-03, & + & 0.2628D-03, 0.1870D-03, 0.1314D-03, 0.9228D-04, 0.6359D-04, & + & 0.4418D-04, 0.3088D-04, 0.2162D-04, 0.1401D-04, 0.9972D-05, & + & 0.6814D-05, 0.4728D-05, 0.3851D-05, 0.2776D-05, 0.1565D-05, & + & 0.1762D-05, 0.3964D-06, 0.4879D-06, 0.5502D-06, 0.5927D-06, & + & 0.6216D-06, 0.6413D-06, 0.6548D-06, 0.6639D-06, 0.6702D-06, & + & 0.6744D-06/ + + data (calcpts(j,21), j = 1,neta) /0.7225D-11, 0.1285D-10, & + & 0.2284D-10, 0.4062D-10, 0.7226D-10, 0.1285D-09, 0.2285D-09, & + & 0.4064D-09, 0.7222D-09, 0.1285D-08, 0.2285D-08, 0.4062D-08, & + & 0.7223D-08, 0.1285D-07, 0.2283D-07, 0.4060D-07, 0.7219D-07, & + & 0.1283D-06, 0.2280D-06, 0.4051D-06, 0.7191D-06, 0.1276D-05, & + & 0.2263D-05, 0.4006D-05, 0.7078D-05, 0.1247D-04, 0.2186D-04, & + & 0.3809D-04, 0.6578D-04, 0.1121D-03, 0.1875D-03, 0.3057D-03, & + & 0.4809D-03, 0.7232D-03, 0.1027D-02, 0.1361D-02, 0.1674D-02, & + & 0.1907D-02, 0.2020D-02, 0.2003D-02, 0.1874D-02, 0.1664D-02, & + & 0.1407D-02, 0.1140D-02, 0.8905D-03, 0.6748D-03, 0.4981D-03, & + & 0.3607D-03, 0.2569D-03, 0.1812D-03, 0.1264D-03, 0.8829D-04, & + & 0.6015D-04, 0.4206D-04, 0.2761D-04, 0.1906D-04, 0.1240D-04, & + & 0.8007D-05, 0.6099D-05, 0.3843D-05, 0.2850D-05, 0.1695D-05, & + & 0.4300D-06, 0.5904D-06, 0.6997D-06, -.7260D-06, -.6753D-06, & + & -.6407D-06, -.6172D-06, -.6012D-06, -.5902D-06, -.5828D-06, & + & -.5777D-06/ + + data (calcpts(j,22), j = 1,neta) /0.8126D-11, 0.1445D-10, & + & 0.2569D-10, 0.4569D-10, 0.8127D-10, 0.1445D-09, 0.2570D-09, & + & 0.4570D-09, 0.8123D-09, 0.1445D-08, 0.2570D-08, 0.4569D-08, & + & 0.8124D-08, 0.1445D-07, 0.2568D-07, 0.4566D-07, 0.8120D-07, & + & 0.1443D-06, 0.2565D-06, 0.4558D-06, 0.8090D-06, 0.1436D-05, & + & 0.2547D-05, 0.4511D-05, 0.7973D-05, 0.1406D-04, 0.2467D-04, & + & 0.4306D-04, 0.7453D-04, 0.1274D-03, 0.2141D-03, 0.3512D-03, & + & 0.5574D-03, 0.8476D-03, 0.1220D-02, 0.1643D-02, 0.2054D-02, & + & 0.2375D-02, 0.2546D-02, 0.2550D-02, 0.2406D-02, 0.2151D-02, & + & 0.1834D-02, 0.1496D-02, 0.1177D-02, 0.8971D-03, 0.6657D-03, & + & 0.4847D-03, 0.3465D-03, 0.2451D-03, 0.1721D-03, 0.1195D-03, & + & 0.8221D-04, 0.5604D-04, 0.3922D-04, 0.2660D-04, 0.1874D-04, & + & 0.1304D-04, 0.8271D-05, 0.6108D-05, 0.3678D-05, 0.2566D-05, & + & 0.1330D-05, 0.1511D-05, 0.1337D-06, 0.2174D-06, 0.2744D-06, & + & 0.3133D-06, 0.3397D-06, 0.3577D-06, 0.3700D-06, 0.3784D-06, & + & 0.3841D-06/ + + data (calcpts(j,23), j = 1,neta) /0.8555D-11, 0.1522D-10, & + & 0.2705D-10, 0.4810D-10, 0.8556D-10, 0.1521D-09, 0.2705D-09, & + & 0.4812D-09, 0.8552D-09, 0.1521D-08, 0.2706D-08, 0.4810D-08, & + & 0.8554D-08, 0.1521D-07, 0.2704D-07, 0.4808D-07, 0.8549D-07, & + & 0.1520D-06, 0.2701D-06, 0.4799D-06, 0.8520D-06, 0.1513D-05, & + & 0.2684D-05, 0.4754D-05, 0.8406D-05, 0.1483D-04, 0.2605D-04, & + & 0.4552D-04, 0.7895D-04, 0.1353D-03, 0.2283D-03, 0.3768D-03, & + & 0.6026D-03, 0.9260D-03, 0.1351D-02, 0.1849D-02, 0.2353D-02, & + & 0.2770D-02, 0.3018D-02, 0.3064D-02, 0.2924D-02, 0.2640D-02, & + & 0.2273D-02, 0.1874D-02, 0.1488D-02, 0.1143D-02, 0.8549D-03, & + & 0.6257D-03, 0.4499D-03, 0.3189D-03, 0.2234D-03, 0.1552D-03, & + & 0.1080D-03, 0.7481D-04, 0.5080D-04, 0.3538D-04, 0.2466D-04, & + & 0.1606D-04, 0.1135D-04, 0.7732D-05, 0.5332D-05, 0.4241D-05, & + & 0.3019D-05, 0.1709D-05, 0.1838D-05, 0.4264D-06, 0.4864D-06, & + & 0.5273D-06, 0.5552D-06, 0.5742D-06, 0.5871D-06, 0.5959D-06, & + & 0.6019D-06/ + + data (calcpts(j,24), j = 1,neta) /0.8413D-11, 0.1496D-10, & + & 0.2660D-10, 0.4731D-10, 0.8414D-10, 0.1496D-09, 0.2660D-09, & + & 0.4732D-09, 0.8410D-09, 0.1496D-08, 0.2661D-08, 0.4731D-08, & + & 0.8412D-08, 0.1496D-07, 0.2659D-07, 0.4728D-07, 0.8408D-07, & + & 0.1494D-06, 0.2656D-06, 0.4721D-06, 0.8381D-06, 0.1488D-05, & + & 0.2640D-05, 0.4678D-05, 0.8275D-05, 0.1461D-04, 0.2567D-04, & + & 0.4492D-04, 0.7802D-04, 0.1340D-03, 0.2268D-03, 0.3760D-03, & + & 0.6052D-03, 0.9383D-03, 0.1385D-02, 0.1925D-02, 0.2495D-02, & + & 0.2996D-02, 0.3329D-02, 0.3440D-02, 0.3331D-02, 0.3050D-02, & + & 0.2661D-02, 0.2221D-02, 0.1785D-02, 0.1387D-02, 0.1048D-02, & + & 0.7719D-03, 0.5577D-03, 0.3976D-03, 0.2806D-03, 0.1956D-03, & + & 0.1362D-03, 0.9383D-04, 0.6522D-04, 0.4373D-04, 0.2997D-04, & + & 0.2133D-04, 0.1360D-04, 0.9969D-05, 0.6059D-05, 0.4962D-05, & + & 0.3735D-05, 0.2422D-05, 0.1049D-05, 0.1136D-05, 0.1195D-05, & + & -.2647D-06, -.2374D-06, -.2187D-06, -.2060D-06, -.1973D-06, & + & -.1914D-06/ + + data (calcpts(j,25), j = 1,neta) /0.7746D-11, 0.1378D-10, & + & 0.2449D-10, 0.4355D-10, 0.7747D-10, 0.1377D-09, 0.2449D-09, & + & 0.4357D-09, 0.7743D-09, 0.1377D-08, 0.2450D-08, 0.4355D-08, & + & 0.7745D-08, 0.1377D-07, 0.2448D-07, 0.4353D-07, 0.7741D-07, & + & 0.1376D-06, 0.2446D-06, 0.4347D-06, 0.7717D-06, 0.1370D-05, & + & 0.2432D-05, 0.4309D-05, 0.7624D-05, 0.1346D-04, 0.2367D-04, & + & 0.4144D-04, 0.7206D-04, 0.1240D-03, 0.2103D-03, 0.3497D-03, & + & 0.5656D-03, 0.8828D-03, 0.1316D-02, 0.1852D-02, 0.2441D-02, & + & 0.2990D-02, 0.3395D-02, 0.3583D-02, 0.3537D-02, 0.3295D-02, & + & 0.2920D-02, 0.2479D-02, 0.2022D-02, 0.1593D-02, 0.1219D-02, & + & 0.9078D-03, 0.6620D-03, 0.4748D-03, 0.3362D-03, 0.2362D-03, & + & 0.1638D-03, 0.1133D-03, 0.7819D-04, 0.5339D-04, 0.3641D-04, & + & 0.2462D-04, 0.1679D-04, 0.1159D-04, 0.7636D-05, 0.5006D-05, & + & 0.3758D-05, 0.2430D-05, 0.1047D-05, 0.1127D-05, 0.1181D-05, & + & 0.1218D-05, -.2567D-06, -.2395D-06, -.2278D-06, -.2198D-06, & + & -.2144D-06/ + + data (calcpts(j,26), j = 1,neta) /0.6715D-11, 0.1194D-10, & + & 0.2123D-10, 0.3775D-10, 0.6716D-10, 0.1194D-09, 0.2123D-09, & + & 0.3777D-09, 0.6712D-09, 0.1194D-08, 0.2124D-08, 0.3776D-08, & + & 0.6714D-08, 0.1194D-07, 0.2122D-07, 0.3774D-07, 0.6711D-07, & + & 0.1193D-06, 0.2120D-06, 0.3768D-06, 0.6690D-06, 0.1188D-05, & + & 0.2108D-05, 0.3737D-05, 0.6612D-05, 0.1168D-04, 0.2054D-04, & + & 0.3598D-04, 0.6259D-04, 0.1078D-03, 0.1831D-03, 0.3051D-03, & + & 0.4950D-03, 0.7763D-03, 0.1165D-02, 0.1656D-02, 0.2213D-02, & + & 0.2759D-02, 0.3201D-02, 0.3456D-02, 0.3490D-02, 0.3320D-02, & + & 0.3002D-02, 0.2595D-02, 0.2157D-02, 0.1730D-02, 0.1343D-02, & + & 0.1015D-02, 0.7487D-03, 0.5417D-03, 0.3862D-03, 0.2735D-03, & + & 0.1906D-03, 0.1314D-03, 0.9113D-04, 0.6284D-04, 0.4252D-04, & + & 0.2901D-04, 0.1952D-04, 0.1272D-04, 0.8687D-05, 0.6008D-05, & + & 0.4726D-05, 0.1876D-05, 0.1977D-05, 0.5462D-06, 0.5933D-06, & + & 0.6254D-06, 0.6473D-06, -.8378D-06, -.8277D-06, -.8207D-06, & + & -.8160D-06/ + + data (calcpts(j,27), j = 1,neta) /0.5527D-11, 0.9830D-11, & + & 0.1747D-10, 0.3108D-10, 0.5528D-10, 0.9829D-10, 0.1748D-09, & + & 0.3109D-09, 0.5525D-09, 0.9827D-09, 0.1748D-08, 0.3108D-08, & + & 0.5526D-08, 0.9828D-08, 0.1747D-07, 0.3106D-07, 0.5524D-07, & + & 0.9818D-07, 0.1745D-06, 0.3102D-06, 0.5507D-06, 0.9780D-06, & + & 0.1736D-05, 0.3076D-05, 0.5444D-05, 0.9614D-05, 0.1691D-04, & + & 0.2963D-04, 0.5158D-04, 0.8887D-04, 0.1511D-03, 0.2521D-03, & + & 0.4098D-03, 0.6445D-03, 0.9714D-03, 0.1391D-02, 0.1877D-02, & + & 0.2374D-02, 0.2806D-02, 0.3100D-02, 0.3208D-02, 0.3127D-02, & + & 0.2890D-02, 0.2554D-02, 0.2168D-02, 0.1775D-02, 0.1405D-02, & + & 0.1080D-02, 0.8101D-03, 0.5929D-03, 0.4277D-03, 0.3048D-03, & + & 0.2141D-03, 0.1493D-03, 0.1037D-03, 0.7180D-04, 0.4960D-04, & + & 0.3432D-04, 0.2316D-04, 0.1623D-04, 0.1211D-04, 0.7877D-05, & + & 0.5057D-05, 0.3680D-05, 0.2263D-05, 0.2320D-05, 0.2359D-05, & + & 0.8854D-06, 0.9034D-06, 0.9157D-06, 0.9240D-06, 0.9297D-06, & + & 0.9336D-06/ + + data (calcpts(j,28), j = 1,neta) /0.4356D-11, 0.7748D-11, & + & 0.1377D-10, 0.2449D-10, 0.4356D-10, 0.7746D-10, 0.1377D-09, & + & 0.2450D-09, 0.4354D-09, 0.7745D-09, 0.1378D-08, 0.2449D-08, & + & 0.4355D-08, 0.7746D-08, 0.1377D-07, 0.2448D-07, 0.4353D-07, & + & 0.7738D-07, 0.1375D-06, 0.2445D-06, 0.4340D-06, 0.7708D-06, & + & 0.1368D-05, 0.2425D-05, 0.4291D-05, 0.7579D-05, 0.1333D-04, & + & 0.2337D-04, 0.4067D-04, 0.7011D-04, 0.1192D-03, 0.1991D-03, & + & 0.3240D-03, 0.5104D-03, 0.7713D-03, 0.1109D-02, 0.1507D-02, & + & 0.1926D-02, 0.2310D-02, 0.2603D-02, 0.2758D-02, 0.2758D-02, & + & 0.2615D-02, 0.2366D-02, 0.2056D-02, 0.1721D-02, 0.1394D-02, & + & 0.1094D-02, 0.8339D-03, 0.6218D-03, 0.4527D-03, 0.3258D-03, & + & 0.2304D-03, 0.1613D-03, 0.1134D-03, 0.7795D-04, 0.5386D-04, & + & 0.3683D-04, 0.2549D-04, 0.1693D-04, 0.1274D-04, 0.8447D-05, & + & 0.5589D-05, 0.4186D-05, 0.2751D-05, 0.1296D-05, 0.1327D-05, & + & 0.1348D-05, 0.1362D-05, 0.1372D-05, -.1219D-06, -.1174D-06, & + & -.1143D-06/ + + data (calcpts(j,29), j = 1,neta) /0.3316D-11, 0.5897D-11, & + & 0.1048D-10, 0.1864D-10, 0.3316D-10, 0.5896D-10, 0.1048D-09, & + & 0.1865D-09, 0.3314D-09, 0.5895D-09, 0.1049D-08, 0.1864D-08, & + & 0.3315D-08, 0.5896D-08, 0.1048D-07, 0.1863D-07, 0.3314D-07, & + & 0.5890D-07, 0.1047D-06, 0.1861D-06, 0.3304D-06, 0.5867D-06, & + & 0.1041D-05, 0.1846D-05, 0.3266D-05, 0.5769D-05, 0.1015D-04, & + & 0.1779D-04, 0.3097D-04, 0.5339D-04, 0.9082D-04, 0.1517D-03, & + & 0.2470D-03, 0.3894D-03, 0.5895D-03, 0.8495D-03, 0.1159D-02, & + & 0.1491D-02, 0.1808D-02, 0.2068D-02, 0.2237D-02, 0.2292D-02, & + & 0.2232D-02, 0.2073D-02, 0.1847D-02, 0.1585D-02, 0.1314D-02, & + & 0.1055D-02, 0.8229D-03, 0.6239D-03, 0.4621D-03, 0.3359D-03, & + & 0.2403D-03, 0.1702D-03, 0.1186D-03, 0.8264D-04, 0.5672D-04, & + & 0.3945D-04, 0.2646D-04, 0.1780D-04, 0.1203D-04, 0.9188D-05, & + & 0.6296D-05, 0.3370D-05, 0.1920D-05, 0.1954D-05, 0.4774D-06, & + & 0.4932D-06, 0.5040D-06, 0.5114D-06, 0.5164D-06, 0.5198D-06, & + & 0.5221D-06/ + + data (calcpts(j,30), j = 1,neta) /0.2456D-11, 0.4369D-11, & + & 0.7765D-11, 0.1381D-10, 0.2457D-10, 0.4368D-10, 0.7767D-10, & + & 0.1381D-09, 0.2455D-09, 0.4367D-09, 0.7768D-09, 0.1381D-08, & + & 0.2456D-08, 0.4368D-08, 0.7762D-08, 0.1380D-07, 0.2455D-07, & + & 0.4363D-07, 0.7756D-07, 0.1378D-06, 0.2448D-06, 0.4347D-06, & + & 0.7714D-06, 0.1367D-05, 0.2420D-05, 0.4274D-05, 0.7520D-05, & + & 0.1318D-04, 0.2295D-04, 0.3956D-04, 0.6730D-04, 0.1124D-03, & + & 0.1831D-03, 0.2889D-03, 0.4376D-03, 0.6315D-03, 0.8634D-03, & + & 0.1115D-02, 0.1361D-02, 0.1574D-02, 0.1729D-02, 0.1809D-02, & + & 0.1807D-02, 0.1725D-02, 0.1579D-02, 0.1391D-02, 0.1183D-02, & + & 0.9743D-03, 0.7788D-03, 0.6043D-03, 0.4562D-03, 0.3371D-03, & + & 0.2448D-03, 0.1753D-03, 0.1230D-03, 0.8669D-04, 0.6049D-04, & + & 0.4154D-04, 0.2841D-04, 0.1966D-04, 0.1383D-04, 0.9450D-05, & + & 0.6530D-05, 0.3585D-05, 0.3622D-05, 0.2147D-05, 0.6646D-06, & + & 0.6763D-06, 0.6843D-06, 0.6898D-06, 0.6935D-06, 0.6960D-06, & + & 0.6977D-06/ + + data (calcpts(j,31), j = 1,neta) /0.1782D-11, 0.3169D-11, & + & 0.5632D-11, 0.1002D-10, 0.1782D-10, 0.3168D-10, 0.5634D-10, & + & 0.1002D-09, 0.1781D-09, 0.3168D-09, 0.5634D-09, 0.1002D-08, & + & 0.1781D-08, 0.3168D-08, 0.5630D-08, 0.1001D-07, 0.1781D-07, & + & 0.3165D-07, 0.5626D-07, 0.9999D-07, 0.1775D-06, 0.3153D-06, & + & 0.5596D-06, 0.9917D-06, 0.1755D-05, 0.3100D-05, 0.5455D-05, & + & 0.9560D-05, 0.1665D-04, 0.2870D-04, 0.4883D-04, 0.8158D-04, & + & 0.1329D-03, 0.2097D-03, 0.3177D-03, 0.4588D-03, 0.6281D-03, & + & 0.8132D-03, 0.9961D-03, 0.1159D-02, 0.1288D-02, 0.1369D-02, & + & 0.1397D-02, 0.1369D-02, 0.1288D-02, 0.1166D-02, 0.1019D-02, & + & 0.8616D-03, 0.7061D-03, 0.5616D-03, 0.4343D-03, 0.3274D-03, & + & 0.2414D-03, 0.1742D-03, 0.1245D-03, 0.8781D-04, 0.6139D-04, & + & 0.4228D-04, 0.2905D-04, 0.2024D-04, 0.1436D-04, 0.9946D-05, & + & 0.7004D-05, 0.4044D-05, 0.2570D-05, 0.2589D-05, 0.1101D-05, & + & 0.1110D-05, 0.1116D-05, 0.1120D-05, -.3777D-06, -.3759D-06, & + & -.3746D-06/ + + data (calcpts(j,32), j = 1,neta) /0.1272D-11, 0.2262D-11, & + & 0.4020D-11, 0.7150D-11, 0.1272D-10, 0.2261D-10, 0.4021D-10, & + & 0.7152D-10, 0.1271D-09, 0.2261D-09, 0.4021D-09, 0.7150D-09, & + & 0.1271D-08, 0.2261D-08, 0.4019D-08, 0.7146D-08, 0.1271D-07, & + & 0.2259D-07, 0.4015D-07, 0.7136D-07, 0.1267D-06, 0.2250D-06, & + & 0.3994D-06, 0.7078D-06, 0.1253D-05, 0.2213D-05, 0.3893D-05, & + & 0.6823D-05, 0.1188D-04, 0.2048D-04, 0.3485D-04, 0.5823D-04, & + & 0.9486D-04, 0.1497D-03, 0.2269D-03, 0.3278D-03, 0.4490D-03, & + & 0.5819D-03, 0.7143D-03, 0.8346D-03, 0.9331D-03, 0.1003D-02, & + & 0.1040D-02, 0.1042D-02, 0.1006D-02, 0.9370D-03, 0.8420D-03, & + & 0.7316D-03, 0.6159D-03, 0.5030D-03, 0.3989D-03, 0.3078D-03, & + & 0.2315D-03, 0.1704D-03, 0.1231D-03, 0.8770D-04, 0.6186D-04, & + & 0.4310D-04, 0.2994D-04, 0.2062D-04, 0.1411D-04, 0.9669D-05, & + & 0.6560D-05, 0.4488D-05, 0.3008D-05, 0.1971D-05, 0.1230D-05, & + & 0.7857D-06, 0.4899D-06, 0.3427D-06, 0.1946D-06, 0.4594D-07, & + & 0.4683D-07/ + + data (calcpts(j,33), j = 1,neta) /0.8970D-12, 0.1596D-11, & + & 0.2836D-11, 0.5044D-11, 0.8972D-11, 0.1595D-10, 0.2837D-10, & + & 0.5045D-10, 0.8967D-10, 0.1595D-09, 0.2837D-09, 0.5044D-09, & + & 0.8969D-09, 0.1595D-08, 0.2835D-08, 0.5041D-08, 0.8965D-08, & + & 0.1594D-07, 0.2832D-07, 0.5034D-07, 0.8939D-07, 0.1587D-06, & + & 0.2817D-06, 0.4993D-06, 0.8838D-06, 0.1561D-05, 0.2747D-05, & + & 0.4814D-05, 0.8381D-05, 0.1445D-04, 0.2459D-04, 0.4108D-04, & + & 0.6692D-04, 0.1056D-03, 0.1601D-03, 0.2313D-03, 0.3170D-03, & + & 0.4110D-03, 0.5051D-03, 0.5914D-03, 0.6637D-03, 0.7184D-03, & + & 0.7533D-03, 0.7669D-03, 0.7573D-03, 0.7242D-03, 0.6695D-03, & + & 0.5985D-03, 0.5181D-03, 0.4348D-03, 0.3544D-03, 0.2805D-03, & + & 0.2162D-03, 0.1625D-03, 0.1195D-03, 0.8643D-04, 0.6152D-04, & + & 0.4342D-04, 0.3035D-04, 0.2115D-04, 0.1461D-04, 0.1015D-04, & + & 0.7032D-05, 0.4801D-05, 0.3315D-05, 0.2424D-05, 0.1681D-05, & + & 0.1235D-05, 0.7878D-06, 0.6398D-06, 0.4911D-06, 0.3421D-06, & + & 0.3427D-06/ + + data (calcpts(j,34), j = 1,neta) /0.6268D-12, 0.1115D-11, & + & 0.1982D-11, 0.3525D-11, 0.6269D-11, 0.1115D-10, 0.1982D-10, & + & 0.3526D-10, 0.6266D-10, 0.1114D-09, 0.1982D-09, 0.3525D-09, & + & 0.6267D-09, 0.1115D-08, 0.1981D-08, 0.3523D-08, 0.6265D-08, & + & 0.1114D-07, 0.1979D-07, 0.3518D-07, 0.6246D-07, 0.1109D-06, & + & 0.1969D-06, 0.3489D-06, 0.6176D-06, 0.1091D-05, 0.1919D-05, & + & 0.3364D-05, 0.5857D-05, 0.1010D-04, 0.1718D-04, 0.2871D-04, & + & 0.4677D-04, 0.7381D-04, 0.1119D-03, 0.1617D-03, 0.2216D-03, & + & 0.2874D-03, 0.3534D-03, 0.4142D-03, 0.4658D-03, 0.5061D-03, & + & 0.5344D-03, 0.5501D-03, 0.5524D-03, 0.5402D-03, 0.5129D-03, & + & 0.4718D-03, 0.4202D-03, 0.3626D-03, 0.3038D-03, 0.2471D-03, & + & 0.1954D-03, 0.1503D-03, 0.1129D-03, 0.8290D-04, 0.5986D-04, & + & 0.4259D-04, 0.3009D-04, 0.2100D-04, 0.1460D-04, 0.1013D-04, & + & 0.6998D-05, 0.4762D-05, 0.3271D-05, 0.2228D-05, 0.1632D-05, & + & 0.1035D-05, 0.7373D-06, 0.5887D-06, 0.4396D-06, 0.2903D-06, & + & 0.1407D-06/ + + data (calcpts(j,35), j = 1,neta) /0.4350D-12, 0.7738D-12, & + & 0.1375D-11, 0.2446D-11, 0.4351D-11, 0.7736D-11, 0.1376D-10, & + & 0.2447D-10, 0.4349D-10, 0.7735D-10, 0.1376D-09, 0.2446D-09, & + & 0.4350D-09, 0.7736D-09, 0.1375D-08, 0.2445D-08, 0.4348D-08, & + & 0.7729D-08, 0.1374D-07, 0.2442D-07, 0.4335D-07, 0.7699D-07, & + & 0.1366D-06, 0.2422D-06, 0.4286D-06, 0.7571D-06, 0.1332D-05, & + & 0.2335D-05, 0.4065D-05, 0.7008D-05, 0.1192D-04, 0.1992D-04, & + & 0.3246D-04, 0.5123D-04, 0.7766D-04, 0.1122D-03, 0.1538D-03, & + & 0.1995D-03, 0.2454D-03, 0.2878D-03, 0.3240D-03, 0.3528D-03, & + & 0.3739D-03, 0.3876D-03, 0.3936D-03, 0.3915D-03, 0.3802D-03, & + & 0.3592D-03, 0.3292D-03, 0.2924D-03, 0.2519D-03, 0.2107D-03, & + & 0.1711D-03, 0.1351D-03, 0.1039D-03, 0.7790D-04, 0.5719D-04, & + & 0.4124D-04, 0.2931D-04, 0.2065D-04, 0.1438D-04, 0.1005D-04, & + & 0.6917D-05, 0.4677D-05, 0.3184D-05, 0.2138D-05, 0.1541D-05, & + & 0.9433D-06, 0.6447D-06, 0.4957D-06, 0.3463D-06, 0.1968D-06, & + & 0.4708D-07/ + + data (calcpts(j,36), j = 1,neta) /0.3005D-12, 0.5345D-12, & + & 0.9500D-12, 0.1690D-11, 0.3005D-11, 0.5344D-11, 0.9502D-11, & + & 0.1690D-10, 0.3004D-10, 0.5343D-10, 0.9503D-10, 0.1690D-09, & + & 0.3005D-09, 0.5344D-09, 0.9497D-09, 0.1689D-08, 0.3003D-08, & + & 0.5338D-08, 0.9488D-08, 0.1686D-07, 0.2994D-07, 0.5318D-07, & + & 0.9438D-07, 0.1673D-06, 0.2960D-06, 0.5229D-06, 0.9201D-06, & + & 0.1613D-05, 0.2808D-05, 0.4841D-05, 0.8237D-05, 0.1376D-04, & + & 0.2242D-04, 0.3538D-04, 0.5364D-04, 0.7751D-04, 0.1062D-03, & + & 0.1378D-03, 0.1696D-03, 0.1989D-03, 0.2240D-03, 0.2442D-03, & + & 0.2594D-03, 0.2699D-03, 0.2761D-03, 0.2777D-03, 0.2743D-03, & + & 0.2651D-03, 0.2496D-03, 0.2282D-03, 0.2023D-03, 0.1741D-03, & + & 0.1455D-03, 0.1180D-03, 0.9320D-04, 0.7159D-04, 0.5369D-04, & + & 0.3936D-04, 0.2845D-04, 0.2023D-04, 0.1425D-04, 0.9918D-05, & + & 0.6928D-05, 0.4684D-05, 0.3339D-05, 0.2292D-05, 0.1544D-05, & + & 0.1095D-05, 0.6464D-06, 0.4971D-06, 0.3476D-06, 0.1979D-06, & + & 0.1981D-06/ + + data (calcpts(j,37), j = 1,neta) /0.2068D-12, 0.3678D-12, & + & 0.6537D-12, 0.1163D-11, 0.2068D-11, 0.3677D-11, 0.6539D-11, & + & 0.1163D-10, 0.2067D-10, 0.3676D-10, 0.6539D-10, 0.1163D-09, & + & 0.2068D-09, 0.3677D-09, 0.6535D-09, 0.1162D-08, 0.2067D-08, & + & 0.3673D-08, 0.6529D-08, 0.1161D-07, 0.2061D-07, 0.3659D-07, & + & 0.6495D-07, 0.1151D-06, 0.2037D-06, 0.3598D-06, 0.6331D-06, & + & 0.1110D-05, 0.1932D-05, 0.3331D-05, 0.5668D-05, 0.9470D-05, & + & 0.1543D-04, 0.2435D-04, 0.3691D-04, 0.5334D-04, 0.7311D-04, & + & 0.9485D-04, 0.1167D-03, 0.1369D-03, 0.1542D-03, 0.1682D-03, & + & 0.1789D-03, 0.1865D-03, 0.1915D-03, 0.1940D-03, 0.1939D-03, & + & 0.1906D-03, 0.1836D-03, 0.1724D-03, 0.1573D-03, 0.1393D-03, & + & 0.1198D-03, 0.1000D-03, 0.8116D-04, 0.6403D-04, 0.4914D-04, & + & 0.3688D-04, 0.2701D-04, 0.1954D-04, 0.1385D-04, 0.9811D-05, & + & 0.6817D-05, 0.4722D-05, 0.3225D-05, 0.2177D-05, 0.1579D-05, & + & 0.9795D-06, 0.6802D-06, 0.5307D-06, 0.3810D-06, 0.2312D-06, & + & 0.8135D-07/ + + data (calcpts(j,38), j = 1,neta) /0.1419D-12, 0.2524D-12, & + & 0.4485D-12, 0.7978D-12, 0.1419D-11, 0.2523D-11, 0.4487D-11, & + & 0.7980D-11, 0.1418D-10, 0.2523D-10, 0.4487D-10, 0.7978D-10, & + & 0.1419D-09, 0.2523D-09, 0.4484D-09, 0.7974D-09, 0.1418D-08, & + & 0.2521D-08, 0.4480D-08, 0.7963D-08, 0.1414D-07, 0.2511D-07, & + & 0.4456D-07, 0.7898D-07, 0.1398D-06, 0.2469D-06, 0.4344D-06, & + & 0.7614D-06, 0.1326D-05, 0.2286D-05, 0.3889D-05, 0.6498D-05, & + & 0.1059D-04, 0.1671D-04, 0.2533D-04, 0.3660D-04, 0.5016D-04, & + & 0.6509D-04, 0.8007D-04, 0.9395D-04, 0.1059D-03, 0.1155D-03, & + & 0.1229D-03, 0.1283D-03, 0.1320D-03, 0.1343D-03, 0.1351D-03, & + & 0.1344D-03, 0.1316D-03, 0.1265D-03, 0.1186D-03, 0.1081D-03, & + & 0.9565D-04, 0.8217D-04, 0.6858D-04, 0.5562D-04, 0.4385D-04, & + & 0.3367D-04, 0.2521D-04, 0.1849D-04, 0.1333D-04, 0.9480D-05, & + & 0.6665D-05, 0.4643D-05, 0.3220D-05, 0.2216D-05, 0.1512D-05, & + & 0.1033D-05, 0.7036D-06, 0.2689D-06, 0.3141D-06, 0.2093D-06, & + & 0.1344D-06/ + + data (calcpts(j,39), j = 1,neta) /0.9721D-13, 0.1729D-12, & + & 0.3073D-12, 0.5466D-12, 0.9722D-12, 0.1729D-11, 0.3074D-11, & + & 0.5467D-11, 0.9717D-11, 0.1728D-10, 0.3074D-10, 0.5466D-10, & + & 0.9719D-10, 0.1729D-09, 0.3072D-09, 0.5463D-09, 0.9715D-09, & + & 0.1727D-08, 0.3069D-08, 0.5455D-08, 0.9686D-08, 0.1720D-07, & + & 0.3053D-07, 0.5411D-07, 0.9577D-07, 0.1692D-06, 0.2976D-06, & + & 0.5216D-06, 0.9082D-06, 0.1566D-05, 0.2664D-05, 0.4452D-05, & + & 0.7252D-05, 0.1145D-04, 0.1735D-04, 0.2507D-04, 0.3437D-04, & + & 0.4459D-04, 0.5486D-04, 0.6437D-04, 0.7254D-04, 0.7914D-04, & + & 0.8422D-04, 0.8797D-04, 0.9062D-04, 0.9238D-04, 0.9334D-04, & + & 0.9349D-04, 0.9267D-04, 0.9059D-04, 0.8691D-04, 0.8140D-04, & + & 0.7414D-04, 0.6557D-04, 0.5631D-04, 0.4698D-04, 0.3810D-04, & + & 0.3004D-04, 0.2306D-04, 0.1728D-04, 0.1268D-04, 0.9146D-05, & + & 0.6510D-05, 0.4592D-05, 0.3213D-05, 0.2224D-05, 0.1550D-05, & + & 0.1070D-05, 0.7407D-06, 0.5159D-06, 0.3511D-06, 0.2462D-06, & + & 0.1713D-06/ + + data (calcpts(j,40), j = 1,neta) /0.6647D-13, 0.1182D-12, & + & 0.2101D-12, 0.3737D-12, 0.6648D-12, 0.1182D-11, 0.2102D-11, & + & 0.3739D-11, 0.6645D-11, 0.1182D-10, 0.2102D-10, 0.3738D-10, & + & 0.6646D-10, 0.1182D-09, 0.2101D-09, 0.3736D-09, 0.6643D-09, & + & 0.1181D-08, 0.2099D-08, 0.3730D-08, 0.6624D-08, 0.1176D-07, & + & 0.2088D-07, 0.3700D-07, 0.6549D-07, 0.1157D-06, 0.2035D-06, & + & 0.3567D-06, 0.6210D-06, 0.1071D-05, 0.1822D-05, 0.3044D-05, & + & 0.4959D-05, 0.7827D-05, 0.1187D-04, 0.1715D-04, 0.2350D-04, & + & 0.3049D-04, 0.3751D-04, 0.4402D-04, 0.4960D-04, 0.5412D-04, & + & 0.5760D-04, 0.6019D-04, 0.6204D-04, 0.6331D-04, 0.6410D-04, & + & 0.6447D-04, 0.6436D-04, 0.6366D-04, 0.6213D-04, 0.5954D-04, & + & 0.5572D-04, 0.5072D-04, 0.4483D-04, 0.3849D-04, 0.3210D-04, & + & 0.2603D-04, 0.2052D-04, 0.1576D-04, 0.1180D-04, 0.8654D-05, & + & 0.6241D-05, 0.4442D-05, 0.3123D-05, 0.2179D-05, 0.1519D-05, & + & 0.1055D-05, 0.7248D-06, 0.5000D-06, 0.3351D-06, 0.2302D-06, & + & 0.1702D-06/ + + data (calcpts(j,41), j = 1,neta) /0.4540D-13, 0.8075D-13, & + & 0.1435D-12, 0.2553D-12, 0.4541D-12, 0.8074D-12, 0.1436D-11, & + & 0.2554D-11, 0.4539D-11, 0.8072D-11, 0.1436D-10, 0.2553D-10, & + & 0.4539D-10, 0.8074D-10, 0.1435D-09, 0.2552D-09, 0.4538D-09, & + & 0.8066D-09, 0.1434D-08, 0.2548D-08, 0.4524D-08, 0.8035D-08, & + & 0.1426D-07, 0.2527D-07, 0.4473D-07, 0.7901D-07, 0.1390D-06, & + & 0.2436D-06, 0.4242D-06, 0.7314D-06, 0.1244D-05, 0.2079D-05, & + & 0.3387D-05, 0.5346D-05, 0.8105D-05, 0.1171D-04, 0.1605D-04, & + & 0.2083D-04, 0.2562D-04, 0.3006D-04, 0.3388D-04, 0.3697D-04, & + & 0.3935D-04, 0.4112D-04, 0.4239D-04, 0.4329D-04, 0.4388D-04, & + & 0.4423D-04, 0.4434D-04, 0.4417D-04, 0.4362D-04, 0.4252D-04, & + & 0.4072D-04, 0.3808D-04, 0.3465D-04, 0.3062D-04, 0.2628D-04, & + & 0.2192D-04, 0.1777D-04, 0.1400D-04, 0.1074D-04, 0.8047D-05, & + & 0.5904D-05, 0.4255D-05, 0.3025D-05, 0.2126D-05, 0.1481D-05, & + & 0.1031D-05, 0.7015D-06, 0.4916D-06, 0.3266D-06, 0.2217D-06, & + & 0.1467D-06/ + + data (calcpts(j,42), j = 1,neta) /0.3100D-13, 0.5513D-13, & + & 0.9799D-13, 0.1743D-12, 0.3100D-12, 0.5512D-12, 0.9801D-12, & + & 0.1743D-11, 0.3098D-11, 0.5511D-11, 0.9802D-11, 0.1743D-10, & + & 0.3099D-10, 0.5512D-10, 0.9795D-10, 0.1742D-09, 0.3098D-09, & + & 0.5506D-09, 0.9787D-09, 0.1740D-08, 0.3089D-08, 0.5485D-08, & + & 0.9735D-08, 0.1725D-07, 0.3054D-07, 0.5394D-07, 0.9490D-07, & + & 0.1663D-06, 0.2896D-06, 0.4993D-06, 0.8496D-06, 0.1420D-05, & + & 0.2313D-05, 0.3650D-05, 0.5533D-05, 0.7995D-05, 0.1096D-04, & + & 0.1422D-04, 0.1749D-04, 0.2052D-04, 0.2313D-04, 0.2524D-04, & + & 0.2686D-04, 0.2807D-04, 0.2895D-04, 0.2957D-04, 0.2999D-04, & + & 0.3026D-04, 0.3040D-04, 0.3041D-04, 0.3025D-04, 0.2984D-04, & + & 0.2907D-04, 0.2782D-04, 0.2601D-04, 0.2366D-04, 0.2091D-04, & + & 0.1794D-04, 0.1497D-04, 0.1213D-04, 0.9555D-05, 0.7337D-05, & + & 0.5493D-05, 0.4024D-05, 0.2899D-05, 0.2059D-05, 0.1460D-05, & + & 0.1010D-05, 0.7099D-06, 0.4850D-06, 0.3350D-06, 0.2300D-06, & + & 0.1551D-06/ + + data (calcpts(j,43), j = 1,neta) /0.2115D-13, 0.3761D-13, & + & 0.6685D-13, 0.1189D-12, 0.2115D-12, 0.3761D-12, 0.6687D-12, & + & 0.1189D-11, 0.2114D-11, 0.3760D-11, 0.6688D-11, 0.1189D-10, & + & 0.2114D-10, 0.3760D-10, 0.6683D-10, 0.1188D-09, 0.2113D-09, & + & 0.3757D-09, 0.6677D-09, 0.1187D-08, 0.2107D-08, 0.3742D-08, & + & 0.6642D-08, 0.1177D-07, 0.2083D-07, 0.3680D-07, 0.6475D-07, & + & 0.1135D-06, 0.1976D-06, 0.3407D-06, 0.5796D-06, 0.9685D-06, & + & 0.1578D-05, 0.2490D-05, 0.3775D-05, 0.5455D-05, 0.7477D-05, & + & 0.9701D-05, 0.1193D-04, 0.1400D-04, 0.1578D-04, 0.1722D-04, & + & 0.1833D-04, 0.1916D-04, 0.1975D-04, 0.2018D-04, 0.2047D-04, & + & 0.2067D-04, 0.2079D-04, 0.2084D-04, 0.2082D-04, 0.2068D-04, & + & 0.2039D-04, 0.1985D-04, 0.1899D-04, 0.1775D-04, 0.1614D-04, & + & 0.1426D-04, 0.1224D-04, 0.1021D-04, 0.8272D-05, 0.6518D-05, & + & 0.5005D-05, 0.3746D-05, 0.2741D-05, 0.1976D-05, 0.1406D-05, & + & 0.9865D-06, 0.6866D-06, 0.4766D-06, 0.3267D-06, 0.2217D-06, & + & 0.1617D-06/ + + data (calcpts(j,44), j = 1,neta) /0.1442D-13, 0.2565D-13, & + & 0.4559D-13, 0.8108D-13, 0.1442D-12, 0.2564D-12, 0.4560D-12, & + & 0.8110D-12, 0.1441D-11, 0.2564D-11, 0.4560D-11, 0.8108D-11, & + & 0.1442D-10, 0.2564D-10, 0.4557D-10, 0.8104D-10, 0.1441D-09, & + & 0.2562D-09, 0.4553D-09, 0.8093D-09, 0.1437D-08, 0.2552D-08, & + & 0.4529D-08, 0.8027D-08, 0.1421D-07, 0.2509D-07, 0.4415D-07, & + & 0.7738D-07, 0.1347D-06, 0.2323D-06, 0.3952D-06, 0.6604D-06, & + & 0.1076D-05, 0.1698D-05, 0.2574D-05, 0.3720D-05, 0.5098D-05, & + & 0.6615D-05, 0.8138D-05, 0.9549D-05, 0.1076D-04, 0.1174D-04, & + & 0.1250D-04, 0.1306D-04, 0.1347D-04, 0.1376D-04, 0.1396D-04, & + & 0.1410D-04, 0.1419D-04, 0.1424D-04, 0.1426D-04, 0.1422D-04, & + & 0.1412D-04, 0.1391D-04, 0.1354D-04, 0.1295D-04, 0.1211D-04, & + & 0.1101D-04, 0.9725D-05, 0.8345D-05, 0.6957D-05, 0.5636D-05, & + & 0.4442D-05, 0.3407D-05, 0.2551D-05, 0.1870D-05, 0.1348D-05, & + & 0.9585D-06, 0.6736D-06, 0.4696D-06, 0.3241D-06, 0.2236D-06, & + & 0.1532D-06/ + + data (calcpts(j,45), j = 1,neta) /0.9834D-14, 0.1749D-13, & + & 0.3109D-13, 0.5530D-13, 0.9836D-13, 0.1749D-12, 0.3110D-12, & + & 0.5531D-12, 0.9831D-12, 0.1749D-11, 0.3110D-11, 0.5530D-11, & + & 0.9833D-11, 0.1749D-10, 0.3108D-10, 0.5527D-10, 0.9829D-10, & + & 0.1747D-09, 0.3105D-09, 0.5519D-09, 0.9800D-09, 0.1740D-08, & + & 0.3089D-08, 0.5474D-08, 0.9689D-08, 0.1711D-07, 0.3011D-07, & + & 0.5277D-07, 0.9189D-07, 0.1584D-06, 0.2696D-06, 0.4504D-06, & + & 0.7337D-06, 0.1158D-05, 0.1756D-05, 0.2537D-05, 0.3477D-05, & + & 0.4511D-05, 0.5550D-05, 0.6512D-05, 0.7339D-05, 0.8008D-05, & + & 0.8524D-05, 0.8909D-05, 0.9187D-05, 0.9385D-05, 0.9524D-05, & + & 0.9620D-05, 0.9684D-05, 0.9725D-05, 0.9746D-05, 0.9745D-05, & + & 0.9716D-05, 0.9642D-05, 0.9496D-05, 0.9241D-05, 0.8837D-05, & + & 0.8258D-05, 0.7509D-05, 0.6633D-05, 0.5691D-05, 0.4745D-05, & + & 0.3847D-05, 0.3031D-05, 0.2327D-05, 0.1743D-05, 0.1278D-05, & + & 0.9198D-06, 0.6558D-06, 0.4624D-06, 0.3229D-06, 0.2254D-06, & + & 0.1564D-06/ + + data (calcpts(j,46), j = 1,neta) /0.6703D-14, 0.1192D-13, & + & 0.2119D-13, 0.3769D-13, 0.6704D-13, 0.1192D-12, 0.2120D-12, & + & 0.3770D-12, 0.6701D-12, 0.1192D-11, 0.2120D-11, 0.3769D-11, & + & 0.6702D-11, 0.1192D-10, 0.2118D-10, 0.3767D-10, 0.6699D-10, & + & 0.1191D-09, 0.2116D-09, 0.3762D-09, 0.6679D-09, 0.1186D-08, & + & 0.2105D-08, 0.3731D-08, 0.6603D-08, 0.1166D-07, 0.2052D-07, & + & 0.3597D-07, 0.6263D-07, 0.1080D-06, 0.1837D-06, 0.3070D-06, & + & 0.5001D-06, 0.7893D-06, 0.1196D-05, 0.1729D-05, 0.2370D-05, & + & 0.3075D-05, 0.3783D-05, 0.4439D-05, 0.5002D-05, 0.5458D-05, & + & 0.5810D-05, 0.6072D-05, 0.6262D-05, 0.6397D-05, 0.6492D-05, & + & 0.6557D-05, 0.6602D-05, 0.6632D-05, 0.6650D-05, 0.6657D-05, & + & 0.6652D-05, 0.6629D-05, 0.6576D-05, 0.6475D-05, 0.6300D-05, & + & 0.6024D-05, 0.5629D-05, 0.5117D-05, 0.4519D-05, 0.3879D-05, & + & 0.3234D-05, 0.2621D-05, 0.2066D-05, 0.1585D-05, 0.1187D-05, & + & 0.8707D-06, 0.6277D-06, 0.4462D-06, 0.3143D-06, 0.2198D-06, & + & 0.1523D-06/ + + data (calcpts(j,47), j = 1,neta) /0.4567D-14, 0.8124D-14, & + & 0.1444D-13, 0.2568D-13, 0.4568D-13, 0.8122D-13, 0.1444D-12, & + & 0.2569D-12, 0.4566D-12, 0.8121D-12, 0.1444D-11, 0.2568D-11, & + & 0.4567D-11, 0.8122D-11, 0.1443D-10, 0.2567D-10, 0.4565D-10, & + & 0.8114D-10, 0.1442D-09, 0.2563D-09, 0.4551D-09, 0.8083D-09, & + & 0.1435D-08, 0.2542D-08, 0.4500D-08, 0.7948D-08, 0.1398D-07, & + & 0.2451D-07, 0.4267D-07, 0.7358D-07, 0.1252D-06, 0.2092D-06, & + & 0.3408D-06, 0.5378D-06, 0.8153D-06, 0.1178D-05, 0.1615D-05, & + & 0.2095D-05, 0.2578D-05, 0.3025D-05, 0.3409D-05, 0.3719D-05, & + & 0.3959D-05, 0.4138D-05, 0.4267D-05, 0.4359D-05, 0.4424D-05, & + & 0.4468D-05, 0.4499D-05, 0.4520D-05, 0.4534D-05, 0.4541D-05, & + & 0.4543D-05, 0.4537D-05, 0.4520D-05, 0.4483D-05, 0.4413D-05, & + & 0.4294D-05, 0.4105D-05, 0.3835D-05, 0.3487D-05, 0.3080D-05, & + & 0.2643D-05, 0.2203D-05, 0.1785D-05, 0.1407D-05, 0.1078D-05, & + & 0.8084D-06, 0.5924D-06, 0.4274D-06, 0.3029D-06, 0.2129D-06, & + & 0.1484D-06/ + + data (calcpts(j,48), j = 1,neta) /0.3113D-14, 0.5537D-14, & + & 0.9840D-14, 0.1750D-13, 0.3113D-13, 0.5535D-13, 0.9843D-13, & + & 0.1751D-12, 0.3112D-12, 0.5534D-12, 0.9844D-12, 0.1750D-11, & + & 0.3112D-11, 0.5535D-11, 0.9837D-11, 0.1749D-10, 0.3111D-10, & + & 0.5530D-10, 0.9829D-10, 0.1747D-09, 0.3102D-09, 0.5509D-09, & + & 0.9777D-09, 0.1733D-08, 0.3067D-08, 0.5417D-08, 0.9531D-08, & + & 0.1670D-07, 0.2908D-07, 0.5014D-07, 0.8532D-07, 0.1426D-06, & + & 0.2322D-06, 0.3665D-06, 0.5557D-06, 0.8030D-06, 0.1101D-05, & + & 0.1428D-05, 0.1757D-05, 0.2061D-05, 0.2323D-05, 0.2535D-05, & + & 0.2698D-05, 0.2820D-05, 0.2908D-05, 0.2971D-05, 0.3015D-05, & + & 0.3045D-05, 0.3067D-05, 0.3081D-05, 0.3091D-05, 0.3097D-05, & + & 0.3100D-05, 0.3099D-05, 0.3094D-05, 0.3082D-05, 0.3056D-05, & + & 0.3009D-05, 0.2927D-05, 0.2798D-05, 0.2614D-05, 0.2377D-05, & + & 0.2099D-05, 0.1801D-05, 0.1502D-05, 0.1217D-05, 0.9587D-06, & + & 0.7353D-06, 0.5508D-06, 0.4038D-06, 0.2913D-06, 0.2073D-06, & + & 0.1458D-06/ + + data (calcpts(j,49), j = 1,neta) /0.2121D-14, 0.3773D-14, & + & 0.6706D-14, 0.1193D-13, 0.2121D-13, 0.3772D-13, 0.6708D-13, & + & 0.1193D-12, 0.2120D-12, 0.3771D-12, 0.6708D-12, 0.1193D-11, & + & 0.2121D-11, 0.3772D-11, 0.6703D-11, 0.1192D-10, 0.2120D-10, & + & 0.3768D-10, 0.6698D-10, 0.1190D-09, 0.2114D-09, 0.3754D-09, & + & 0.6662D-09, 0.1181D-08, 0.2090D-08, 0.3691D-08, 0.6495D-08, & + & 0.1138D-07, 0.1982D-07, 0.3417D-07, 0.5814D-07, 0.9715D-07, & + & 0.1583D-06, 0.2498D-06, 0.3786D-06, 0.5472D-06, 0.7499D-06, & + & 0.9731D-06, 0.1197D-05, 0.1405D-05, 0.1583D-05, 0.1727D-05, & + & 0.1839D-05, 0.1921D-05, 0.1982D-05, 0.2024D-05, 0.2054D-05, & + & 0.2075D-05, 0.2090D-05, 0.2100D-05, 0.2106D-05, 0.2111D-05, & + & 0.2113D-05, 0.2114D-05, 0.2113D-05, 0.2110D-05, 0.2101D-05, & + & 0.2083D-05, 0.2050D-05, 0.1994D-05, 0.1907D-05, 0.1781D-05, & + & 0.1620D-05, 0.1430D-05, 0.1227D-05, 0.1023D-05, 0.8291D-06, & + & 0.6532D-06, 0.5011D-06, 0.3751D-06, 0.2746D-06, 0.1981D-06, & + & 0.1411D-06/ + + data (dlaeta(j), j = 1,neta) / & + & -6d0, -5.83333333d0, -5.66666667d0, -5.5d0, -5.33333333d0, & + & -5.16666667d0, -5d0, -4.83333333d0, -4.66666667d0, -4.5d0, & + & -4.33333333d0, -4.16666667d0, -4d0, -3.83333333d0, & + & -3.66666667d0, -3.5d0, -3.33333333d0, -3.16666667d0, -3d0, & + & -2.83333333d0, -2.66666667d0, -2.5d0, -2.33333333d0, & + & -2.16666667d0, -2d0, -1.83333333d0, -1.66666667d0, -1.5d0, & + & -1.33333333d0, -1.16666667d0, -1d0, -0.83333333d0, -0.66666667d0,& + & -0.5d0, -0.33333333d0, -0.16666667d0, 0d0, 0.16666667d0, & + & 0.33333333d0, 0.5d0, 0.66666667d0, 0.83333333d0, 1d0, & + & 1.16666667d0, 1.33333333d0, 1.5d0, 1.66666667d0, 1.83333333d0, & + & 2d0, 2.16666667d0, 2.33333333d0, 2.5d0, 2.66666667d0, & + & 2.83333333d0, 3d0, 3.16666667d0, 3.33333333d0, 3.5d0, & + & 3.66666667d0, 3.83333333d0, 4d0, 4.16666667d0, 4.33333333d0, & + & 4.5d0, 4.66666667d0, 4.83333333d0, 5d0, 5.16666667d0, & + & 5.33333333d0, 5.5d0, 5.66666667d0, 5.83333333d0, 6d0/ + + data (dlaxi(j), j = 1,nxi) / & + & -3d0, -2.83333333d0, -2.66666667d0, -2.5d0, -2.33333333d0, & + & -2.16666667d0, -2d0, -1.83333333d0, -1.66666667d0, -1.5d0, & + & -1.33333333d0, -1.16666667d0, -1d0, -0.83333333d0, -0.66666667d0,& + & -0.5d0, -0.33333333d0, -0.16666667d0, 0d0, 0.16666667d0, & + & 0.33333333d0, 0.5d0, 0.66666667d0, 0.83333333d0, 1d0, & + & 1.16666667d0, 1.33333333d0, 1.5d0, 1.66666667d0, 1.83333333d0, & + & 2d0, 2.16666667d0, 2.33333333d0, 2.5d0, 2.66666667d0, & + & 2.83333333d0, 3d0, 3.16666667d0, 3.33333333d0, 3.5d0, & + & 3.66666667d0, 3.83333333d0, 4d0, 4.16666667d0, 4.33333333d0, & + & 4.5d0, 4.66666667d0, 4.83333333d0, 5d0/ + + dleta = dlog10(eta) + dlxi = dlog10(xi) + if (dlxi .le. dlaxi(1)) dlxi = dlaxi(1) + if (dlxi .ge. dlaxi(nxi)) dlxi = dlaxi(nxi) + if (dleta .ge. dlaeta(neta)) dleta = dlaeta(neta) + if (dleta .le. dlaeta(1)) dleta = dlaeta(1) + call locate(dlaeta,neta, dleta, ieta) + call locate(dlaxi, nxi, dlxi, ixi) +! interpolating between the appropriate points + delxi = 1d0/6d0 + deleta = 1d0/6d0 +! lagrange 3-pt. + if (ixi .le. 2) ixi = 2 + if (ixi .ge. 48) ixi = 48 + if (ieta .le. 2) ieta = 2 + if (ieta .ge. 72) ieta = 72 + pxi = (dlxi - dlaxi(ixi))/delxi + f(-1) = pxi*(pxi-1d0)/2d0*calcpts(ieta-1,ixi-1) + & + & (1d0 - pxi**2)*calcpts(ieta-1,ixi) + & + & pxi*(pxi+1d0)/2d0*calcpts(ieta-1,ixi+1) + f(0) = pxi*(pxi-1d0)/2d0*calcpts(ieta,ixi-1) + & + & (1d0 - pxi**2)*calcpts(ieta,ixi) + & + & pxi*(pxi+1d0)/2d0*calcpts(ieta,ixi+1) + f(1) = pxi*(pxi-1d0)/2d0*calcpts(ieta+1,ixi-1) + & + & (1d0 - pxi**2)*calcpts(ieta+1,ixi) + & + & pxi*(pxi+1d0)/2d0*calcpts(ieta+1,ixi+1) + peta = (dleta - dlaeta(ieta))/deleta + h1bar_HLq = peta*(peta-1d0)/2d0*f(-1) + & + & (1d0 - peta**2)*f(0) + & + & peta*(peta+1d0)/2d0*f(1) +!MB + + peta*(peta+1d0)/2d0*f(1) + return + END + +! ========================================= + double precision function h1f_LLq(eta,xi) +! ========================================= + +! eq (28) in PLB347 (1995) 143 - 151 for the longitudinal piece +! This also takes into account the additional mass factorizations +! necessary from a low Q^2 photon coupling to the light quark. +! MSbar scheme +! This routine is called subd1lqf in the original code. +! Gives h1_LLq for Q2 < 1.5 GeV2 (use h1_LLq for Q2 > 1.5 GeV2). + + implicit none + integer neta, nxi + parameter (neta = 45, nxi = 15) + double precision calcpts(neta,nxi), aeta(neta), axi(nxi) + double precision eta, xi, huge, small + double precision t, u, y1, y2, y3, y4 + parameter (small = 1.d-8, huge = 1.d10) + integer j, ieta, ixi + + data (calcpts(j, 1), j=1,neta) /0.d0, -.4776D-09, -.6020D-08, & + & -.1815D-07, -.3618D-07, -.5922D-07, -.7236D-07, -.4052D-06, & + & -.5175D-06, -.9498D-07, 0.1024D-05, 0.1868D-05, 0.2083D-04, & + & 0.5522D-04, 0.9831D-04, 0.1448D-03, 0.1913D-03, 0.2357D-03, & + & 0.2769D-03, 0.3144D-03, 0.3480D-03, 0.5190D-03, 0.5396D-03, & + & 0.5166D-03, 0.4819D-03, 0.4467D-03, 0.4138D-03, 0.3843D-03, & + & 0.3581D-03, 0.3348D-03, 0.1415D-03, 0.8921D-04, 0.6507D-04, & + & 0.5126D-04, 0.4629D-04, 0.2359D-04, 0.1582D-04, 0.9541D-05, & + & 0.6834D-05, 0.5321D-05, 0.4785D-05, 0.9609D-06, 0.4809D-06, & + & 0.4800D-07, 0.d0/ +! + data (calcpts(j, 2), j=1,neta) /0.d0, -.3228D-09, -.4385D-08, & + & -.1380D-07, -.2816D-07, -.4656D-07, -.5691D-07, -.1957D-06, & + & 0.4271D-06, 0.2429D-05, 0.6145D-05, 0.8706D-05, 0.5987D-04, & + & 0.1485D-03, 0.2585D-03, 0.3771D-03, 0.4953D-03, 0.6087D-03, & + & 0.7136D-03, 0.8094D-03, 0.8954D-03, 0.1336D-02, 0.1391D-02, & + & 0.1332D-02, 0.1244D-02, 0.1153D-02, 0.1069D-02, 0.9933D-03, & + & 0.9254D-03, 0.8649D-03, 0.3657D-03, 0.2305D-03, 0.1682D-03, & + & 0.1325D-03, 0.1197D-03, 0.6099D-04, 0.4089D-04, 0.2469D-04, & + & 0.1765D-04, 0.1375D-04, 0.1239D-04, 0.2480D-05, 0.1242D-05, & + & 0.1244D-06, 0.d0/ +! + data (calcpts(j, 3), j=1,neta) /0.d0, -.7553D-10, -.9480D-09, & + & -.2635D-08, -.4464D-08, -.5487D-08, -.5352D-08, 0.3277D-06, & + & 0.2037D-05, 0.5960D-05, 0.1261D-04, 0.1707D-04, 0.1039D-03, & + & 0.2553D-03, 0.4464D-03, 0.6548D-03, 0.8652D-03, 0.1068D-02, & + & 0.1259D-02, 0.1434D-02, 0.1592D-02, 0.2423D-02, 0.2543D-02, & + & 0.2445D-02, 0.2289D-02, 0.2125D-02, 0.1971D-02, 0.1832D-02, & + & 0.1707D-02, 0.1598D-02, 0.6758D-03, 0.4258D-03, 0.3108D-03, & + & 0.2446D-03, 0.2209D-03, 0.1126D-03, 0.7551D-04, 0.4554D-04, & + & 0.3260D-04, 0.2538D-04, 0.2284D-04, 0.4588D-05, 0.2292D-05, & + & 0.2292D-06, 0.d0/ +! + data (calcpts(j, 4), j=1,neta) /0.d0, 0.1486D-11, 0.9642D-10, & + & 0.6003D-09, 0.1963D-08, 0.4715D-08, 0.6797D-08, 0.2807D-06, & + & 0.1468D-05, 0.4193D-05, 0.8945D-05, 0.1219D-04, 0.8137D-04, & + & 0.2145D-03, 0.3941D-03, 0.6006D-03, 0.8178D-03, 0.1034D-02, & + & 0.1243D-02, 0.1439D-02, 0.1620D-02, 0.2652D-02, 0.2861D-02, & + & 0.2787D-02, 0.2627D-02, 0.2448D-02, 0.2279D-02, 0.2121D-02, & + & 0.1980D-02, 0.1854D-02, 0.7854D-03, 0.4940D-03, 0.3602D-03, & + & 0.2834D-03, 0.2559D-03, 0.1302D-03, 0.8738D-04, 0.5263D-04, & + & 0.3765D-04, 0.2933D-04, 0.2638D-04, 0.5286D-05, 0.2649D-05, & + & 0.2645D-06, 0.d0/ +! + data (calcpts(j, 5), j=1,neta) /0.d0, 0.7637D-12, 0.3540D-10, & + & 0.2097D-09, 0.6749D-09, 0.1613D-08, 0.2322D-08, 0.9969D-07, & + & 0.5478D-06, 0.1638D-05, 0.3644D-05, 0.5064D-05, 0.3938D-04, & + & 0.1154D-03, 0.2295D-03, 0.3726D-03, 0.5337D-03, 0.7044D-03, & + & 0.8778D-03, 0.1048D-02, 0.1212D-02, 0.2309D-02, 0.2654D-02, & + & 0.2671D-02, 0.2570D-02, 0.2426D-02, 0.2276D-02, 0.2130D-02, & + & 0.1998D-02, 0.1876D-02, 0.8007D-03, 0.5025D-03, 0.3653D-03, & + & 0.2870D-03, 0.2591D-03, 0.1314D-03, 0.8796D-04, 0.5287D-04, & + & 0.3783D-04, 0.2940D-04, 0.2647D-04, 0.5306D-05, 0.2651D-05, & + & 0.2651D-06, 0.d0/ +! + data (calcpts(j, 6), j=1,neta) /0.d0, 0.3057D-12, 0.1420D-10, & + & 0.8435D-10, 0.2719D-09, 0.6511D-09, 0.9384D-09, 0.4110D-07, & + & 0.2302D-06, 0.7017D-06, 0.1588D-05, 0.2228D-05, 0.1869D-04, & + & 0.5837D-04, 0.1227D-03, 0.2088D-03, 0.3120D-03, 0.4274D-03, & + & 0.5504D-03, 0.6773D-03, 0.8046D-03, 0.1824D-02, 0.2286D-02, & + & 0.2424D-02, 0.2408D-02, 0.2325D-02, 0.2216D-02, 0.2100D-02, & + & 0.1985D-02, 0.1876D-02, 0.8223D-03, 0.5151D-03, 0.3734D-03, & + & 0.2925D-03, 0.2639D-03, 0.1329D-03, 0.8870D-04, 0.5322D-04, & + & 0.3800D-04, 0.2958D-04, 0.2661D-04, 0.5309D-05, 0.2655D-05, & + & 0.2652D-06, 0.d0/ +! + data (calcpts(j, 7), j=1,neta) /0.d0, 0.2418D-12, 0.1123D-10, & + & 0.6674D-10, 0.2154D-09, 0.5155D-09, 0.7433D-09, 0.3266D-07, & + & 0.1835D-06, 0.5605D-06, 0.1272D-05, 0.1787D-05, 0.1518D-04, & + & 0.4799D-04, 0.1020D-03, 0.1754D-03, 0.2644D-03, 0.3654D-03, & + & 0.4742D-03, 0.5879D-03, 0.7031D-03, 0.1673D-02, 0.2155D-02, & + & 0.2326D-02, 0.2337D-02, 0.2276D-02, 0.2183D-02, 0.2078D-02, & + & 0.1971D-02, 0.1869D-02, 0.8293D-03, 0.5196D-03, 0.3765D-03, & + & 0.2948D-03, 0.2657D-03, 0.1336D-03, 0.8898D-04, 0.5337D-04, & + & 0.3807D-04, 0.2961D-04, 0.2664D-04, 0.5312D-05, 0.2655D-05, & + & 0.2654D-06, 0.d0/ +! + data (calcpts(j, 8), j=1,neta) /0.d0, 0.1019D-12, 0.4742D-11, & + & 0.2817D-10, 0.9098D-10, 0.2179D-09, 0.3144D-09, 0.1390D-07, & + & 0.7859D-07, 0.2416D-06, 0.5520D-06, 0.7771D-06, 0.6819D-05, & + & 0.2222D-04, 0.4859D-04, 0.8589D-04, 0.1330D-03, 0.1882D-03, & + & 0.2503D-03, 0.3175D-03, 0.3882D-03, 0.1095D-02, 0.1577D-02, & + & 0.1835D-02, 0.1947D-02, 0.1976D-02, 0.1955D-02, 0.1908D-02, & + & 0.1847D-02, 0.1779D-02, 0.8622D-03, 0.5429D-03, 0.3925D-03, & + & 0.3067D-03, 0.2760D-03, 0.1374D-03, 0.9090D-04, 0.5416D-04, & + & 0.3855D-04, 0.2988D-04, 0.2687D-04, 0.5327D-05, 0.2658D-05, & + & 0.2655D-06, 0.d0/ +! + data (calcpts(j, 9), j=1,neta) /0.d0, 0.7647D-13, 0.3556D-11, & + & 0.2113D-10, 0.6827D-10, 0.1635D-09, 0.2358D-09, 0.1045D-07, & + & 0.5912D-07, 0.1821D-06, 0.4163D-06, 0.5868D-06, 0.5177D-05, & + & 0.1697D-04, 0.3735D-04, 0.6637D-04, 0.1034D-03, 0.1474D-03, & + & 0.1971D-03, 0.2514D-03, 0.3091D-03, 0.9150D-03, 0.1365D-02, & + & 0.1635D-02, 0.1773D-02, 0.1829D-02, 0.1836D-02, 0.1811D-02, & + & 0.1769D-02, 0.1716D-02, 0.8732D-03, 0.5532D-03, 0.4004D-03, & + & 0.3122D-03, 0.2813D-03, 0.1392D-03, 0.9206D-04, 0.5460D-04, & + & 0.3876D-04, 0.3009D-04, 0.2702D-04, 0.5337D-05, 0.2666D-05, & + & 0.2654D-06, 0.d0/ +! + data (calcpts(j,10), j=1,neta) /0.d0, 0.2420D-13, 0.1125D-11, & + & 0.6694D-11, 0.2160D-10, 0.5178D-10, 0.7469D-10, 0.3315D-08, & + & 0.1881D-07, 0.5808D-07, 0.1332D-06, 0.1879D-06, 0.1680D-05, & + & 0.5582D-05, 0.1245D-04, 0.2245D-04, 0.3549D-04, 0.5128D-04, & + & 0.6956D-04, 0.8996D-04, 0.1122D-03, 0.3801D-03, 0.6375D-03, & + & 0.8418D-03, 0.9927D-03, 0.1100D-02, 0.1172D-02, 0.1219D-02, & + & 0.1246D-02, 0.1259D-02, 0.8760D-03, 0.5937D-03, 0.4388D-03, & + & 0.3447D-03, 0.3107D-03, 0.1521D-03, 0.9921D-04, 0.5789D-04, & + & 0.4068D-04, 0.3131D-04, 0.2807D-04, 0.5393D-05, 0.2676D-05, & + & 0.2657D-06, 0.d0/ +! + data (calcpts(j,11), j=1,neta) /0.d0, 0.7649D-14, 0.3559D-12, & + & 0.2115D-11, 0.6834D-11, 0.1638D-10, 0.2363D-10, 0.1050D-08, & + & 0.5961D-08, 0.1842D-07, 0.4226D-07, 0.5963D-07, 0.5356D-06, & + & 0.1787D-05, 0.4008D-05, 0.7258D-05, 0.1153D-04, 0.1675D-04, & + & 0.2284D-04, 0.2971D-04, 0.3726D-04, 0.1337D-03, 0.2379D-03, & + & 0.3324D-03, 0.4140D-03, 0.4825D-03, 0.5399D-03, 0.5868D-03, & + & 0.6257D-03, 0.6576D-03, 0.7086D-03, 0.5671D-03, 0.4546D-03, & + & 0.3732D-03, 0.3411D-03, 0.1752D-03, 0.1142D-03, 0.6549D-04, & + & 0.4530D-04, 0.3443D-04, 0.3069D-04, 0.5568D-05, 0.2727D-05, & + & 0.2662D-06, 0.d0/ +! + data (calcpts(j,12), j=1,neta) /0.d0, 0.2418D-14, 0.1125D-12, & + & 0.6692D-12, 0.2161D-11, 0.5181D-11, 0.7473D-11, 0.3320D-09, & + & 0.1887D-08, 0.5829D-08, 0.1338D-07, 0.1889D-07, 0.1698D-06, & + & 0.5675D-06, 0.1274D-05, 0.2312D-05, 0.3679D-05, 0.5354D-05, & + & 0.7313D-05, 0.9531D-05, 0.1198D-04, 0.4386D-04, 0.7982D-04, & + & 0.1143D-03, 0.1456D-03, 0.1738D-03, 0.1991D-03, 0.2216D-03, & + & 0.2415D-03, 0.2595D-03, 0.3963D-03, 0.3921D-03, 0.3609D-03, & + & 0.3261D-03, 0.3095D-03, 0.1923D-03, 0.1333D-03, 0.7890D-04, & + & 0.5455D-04, 0.4114D-04, 0.3653D-04, 0.6024D-05, 0.2865D-05, & + & 0.2682D-06, 0.d0/ +! + data (calcpts(j,13), j=1,neta) /0.d0, 0.7684D-15, 0.3558D-13, & + & 0.2117D-12, 0.6833D-12, 0.1638D-11, 0.2362D-11, 0.1050D-09, & + & 0.5965D-09, 0.1844D-08, 0.4233D-08, 0.5975D-08, 0.5375D-07, & + & 0.1797D-06, 0.4038D-06, 0.7329D-06, 0.1166D-05, 0.1700D-05, & + & 0.2322D-05, 0.3029D-05, 0.3806D-05, 0.1403D-04, 0.2573D-04, & + & 0.3713D-04, 0.4772D-04, 0.5745D-04, 0.6639D-04, 0.7458D-04, & + & 0.8210D-04, 0.8896D-04, 0.1616D-03, 0.1850D-03, 0.1919D-03, & + & 0.1917D-03, 0.1901D-03, 0.1583D-03, 0.1280D-03, 0.8802D-04, & + & 0.6498D-04, 0.5058D-04, 0.4533D-04, 0.7158D-05, 0.3225D-05, & + & 0.2742D-06, 0.d0/ +! + data (calcpts(j,14), j=1,neta) /0.d0, 0.1468D-15, 0.7101D-14, & + & 0.4230D-13, 0.1367D-12, 0.3276D-12, 0.4727D-12, 0.2100D-10, & + & 0.1194D-09, 0.3687D-09, 0.8462D-09, 0.1195D-08, 0.1075D-07, & + & 0.3596D-07, 0.8079D-07, 0.1467D-06, 0.2335D-06, 0.3402D-06, & + & 0.4652D-06, 0.6066D-06, 0.7628D-06, 0.2819D-05, 0.5184D-05, & + & 0.7505D-05, 0.9676D-05, 0.1169D-04, 0.1356D-04, 0.1527D-04, & + & 0.1688D-04, 0.1836D-04, 0.3604D-04, 0.4455D-04, 0.4976D-04, & + & 0.5326D-04, 0.5457D-04, 0.6029D-04, 0.6027D-04, 0.5579D-04, & + & 0.5019D-04, 0.4495D-04, 0.4254D-04, 0.1047D-04, 0.4619D-05, & + & 0.3043D-06, 0.d0/ +! + data (calcpts(j,15), j=1,neta) /0.d0, 0.8083D-16, 0.3549D-14, & + & 0.2130D-13, 0.6840D-13, 0.1637D-12, 0.2361D-12, 0.1050D-10, & + & 0.5967D-10, 0.1844D-09, 0.4233D-09, 0.5976D-09, 0.5376D-08, & + & 0.1799D-07, 0.4040D-07, 0.7337D-07, 0.1168D-06, 0.1701D-06, & + & 0.2325D-06, 0.3033D-06, 0.3815D-06, 0.1410D-05, 0.2595D-05, & + & 0.3756D-05, 0.4847D-05, 0.5861D-05, 0.6792D-05, 0.7664D-05, & + & 0.8469D-05, 0.9219D-05, 0.1827D-04, 0.2285D-04, 0.2580D-04, & + & 0.2793D-04, 0.2877D-04, 0.3348D-04, 0.3515D-04, 0.3546D-04, & + & 0.3425D-04, 0.3258D-04, 0.3168D-04, 0.1158D-04, 0.5529D-05, & + & 0.3374D-06, 0.d0/ +! + data (aeta(j), j = 1,neta) /small, 0.1000d-02, 0.3000d-02, & + & 0.5000d-02, 0.7000d-02, 0.9000d-02, 0.1000d-01, 0.3000d-01, & + & 0.5000d-01, 0.7000d-01, 0.9000d-01, 0.1000d+00, 0.2000d+00, & + & 0.3000d+00, 0.4000d+00, 0.5000d+00, 0.6000d+00, 0.7000d+00, & + & 0.8000d+00, 0.9000d+00, 0.1000d+01, 0.2000d+01, 0.3000d+01, & + & 0.4000d+01, 0.5000d+01, 0.6000d+01, 0.7000d+01, 0.8000d+01, & + & 0.9000d+01, 0.1000d+02, 0.3000d+02, 0.5000d+02, 0.7000d+02, & + & 0.9000d+02, 0.1000d+03, 0.2000d+03, 0.3000d+03, 0.5000d+03, & + & 0.7000d+03, 0.9000d+03, 0.1000d+04, 0.5000d+04, 0.1000d+05, & + & 0.1000d+06, huge/ +! + data (axi(j), j = 1,nxi) /0.1000d-01, 0.3162d-01, 0.1000d+00, & + & 0.3162d+00, 0.1000d+01, 0.2500d+01, 0.3162d+01, 0.7500d+01, & + & 0.1000d+02, 0.3162d+02, 0.1000d+03, 0.3162d+03, 0.1000d+04, & + & 0.5000d+04, 0.1000d+05/ +! +! here we have to choose the array elements that will go into the +! interpolation. + call locate(aeta, neta, eta, ieta) + call locate(axi, nxi, xi, ixi) + if (ieta .le. 1) ieta = 1 + if (ieta .gt. (neta - 1)) ieta = neta - 1 + if (ixi .le. 1) ixi = 1 + if (ixi .gt. (nxi - 1)) ixi = nxi - 1 + y1 = calcpts(ieta,ixi) + y2 = calcpts(ieta+1,ixi) + y3 = calcpts(ieta+1,ixi+1) + y4 = calcpts(ieta,ixi+1) +! interpolating between the points + t = (eta - aeta(ieta))/(aeta(ieta + 1) - aeta(ieta)) + u = (xi - axi(ixi))/(axi(ixi + 1) - axi(ixi)) + h1f_LLq = (1.d0 - t)*(1.d0 - u)*y1 + t*(1.d0 - u)*y2 + & + & t*u*y3 + (1.d0 - t)*u*y4 + + return + END + +! ======================================== + double precision function h1_LLq(eta,xi) +! ======================================== + +! eq (28) in PLB347 (1995) 143 - 151 for the longitudinal piece +! MSbar scheme +! This routine is called subd1lq in the original code. +! Gives h1_LLq for Q2 > 1.5 GeV2 (use h1f_LLq for Q2 < 1.5 GeV2). +! Called sclql in updated code (03/06/96). + + implicit none + integer neta, nxi + parameter (neta = 73, nxi = 49) + double precision calcpts(neta, nxi), dlaeta(neta), dlaxi(nxi) + double precision eta, xi, dleta, dlxi + double precision pxi, peta, f(-1:1), delxi, deleta + integer j, ieta, ixi + + data (calcpts(j, 1), j = 1,neta) /0.2423D-19, 0.9273D-19, & + & 0.3548D-18, 0.1357D-17, 0.5186D-17, 0.1980D-16, 0.7542D-16, & + & 0.2866D-15, 0.1085D-14, 0.4089D-14, 0.1530D-13, 0.5665D-13, & + & 0.2072D-12, 0.7446D-12, 0.2620D-11, 0.8998D-11, 0.3005D-10, & + & 0.9740D-10, 0.3063D-09, 0.9353D-09, 0.2775D-08, 0.8042D-08, & + & 0.2279D-07, 0.6327D-07, 0.1727D-06, 0.4629D-06, 0.1221D-05, & + & 0.3162D-05, 0.8022D-05, 0.1983D-04, 0.4740D-04, 0.1084D-03, & + & 0.2341D-03, 0.4692D-03, 0.8571D-03, 0.1404D-02, 0.2035D-02, & + & 0.2598D-02, 0.2933D-02, 0.2958D-02, 0.2711D-02, 0.2297D-02, & + & 0.1833D-02, 0.1397D-02, 0.1031D-02, 0.7420D-03, 0.5253D-03, & + & 0.3675D-03, 0.2550D-03, 0.1760D-03, 0.1209D-03, 0.8283D-04, & + & 0.5665D-04, 0.3870D-04, 0.2642D-04, 0.1803D-04, 0.1229D-04, & + & 0.8378D-05, 0.5710D-05, 0.3891D-05, 0.2652D-05, 0.1806D-05, & + & 0.1231D-05, 0.8387D-06, 0.5715D-06, 0.3893D-06, 0.2652D-06, & + & 0.1808D-06, 0.1231D-06, 0.8388D-07, 0.5715D-07, 0.3894D-07, & + & 0.2652D-07/ + + data (calcpts(j, 2), j = 1,neta) /0.1652D-19, 0.6323D-19, & + & 0.2421D-18, 0.9263D-18, 0.3541D-17, 0.1354D-16, 0.5166D-16, & + & 0.1968D-15, 0.7482D-15, 0.2834D-14, 0.1067D-13, 0.3993D-13, & + & 0.1479D-12, 0.5406D-12, 0.1944D-11, 0.6840D-11, 0.2347D-10, & + & 0.7839D-10, 0.2540D-09, 0.7985D-09, 0.2433D-08, 0.7222D-08, & + & 0.2090D-07, 0.5907D-07, 0.1635D-06, 0.4438D-06, 0.1182D-05, & + & 0.3085D-05, 0.7875D-05, 0.1956D-04, 0.4694D-04, 0.1077D-03, & + & 0.2329D-03, 0.4676D-03, 0.8553D-03, 0.1402D-02, 0.2034D-02, & + & 0.2598D-02, 0.2933D-02, 0.2958D-02, 0.2711D-02, 0.2297D-02, & + & 0.1833D-02, 0.1397D-02, 0.1031D-02, 0.7420D-03, 0.5253D-03, & + & 0.3675D-03, 0.2550D-03, 0.1760D-03, 0.1209D-03, 0.8283D-04, & + & 0.5665D-04, 0.3871D-04, 0.2642D-04, 0.1803D-04, 0.1229D-04, & + & 0.8378D-05, 0.5710D-05, 0.3891D-05, 0.2652D-05, 0.1806D-05, & + & 0.1231D-05, 0.8387D-06, 0.5715D-06, 0.3893D-06, 0.2652D-06, & + & 0.1808D-06, 0.1231D-06, 0.8388D-07, 0.5715D-07, 0.3894D-07, & + & 0.2652D-07/ + + data (calcpts(j, 3), j = 1,neta) /0.1125D-19, 0.4310D-19, & + & 0.1650D-18, 0.6318D-18, 0.2418D-17, 0.9246D-17, 0.3534D-16, & + & 0.1349D-15, 0.5139D-15, 0.1953D-14, 0.7395D-14, 0.2786D-13, & + & 0.1042D-12, 0.3859D-12, 0.1411D-11, 0.5072D-11, 0.1785D-10, & + & 0.6126D-10, 0.2045D-09, 0.6621D-09, 0.2081D-08, 0.6333D-08, & + & 0.1876D-07, 0.5418D-07, 0.1527D-06, 0.4206D-06, 0.1134D-05, & + & 0.2988D-05, 0.7687D-05, 0.1922D-04, 0.4632D-04, 0.1066D-03, & + & 0.2314D-03, 0.4655D-03, 0.8527D-03, 0.1399D-02, 0.2031D-02, & + & 0.2597D-02, 0.2931D-02, 0.2958D-02, 0.2711D-02, 0.2298D-02, & + & 0.1833D-02, 0.1398D-02, 0.1031D-02, 0.7420D-03, 0.5253D-03, & + & 0.3675D-03, 0.2550D-03, 0.1760D-03, 0.1209D-03, 0.8283D-04, & + & 0.5665D-04, 0.3871D-04, 0.2642D-04, 0.1803D-04, 0.1229D-04, & + & 0.8378D-05, 0.5710D-05, 0.3891D-05, 0.2652D-05, 0.1806D-05, & + & 0.1231D-05, 0.8387D-06, 0.5715D-06, 0.3893D-06, 0.2652D-06, & + & 0.1808D-06, 0.1231D-06, 0.8388D-07, 0.5715D-07, 0.3894D-07, & + & 0.2652D-07/ + + data (calcpts(j, 4), j = 1,neta) /0.7668D-20, 0.2937D-19, & + & 0.1125D-18, 0.4308D-18, 0.1648D-17, 0.6311D-17, 0.2413D-16, & + & 0.9224D-16, 0.3521D-15, 0.1341D-14, 0.5097D-14, 0.1931D-13, & + & 0.7272D-13, 0.2720D-12, 0.1007D-11, 0.3683D-11, 0.1323D-10, & + & 0.4656D-10, 0.1597D-09, 0.5330D-09, 0.1725D-08, 0.5406D-08, & + & 0.1646D-07, 0.4866D-07, 0.1400D-06, 0.3927D-06, 0.1074D-05, & + & 0.2866D-05, 0.7448D-05, 0.1877D-04, 0.4551D-04, 0.1053D-03, & + & 0.2294D-03, 0.4626D-03, 0.8493D-03, 0.1396D-02, 0.2028D-02, & + & 0.2595D-02, 0.2931D-02, 0.2957D-02, 0.2711D-02, 0.2298D-02, & + & 0.1833D-02, 0.1398D-02, 0.1031D-02, 0.7422D-03, 0.5255D-03, & + & 0.3675D-03, 0.2550D-03, 0.1760D-03, 0.1209D-03, 0.8283D-04, & + & 0.5665D-04, 0.3871D-04, 0.2642D-04, 0.1803D-04, 0.1229D-04, & + & 0.8378D-05, 0.5710D-05, 0.3891D-05, 0.2652D-05, 0.1806D-05, & + & 0.1231D-05, 0.8387D-06, 0.5715D-06, 0.3893D-06, 0.2652D-06, & + & 0.1808D-06, 0.1231D-06, 0.8388D-07, 0.5715D-07, 0.3894D-07, & + & 0.2652D-07/ + + data (calcpts(j, 5), j = 1,neta) /0.5226D-20, 0.2001D-19, & + & 0.7668D-19, 0.2937D-18, 0.1124D-17, 0.4305D-17, 0.1647D-16, & + & 0.6300D-16, 0.2408D-15, 0.9189D-15, 0.3501D-14, 0.1330D-13, & + & 0.5038D-13, 0.1897D-12, 0.7098D-12, 0.2630D-11, 0.9607D-11, & + & 0.3452D-10, 0.1214D-09, 0.4164D-09, 0.1388D-08, 0.4484D-08, & + & 0.1405D-07, 0.4267D-07, 0.1258D-06, 0.3603D-06, 0.1004D-05, & + & 0.2718D-05, 0.7148D-05, 0.1818D-04, 0.4446D-04, 0.1035D-03, & + & 0.2265D-03, 0.4587D-03, 0.8447D-03, 0.1391D-02, 0.2025D-02, & + & 0.2592D-02, 0.2930D-02, 0.2957D-02, 0.2711D-02, 0.2298D-02, & + & 0.1833D-02, 0.1398D-02, 0.1031D-02, 0.7422D-03, 0.5255D-03, & + & 0.3675D-03, 0.2550D-03, 0.1760D-03, 0.1209D-03, 0.8283D-04, & + & 0.5665D-04, 0.3871D-04, 0.2642D-04, 0.1803D-04, 0.1229D-04, & + & 0.8378D-05, 0.5710D-05, 0.3891D-05, 0.2652D-05, 0.1806D-05, & + & 0.1231D-05, 0.8387D-06, 0.5715D-06, 0.3893D-06, 0.2652D-06, & + & 0.1808D-06, 0.1231D-06, 0.8388D-07, 0.5715D-07, 0.3894D-07, & + & 0.2652D-07/ + + data (calcpts(j, 6), j = 1,neta) /0.3561D-20, 0.1364D-19, & + & 0.5224D-19, 0.2001D-18, 0.7665D-18, 0.2936D-17, 0.1124D-16, & + & 0.4299D-16, 0.1644D-15, 0.6284D-15, 0.2399D-14, 0.9138D-14, & + & 0.3473D-13, 0.1315D-12, 0.4953D-12, 0.1853D-11, 0.6860D-11, & + & 0.2506D-10, 0.9003D-10, 0.3165D-09, 0.1085D-08, 0.3609D-08, & + & 0.1165D-07, 0.3644D-07, 0.1103D-06, 0.3237D-06, 0.9210D-06, & + & 0.2540D-05, 0.6779D-05, 0.1746D-04, 0.4312D-04, 0.1012D-03, & + & 0.2229D-03, 0.4536D-03, 0.8383D-03, 0.1385D-02, 0.2019D-02, & + & 0.2587D-02, 0.2927D-02, 0.2957D-02, 0.2711D-02, 0.2298D-02, & + & 0.1835D-02, 0.1398D-02, 0.1031D-02, 0.7424D-03, 0.5255D-03, & + & 0.3677D-03, 0.2550D-03, 0.1760D-03, 0.1209D-03, 0.8284D-04, & + & 0.5665D-04, 0.3871D-04, 0.2642D-04, 0.1803D-04, 0.1229D-04, & + & 0.8378D-05, 0.5710D-05, 0.3891D-05, 0.2652D-05, 0.1806D-05, & + & 0.1231D-05, 0.8387D-06, 0.5715D-06, 0.3893D-06, 0.2652D-06, & + & 0.1808D-06, 0.1231D-06, 0.8388D-07, 0.5715D-07, 0.3894D-07, & + & 0.2652D-07/ + + data (calcpts(j, 7), j = 1,neta) /0.2426D-20, 0.9294D-20, & + & 0.3561D-19, 0.1364D-18, 0.5224D-18, 0.2001D-17, 0.7662D-17, & + & 0.2933D-16, 0.1122D-15, 0.4293D-15, 0.1640D-14, 0.6260D-14, & + & 0.2385D-13, 0.9065D-13, 0.3432D-12, 0.1293D-11, 0.4833D-11, & + & 0.1790D-10, 0.6537D-10, 0.2348D-09, 0.8247D-09, 0.2820D-08, & + & 0.9381D-08, 0.3023D-07, 0.9423D-07, 0.2841D-06, 0.8278D-06, & + & 0.2331D-05, 0.6338D-05, 0.1658D-04, 0.4145D-04, 0.9827D-04, & + & 0.2182D-03, 0.4468D-03, 0.8298D-03, 0.1376D-02, 0.2012D-02, & + & 0.2583D-02, 0.2925D-02, 0.2955D-02, 0.2711D-02, 0.2298D-02, & + & 0.1835D-02, 0.1398D-02, 0.1031D-02, 0.7425D-03, 0.5256D-03, & + & 0.3677D-03, 0.2550D-03, 0.1760D-03, 0.1209D-03, 0.8284D-04, & + & 0.5667D-04, 0.3871D-04, 0.2642D-04, 0.1803D-04, 0.1229D-04, & + & 0.8378D-05, 0.5710D-05, 0.3891D-05, 0.2652D-05, 0.1806D-05, & + & 0.1231D-05, 0.8387D-06, 0.5715D-06, 0.3893D-06, 0.2652D-06, & + & 0.1808D-06, 0.1231D-06, 0.8388D-07, 0.5715D-07, 0.3894D-07, & + & 0.2652D-07/ + + data (calcpts(j, 8), j = 1,neta) /0.1653D-20, 0.6333D-20, & + & 0.2425D-19, 0.9294D-19, 0.3559D-18, 0.1364D-17, 0.5223D-17, & + & 0.2000D-16, 0.7656D-16, 0.2930D-15, 0.1120D-14, 0.4281D-14, & + & 0.1634D-13, 0.6225D-13, 0.2366D-12, 0.8955D-12, 0.3373D-11, & + & 0.1261D-10, 0.4666D-10, 0.1704D-09, 0.6116D-09, 0.2147D-08, & + & 0.7331D-08, 0.2433D-07, 0.7818D-07, 0.2427D-06, 0.7266D-06, & + & 0.2097D-05, 0.5823D-05, 0.1551D-04, 0.3938D-04, 0.9454D-04, & + & 0.2121D-03, 0.4378D-03, 0.8186D-03, 0.1363D-02, 0.2001D-02, & + & 0.2576D-02, 0.2921D-02, 0.2953D-02, 0.2711D-02, 0.2299D-02, & + & 0.1835D-02, 0.1399D-02, 0.1032D-02, 0.7426D-03, 0.5256D-03, & + & 0.3677D-03, 0.2550D-03, 0.1760D-03, 0.1209D-03, 0.8284D-04, & + & 0.5667D-04, 0.3871D-04, 0.2642D-04, 0.1803D-04, 0.1229D-04, & + & 0.8378D-05, 0.5710D-05, 0.3891D-05, 0.2652D-05, 0.1806D-05, & + & 0.1231D-05, 0.8387D-06, 0.5715D-06, 0.3893D-06, 0.2652D-06, & + & 0.1808D-06, 0.1231D-06, 0.8388D-07, 0.5715D-07, 0.3894D-07, & + & 0.2652D-07/ + + data (calcpts(j, 9), j = 1,neta) /0.1126D-20, 0.4314D-20, & + & 0.1653D-19, 0.6333D-19, 0.2426D-18, 0.9293D-18, 0.3560D-17, & + & 0.1363D-16, 0.5220D-16, 0.1998D-15, 0.7647D-15, 0.2925D-14, & + & 0.1117D-13, 0.4264D-13, 0.1625D-12, 0.6173D-12, 0.2337D-11, & + & 0.8799D-11, 0.3289D-10, 0.1217D-09, 0.4440D-09, 0.1591D-08, & + & 0.5573D-08, 0.1902D-07, 0.6296D-07, 0.2013D-06, 0.6208D-06, & + & 0.1842D-05, 0.5241D-05, 0.1426D-04, 0.3689D-04, 0.8996D-04, & + & 0.2045D-03, 0.4264D-03, 0.8037D-03, 0.1347D-02, 0.1986D-02, & + & 0.2565D-02, 0.2915D-02, 0.2952D-02, 0.2711D-02, 0.2301D-02, & + & 0.1836D-02, 0.1400D-02, 0.1032D-02, 0.7430D-03, 0.5257D-03, & + & 0.3678D-03, 0.2552D-03, 0.1760D-03, 0.1209D-03, 0.8284D-04, & + & 0.5667D-04, 0.3871D-04, 0.2642D-04, 0.1803D-04, 0.1229D-04, & + & 0.8378D-05, 0.5710D-05, 0.3891D-05, 0.2652D-05, 0.1806D-05, & + & 0.1231D-05, 0.8387D-06, 0.5715D-06, 0.3893D-06, 0.2652D-06, & + & 0.1808D-06, 0.1231D-06, 0.8388D-07, 0.5715D-07, 0.3894D-07, & + & 0.2652D-07/ + + data (calcpts(j,10), j = 1,neta) /0.7672D-21, 0.2940D-20, & + & 0.1126D-19, 0.4314D-19, 0.1653D-18, 0.6333D-18, 0.2425D-17, & + & 0.9291D-17, 0.3558D-16, 0.1363D-15, 0.5216D-15, 0.1996D-14, & + & 0.7634D-14, 0.2916D-13, 0.1113D-12, 0.4239D-12, 0.1611D-11, & + & 0.6096D-11, 0.2295D-10, 0.8574D-10, 0.3171D-09, 0.1156D-08, & + & 0.4133D-08, 0.1446D-07, 0.4922D-07, 0.1622D-06, 0.5154D-06, & + & 0.1575D-05, 0.4605D-05, 0.1285D-04, 0.3396D-04, 0.8439D-04, & + & 0.1948D-03, 0.4119D-03, 0.7844D-03, 0.1326D-02, 0.1966D-02, & + & 0.2550D-02, 0.2907D-02, 0.2949D-02, 0.2712D-02, 0.2301D-02, & + & 0.1837D-02, 0.1401D-02, 0.1033D-02, 0.7432D-03, 0.5261D-03, & + & 0.3678D-03, 0.2552D-03, 0.1760D-03, 0.1209D-03, 0.8286D-04, & + & 0.5667D-04, 0.3871D-04, 0.2643D-04, 0.1803D-04, 0.1229D-04, & + & 0.8378D-05, 0.5710D-05, 0.3891D-05, 0.2652D-05, 0.1806D-05, & + & 0.1231D-05, 0.8387D-06, 0.5715D-06, 0.3893D-06, 0.2652D-06, & + & 0.1808D-06, 0.1231D-06, 0.8388D-07, 0.5715D-07, 0.3894D-07, & + & 0.2652D-07/ + + data (calcpts(j,11), j = 1,neta) /0.5227D-21, 0.2003D-20, & + & 0.7672D-20, 0.2940D-19, 0.1126D-18, 0.4314D-18, 0.1653D-17, & + & 0.6332D-17, 0.2426D-16, 0.9288D-16, 0.3557D-15, 0.1362D-14, & + & 0.5209D-14, 0.1992D-13, 0.7612D-13, 0.2904D-12, 0.1106D-11, & + & 0.4202D-11, 0.1590D-10, 0.5984D-10, 0.2234D-09, 0.8253D-09, & + & 0.3000D-08, 0.1072D-07, 0.3741D-07, 0.1268D-06, 0.4154D-06, & + & 0.1308D-05, 0.3941D-05, 0.1130D-04, 0.3065D-04, 0.7785D-04, & + & 0.1832D-03, 0.3936D-03, 0.7596D-03, 0.1297D-02, 0.1939D-02, & + & 0.2531D-02, 0.2897D-02, 0.2946D-02, 0.2711D-02, 0.2302D-02, & + & 0.1839D-02, 0.1402D-02, 0.1033D-02, 0.7437D-03, 0.5263D-03, & + & 0.3680D-03, 0.2553D-03, 0.1761D-03, 0.1209D-03, 0.8288D-04, & + & 0.5669D-04, 0.3871D-04, 0.2643D-04, 0.1803D-04, 0.1229D-04, & + & 0.8378D-05, 0.5710D-05, 0.3891D-05, 0.2652D-05, 0.1806D-05, & + & 0.1231D-05, 0.8387D-06, 0.5715D-06, 0.3893D-06, 0.2652D-06, & + & 0.1808D-06, 0.1231D-06, 0.8388D-07, 0.5715D-07, 0.3894D-07, & + & 0.2652D-07/ + + data (calcpts(j,12), j = 1,neta) /0.3561D-21, 0.1365D-20, & + & 0.5227D-20, 0.2003D-19, 0.7674D-19, 0.2940D-18, 0.1126D-17, & + & 0.4314D-17, 0.1653D-16, 0.6330D-16, 0.2424D-15, 0.9283D-15, & + & 0.3554D-14, 0.1360D-13, 0.5199D-13, 0.1986D-12, 0.7580D-12, & + & 0.2886D-11, 0.1096D-10, 0.4146D-10, 0.1559D-09, 0.5817D-09, & + & 0.2145D-08, 0.7786D-08, 0.2775D-07, 0.9642D-07, 0.3247D-06, & + & 0.1054D-05, 0.3276D-05, 0.9683D-05, 0.2700D-04, 0.7040D-04, & + & 0.1695D-03, 0.3712D-03, 0.7283D-03, 0.1260D-02, 0.1905D-02, & + & 0.2504D-02, 0.2880D-02, 0.2938D-02, 0.2711D-02, 0.2306D-02, & + & 0.1841D-02, 0.1404D-02, 0.1035D-02, 0.7445D-03, 0.5267D-03, & + & 0.3683D-03, 0.2553D-03, 0.1761D-03, 0.1210D-03, 0.8289D-04, & + & 0.5669D-04, 0.3871D-04, 0.2643D-04, 0.1803D-04, 0.1229D-04, & + & 0.8379D-05, 0.5710D-05, 0.3891D-05, 0.2652D-05, 0.1806D-05, & + & 0.1231D-05, 0.8387D-06, 0.5715D-06, 0.3894D-06, 0.2652D-06, & + & 0.1808D-06, 0.1231D-06, 0.8388D-07, 0.5715D-07, 0.3894D-07, & + & 0.2652D-07/ + + data (calcpts(j,13), j = 1,neta) /0.2427D-21, 0.9296D-21, & + & 0.3561D-20, 0.1365D-19, 0.5227D-19, 0.2003D-18, 0.7674D-18, & + & 0.2940D-17, 0.1126D-16, 0.4314D-16, 0.1653D-15, 0.6329D-15, & + & 0.2423D-14, 0.9275D-14, 0.3549D-13, 0.1357D-12, 0.5183D-12, & + & 0.1977D-11, 0.7527D-11, 0.2858D-10, 0.1080D-09, 0.4059D-09, & + & 0.1512D-08, 0.5560D-08, 0.2016D-07, 0.7152D-07, 0.2471D-06, & + & 0.8250D-06, 0.2643D-05, 0.8058D-05, 0.2318D-04, 0.6216D-04, & + & 0.1536D-03, 0.3445D-03, 0.6896D-03, 0.1214D-02, 0.1858D-02, & + & 0.2466D-02, 0.2858D-02, 0.2930D-02, 0.2709D-02, 0.2307D-02, & + & 0.1844D-02, 0.1406D-02, 0.1036D-02, 0.7453D-03, 0.5273D-03, & + & 0.3686D-03, 0.2556D-03, 0.1763D-03, 0.1210D-03, 0.8291D-04, & + & 0.5670D-04, 0.3873D-04, 0.2643D-04, 0.1803D-04, 0.1229D-04, & + & 0.8379D-05, 0.5710D-05, 0.3891D-05, 0.2652D-05, 0.1807D-05, & + & 0.1231D-05, 0.8388D-06, 0.5715D-06, 0.3894D-06, 0.2652D-06, & + & 0.1808D-06, 0.1231D-06, 0.8388D-07, 0.5715D-07, 0.3894D-07, & + & 0.2652D-07/ + + data (calcpts(j,14), j = 1,neta) /0.1653D-21, 0.6333D-21, & + & 0.2427D-20, 0.9297D-20, 0.3562D-19, 0.1365D-18, 0.5229D-18, & + & 0.2003D-17, 0.7674D-17, 0.2940D-16, 0.1126D-15, 0.4313D-15, & + & 0.1651D-14, 0.6324D-14, 0.2421D-13, 0.9261D-13, 0.3540D-12, & + & 0.1352D-11, 0.5157D-11, 0.1962D-10, 0.7446D-10, 0.2813D-09, & + & 0.1055D-08, 0.3918D-08, 0.1439D-07, 0.5196D-07, 0.1833D-06, & + & 0.6278D-06, 0.2070D-05, 0.6507D-05, 0.1932D-04, 0.5346D-04, & + & 0.1361D-03, 0.3135D-03, 0.6428D-03, 0.1155D-02, 0.1797D-02, & + & 0.2417D-02, 0.2826D-02, 0.2916D-02, 0.2706D-02, 0.2309D-02, & + & 0.1847D-02, 0.1409D-02, 0.1038D-02, 0.7467D-03, 0.5280D-03, & + & 0.3690D-03, 0.2558D-03, 0.1763D-03, 0.1211D-03, 0.8293D-04, & + & 0.5672D-04, 0.3873D-04, 0.2643D-04, 0.1803D-04, 0.1229D-04, & + & 0.8379D-05, 0.5710D-05, 0.3891D-05, 0.2652D-05, 0.1807D-05, & + & 0.1231D-05, 0.8388D-06, 0.5715D-06, 0.3894D-06, 0.2652D-06, & + & 0.1808D-06, 0.1231D-06, 0.8388D-07, 0.5715D-07, 0.3894D-07, & + & 0.2652D-07/ + + data (calcpts(j,15), j = 1,neta) /0.1127D-21, 0.4316D-21, & + & 0.1653D-20, 0.6334D-20, 0.2427D-19, 0.9297D-19, 0.3562D-18, & + & 0.1365D-17, 0.5229D-17, 0.2003D-16, 0.7673D-16, 0.2938D-15, & + & 0.1126D-14, 0.4311D-14, 0.1650D-13, 0.6317D-13, 0.2416D-12, & + & 0.9237D-12, 0.3526D-11, 0.1344D-10, 0.5113D-10, 0.1938D-09, & + & 0.7313D-09, 0.2735D-08, 0.1014D-07, 0.3710D-07, 0.1332D-06, & + & 0.4659D-06, 0.1575D-05, 0.5100D-05, 0.1562D-04, 0.4467D-04, & + & 0.1174D-03, 0.2789D-03, 0.5880D-03, 0.1083D-02, 0.1721D-02, & + & 0.2352D-02, 0.2782D-02, 0.2895D-02, 0.2702D-02, 0.2311D-02, & + & 0.1851D-02, 0.1413D-02, 0.1041D-02, 0.7485D-03, 0.5291D-03, & + & 0.3696D-03, 0.2561D-03, 0.1764D-03, 0.1212D-03, 0.8298D-04, & + & 0.5673D-04, 0.3875D-04, 0.2645D-04, 0.1803D-04, 0.1229D-04, & + & 0.8381D-05, 0.5710D-05, 0.3891D-05, 0.2652D-05, 0.1807D-05, & + & 0.1231D-05, 0.8388D-06, 0.5715D-06, 0.3894D-06, 0.2652D-06, & + & 0.1808D-06, 0.1231D-06, 0.8388D-07, 0.5715D-07, 0.3894D-07, & + & 0.2652D-07/ + + data (calcpts(j,16), j = 1,neta) /0.7679D-22, 0.2940D-21, & + & 0.1126D-20, 0.4316D-20, 0.1653D-19, 0.6334D-19, 0.2427D-18, & + & 0.9299D-18, 0.3563D-17, 0.1365D-16, 0.5229D-16, 0.2002D-15, & + & 0.7671D-15, 0.2939D-14, 0.1125D-13, 0.4307D-13, 0.1649D-12, & + & 0.6305D-12, 0.2409D-11, 0.9195D-11, 0.3504D-10, 0.1331D-09, & + & 0.5040D-09, 0.1898D-08, 0.7077D-08, 0.2615D-07, 0.9512D-07, & + & 0.3386D-06, 0.1170D-05, 0.3886D-05, 0.1226D-04, 0.3621D-04, & + & 0.9842D-04, 0.2416D-03, 0.5259D-03, 0.9966D-03, 0.1623D-02, & + & 0.2265D-02, 0.2724D-02, 0.2865D-02, 0.2693D-02, 0.2313D-02, & + & 0.1857D-02, 0.1418D-02, 0.1045D-02, 0.7509D-03, 0.5304D-03, & + & 0.3703D-03, 0.2565D-03, 0.1767D-03, 0.1213D-03, 0.8304D-04, & + & 0.5676D-04, 0.3876D-04, 0.2645D-04, 0.1803D-04, 0.1230D-04, & + & 0.8381D-05, 0.5712D-05, 0.3893D-05, 0.2652D-05, 0.1807D-05, & + & 0.1231D-05, 0.8388D-06, 0.5715D-06, 0.3894D-06, 0.2652D-06, & + & 0.1808D-06, 0.1231D-06, 0.8388D-07, 0.5715D-07, 0.3894D-07, & + & 0.2652D-07/ + + data (calcpts(j,17), j = 1,neta) /0.5235D-22, 0.2003D-21, & + & 0.7672D-21, 0.2940D-20, 0.1127D-19, 0.4316D-19, 0.1653D-18, & + & 0.6334D-18, 0.2427D-17, 0.9299D-17, 0.3562D-16, 0.1365D-15, & + & 0.5228D-15, 0.2003D-14, 0.7668D-14, 0.2936D-13, 0.1124D-12, & + & 0.4301D-12, 0.1644D-11, 0.6281D-11, 0.2396D-10, 0.9120D-10, & + & 0.3462D-09, 0.1308D-08, 0.4904D-08, 0.1826D-07, 0.6705D-07, & + & 0.2418D-06, 0.8505D-06, 0.2888D-05, 0.9354D-05, 0.2847D-04, & + & 0.8001D-04, 0.2034D-03, 0.4584D-03, 0.8976D-03, 0.1506D-02, & + & 0.2155D-02, 0.2643D-02, 0.2820D-02, 0.2678D-02, 0.2315D-02, & + & 0.1863D-02, 0.1424D-02, 0.1050D-02, 0.7542D-03, 0.5324D-03, & + & 0.3714D-03, 0.2571D-03, 0.1770D-03, 0.1215D-03, 0.8313D-04, & + & 0.5680D-04, 0.3878D-04, 0.2646D-04, 0.1805D-04, 0.1230D-04, & + & 0.8382D-05, 0.5712D-05, 0.3893D-05, 0.2652D-05, 0.1807D-05, & + & 0.1231D-05, 0.8388D-06, 0.5715D-06, 0.3894D-06, 0.2652D-06, & + & 0.1808D-06, 0.1231D-06, 0.8388D-07, 0.5715D-07, 0.3894D-07, & + & 0.2652D-07/ + + data (calcpts(j,18), j = 1,neta) /0.3573D-22, 0.1365D-21, & + & 0.5227D-21, 0.2003D-20, 0.7674D-20, 0.2940D-19, 0.1127D-18, & + & 0.4316D-18, 0.1653D-17, 0.6334D-17, 0.2427D-16, 0.9298D-16, & + & 0.3563D-15, 0.1364D-14, 0.5226D-14, 0.2001D-13, 0.7662D-13, & + & 0.2933D-12, 0.1122D-11, 0.4287D-11, 0.1637D-10, 0.6237D-10, & + & 0.2372D-09, 0.8985D-09, 0.3381D-08, 0.1265D-07, 0.4680D-07, & + & 0.1706D-06, 0.6078D-06, 0.2100D-05, 0.6957D-05, 0.2177D-04, & + & 0.6311D-04, 0.1661D-03, 0.3881D-03, 0.7881D-03, 0.1368D-02, & + & 0.2018D-02, 0.2537D-02, 0.2759D-02, 0.2652D-02, 0.2311D-02, & + & 0.1869D-02, 0.1432D-02, 0.1056D-02, 0.7584D-03, 0.5351D-03, & + & 0.3729D-03, 0.2580D-03, 0.1775D-03, 0.1217D-03, 0.8325D-04, & + & 0.5687D-04, 0.3882D-04, 0.2647D-04, 0.1805D-04, 0.1230D-04, & + & 0.8384D-05, 0.5714D-05, 0.3893D-05, 0.2652D-05, 0.1807D-05, & + & 0.1231D-05, 0.8388D-06, 0.5715D-06, 0.3894D-06, 0.2652D-06, & + & 0.1808D-06, 0.1231D-06, 0.8388D-07, 0.5715D-07, 0.3894D-07, & + & 0.2652D-07/ + + data (calcpts(j,19), j = 1,neta) /0.2443D-22, 0.9299D-22, & + & 0.3561D-21, 0.1365D-20, 0.5229D-20, 0.2003D-19, 0.7675D-19, & + & 0.2940D-18, 0.1127D-17, 0.4317D-17, 0.1653D-16, 0.6334D-16, & + & 0.2427D-15, 0.9297D-15, 0.3561D-14, 0.1364D-13, 0.5222D-13, & + & 0.1998D-12, 0.7647D-12, 0.2923D-11, 0.1117D-10, 0.4260D-10, & + & 0.1622D-09, 0.6156D-09, 0.2322D-08, 0.8717D-08, 0.3243D-07, & + & 0.1190D-06, 0.4286D-06, 0.1502D-05, 0.5064D-05, 0.1621D-04, & + & 0.4834D-04, 0.1315D-03, 0.3186D-03, 0.6722D-03, 0.1212D-02, & + & 0.1851D-02, 0.2399D-02, 0.2670D-02, 0.2613D-02, 0.2304D-02, & + & 0.1875D-02, 0.1442D-02, 0.1064D-02, 0.7641D-03, 0.5385D-03, & + & 0.3750D-03, 0.2591D-03, 0.1781D-03, 0.1220D-03, 0.8342D-04, & + & 0.5695D-04, 0.3885D-04, 0.2649D-04, 0.1806D-04, 0.1231D-04, & + & 0.8387D-05, 0.5715D-05, 0.3894D-05, 0.2652D-05, 0.1807D-05, & + & 0.1231D-05, 0.8388D-06, 0.5715D-06, 0.3894D-06, 0.2652D-06, & + & 0.1808D-06, 0.1231D-06, 0.8388D-07, 0.5715D-07, 0.3894D-07, & + & 0.2652D-07/ + + data (calcpts(j,20), j = 1,neta) /0.1677D-22, 0.6337D-22, & + & 0.2424D-21, 0.9296D-21, 0.3563D-20, 0.1365D-19, 0.5229D-19, & + & 0.2004D-18, 0.7676D-18, 0.2940D-17, 0.1127D-16, 0.4316D-16, & + & 0.1653D-15, 0.6335D-15, 0.2427D-14, 0.9293D-14, 0.3558D-13, & + & 0.1362D-12, 0.5213D-12, 0.1993D-11, 0.7619D-11, 0.2909D-10, & + & 0.1108D-09, 0.4211D-09, 0.1593D-08, 0.5987D-08, 0.2235D-07, & + & 0.8247D-07, 0.2991D-06, 0.1059D-05, 0.3622D-05, 0.1181D-04, & + & 0.3608D-04, 0.1011D-03, 0.2535D-03, 0.5559D-03, 0.1044D-02, & + & 0.1658D-02, 0.2224D-02, 0.2552D-02, 0.2553D-02, 0.2286D-02, & + & 0.1880D-02, 0.1452D-02, 0.1074D-02, 0.7713D-03, 0.5433D-03, & + & 0.3778D-03, 0.2607D-03, 0.1790D-03, 0.1225D-03, 0.8365D-04, & + & 0.5708D-04, 0.3893D-04, 0.2652D-04, 0.1808D-04, 0.1231D-04, & + & 0.8391D-05, 0.5717D-05, 0.3894D-05, 0.2654D-05, 0.1807D-05, & + & 0.1231D-05, 0.8390D-06, 0.5715D-06, 0.3894D-06, 0.2652D-06, & + & 0.1808D-06, 0.1231D-06, 0.8388D-07, 0.5715D-07, 0.3894D-07, & + & 0.2652D-07/ + + data (calcpts(j,21), j = 1,neta) /0.1158D-22, 0.4320D-22, & + & 0.1650D-21, 0.6332D-21, 0.2427D-20, 0.9297D-20, 0.3562D-19, & + & 0.1365D-18, 0.5229D-18, 0.2004D-17, 0.7676D-17, 0.2940D-16, & + & 0.1127D-15, 0.4316D-15, 0.1653D-14, 0.6331D-14, 0.2424D-13, & + & 0.9284D-13, 0.3553D-12, 0.1359D-11, 0.5195D-11, 0.1983D-10, & + & 0.7562D-10, 0.2876D-09, 0.1090D-08, 0.4103D-08, 0.1536D-07, & + & 0.5686D-07, 0.2073D-06, 0.7396D-06, 0.2556D-05, 0.8457D-05, & + & 0.2634D-04, 0.7564D-04, 0.1958D-03, 0.4452D-03, 0.8708D-03, & + & 0.1443D-02, 0.2016D-02, 0.2396D-02, 0.2466D-02, 0.2254D-02, & + & 0.1880D-02, 0.1463D-02, 0.1086D-02, 0.7806D-03, 0.5493D-03, & + & 0.3816D-03, 0.2628D-03, 0.1801D-03, 0.1231D-03, 0.8399D-04, & + & 0.5725D-04, 0.3900D-04, 0.2657D-04, 0.1811D-04, 0.1233D-04, & + & 0.8396D-05, 0.5720D-05, 0.3896D-05, 0.2654D-05, 0.1807D-05, & + & 0.1231D-05, 0.8390D-06, 0.5715D-06, 0.3894D-06, 0.2654D-06, & + & 0.1808D-06, 0.1231D-06, 0.8388D-07, 0.5715D-07, 0.3894D-07, & + & 0.2652D-07/ + + data (calcpts(j,22), j = 1,neta) /0.8067D-23, 0.2946D-22, & + & 0.1123D-21, 0.4311D-21, 0.1654D-20, 0.6333D-20, 0.2427D-19, & + & 0.9298D-19, 0.3562D-18, 0.1365D-17, 0.5229D-17, 0.2004D-16, & + & 0.7676D-16, 0.2940D-15, 0.1126D-14, 0.4314D-14, 0.1652D-13, & + & 0.6326D-13, 0.2421D-12, 0.9263D-12, 0.3542D-11, 0.1353D-10, & + & 0.5158D-10, 0.1962D-09, 0.7445D-09, 0.2805D-08, 0.1052D-07, & + & 0.3906D-07, 0.1430D-06, 0.5127D-06, 0.1785D-05, 0.5972D-05, & + & 0.1887D-04, 0.5534D-04, 0.1470D-03, 0.3458D-03, 0.7032D-03, & + & 0.1217D-02, 0.1777D-02, 0.2201D-02, 0.2345D-02, 0.2201D-02, & + & 0.1869D-02, 0.1472D-02, 0.1099D-02, 0.7918D-03, 0.5573D-03, & + & 0.3864D-03, 0.2657D-03, 0.1818D-03, 0.1240D-03, 0.8445D-04, & + & 0.5750D-04, 0.3914D-04, 0.2664D-04, 0.1814D-04, 0.1234D-04, & + & 0.8405D-05, 0.5722D-05, 0.3897D-05, 0.2655D-05, 0.1807D-05, & + & 0.1232D-05, 0.8391D-06, 0.5717D-06, 0.3894D-06, 0.2654D-06, & + & 0.1808D-06, 0.1231D-06, 0.8388D-07, 0.5715D-07, 0.3894D-07, & + & 0.2652D-07/ + + data (calcpts(j,23), j = 1,neta) /0.5685D-23, 0.2010D-22, & + & 0.7636D-22, 0.2936D-21, 0.1128D-20, 0.4314D-20, 0.1654D-19, & + & 0.6336D-19, 0.2427D-18, 0.9300D-18, 0.3563D-17, 0.1365D-16, & + & 0.5229D-16, 0.2004D-15, 0.7674D-15, 0.2940D-14, 0.1126D-13, & + & 0.4310D-13, 0.1650D-12, 0.6312D-12, 0.2414D-11, 0.9221D-11, & + & 0.3517D-10, 0.1339D-09, 0.5081D-09, 0.1920D-08, 0.7194D-08, & + & 0.2676D-07, 0.9820D-07, 0.3536D-06, 0.1238D-05, 0.4173D-05, & + & 0.1334D-04, 0.3972D-04, 0.1079D-03, 0.2610D-03, 0.5501D-03, & + & 0.9924D-03, 0.1517D-02, 0.1965D-02, 0.2182D-02, 0.2118D-02, & + & 0.1844D-02, 0.1476D-02, 0.1113D-02, 0.8052D-03, 0.5671D-03, & + & 0.3929D-03, 0.2696D-03, 0.1839D-03, 0.1252D-03, 0.8508D-04, & + & 0.5783D-04, 0.3930D-04, 0.2672D-04, 0.1818D-04, 0.1236D-04, & + & 0.8415D-05, 0.5729D-05, 0.3900D-05, 0.2657D-05, 0.1809D-05, & + & 0.1232D-05, 0.8393D-06, 0.5717D-06, 0.3894D-06, 0.2654D-06, & + & 0.1808D-06, 0.1231D-06, 0.8390D-07, 0.5715D-07, 0.3894D-07, & + & 0.2652D-07/ + + data (calcpts(j,24), j = 1,neta) /0.4040D-23, 0.1371D-22, & + & 0.5190D-22, 0.1998D-21, 0.7686D-21, 0.2938D-20, 0.1127D-19, & + & 0.4317D-19, 0.1655D-18, 0.6336D-18, 0.2427D-17, 0.9300D-17, & + & 0.3562D-16, 0.1365D-15, 0.5229D-15, 0.2003D-14, 0.7670D-14, & + & 0.2937D-13, 0.1124D-12, 0.4302D-12, 0.1646D-11, 0.6284D-11, & + & 0.2397D-10, 0.9129D-10, 0.3467D-09, 0.1310D-08, 0.4914D-08, & + & 0.1830D-07, 0.6728D-07, 0.2428D-06, 0.8538D-06, 0.2894D-05, & + & 0.9329D-05, 0.2811D-04, 0.7761D-04, 0.1922D-03, 0.4178D-03, & + & 0.7832D-03, 0.1251D-02, 0.1699D-02, 0.1977D-02, 0.1998D-02, & + & 0.1796D-02, 0.1471D-02, 0.1125D-02, 0.8201D-03, 0.5792D-03, & + & 0.4010D-03, 0.2745D-03, 0.1869D-03, 0.1268D-03, 0.8597D-04, & + & 0.5829D-04, 0.3954D-04, 0.2685D-04, 0.1824D-04, 0.1240D-04, & + & 0.8430D-05, 0.5736D-05, 0.3905D-05, 0.2658D-05, 0.1811D-05, & + & 0.1233D-05, 0.8394D-06, 0.5718D-06, 0.3895D-06, 0.2654D-06, & + & 0.1808D-06, 0.1231D-06, 0.8390D-07, 0.5715D-07, 0.3894D-07, & + & 0.2652D-07/ + + data (calcpts(j,25), j = 1,neta) /0.2879D-23, 0.9354D-23, & + & 0.3524D-22, 0.1360D-21, 0.5241D-21, 0.2003D-20, 0.7677D-20, & + & 0.2942D-19, 0.1127D-18, 0.4317D-18, 0.1653D-17, 0.6336D-17, & + & 0.2427D-16, 0.9298D-16, 0.3563D-15, 0.1364D-14, 0.5226D-14, & + & 0.2001D-13, 0.7659D-13, 0.2931D-12, 0.1121D-11, 0.4282D-11, & + & 0.1634D-10, 0.6224D-10, 0.2364D-09, 0.8938D-09, 0.3354D-08, & + & 0.1250D-07, 0.4602D-07, 0.1664D-06, 0.5867D-06, 0.1997D-05, & + & 0.6473D-05, 0.1968D-04, 0.5502D-04, 0.1387D-03, 0.3092D-03, & + & 0.5991D-03, 0.9977D-03, 0.1421D-02, 0.1734D-02, 0.1836D-02, & + & 0.1718D-02, 0.1449D-02, 0.1132D-02, 0.8349D-03, 0.5929D-03, & + & 0.4111D-03, 0.2811D-03, 0.1906D-03, 0.1290D-03, 0.8716D-04, & + & 0.5892D-04, 0.3987D-04, 0.2702D-04, 0.1833D-04, 0.1244D-04, & + & 0.8453D-05, 0.5748D-05, 0.3909D-05, 0.2661D-05, 0.1811D-05, & + & 0.1233D-05, 0.8398D-06, 0.5719D-06, 0.3895D-06, 0.2654D-06, & + & 0.1808D-06, 0.1232D-06, 0.8390D-07, 0.5715D-07, 0.3894D-07, & + & 0.2652D-07/ + + data (calcpts(j,26), j = 1,neta) /0.2059D-23, 0.6393D-23, & + & 0.2394D-22, 0.9253D-22, 0.3573D-21, 0.1364D-20, 0.5231D-20, & + & 0.2004D-19, 0.7677D-19, 0.2940D-18, 0.1127D-17, 0.4317D-17, & + & 0.1653D-16, 0.6336D-16, 0.2427D-15, 0.9296D-15, 0.3560D-14, & + & 0.1363D-13, 0.5218D-13, 0.1997D-12, 0.7637D-12, 0.2918D-11, & + & 0.1114D-10, 0.4242D-10, 0.1611D-09, 0.6094D-09, 0.2289D-08, & + & 0.8532D-08, 0.3144D-07, 0.1138D-06, 0.4020D-06, 0.1372D-05, & + & 0.4467D-05, 0.1366D-04, 0.3855D-04, 0.9854D-04, 0.2239D-03, & + & 0.4461D-03, 0.7699D-03, 0.1146D-02, 0.1469D-02, 0.1635D-02, & + & 0.1601D-02, 0.1404D-02, 0.1127D-02, 0.8472D-03, 0.6080D-03, & + & 0.4232D-03, 0.2892D-03, 0.1958D-03, 0.1319D-03, 0.8879D-04, & + & 0.5981D-04, 0.4033D-04, 0.2726D-04, 0.1845D-04, 0.1250D-04, & + & 0.8484D-05, 0.5763D-05, 0.3918D-05, 0.2664D-05, 0.1814D-05, & + & 0.1234D-05, 0.8403D-06, 0.5721D-06, 0.3897D-06, 0.2654D-06, & + & 0.1808D-06, 0.1232D-06, 0.8390D-07, 0.5715D-07, 0.3894D-07, & + & 0.2654D-07/ + + data (calcpts(j,27), j = 1,neta) /0.1454D-23, 0.4358D-23, & + & 0.1624D-22, 0.6296D-22, 0.2436D-21, 0.9289D-21, 0.3564D-20, & + & 0.1365D-19, 0.5230D-19, 0.2004D-18, 0.7676D-18, 0.2941D-17, & + & 0.1127D-16, 0.4316D-16, 0.1653D-15, 0.6333D-15, 0.2426D-14, & + & 0.9288D-14, 0.3555D-13, 0.1361D-12, 0.5203D-12, 0.1989D-11, & + & 0.7587D-11, 0.2891D-10, 0.1098D-09, 0.4155D-09, 0.1563D-08, & + & 0.5820D-08, 0.2145D-07, 0.7775D-07, 0.2750D-06, 0.9402D-06, & + & 0.3071D-05, 0.9431D-05, 0.2679D-04, 0.6917D-04, 0.1596D-03, & + & 0.3246D-03, 0.5772D-03, 0.8927D-03, 0.1199D-02, 0.1404D-02, & + & 0.1446D-02, 0.1327D-02, 0.1105D-02, 0.8527D-03, 0.6221D-03, & + & 0.4365D-03, 0.2991D-03, 0.2022D-03, 0.1357D-03, 0.9096D-04, & + & 0.6099D-04, 0.4098D-04, 0.2759D-04, 0.1862D-04, 0.1259D-04, & + & 0.8529D-05, 0.5785D-05, 0.3929D-05, 0.2670D-05, 0.1816D-05, & + & 0.1235D-05, 0.8409D-06, 0.5726D-06, 0.3899D-06, 0.2655D-06, & + & 0.1809D-06, 0.1232D-06, 0.8391D-07, 0.5717D-07, 0.3894D-07, & + & 0.2654D-07/ + + data (calcpts(j,28), j = 1,neta) /0.1025D-23, 0.2973D-23, & + & 0.1104D-22, 0.4286D-22, 0.1661D-21, 0.6328D-21, 0.2428D-20, & + & 0.9300D-20, 0.3564D-19, 0.1365D-18, 0.5229D-18, 0.2004D-17, & + & 0.7676D-17, 0.2940D-16, 0.1127D-15, 0.4316D-15, 0.1653D-14, & + & 0.6329D-14, 0.2422D-13, 0.9270D-13, 0.3545D-12, 0.1355D-11, & + & 0.5171D-11, 0.1970D-10, 0.7482D-10, 0.2832D-09, 0.1066D-08, & + & 0.3969D-08, 0.1464D-07, 0.5307D-07, 0.1878D-06, 0.6432D-06, & + & 0.2105D-05, 0.6485D-05, 0.1851D-04, 0.4812D-04, 0.1122D-03, & + & 0.2321D-03, 0.4224D-03, 0.6744D-03, 0.9441D-03, 0.1161D-02, & + & 0.1259D-02, 0.1215D-02, 0.1058D-02, 0.8457D-03, 0.6321D-03, & + & 0.4501D-03, 0.3105D-03, 0.2100D-03, 0.1406D-03, 0.9384D-04, & + & 0.6260D-04, 0.4185D-04, 0.2805D-04, 0.1886D-04, 0.1271D-04, & + & 0.8592D-05, 0.5817D-05, 0.3945D-05, 0.2677D-05, 0.1820D-05, & + & 0.1237D-05, 0.8418D-06, 0.5730D-06, 0.3900D-06, 0.2657D-06, & + & 0.1809D-06, 0.1232D-06, 0.8393D-07, 0.5717D-07, 0.3894D-07, & + & 0.2654D-07/ + + data (calcpts(j,29), j = 1,neta) /0.7223D-24, 0.2028D-23, & + & 0.7517D-23, 0.2915D-22, 0.1131D-21, 0.4311D-21, 0.1654D-20, & + & 0.6336D-20, 0.2427D-19, 0.9300D-19, 0.3562D-18, 0.1365D-17, & + & 0.5229D-17, 0.2004D-16, 0.7674D-16, 0.2940D-15, 0.1126D-14, & + & 0.4311D-14, 0.1650D-13, 0.6315D-13, 0.2415D-12, 0.9230D-12, & + & 0.3522D-11, 0.1342D-10, 0.5098D-10, 0.1931D-09, 0.7263D-09, & + & 0.2706D-08, 0.9980D-08, 0.3620D-07, 0.1282D-06, 0.4393D-06, & + & 0.1440D-05, 0.4445D-05, 0.1273D-04, 0.3327D-04, 0.7820D-04, & + & 0.1637D-03, 0.3032D-03, 0.4965D-03, 0.7194D-03, 0.9237D-03, & + & 0.1054D-02, 0.1073D-02, 0.9827D-03, 0.8201D-03, 0.6337D-03, & + & 0.4617D-03, 0.3225D-03, 0.2193D-03, 0.1468D-03, 0.9754D-04, & + & 0.6474D-04, 0.4302D-04, 0.2868D-04, 0.1919D-04, 0.1288D-04, & + & 0.8679D-05, 0.5861D-05, 0.3966D-05, 0.2689D-05, 0.1825D-05, & + & 0.1240D-05, 0.8432D-06, 0.5736D-06, 0.3904D-06, 0.2658D-06, & + & 0.1809D-06, 0.1232D-06, 0.8394D-07, 0.5718D-07, 0.3896D-07, & + & 0.2654D-07/ + + data (calcpts(j,30), j = 1,neta) /0.4949D-24, 0.1383D-23, & + & 0.5113D-23, 0.1989D-22, 0.7709D-22, 0.2936D-21, 0.1127D-20, & + & 0.4317D-20, 0.1654D-19, 0.6336D-19, 0.2427D-18, 0.9300D-18, & + & 0.3563D-17, 0.1365D-16, 0.5229D-16, 0.2002D-15, 0.7671D-15, & + & 0.2937D-14, 0.1124D-13, 0.4304D-13, 0.1646D-12, 0.6288D-12, & + & 0.2400D-11, 0.9144D-11, 0.3474D-10, 0.1315D-09, 0.4950D-09, & + & 0.1848D-08, 0.6803D-08, 0.2469D-07, 0.8746D-07, 0.2998D-06, & + & 0.9835D-06, 0.3042D-05, 0.8730D-05, 0.2289D-04, 0.5411D-04, & + & 0.1142D-03, 0.2144D-03, 0.3581D-03, 0.5332D-03, 0.7101D-03, & + & 0.8477D-03, 0.9087D-03, 0.8783D-03, 0.7709D-03, 0.6216D-03, & + & 0.4676D-03, 0.3336D-03, 0.2294D-03, 0.1541D-03, 0.1022D-03, & + & 0.6752D-04, 0.4460D-04, 0.2954D-04, 0.1965D-04, 0.1312D-04, & + & 0.8800D-05, 0.5924D-05, 0.3998D-05, 0.2705D-05, 0.1833D-05, & + & 0.1244D-05, 0.8451D-06, 0.5745D-06, 0.3909D-06, 0.2660D-06, & + & 0.1810D-06, 0.1233D-06, 0.8397D-07, 0.5719D-07, 0.3896D-07, & + & 0.2654D-07/ + + data (calcpts(j,31), j = 1,neta) /0.3417D-24, 0.9340D-24, & + & 0.3495D-23, 0.1351D-22, 0.5253D-22, 0.2000D-21, 0.7671D-21, & + & 0.2941D-20, 0.1127D-19, 0.4317D-19, 0.1653D-18, 0.6336D-18, & + & 0.2427D-17, 0.9299D-17, 0.3562D-16, 0.1365D-15, 0.5226D-15, & + & 0.2001D-14, 0.7661D-14, 0.2931D-13, 0.1121D-12, 0.4284D-12, & + & 0.1635D-11, 0.6229D-11, 0.2367D-10, 0.8960D-10, 0.3372D-09, & + & 0.1259D-08, 0.4636D-08, 0.1683D-07, 0.5964D-07, 0.2046D-06, & + & 0.6714D-06, 0.2079D-05, 0.5975D-05, 0.1570D-04, 0.3726D-04, & + & 0.7914D-04, 0.1500D-03, 0.2541D-03, 0.3864D-03, 0.5300D-03, & + & 0.6575D-03, 0.7388D-03, 0.7529D-03, 0.6975D-03, 0.5913D-03, & + & 0.4636D-03, 0.3410D-03, 0.2391D-03, 0.1622D-03, 0.1079D-03, & + & 0.7103D-04, 0.4665D-04, 0.3069D-04, 0.2026D-04, 0.1345D-04, & + & 0.8972D-05, 0.6011D-05, 0.4043D-05, 0.2727D-05, 0.1844D-05, & + & 0.1250D-05, 0.8478D-06, 0.5759D-06, 0.3915D-06, 0.2662D-06, & + & 0.1812D-06, 0.1234D-06, 0.8400D-07, 0.5721D-07, 0.3897D-07, & + & 0.2654D-07/ + + data (calcpts(j,32), j = 1,neta) /0.2423D-24, 0.6489D-24, & + & 0.2356D-23, 0.9243D-23, 0.3575D-22, 0.1364D-21, 0.5237D-21, & + & 0.2004D-20, 0.7677D-20, 0.2942D-19, 0.1127D-18, 0.4317D-18, & + & 0.1653D-17, 0.6336D-17, 0.2427D-16, 0.9295D-16, 0.3561D-15, & + & 0.1363D-14, 0.5218D-14, 0.1998D-13, 0.7638D-13, 0.2919D-12, & + & 0.1114D-11, 0.4245D-11, 0.1613D-10, 0.6105D-10, 0.2298D-09, & + & 0.8580D-09, 0.3159D-08, 0.1147D-07, 0.4065D-07, 0.1395D-06, & + & 0.4581D-06, 0.1419D-05, 0.4083D-05, 0.1075D-04, 0.2558D-04, & + & 0.5456D-04, 0.1041D-03, 0.1782D-03, 0.2751D-03, 0.3859D-03, & + & 0.4940D-03, 0.5780D-03, 0.6183D-03, 0.6045D-03, 0.5411D-03, & + & 0.4456D-03, 0.3414D-03, 0.2466D-03, 0.1704D-03, 0.1143D-03, & + & 0.7532D-04, 0.4927D-04, 0.3219D-04, 0.2110D-04, 0.1390D-04, & + & 0.9206D-05, 0.6132D-05, 0.4104D-05, 0.2759D-05, 0.1860D-05, & + & 0.1257D-05, 0.8517D-06, 0.5778D-06, 0.3924D-06, 0.2667D-06, & + & 0.1815D-06, 0.1235D-06, 0.8406D-07, 0.5723D-07, 0.3897D-07, & + & 0.2655D-07/ + + data (calcpts(j,33), j = 1,neta) /0.1613D-24, 0.4423D-24, & + & 0.1620D-23, 0.6268D-23, 0.2436D-22, 0.9282D-22, 0.3569D-21, & + & 0.1365D-20, 0.5231D-20, 0.2004D-19, 0.7675D-19, 0.2941D-18, & + & 0.1127D-17, 0.4316D-17, 0.1653D-16, 0.6333D-16, 0.2426D-15, & + & 0.9288D-15, 0.3557D-14, 0.1361D-13, 0.5204D-13, 0.1989D-12, & + & 0.7590D-12, 0.2892D-11, 0.1099D-10, 0.4159D-10, 0.1566D-09, & + & 0.5847D-09, 0.2155D-08, 0.7815D-08, 0.2770D-07, 0.9510D-07, & + & 0.3123D-06, 0.9679D-06, 0.2787D-05, 0.7349D-05, 0.1752D-04, & + & 0.3747D-04, 0.7182D-04, 0.1238D-03, 0.1935D-03, 0.2760D-03, & + & 0.3617D-03, 0.4372D-03, 0.4877D-03, 0.5012D-03, 0.4735D-03, & + & 0.4121D-03, 0.3317D-03, 0.2492D-03, 0.1771D-03, 0.1208D-03, & + & 0.8025D-04, 0.5250D-04, 0.3414D-04, 0.2220D-04, 0.1450D-04, & + & 0.9528D-05, 0.6300D-05, 0.4191D-05, 0.2802D-05, 0.1883D-05, & + & 0.1268D-05, 0.8571D-06, 0.5805D-06, 0.3938D-06, 0.2674D-06, & + & 0.1818D-06, 0.1236D-06, 0.8413D-07, 0.5727D-07, 0.3900D-07, & + & 0.2655D-07/ + + data (calcpts(j,34), j = 1,neta) /0.1105D-24, 0.3016D-24, & + & 0.1082D-23, 0.4271D-23, 0.1659D-22, 0.6324D-22, 0.2432D-21, & + & 0.9297D-21, 0.3563D-20, 0.1365D-19, 0.5229D-19, 0.2004D-18, & + & 0.7676D-18, 0.2940D-17, 0.1127D-16, 0.4316D-16, 0.1653D-15, & + & 0.6329D-15, 0.2423D-14, 0.9270D-14, 0.3546D-13, 0.1355D-12, & + & 0.5172D-12, 0.1970D-11, 0.7487D-11, 0.2834D-10, 0.1067D-09, & + & 0.3984D-09, 0.1470D-08, 0.5325D-08, 0.1889D-07, 0.6482D-07, & + & 0.2130D-06, 0.6602D-06, 0.1902D-05, 0.5018D-05, 0.1198D-04, & + & 0.2567D-04, 0.4937D-04, 0.8555D-04, 0.1347D-03, 0.1946D-03, & + & 0.2595D-03, 0.3218D-03, 0.3714D-03, 0.3984D-03, 0.3962D-03, & + & 0.3642D-03, 0.3095D-03, 0.2442D-03, 0.1805D-03, 0.1266D-03, & + & 0.8544D-04, 0.5625D-04, 0.3654D-04, 0.2363D-04, 0.1530D-04, & + & 0.9963D-05, 0.6531D-05, 0.4309D-05, 0.2863D-05, 0.1913D-05, & + & 0.1284D-05, 0.8649D-06, 0.5844D-06, 0.3957D-06, 0.2683D-06, & + & 0.1823D-06, 0.1239D-06, 0.8424D-07, 0.5732D-07, 0.3902D-07, & + & 0.2657D-07/ + + data (calcpts(j,35), j = 1,neta) /0.8031D-25, 0.2055D-24, & + & 0.7368D-24, 0.2908D-23, 0.1125D-22, 0.4308D-22, 0.1656D-21, & + & 0.6338D-21, 0.2427D-20, 0.9300D-20, 0.3562D-19, 0.1365D-18, & + & 0.5229D-18, 0.2004D-17, 0.7674D-17, 0.2940D-16, 0.1126D-15, & + & 0.4311D-15, 0.1650D-14, 0.6316D-14, 0.2415D-13, 0.9231D-13, & + & 0.3524D-12, 0.1342D-11, 0.5100D-11, 0.1931D-10, 0.7267D-10, & + & 0.2714D-09, 0.1002D-08, 0.3629D-08, 0.1287D-07, 0.4418D-07, & + & 0.1451D-06, 0.4500D-06, 0.1297D-05, 0.3424D-05, 0.8178D-05, & + & 0.1755D-04, 0.3384D-04, 0.5884D-04, 0.9319D-04, 0.1357D-03, & + & 0.1835D-03, 0.2317D-03, 0.2747D-03, 0.3053D-03, 0.3172D-03, & + & 0.3071D-03, 0.2759D-03, 0.2299D-03, 0.1784D-03, 0.1301D-03, & + & 0.9017D-04, 0.6026D-04, 0.3936D-04, 0.2540D-04, 0.1635D-04, & + & 0.1054D-04, 0.6843D-05, 0.4475D-05, 0.2949D-05, 0.1956D-05, & + & 0.1306D-05, 0.8760D-06, 0.5898D-06, 0.3984D-06, 0.2697D-06, & + & 0.1828D-06, 0.1242D-06, 0.8441D-07, 0.5740D-07, 0.3906D-07, & + & 0.2658D-07/ + + data (calcpts(j,36), j = 1,neta) /0.5171D-25, 0.1239D-24, & + & 0.5018D-24, 0.1958D-23, 0.7728D-23, 0.2945D-22, 0.1128D-21, & + & 0.4314D-21, 0.1654D-20, 0.6336D-20, 0.2427D-19, 0.9300D-19, & + & 0.3562D-18, 0.1365D-17, 0.5229D-17, 0.2003D-16, 0.7671D-16, & + & 0.2937D-15, 0.1124D-14, 0.4303D-14, 0.1646D-13, 0.6290D-13, & + & 0.2400D-12, 0.9146D-12, 0.3475D-11, 0.1316D-10, 0.4951D-10, & + & 0.1850D-09, 0.6825D-09, 0.2474D-08, 0.8768D-08, 0.3011D-07, & + & 0.9891D-07, 0.3068D-06, 0.8843D-06, 0.2336D-05, 0.5582D-05, & + & 0.1199D-04, 0.2314D-04, 0.4037D-04, 0.6416D-04, 0.9402D-04, & + & 0.1283D-03, 0.1643D-03, 0.1986D-03, 0.2268D-03, 0.2444D-03, & + & 0.2475D-03, 0.2343D-03, 0.2065D-03, 0.1694D-03, 0.1295D-03, & + & 0.9328D-04, 0.6401D-04, 0.4241D-04, 0.2750D-04, 0.1764D-04, & + & 0.1130D-04, 0.7261D-05, 0.4700D-05, 0.3066D-05, 0.2018D-05, & + & 0.1337D-05, 0.8915D-06, 0.5976D-06, 0.4023D-06, 0.2717D-06, & + & 0.1839D-06, 0.1246D-06, 0.8462D-07, 0.5751D-07, 0.3910D-07, & + & 0.2661D-07/ + + data (calcpts(j,37), j = 1,neta) /0.3531D-25, 0.9543D-25, & + & 0.3418D-24, 0.1334D-23, 0.5265D-23, 0.1999D-22, 0.7687D-22, & + & 0.2940D-21, 0.1127D-20, 0.4317D-20, 0.1654D-19, 0.6336D-19, & + & 0.2427D-18, 0.9299D-18, 0.3563D-17, 0.1365D-16, 0.5226D-16, & + & 0.2001D-15, 0.7660D-15, 0.2931D-14, 0.1121D-13, 0.4284D-13, & + & 0.1635D-12, 0.6231D-12, 0.2367D-11, 0.8963D-11, 0.3374D-10, & + & 0.1260D-09, 0.4650D-09, 0.1688D-08, 0.5974D-08, 0.2051D-07, & + & 0.6740D-07, 0.2090D-06, 0.6027D-06, 0.1592D-05, 0.3807D-05, & + & 0.8184D-05, 0.1581D-04, 0.2762D-04, 0.4402D-04, 0.6478D-04, & + & 0.8898D-04, 0.1151D-03, 0.1411D-03, 0.1646D-03, 0.1824D-03, & + & 0.1917D-03, 0.1901D-03, 0.1766D-03, 0.1532D-03, 0.1238D-03, & + & 0.9359D-04, 0.6668D-04, 0.4533D-04, 0.2980D-04, 0.1920D-04, & + & 0.1225D-04, 0.7807D-05, 0.5000D-05, 0.3227D-05, 0.2100D-05, & + & 0.1380D-05, 0.9132D-06, 0.6085D-06, 0.4077D-06, 0.2744D-06, & + & 0.1851D-06, 0.1253D-06, 0.8495D-07, 0.5766D-07, 0.3918D-07, & + & 0.2664D-07/ + + data (calcpts(j,38), j = 1,neta) /0.2861D-25, 0.5749D-25, & + & 0.2328D-24, 0.9369D-24, 0.3558D-23, 0.1362D-22, 0.5230D-22, & + & 0.2003D-21, 0.7674D-21, 0.2940D-20, 0.1127D-19, 0.4317D-19, & + & 0.1653D-18, 0.6336D-18, 0.2427D-17, 0.9296D-17, 0.3561D-16, & + & 0.1363D-15, 0.5220D-15, 0.1998D-14, 0.7639D-14, 0.2919D-13, & + & 0.1114D-12, 0.4245D-12, 0.1613D-11, 0.6107D-11, 0.2298D-10, & + & 0.8583D-10, 0.3168D-09, 0.1150D-08, 0.4071D-08, 0.1398D-07, & + & 0.4592D-07, 0.1424D-06, 0.4107D-06, 0.1085D-05, 0.2595D-05, & + & 0.5583D-05, 0.1080D-04, 0.1887D-04, 0.3015D-04, 0.4449D-04, & + & 0.6138D-04, 0.7995D-04, 0.9905D-04, 0.1172D-03, 0.1327D-03, & + & 0.1436D-03, 0.1479D-03, 0.1440D-03, 0.1318D-03, 0.1127D-03, & + & 0.9003D-04, 0.6732D-04, 0.4752D-04, 0.3204D-04, 0.2091D-04, & + & 0.1339D-04, 0.8498D-05, 0.5394D-05, 0.3443D-05, 0.2216D-05, & + & 0.1439D-05, 0.9437D-06, 0.6239D-06, 0.4154D-06, 0.2781D-06, & + & 0.1870D-06, 0.1262D-06, 0.8540D-07, 0.5789D-07, 0.3930D-07, & + & 0.2670D-07/ + + data (calcpts(j,39), j = 1,neta) /0.1952D-25, 0.4561D-25, & + & 0.1587D-24, 0.6522D-24, 0.2424D-23, 0.9308D-23, 0.3564D-22, & + & 0.1364D-21, 0.5231D-21, 0.2004D-20, 0.7676D-20, 0.2942D-19, & + & 0.1127D-18, 0.4316D-18, 0.1653D-17, 0.6333D-17, 0.2426D-16, & + & 0.9288D-16, 0.3557D-15, 0.1361D-14, 0.5205D-14, 0.1989D-13, & + & 0.7590D-13, 0.2892D-12, 0.1099D-11, 0.4160D-11, 0.1566D-10, & + & 0.5849D-10, 0.2158D-09, 0.7836D-09, 0.2774D-08, 0.9522D-08, & + & 0.3129D-07, 0.9705D-07, 0.2799D-06, 0.7395D-06, 0.1769D-05, & + & 0.3807D-05, 0.7365D-05, 0.1289D-04, 0.2061D-04, 0.3048D-04, & + & 0.4218D-04, 0.5520D-04, 0.6888D-04, 0.8240D-04, 0.9478D-04, & + & 0.1048D-03, 0.1112D-03, 0.1125D-03, 0.1080D-03, 0.9752D-04, & + & 0.8245D-04, 0.6516D-04, 0.4827D-04, 0.3378D-04, 0.2261D-04, & + & 0.1466D-04, 0.9330D-05, 0.5894D-05, 0.3724D-05, 0.2369D-05, & + & 0.1521D-05, 0.9858D-06, 0.6455D-06, 0.4263D-06, 0.2835D-06, & + & 0.1898D-06, 0.1276D-06, 0.8605D-07, 0.5822D-07, 0.3945D-07, & + & 0.2677D-07/ + + data (calcpts(j,40), j = 1,neta) /0.7491D-26, 0.2667D-25, & + & 0.1178D-24, 0.4443D-24, 0.1649D-23, 0.6341D-23, 0.2426D-22, & + & 0.9296D-22, 0.3564D-21, 0.1365D-20, 0.5229D-20, 0.2004D-19, & + & 0.7675D-19, 0.2940D-18, 0.1127D-17, 0.4316D-17, 0.1653D-16, & + & 0.6329D-16, 0.2423D-15, 0.9270D-15, 0.3546D-14, 0.1355D-13, & + & 0.5172D-13, 0.1971D-12, 0.7486D-12, 0.2834D-11, 0.1067D-10, & + & 0.3984D-10, 0.1471D-09, 0.5338D-09, 0.1893D-08, 0.6488D-08, & + & 0.2132D-07, 0.6614D-07, 0.1907D-06, 0.5040D-06, 0.1206D-05, & + & 0.2595D-05, 0.5022D-05, 0.8793D-05, 0.1407D-04, 0.2083D-04, & + & 0.2891D-04, 0.3795D-04, 0.4760D-04, 0.5738D-04, 0.6674D-04, & + & 0.7500D-04, 0.8136D-04, 0.8488D-04, 0.8471D-04, 0.8025D-04, & + & 0.7167D-04, 0.6000D-04, 0.4698D-04, 0.3450D-04, 0.2397D-04, & + & 0.1593D-04, 0.1026D-04, 0.6498D-05, 0.4085D-05, 0.2571D-05, & + & 0.1631D-05, 0.1044D-05, 0.6753D-06, 0.4414D-06, 0.2912D-06, & + & 0.1935D-06, 0.1295D-06, 0.8699D-07, 0.5866D-07, 0.3968D-07, & + & 0.2688D-07/ + + data (calcpts(j,41), j = 1,neta) /0.5321D-26, 0.2247D-25, & + & 0.7351D-25, 0.2945D-24, 0.1133D-23, 0.4324D-23, 0.1653D-22, & + & 0.6333D-22, 0.2427D-21, 0.9299D-21, 0.3563D-20, 0.1365D-19, & + & 0.5229D-19, 0.2004D-18, 0.7674D-18, 0.2940D-17, 0.1126D-16, & + & 0.4311D-16, 0.1650D-15, 0.6317D-15, 0.2415D-14, 0.9231D-14, & + & 0.3524D-13, 0.1342D-12, 0.5102D-12, 0.1931D-11, 0.7269D-11, & + & 0.2715D-10, 0.1002D-09, 0.3638D-09, 0.1290D-08, 0.4421D-08, & + & 0.1452D-07, 0.4506D-07, 0.1299D-06, 0.3434D-06, 0.8217D-06, & + & 0.1769D-05, 0.3423D-05, 0.5997D-05, 0.9603D-05, 0.1423D-04, & + & 0.1977D-04, 0.2602D-04, 0.3274D-04, 0.3969D-04, 0.4653D-04, & + & 0.5289D-04, 0.5832D-04, 0.6227D-04, 0.6408D-04, 0.6318D-04, & + & 0.5922D-04, 0.5238D-04, 0.4346D-04, 0.3375D-04, 0.2460D-04, & + & 0.1697D-04, 0.1121D-04, 0.7182D-05, 0.4523D-05, 0.2831D-05, & + & 0.1774D-05, 0.1122D-05, 0.7163D-06, 0.4626D-06, 0.3020D-06, & + & 0.1989D-06, 0.1321D-06, 0.8830D-07, 0.5931D-07, 0.3999D-07, & + & 0.2705D-07/ + + data (calcpts(j,42), j = 1,neta) /0.1749D-26, 0.1238D-25, & + & 0.4942D-25, 0.1999D-24, 0.7656D-24, 0.2949D-23, 0.1128D-22, & + & 0.4317D-22, 0.1655D-21, 0.6336D-21, 0.2427D-20, 0.9300D-20, & + & 0.3562D-19, 0.1365D-18, 0.5229D-18, 0.2003D-17, 0.7671D-17, & + & 0.2937D-16, 0.1124D-15, 0.4303D-15, 0.1646D-14, 0.6290D-14, & + & 0.2400D-13, 0.9146D-13, 0.3476D-12, 0.1315D-11, 0.4952D-11, & + & 0.1850D-10, 0.6827D-10, 0.2478D-09, 0.8790D-09, 0.3012D-08, & + & 0.9895D-08, 0.3069D-07, 0.8855D-07, 0.2340D-06, 0.5598D-06, & + & 0.1205D-05, 0.2334D-05, 0.4088D-05, 0.6549D-05, 0.9714D-05, & + & 0.1351D-04, 0.1780D-04, 0.2246D-04, 0.2732D-04, 0.3221D-04, & + & 0.3692D-04, 0.4119D-04, 0.4472D-04, 0.4710D-04, 0.4792D-04, & + & 0.4677D-04, 0.4344D-04, 0.3810D-04, 0.3135D-04, 0.2418D-04, & + & 0.1751D-04, 0.1200D-04, 0.7878D-05, 0.5021D-05, 0.3147D-05, & + & 0.1961D-05, 0.1225D-05, 0.7718D-06, 0.4916D-06, 0.3168D-06, & + & 0.2066D-06, 0.1359D-06, 0.9018D-07, 0.6024D-07, 0.4046D-07, & + & 0.2727D-07/ + + data (calcpts(j,43), j = 1,neta) /0.2703D-26, 0.8444D-26, & + & 0.3725D-25, 0.1405D-24, 0.5220D-24, 0.2006D-23, 0.7684D-23, & + & 0.2938D-22, 0.1127D-21, 0.4316D-21, 0.1654D-20, 0.6336D-20, & + & 0.2427D-19, 0.9298D-19, 0.3562D-18, 0.1365D-17, 0.5226D-17, & + & 0.2001D-16, 0.7661D-16, 0.2931D-15, 0.1121D-14, 0.4284D-14, & + & 0.1635D-13, 0.6231D-13, 0.2367D-12, 0.8963D-12, 0.3373D-11, & + & 0.1260D-10, 0.4650D-10, 0.1689D-09, 0.5988D-09, 0.2055D-08, & + & 0.6742D-08, 0.2091D-07, 0.6033D-07, 0.1595D-06, 0.3815D-06, & + & 0.8212D-06, 0.1590D-05, 0.2787D-05, 0.4466D-05, 0.6626D-05, & + & 0.9219D-05, 0.1217D-04, 0.1538D-04, 0.1875D-04, 0.2219D-04, & + & 0.2556D-04, 0.2877D-04, 0.3160D-04, 0.3387D-04, 0.3530D-04, & + & 0.3555D-04, 0.3439D-04, 0.3168D-04, 0.2759D-04, 0.2254D-04, & + & 0.1727D-04, 0.1243D-04, 0.8470D-05, 0.5531D-05, 0.3507D-05, & + & 0.2188D-05, 0.1358D-05, 0.8454D-06, 0.5310D-06, 0.3373D-06, & + & 0.2171D-06, 0.1412D-06, 0.9284D-07, 0.6156D-07, 0.4110D-07, & + & 0.2759D-07/ + + data (calcpts(j,44), j = 1,neta) /0.1634D-26, 0.5751D-26, & + & 0.2562D-25, 0.9281D-25, 0.3562D-24, 0.1366D-23, 0.5227D-23, & + & 0.2003D-22, 0.7679D-22, 0.2940D-21, 0.1127D-20, 0.4317D-20, & + & 0.1654D-19, 0.6336D-19, 0.2427D-18, 0.9295D-18, 0.3561D-17, & + & 0.1363D-16, 0.5220D-16, 0.1998D-15, 0.7640D-15, 0.2919D-14, & + & 0.1114D-13, 0.4245D-13, 0.1612D-12, 0.6107D-12, 0.2298D-11, & + & 0.8583D-11, 0.3168D-10, 0.1150D-09, 0.4080D-09, 0.1401D-08, & + & 0.4593D-08, 0.1425D-07, 0.4110D-07, 0.1086D-06, 0.2599D-06, & + & 0.5595D-06, 0.1084D-05, 0.1899D-05, 0.3044D-05, 0.4518D-05, & + & 0.6290D-05, 0.8306D-05, 0.1051D-04, 0.1283D-04, 0.1523D-04, & + & 0.1763D-04, 0.1994D-04, 0.2209D-04, 0.2397D-04, 0.2541D-04, & + & 0.2622D-04, 0.2621D-04, 0.2516D-04, 0.2301D-04, 0.1991D-04, & + & 0.1617D-04, 0.1231D-04, 0.8811D-05, 0.5972D-05, 0.3881D-05, & + & 0.2448D-05, 0.1521D-05, 0.9401D-06, 0.5832D-06, 0.3652D-06, & + & 0.2314D-06, 0.1486D-06, 0.9657D-07, 0.6342D-07, 0.4202D-07, & + & 0.2804D-07/ + + data (calcpts(j,45), j = 1,neta) /0.1110D-26, 0.4410D-26, & + & 0.1734D-25, 0.6595D-25, 0.2443D-24, 0.9300D-24, 0.3569D-23, & + & 0.1366D-22, 0.5229D-22, 0.2005D-21, 0.7677D-21, 0.2941D-20, & + & 0.1127D-19, 0.4317D-19, 0.1653D-18, 0.6333D-18, 0.2425D-17, & + & 0.9288D-17, 0.3557D-16, 0.1361D-15, 0.5205D-15, 0.1989D-14, & + & 0.7590D-14, 0.2892D-13, 0.1099D-12, 0.4160D-12, 0.1566D-11, & + & 0.5849D-11, 0.2159D-10, 0.7838D-10, 0.2780D-09, 0.9544D-09, & + & 0.3129D-08, 0.9708D-08, 0.2801D-07, 0.7400D-07, 0.1771D-06, & + & 0.3813D-06, 0.7383D-06, 0.1294D-05, 0.2075D-05, 0.3080D-05, & + & 0.4289D-05, 0.5666D-05, 0.7174D-05, 0.8773D-05, 0.1043D-04, & + & 0.1210D-04, 0.1375D-04, 0.1533D-04, 0.1677D-04, 0.1800D-04, & + & 0.1892D-04, 0.1935D-04, 0.1920D-04, 0.1831D-04, 0.1665D-04, & + & 0.1431D-04, 0.1157D-04, 0.8758D-05, 0.6236D-05, 0.4206D-05, & + & 0.2719D-05, 0.1709D-05, 0.1056D-05, 0.6505D-06, 0.4023D-06, & + & 0.2513D-06, 0.1588D-06, 0.1018D-06, 0.6605D-07, 0.4332D-07, & + & 0.2868D-07/ + + data (calcpts(j,46), j = 1,neta) /0.9015D-27, 0.2622D-26, & + & 0.1135D-25, 0.4299D-25, 0.1673D-24, 0.6300D-24, 0.2432D-23, & + & 0.9301D-23, 0.3562D-22, 0.1364D-21, 0.5229D-21, 0.2004D-20, & + & 0.7676D-20, 0.2940D-19, 0.1127D-18, 0.4316D-18, 0.1653D-17, & + & 0.6329D-17, 0.2423D-16, 0.9270D-16, 0.3546D-15, 0.1355D-14, & + & 0.5172D-14, 0.1971D-13, 0.7487D-13, 0.2834D-12, 0.1067D-11, & + & 0.3984D-11, 0.1471D-10, 0.5340D-10, 0.1893D-09, 0.6503D-09, & + & 0.2135D-08, 0.6613D-08, 0.1908D-07, 0.5042D-07, 0.1207D-06, & + & 0.2598D-06, 0.5031D-06, 0.8817D-06, 0.1414D-05, 0.2098D-05, & + & 0.2924D-05, 0.3864D-05, 0.4895D-05, 0.5991D-05, 0.7128D-05, & + & 0.8286D-05, 0.9442D-05, 0.1057D-04, 0.1164D-04, 0.1260D-04, & + & 0.1341D-04, 0.1397D-04, 0.1420D-04, 0.1400D-04, 0.1327D-04, & + & 0.1200D-04, 0.1027D-04, 0.8253D-05, 0.6219D-05, 0.4407D-05, & + & 0.2958D-05, 0.1904D-05, 0.1191D-05, 0.7338D-06, 0.4501D-06, & + & 0.2775D-06, 0.1728D-06, 0.1090D-06, 0.6971D-07, 0.4516D-07, & + & 0.2959D-07/ + + data (calcpts(j,47), j = 1,neta) /0.6257D-27, 0.1967D-26, & + & 0.7812D-26, 0.2892D-25, 0.1132D-24, 0.4352D-24, 0.1650D-23, & + & 0.6303D-23, 0.2431D-22, 0.9296D-22, 0.3559D-21, 0.1364D-20, & + & 0.5231D-20, 0.2004D-19, 0.7675D-19, 0.2940D-18, 0.1126D-17, & + & 0.4311D-17, 0.1650D-16, 0.6316D-16, 0.2415D-15, 0.9231D-15, & + & 0.3524D-14, 0.1342D-13, 0.5101D-13, 0.1930D-12, 0.7269D-12, & + & 0.2715D-11, 0.1002D-10, 0.3638D-10, 0.1290D-09, 0.4430D-09, & + & 0.1456D-08, 0.4506D-08, 0.1300D-07, 0.3435D-07, 0.8220D-07, & + & 0.1770D-06, 0.3428D-06, 0.6008D-06, 0.9632D-06, 0.1430D-05, & + & 0.1992D-05, 0.2634D-05, 0.3337D-05, 0.4088D-05, 0.4869D-05, & + & 0.5667D-05, 0.6470D-05, 0.7263D-05, 0.8031D-05, 0.8751D-05, & + & 0.9393D-05, 0.9915D-05, 0.1026D-04, 0.1037D-04, 0.1016D-04, & + & 0.9585D-05, 0.8626D-05, 0.7344D-05, 0.5877D-05, 0.4409D-05, & + & 0.3110D-05, 0.2079D-05, 0.1332D-05, 0.8301D-06, 0.5094D-06, & + & 0.3114D-06, 0.1912D-06, 0.1188D-06, 0.7476D-07, 0.4773D-07, & + & 0.3089D-07/ + + data (calcpts(j,48), j = 1,neta) /0.1929D-27, 0.1065D-26, & + & 0.5550D-26, 0.2037D-25, 0.7890D-25, 0.2965D-24, 0.1121D-23, & + & 0.4320D-23, 0.1657D-22, 0.6348D-22, 0.2428D-21, 0.9311D-21, & + & 0.3563D-20, 0.1364D-19, 0.5229D-19, 0.2003D-18, 0.7671D-18, & + & 0.2937D-17, 0.1124D-16, 0.4303D-16, 0.1646D-15, 0.6290D-15, & + & 0.2400D-14, 0.9146D-14, 0.3475D-13, 0.1316D-12, 0.4952D-12, & + & 0.1850D-11, 0.6827D-11, 0.2478D-10, 0.8790D-10, 0.3018D-09, & + & 0.9918D-09, 0.3071D-08, 0.8855D-08, 0.2340D-07, 0.5601D-07, & + & 0.1206D-06, 0.2335D-06, 0.4093D-06, 0.6563D-06, 0.9747D-06, & + & 0.1358D-05, 0.1796D-05, 0.2276D-05, 0.2789D-05, 0.3322D-05, & + & 0.3870D-05, 0.4424D-05, 0.4977D-05, 0.5518D-05, 0.6041D-05, & + & 0.6524D-05, 0.6949D-05, 0.7287D-05, 0.7499D-05, 0.7535D-05, & + & 0.7349D-05, 0.6900D-05, 0.6183D-05, 0.5241D-05, 0.4176D-05, & + & 0.3120D-05, 0.2192D-05, 0.1459D-05, 0.9318D-06, 0.5783D-06, & + & 0.3536D-06, 0.2154D-06, 0.1319D-06, 0.8168D-07, 0.5130D-07, & + & 0.3269D-07/ + + data (calcpts(j,49), j = 1,neta) /0.1342D-27, 0.7954D-27, & + & 0.3825D-26, 0.1374D-25, 0.5324D-25, 0.2004D-24, 0.7458D-24, & + & 0.2908D-23, 0.1111D-22, 0.4303D-22, 0.1656D-21, 0.6326D-21, & + & 0.2435D-20, 0.9320D-20, 0.3557D-19, 0.1364D-18, 0.5224D-18, & + & 0.2001D-17, 0.7657D-17, 0.2933D-16, 0.1121D-15, 0.4284D-15, & + & 0.1635D-14, 0.6231D-14, 0.2367D-13, 0.8962D-13, 0.3373D-12, & + & 0.1260D-11, 0.4650D-11, 0.1689D-10, 0.5988D-10, 0.2057D-09, & + & 0.6758D-09, 0.2094D-08, 0.6033D-08, 0.1595D-07, 0.3816D-07, & + & 0.8215D-07, 0.1592D-06, 0.2789D-06, 0.4472D-06, 0.6641D-06, & + & 0.9252D-06, 0.1224D-05, 0.1551D-05, 0.1901D-05, 0.2267D-05, & + & 0.2642D-05, 0.3023D-05, 0.3403D-05, 0.3783D-05, 0.4152D-05, & + & 0.4505D-05, 0.4829D-05, 0.5111D-05, 0.5328D-05, 0.5454D-05, & + & 0.5454D-05, 0.5297D-05, 0.4953D-05, 0.4421D-05, 0.3732D-05, & + & 0.2963D-05, 0.2205D-05, 0.1544D-05, 0.1024D-05, 0.6512D-06, & + & 0.4026D-06, 0.2453D-06, 0.1489D-06, 0.9093D-07, 0.5616D-07, & + & 0.3519D-07/ + + data (dlaeta(j), j = 1,neta) / & + & -6d0, -5.83333333d0, -5.66666667d0, -5.5d0, -5.33333333d0, & + & -5.16666667d0, -5d0, -4.83333333d0, -4.66666667d0, -4.5d0, & + & -4.33333333d0, -4.16666667d0, -4d0, -3.83333333d0, & + & -3.66666667d0, -3.5d0, -3.33333333d0, -3.16666667d0, -3d0, & + & -2.83333333d0, -2.66666667d0, -2.5d0, -2.33333333d0, & + & -2.16666667d0, -2d0, -1.83333333d0, -1.66666667d0, -1.5d0, & + & -1.33333333d0, -1.16666667d0, -1d0, -0.83333333d0, -0.66666667d0,& + & -0.5d0, -0.33333333d0, -0.16666667d0, 0d0, 0.16666667d0, & + & 0.33333333d0, 0.5d0, 0.66666667d0, 0.83333333d0, 1d0, & + & 1.16666667d0, 1.33333333d0, 1.5d0, 1.66666667d0, 1.83333333d0, & + & 2d0, 2.16666667d0, 2.33333333d0, 2.5d0, 2.66666667d0, & + & 2.83333333d0, 3d0, 3.16666667d0, 3.33333333d0, 3.5d0, & + & 3.66666667d0, 3.83333333d0, 4d0, 4.16666667d0, 4.33333333d0, & + & 4.5d0, 4.66666667d0, 4.83333333d0, 5d0, 5.16666667d0, & + & 5.33333333d0, 5.5d0, 5.66666667d0, 5.83333333d0, 6d0/ + + data (dlaxi(j), j = 1,nxi) / & + & -3d0, -2.83333333d0, -2.66666667d0, -2.5d0, -2.33333333d0, & + & -2.16666667d0, -2d0, -1.83333333d0, -1.66666667d0, -1.5d0, & + & -1.33333333d0, -1.16666667d0, -1d0, -0.83333333d0, -0.66666667d0,& + & -0.5d0, -0.33333333d0, -0.16666667d0, 0d0, 0.16666667d0, & + & 0.33333333d0, 0.5d0, 0.66666667d0, 0.83333333d0, 1d0, & + & 1.16666667d0, 1.33333333d0, 1.5d0, 1.66666667d0, 1.83333333d0, & + & 2d0, 2.16666667d0, 2.33333333d0, 2.5d0, 2.66666667d0, & + & 2.83333333d0, 3d0, 3.16666667d0, 3.33333333d0, 3.5d0, & + & 3.66666667d0, 3.83333333d0, 4d0, 4.16666667d0, 4.33333333d0, & + & 4.5d0, 4.66666667d0, 4.83333333d0, 5d0/ + + dleta = dlog10(eta) + dlxi = dlog10(xi) + if (dlxi .le. dlaxi(1)) dlxi = dlaxi(1) + if (dlxi .ge. dlaxi(nxi)) dlxi = dlaxi(nxi) + if (dleta .ge. dlaeta(neta)) dleta = dlaeta(neta) + if (dleta .le. dlaeta(1)) dleta = dlaeta(1) + call locate(dlaeta,neta, dleta, ieta) + call locate(dlaxi, nxi, dlxi, ixi) +! interpolating between the appropriate points + delxi = 1d0/6d0 + deleta = 1d0/6d0 +! lagrange 3-pt. + if (ixi .le. 2) ixi = 2 + if (ixi .ge. 48) ixi = 48 + if (ieta .le. 2) ieta = 2 + if (ieta .ge. 72) ieta = 72 + pxi = (dlxi - dlaxi(ixi))/delxi + f(-1) = pxi*(pxi-1d0)/2d0*calcpts(ieta-1,ixi-1) + & + & (1d0 - pxi**2)*calcpts(ieta-1,ixi) + & + & pxi*(pxi+1d0)/2d0*calcpts(ieta-1,ixi+1) + f(0) = pxi*(pxi-1d0)/2d0*calcpts(ieta,ixi-1) + & + & (1d0 - pxi**2)*calcpts(ieta,ixi) + & + & pxi*(pxi+1d0)/2d0*calcpts(ieta,ixi+1) + f(1) = pxi*(pxi-1d0)/2d0*calcpts(ieta+1,ixi-1) + & + & (1d0 - pxi**2)*calcpts(ieta+1,ixi) + & + & pxi*(pxi+1d0)/2d0*calcpts(ieta+1,ixi+1) + peta = (dleta - dlaeta(ieta))/deleta + h1_LLq = peta*(peta-1d0)/2d0*f(-1) + & + & (1d0 - peta**2)*f(0) + & + & peta*(peta+1d0)/2d0*f(1) +!MB + + peta*(peta+1d0)/2d0*f(1) + return + END + + +!DECK ID>, QCUTIL. + +!DECK ID>, QNMACRO. + +! ================================================== + SUBROUTINE QNMACRO(lun,name,isym,xx,yy,ee,np,text) +! ================================================== + + implicit double precision (A-H,O-Z) + + character*(*) name + character*(*) text + dimension xx(*), yy(*), ee(*) + dimension luns(50) + + data nluns,luns /0,50*0/ + + nn = max(np,0) + lseen = 0 + do i = 1,nluns + if(luns(i).eq.lun) lseen = 1 + enddo + + if(lseen.eq.0) then + + nluns = min(nluns+1,50) + luns(nluns) = lun + + write(lun,*) ' ' + write(lun,'(''*'',60(''-''))') + write(lun,*) ' macro qnplot' + write(lun,'(''*'',60(''-''))') + write(lun,'(''* 1=opt 2=sym 3=xmin 4=xmax'', & + & '' 5=ymin 6=ymax 7=size 8=npt'')') + write(lun,'(''*'',60(''-''))') + write(lun,*) ' ' + write(lun,*) ' if [1].eq.h then' + write(lun,'('' mess 1=opt 2=sym 3=xmin 4=xmax'', & + & '' 5=ymin 6=ymax 7=size 8=npt'')') + write(lun,*) ' goto klaar' + write(lun,*) ' elseif [1].eq.s then' + write(lun,*) ' if [8].le.0 goto klaar' + write(lun,*) ' elseif [8].eq.0 then' + write(lun,*) ' goto klaar' + write(lun,*) ' else' + write(lun,*) ' null [3] [4] [5] [6]' + write(lun,*) ' if [8].lt.0 goto klaar' + write(lun,*) ' endif' + write(lun,*) ' if [2].lt.20 then' + write(lun,*) ' set dmod abs([2])' + write(lun,*) ' if [2].gt.0 then' + write(lun,*) ' graph [8] xx yy C' + write(lun,*) ' endif' + write(lun,*) ' if [2].lt.0 then' + write(lun,*) ' sigma up=yy+ey' + write(lun,*) ' sigma dn=yy-ey' + write(lun,*) ' graph [8] xx up C' + write(lun,*) ' graph [8] xx dn C' + write(lun,*) ' endif' + write(lun,*) ' else' + write(lun,*) ' set dmod 1' + write(lun,*) ' hplot/errors xx yy ex ey [8] [2] [7]' + write(lun,*) ' endif' + write(lun,*) ' ' + write(lun,*) ' klaar:' + write(lun,*) ' ' + write(lun,*) ' return' + + endif + + if(nn.le.0) then + + xmin = 0. + xmax = 0. + ymin = 0. + ymax = 0. + + else + + xmin = xx(1) + xmax = xx(1) + ymin = yy(1) + ymax = yy(1) + do i = 2,nn + xmin = min(xmin,xx(i)) + xmax = max(xmax,xx(i)) + ymin = min(ymin,yy(i)) + ymax = max(ymax,yy(i)) + enddo + + dx = xmax-xmin + xmin = xmin-0.1*dx + xmax = xmax+0.1*dx + + dy = ymax-ymin + ymin = ymin-0.1*dy + ymax = ymax+0.1*dy + + endif + + write(lun,*) ' ' + write(lun,'(''*'',60(''-''))') + if(isym.lt.10) then + write(lun,'('' macro '',A,'' 1=n 2='',I1,'' _'')') name,isym + elseif(isym.lt.100) then + write(lun,'('' macro '',A,'' 1=n 2='',I2,'' _'')') name,isym + else + write(lun,'('' macro '',A,'' 1=n 2='',I3,'' _'')') name,isym + endif + if(nn.lt.10) then + write(lun,'('' 3='',E9.3,'' 4='',E9.3, & + & '' 5='',E9.3,'' 6='',E9.3,'' 7=0.28 8='',I1)') & + & xmin,xmax,ymin,ymax,nn + elseif(nn.lt.100) then + write(lun,'('' 3='',E9.3,'' 4='',E9.3, & + & '' 5='',E9.3,'' 6='',E9.3,'' 7=0.28 8='',I2)') & + & xmin,xmax,ymin,ymax,nn + elseif(nn.lt.1000) then + write(lun,'('' 3='',E9.3,'' 4='',E9.3, & + & '' 5='',E9.3,'' 6='',E9.3,'' 7=0.28 8='',I3)') & + & xmin,xmax,ymin,ymax,nn + else + write(lun,'('' 3='',E9.3,'' 4='',E9.3, & + & '' 5='',E9.3,'' 6='',E9.3,'' 7=0.28 8='',I4)') & + & xmin,xmax,ymin,ymax,nn + endif + write(lun,'(''*'',60(''-''))') +! write(lun,*) ' ' + write(lun,'(''* '',A)') text + + if(nn.le.0) goto 500 + + write(lun,*) ' ' + if(nn.le.9) then + write(lun,'('' ve/cr xx('',I1,'') r _'')') nn + elseif(nn.le.99) then + write(lun,'('' ve/cr xx('',I2,'') r _'')') nn + elseif(nn.le.999) then + write(lun,'('' ve/cr xx('',I3,'') r _'')') nn + elseif(nn.le.9999) then + write(lun,'('' ve/cr xx('',I4,'') r _'')') nn + endif + do i1 = 1,nn,6 + i2 = i1+5 + if(i2.lt.nn) then + write(lun,'(6E12.4,'' _'')') (xx(i),i=i1,i2) + else + write(lun,'(6E12.4 )') (xx(i),i=i1,nn) + endif + enddo + +! write(lun,*) ' ' + if(nn.le.9) then + write(lun,'('' ve/cr ex('',I1,'') r '',I1, & + & ''*0'')') nn,nn + elseif(nn.le.99) then + write(lun,'('' ve/cr ex('',I2,'') r '',I2, & + & ''*0'')') nn,nn + elseif(nn.le.999) then + write(lun,'('' ve/cr ex('',I3,'') r '',I3, & + & ''*0'')') nn,nn + elseif(nn.le.9999) then + write(lun,'('' ve/cr ex('',I4,'') r '',I4, & + & ''*0'')') nn,nn + endif + +! write(lun,*) ' ' + if(nn.le.9) then + write(lun,'('' ve/cr yy('',I1,'') r _'')') nn + elseif(nn.le.99) then + write(lun,'('' ve/cr yy('',I2,'') r _'')') nn + elseif(nn.le.999) then + write(lun,'('' ve/cr yy('',I3,'') r _'')') nn + elseif(nn.le.9999) then + write(lun,'('' ve/cr yy('',I4,'') r _'')') nn + endif + do i1 = 1,nn,6 + i2 = i1+5 + if(i2.lt.nn) then + write(lun,'(6E12.4,'' _'')') (yy(i),i=i1,i2) + else + write(lun,'(6E12.4 )') (yy(i),i=i1,nn) + endif + enddo + +! write(lun,*) ' ' + if(nn.le.9) then + write(lun,'('' ve/cr ey('',I1,'') r _'')') nn + elseif(nn.le.99) then + write(lun,'('' ve/cr ey('',I2,'') r _'')') nn + elseif(nn.le.999) then + write(lun,'('' ve/cr ey('',I3,'') r _'')') nn + elseif(nn.le.9999) then + write(lun,'('' ve/cr ey('',I4,'') r _'')') nn + endif + do i1 = 1,nn,6 + i2 = i1+5 + if(i2.lt.nn) then + write(lun,'(6E12.4,'' _'')') (ee(i),i=i1,i2) + else + write(lun,'(6E12.4 )') (ee(i),i=i1,nn) + endif + enddo + + 500 continue + + write(lun,*) ' ' + write(lun,*) ' exec qnplot [1] [2] [3] [4] [5] [6] [7] [8]' + write(lun,*) ' ' + write(lun,*) 'return' + + + return + END + +!DECK ID>, QNSORT. + +! ================================= + SUBROUTINE QNSORT(ARRAY,NIN,NOUT) +! ================================= + +!-- Interface routine to CERN library FLPSOR. +!-- Sorts NIN (< 5000) elements of ARRAY in ascending +!-- order into itself. Identical elements are removed +!-- so that NOUT might be < NIN. In this case the elements +!-- NOUT+1, ..., NIN are set to zero on output. +!-- Note: ARRAY is internally copied to the single precision +!-- array XXX which is copied back again to ARRAY on output. +!-- The double precision thus gets lost. + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + REAL XXX + + DIMENSION ARRAY(*) + DIMENSION XXX(5000) + + IF(NIN.LE.1) THEN + NOUT = MAX(NIN,0) + RETURN + ENDIF + IF(NIN.GT.5000) THEN + IERR = 1 + GOTO 500 + ENDIF + + DO I = 1,NIN + XXX(I) = ARRAY(I) + ENDDO + + CALL FLPSOR_LHA(XXX,NIN) + + NOUT = 1 + DO I = 2,NIN + IF(XXX(I).GT.XXX(I-1)) THEN + NOUT = NOUT + 1 + XXX(NOUT) = XXX(I) + ENDIF + ENDDO + + DO I = 1,NOUT + ARRAY(I) = XXX(I) + ENDDO + + DO I = NOUT+1,NIN + ARRAY(I) = 0. + ENDDO + + RETURN + + 500 CONTINUE + + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r QNSORT ---> STOP'')') + WRITE(6,'( '' ------------------------------------'')') + WRITE(6,'( '' Input ARRAY(1) :'',E12.5)') ARRAY(1) + WRITE(6,'( '' NN :'',I12 )') NIN + WRITE(6,'(/'' NN should be .le. 5000'')') + STOP + + END + +!DECK ID>, QNUCPY. + +! ======================== + SUBROUTINE QNUCPY(A,B,N) +! ======================== + + DOUBLE PRECISION A,B + DIMENSION A(*),B(*) + + DO 10 I=1,N + B(I) = A(I) + 10 END DO + + RETURN + END + +!DECK ID>, QNVFIL. + +! ======================== + SUBROUTINE QNVFIL(A,N,V) +! ======================== + + DOUBLE PRECISION A,V + DIMENSION A(*) + + DO 10 I=1,N + A(I) = V + 10 END DO + + RETURN + END +! +!DECK ID>, QNVNUL. + +! ====================== + SUBROUTINE QNVNUL(A,N) +! ====================== + + DOUBLE PRECISION A + DIMENSION A(*) + + DO 10 I=1,N + A(I) = 0. + 10 END DO + + RETURN + END + +!DECK ID>, QNINUL. + +! ======================= + SUBROUTINE QNINUL(IA,N) +! ======================= + + DIMENSION IA(*) + + DO 10 I=1,N + IA(I) = 0 + 10 END DO + + RETURN + END + +!DECK ID>, QNTRUE. + +! ======================= + SUBROUTINE QNTRUE(LA,N) +! ======================= + + LOGICAL LA + DIMENSION LA(*) + + DO 10 I=1,N + LA(I) = .TRUE. + 10 END DO + + RETURN + END + +!DECK ID>, QNFALS. + +! ======================= + SUBROUTINE QNFALS(LA,N) +! ======================= + + LOGICAL LA + DIMENSION LA(*) + + DO 10 I=1,N + LA(I) = .FALSE. + 10 END DO + + RETURN + END + +!DECK ID>, QNVMAX. + +! ==================================== + DOUBLE PRECISION FUNCTION QNVMAX(A,N) +! ==================================== + DOUBLE PRECISION A + DIMENSION A(*) + + QNVMAX = A(1) + IF(N.LE.1) RETURN + DO 10 I=2,N + QNVMAX = MAX(A(I),QNVMAX) + 10 END DO + + RETURN + END + +!DECK ID>, MXDFZE. + +! ==================== + FUNCTION MXDFZE(A,N) +! ==================== + + DOUBLE PRECISION A,V + DIMENSION A(*) + + IF(N.LE.1) THEN + MXDFZE = 1 + ELSE + V = A(1) + DO 10 I=2,N + V = MAX(A(I),V) + 10 CONTINUE + DO 20 I=1,N + IF(A(I).EQ.V) MXDFZE = I + 20 CONTINUE + ENDIF + + RETURN + END + +!DECK ID>, CURRENT_TIME. + +! =============================== + INTEGER FUNCTION CURRENT_TIME() +! =============================== + + COMMON/QCSHIT/T1,T2 + CHARACTER*8 T1,T2 + INTEGER ITIME,D(2),T(2) + + EQUIVALENCE (T1,D) + EQUIVALENCE (T2,T) + + CALL DATIMH_LHA(D,T) + CALL CONV_TIME(T2,ITIME) + + CURRENT_TIME = ITIME + RETURN + END + +!DECK ID>, ELAPSED_TIME. + +! ================================= + INTEGER FUNCTION ELAPSED_TIME(OT) +! ================================= + + EXTERNAL CURRENT_TIME + INTEGER OT,CT,CURRENT_TIME,IHRO,IMINO,ISECO + INTEGER IHRP,IMINP,ISECP,EHR,EMI,ESE + + CT = CURRENT_TIME() + + IHRO = OT/10000 + IMINO = (OT-(IHRO*10000))/100 + ISECO = (OT-(IHRO*10000)-(IMINO*100)) + + IHRP = CT/10000 + IMINP = (CT-(IHRP*10000))/100 + ISECP = (CT-(IHRP*10000)-(IMINP*100)) + + EHR = IHRP-IHRO + IF (EHR.LT.0) EHR = EHR + 24 + EMI = IMINP - IMINO + ESE = ISECP - ISECO + + ELAPSED_TIME = 60*60*EHR + 60*EMI + ESE + RETURN + END + +!DECK ID>, CONV_TIME. + +! ================================ + SUBROUTINE CONV_TIME(TIME,ITIME) +! ================================ + + CHARACTER*8 TIME + INTEGER ITIME,IHRS,IMINS,ISECS + + CALL CONV_LHA(TIME(1:2),IHRS) + CALL CONV_LHA(TIME(4:5),IMINS) + CALL CONV_LHA(TIME(7:8),ISECS) + + ITIME = 10000*IHRS+100*IMINS+ISECS + RETURN + END + +!DECK ID>, CONV. + +! ============================ + SUBROUTINE CONV_LHA(ICHAR,ITIME) +! ============================ +! + CHARACTER*2 ICHAR + CHARACTER*1 IT(0:9) + INTEGER ITIME,I,ITEN,IUNI +! + DATA IT /'0','1','2','3','4','5','6','7','8','9' / + ITEN = 0 + IUNI = 0 + DO I = 0,9 + IF (ICHAR(1:1).EQ.IT(I)) ITEN = I + IF (ICHAR(2:2).EQ.IT(I)) IUNI = I + ENDDO + ITIME = 10*ITEN + IUNI + RETURN + END diff --git a/LHAPDF/lhapdf-5.9.1/src/QCDNUM.f b/LHAPDF/lhapdf-5.9.1/src/QCDNUM.f new file mode 100644 index 00000000000..34de8fc2b9a --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/QCDNUM.f @@ -0,0 +1,27359 @@ +! -*- F90 -*- + + +!DECK ID>, QCDCOM. + +!DECK ID>, QCDCOM. + +!------------------------QCDNUM COMMON BLOCKS--------------------- + +!DECK ID>, QCDNUM. + +!DECK ID>, QNINIT. + +! ================= + SUBROUTINE QNINIT +! ================= + +!--- QNINIT: initialisation. +!--- Called by user. + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + CHARACTER*8 CHVERS,CHDATE + COMMON/QCVERS/ CHVERS,CHDATE + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + REAL & + &WGTFF1,WGTFG1, & + &WGTGF1,WGTGG1, & + &WGTPP2,WGTPM2,WGTNS2, & + &WGTFF2,WGTFG2, & + &WGTGF2,WGTGG2, & + &WGTC2Q,WGTC2G,YNTC2Q, & + &WGTCLQ,WGTCLG,WGTC3Q + + COMMON/QCWEIT/ & + &WGTFF1(MXX*(MXX+1)/2) ,WGTFG1(MXX*(MXX+1)/2,3:5), & + &WGTGF1(MXX*(MXX+1)/2) ,WGTGG1(MXX*(MXX+1)/2,3:5), & + &WGTPP2(MXX*(MXX+1)/2,3:5),WGTPM2(MXX*(MXX+1)/2,3:5), & + &WGTNS2(MXX*(MXX+1)/2,3:5), & + &WGTFF2(MXX*(MXX+1)/2,3:5),WGTFG2(MXX*(MXX+1)/2,3:5), & + &WGTGF2(MXX*(MXX+1)/2,3:5),WGTGG2(MXX*(MXX+1)/2,3:5), & + &WGTC2Q(MXX*(MXX+1)/2) ,WGTC2G(MXX*(MXX+1)/2,3:5), & + &WGTCLQ(MXX*(MXX+1)/2) ,WGTCLG(MXX*(MXX+1)/2,3:5), & + &WGTC3Q(MXX*(MXX+1)/2) ,YNTC2Q(MXX) + + COMMON/QCWADR/ IWADR(MXX,MXX) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + CHARACTER*5 PNAM,STFNAM + LOGICAL LNFP + COMMON /QCLNFP/ LNFP(0:30,3:5) + COMMON /QCPNAM/ PNAM(0:30) + COMMON /QCPWGT/ PWGT(0:10,0:30,3:5) + COMMON /QCFNAM/ STFNAM(7) + + + LOGICAL LTIME + REAL T_START,T_END,T_SPENT + COMMON/QCTIME/T_START(10),T_END(10),T_SPENT(10),N_CALLS(10), & + &E_CALLS(10),LTIME + COMMON/QCFCNT/IFCNT(-1:1,5) + + CHARACTER*7 TSNAM + COMMON/QCTRCE/ TSNAM(0:19) + COMMON/QCTRCI/ NTCAL(0:19),ITADR +! +! common added by MRW 18/3/05 to make silent mode for LHAPDF +! + common/lhasilent/lhasilent +! + + CHVERS = '16.12 ' + CHDATE = '12-08-98' + + LDOUBL = .TRUE. + if(lhasilent.eq.0) then + WRITE(6,'(/////)') + WRITE(6, & + &'(8X,''+-----------------------------------------------+'')') + WRITE(6, & + &'(8X,''| |'')') +! LDOUBL = .TRUE. + WRITE(6, & + &'(8X,''| You are using the double precision version of |'')') + WRITE(6, & + &'(8X,''| |'')') + WRITE(6, & + &'(8X,''| Q C D N U M '',A8, & + & '' |'')') CHVERS + WRITE(6, & + &'(8X,''| |'')') + WRITE(6, & + &'(8X,''| Author : Michiel Botje |'')') + WRITE(6, & + &'(8X,''| Email : h24@nikhef.nl |'')') + WRITE(6, & + &'(8X,''| |'')') + WRITE(6, & + &'(8X,''| Date : '',A8, & + & '' |'')') CHDATE + WRITE(6, & + &'(8X,''| Max NX : '',I3, & + & '' |'')') MXX-1 + WRITE(6, & + &'(8X,''| Max NQ2 : '',I3, & + & '' |'')') MQ2-1 + WRITE(6, & + &'(8X,''| |'')') + WRITE(6, & + &'(8X,''+-----------------------------------------------+'')') + WRITE(6,'(/////)') + endif + + IORD = 2 + IOLAST = -999 + Q0ALFA = 50. + ALPHA0 = 0.180 + QALAST = -999. + ASLAST = -999. + SCAX0 = 0.20 + SCAQ0 = 1.D10 + + PI = 3.14159265359 + PROTON = 0.9382796 + EUTRON = 0.9395731 + UCLEON = (PROTON + EUTRON) / 2. + UDSCBT(1) = 0.005 + UDSCBT(2) = 0.01 + UDSCBT(3) = 0.3 + UDSCBT(4) = 1.5 + UDSCBT(5) = 5.0 + UDSCBT(6) = 188. + CBMSTF(4) = UDSCBT(4) + CBMSTF(5) = UDSCBT(4) + CBMSTF(6) = UDSCBT(5) + CBMSTF(7) = UDSCBT(5) + CHARGE(4) = 4./9. + CHARGE(5) = 4./9. + CHARGE(6) = 1./9. + CHARGE(7) = 1./9. + AAM2H = 1. + BBM2H = 0. + AAM2L = 1. + BBM2L = 0. + AAAR2 = 1. + BBBR2 = 0. + FL_FAC = 0. + C1S3 = 1./3. + C2S3 = 2./3. + C4S3 = 4./3. + C5S3 = 5./3. + C8S3 = 8./3. + C14S3 = 14./3. + C16S3 = 16./3. + C20S3 = 20./3. + C28S3 = 28./3. + C38S3 = 38./3. + C40S3 = 40./3. + C44S3 = 44./3. + C52S3 = 52./3. + C136S3 = 136./3. + C11S6 = 11./6. + C2S9 = 2./9. + C4S9 = 4./9. + C10S9 = 10./9. + C14S9 = 14./9. + C16S9 = 16./9. + C40S9 = 40./9. + C44S9 = 44./9. + C62S9 = 62./9. + C112S9 = 112./9. + C182S9 = 182./9. + C11S12 = 11./12. + C35S18 = 35./18. + C11S3 = 11./3. + C22S3 = 22./3. + C61S12 = 61./12. + C215S1 = 215./12. + C29S12 = 29./12. + CPI2S3 = PI**2/3. + CPIA = 67./18. - CPI2S3/2. + CPIB = 4.*CPI2S3 + CPIC = 17./18. + 3.5*CPI2S3 + CPID = 367./36. - CPI2S3 + CPIE = 5. - CPI2S3 + CPIF = CPI2S3 - 218./9. + + CCA = 3. + CCF = (CCA*CCA-1.)/(2.*CCA) + CTF = 0.5 + CATF = CCA*CTF + CFTF = CCF*CTF + + DO I = 1,10 + T_SPENT(I) = 0. + E_CALLS(I) = 0. + N_CALLS(I) = 0 + ENDDO + LTIME = .FALSE. + + LBMARK = .FALSE. + LW1ANA = .TRUE. + LW1NUM = .FALSE. + LW2NUM = .TRUE. + LW2STF = .TRUE. + LWF2C = .FALSE. + LWF2B = .FALSE. + LWFLC = .FALSE. + LWFLB = .FALSE. + LIMCK = .TRUE. + LPLUS = .TRUE. + LALFOK = .FALSE. + LDQ2OK = .FALSE. + LWT1OK = .FALSE. + LWT2OK = .FALSE. + LWTFOK = .FALSE. + LWFCOK = .FALSE. + LWLCOK = .FALSE. + LWFBOK = .FALSE. + LWLBOK = .FALSE. + LMARK = .FALSE. + LCLOWQ = .TRUE. + LASOLD = .FALSE. + DO I = 1,30 + DO J = 1,7 + LFFCAL(J,I) = .FALSE. + ENDDO + ENDDO +!-- Invalidate all evolutions + CALL QNFALS(LEVDONE,MXX*10) + CALL QNFALS(LE_DONE,MXX) + CALL QNINUL(IQL_LAST,10) + CALL QNINUL(IQ0_LAST,10) + CALL QNINUL(IQH_LAST,10) + + ITADR = 0 + DO I = 0,19 + TSNAM(I) = ' ' + NTCAL(I) = 0 + ENDDO + + NXX = 0 + NQ2 = 0 + NGRVER = 0 + NDFAST = 30 + XMICUT = -1. + QMICUT = -1. + QMACUT = -1. + RS2CUT = -1. + QMINAS = 0. + THRS34 = -1.D10 + THRS45 = 1.D10 + + CALL VZERO_LHA (WGTFF1,MXX*(MXX+1)/2) + CALL VZERO_LHA (WGTFG1,MXX*(MXX+1)*3/2) + CALL VZERO_LHA (WGTGF1,MXX*(MXX+1)/2) + CALL VZERO_LHA (WGTGG1,MXX*(MXX+1)*3/2) + CALL VZERO_LHA (WGTPP2,MXX*(MXX+1)*3/2) + CALL VZERO_LHA (WGTPM2,MXX*(MXX+1)*3/2) + CALL VZERO_LHA (WGTNS2,MXX*(MXX+1)*3/2) + CALL VZERO_LHA (WGTFF2,MXX*(MXX+1)*3/2) + CALL VZERO_LHA (WGTFG2,MXX*(MXX+1)*3/2) + CALL VZERO_LHA (WGTGF2,MXX*(MXX+1)*3/2) + CALL VZERO_LHA (WGTGG2,MXX*(MXX+1)*3/2) + CALL VZERO_LHA (WGTC2Q,MXX*(MXX+1)/2) + CALL VZERO_LHA (WGTC2G,MXX*(MXX+1)*3/2) + CALL VZERO_LHA (YNTC2Q,MXX) + CALL VZERO_LHA (WGTCLQ,MXX*(MXX+1)/2) + CALL VZERO_LHA (WGTCLG,MXX*(MXX+1)*3/2) + CALL VZERO_LHA (WGTC3Q,MXX*(MXX+1)/2) + + CALL QNVNUL(PWGT,11*31*3) + CALL QNINUL(NFMAP,MQ2) + CALL QNINUL(MARKFF,MXX*MQ2) + CALL QNINUL(MARKFH,MXX*MQ2) + CALL QNINUL(MARKQQ,MQ2) + CALL QNINUL(IDFAST,7*30) + CALL QNINUL(IFCNT,3*5) + + CALL QNVNUL(PDFQCD,MXX*MQ2*11) + DO ID = 1,NDFMAX + DO IX = 1,MXX + DO IQ = 1,MQ2 + FSTORE(IX,IQ,30+ID) = -501. + ENDDO + ENDDO + ENDDO + + PNAM(0) = 'GLUON' + PNAM(1) = 'SINGL' + LNFP(0,3) = .TRUE. + LNFP(0,4) = .TRUE. + LNFP(0,5) = .TRUE. + LNFP(1,3) = .TRUE. + LNFP(1,4) = .TRUE. + LNFP(1,5) = .TRUE. + DO 10 I = 2,30 + PNAM(I) = 'FREE ' + LNFP(I,3) = .FALSE. + LNFP(I,4) = .FALSE. + LNFP(I,5) = .FALSE. + 10 END DO + PWGT(0,0,3) = 1. + PWGT(0,0,4) = 1. + PWGT(0,0,5) = 1. + PWGT(1,1,3) = 1. + PWGT(1,1,4) = 1. + PWGT(1,1,5) = 1. + STFNAM(1) = 'F2 ' + STFNAM(2) = 'FL ' + STFNAM(3) = 'XF3 ' + STFNAM(4) = 'F2C ' + STFNAM(5) = 'FLC ' + STFNAM(6) = 'F2B ' + STFNAM(7) = 'FLB ' + + CALL QTRACE('QNINIT ',0) + + RETURN + END + +!DECK ID>, QTRACE. + +! =============================== + SUBROUTINE QTRACE(SRNAM,IPRINT) +! =============================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + CHARACTER*7 SRNAM + + CHARACTER*7 TSNAM + COMMON/QCTRCE/ TSNAM(0:19) + COMMON/QCTRCI/ NTCAL(0:19),ITADR + + + IF(IPRINT.EQ.0) THEN + + IF(SRNAM.EQ.TSNAM(ITADR)) THEN + NTCAL(ITADR) = NTCAL(ITADR) + 1 + ELSE + ITADR = MOD(ITADR+1,20) + TSNAM(ITADR) = SRNAM + NTCAL(ITADR) = 1 + ENDIF + + ELSE + + WRITE(6,'(/'' ----------------------------'')') + + K = -20 + DO I = ITADR+1,ITADR+19 + J = MOD(I,20) + K = K+1 + WRITE(6,'(I4,2X,A7,'' #calls = '',I5)') & + & K,TSNAM(J),NTCAL(J) + ENDDO + K = 0 + WRITE(6,'(I4,2X,A7,'' #calls = '',I5,'' <--- error'')') & + & K,TSNAM(ITADR),NTCAL(ITADR) + + WRITE(6,'( '' ----------------------------'')') + + ENDIF + + RETURN + END + +!DECK ID>, QNDUMP. + +! ====================== + SUBROUTINE QNDUMP(LUN) +! ====================== + +!--- QNDUMP: write weight tables to LUN. +!--- Called by user. + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + CHARACTER*8 CHVERS,CHDATE + COMMON/QCVERS/ CHVERS,CHDATE + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + REAL & + &WGTFF1,WGTFG1, & + &WGTGF1,WGTGG1, & + &WGTPP2,WGTPM2,WGTNS2, & + &WGTFF2,WGTFG2, & + &WGTGF2,WGTGG2, & + &WGTC2Q,WGTC2G,YNTC2Q, & + &WGTCLQ,WGTCLG,WGTC3Q + + COMMON/QCWEIT/ & + &WGTFF1(MXX*(MXX+1)/2) ,WGTFG1(MXX*(MXX+1)/2,3:5), & + &WGTGF1(MXX*(MXX+1)/2) ,WGTGG1(MXX*(MXX+1)/2,3:5), & + &WGTPP2(MXX*(MXX+1)/2,3:5),WGTPM2(MXX*(MXX+1)/2,3:5), & + &WGTNS2(MXX*(MXX+1)/2,3:5), & + &WGTFF2(MXX*(MXX+1)/2,3:5),WGTFG2(MXX*(MXX+1)/2,3:5), & + &WGTGF2(MXX*(MXX+1)/2,3:5),WGTGG2(MXX*(MXX+1)/2,3:5), & + &WGTC2Q(MXX*(MXX+1)/2) ,WGTC2G(MXX*(MXX+1)/2,3:5), & + &WGTCLQ(MXX*(MXX+1)/2) ,WGTCLG(MXX*(MXX+1)/2,3:5), & + &WGTC3Q(MXX*(MXX+1)/2) ,YNTC2Q(MXX) + + COMMON/QCWADR/ IWADR(MXX,MXX) + + + REAL & + &WH_C0KG,WH_C1KG,WH_C1BKG, & + &WH_C1KQ,WH_C1BKQ,WH_D1KQ,WH_D1BKQ + + COMMON/QCHWGT/ & + &WH_C0KG(0:MXX,MQ2,4:7), & + &WH_C1KG(0:MXX,MQ2,4:7),WH_C1BKG(0:MXX,MQ2,4:7), & + &WH_C1KQ(0:MXX,MQ2,4:7),WH_C1BKQ(0:MXX,MQ2,4:7), & + &WH_D1KQ(0:MXX,MQ2,4:7),WH_D1BKQ(0:MXX,MQ2,4:7) + + + DIMENSION STOREM(6) + + CALL QTRACE('QNDUMP ',0) + + STOREM(1) = CBMSTF(4) + STOREM(2) = CBMSTF(6) + STOREM(3) = 0. + STOREM(4) = 0. + STOREM(5) = 0. + STOREM(6) = 0. + + WRITE(LUN) MXX,MQ2 + WRITE(LUN) CHVERS,CHDATE + WRITE(LUN) STOREM + WRITE(LUN) LWT1OK,LWT2OK,LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK, & + & LPLUS + WRITE(LUN) XXTAB,Q2TAB, & + & NXX,NQ2,IQF2C,IQF2B,IQFLC,IQFLB + IF(LWT1OK) THEN + WRITE(LUN) WGTFF1,WGTFG1,WGTGF1,WGTGG1 + ENDIF + IF(LWT2OK) THEN + WRITE(LUN) WGTPP2,WGTPM2,WGTNS2,WGTFF2,WGTFG2,WGTGF2,WGTGG2 + ENDIF + IF(LWTFOK) THEN + WRITE(LUN) WGTC2Q,WGTC2G,YNTC2Q,WGTCLQ,WGTCLG,WGTC3Q + ENDIF + IF(LWFCOK.OR.LWLCOK.OR.LWFBOK.OR.LWLBOK) THEN + WRITE(LUN) WH_C0KG,WH_C1KG,WH_C1BKG, & + & WH_C1KQ,WH_C1BKQ,WH_D1KQ,WH_D1BKQ + ENDIF + + RETURN + END + +!DECK ID>, QNREAD. + +! ================================= + SUBROUTINE QNREAD(LUN,ISTOP,IERR) +! ================================= + +!--- QNDUMP: read weight tables from LUN. +!--- Called by user. +!--- Input integer LUN +!--- integer ISTOP = 0 read the file +!--- ISTOP = 1 read only when ierr = 0 +!--- ISTOP = 2 stop the program when ierr .ne. 0 +!--- Output integer IERR = 0 all ok +!--- = 1 xgrid on file .ne. that in QCDNUM +!--- = 2 file contains heavy quark weight tables a +!--- qgrid on file .ne. that in QCDNUM +!--- = 3 file contains charm weight tables and +!--- c mass on the file .ne. that in QCDNUM +!--- = 4 file contains bottom weight tables and +!--- b mass on the file .ne. that in QCDNUM + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + CHARACTER*8 CHVERS,CHDATE + COMMON/QCVERS/ CHVERS,CHDATE + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + REAL & + &WGTFF1,WGTFG1, & + &WGTGF1,WGTGG1, & + &WGTPP2,WGTPM2,WGTNS2, & + &WGTFF2,WGTFG2, & + &WGTGF2,WGTGG2, & + &WGTC2Q,WGTC2G,YNTC2Q, & + &WGTCLQ,WGTCLG,WGTC3Q + + COMMON/QCWEIT/ & + &WGTFF1(MXX*(MXX+1)/2) ,WGTFG1(MXX*(MXX+1)/2,3:5), & + &WGTGF1(MXX*(MXX+1)/2) ,WGTGG1(MXX*(MXX+1)/2,3:5), & + &WGTPP2(MXX*(MXX+1)/2,3:5),WGTPM2(MXX*(MXX+1)/2,3:5), & + &WGTNS2(MXX*(MXX+1)/2,3:5), & + &WGTFF2(MXX*(MXX+1)/2,3:5),WGTFG2(MXX*(MXX+1)/2,3:5), & + &WGTGF2(MXX*(MXX+1)/2,3:5),WGTGG2(MXX*(MXX+1)/2,3:5), & + &WGTC2Q(MXX*(MXX+1)/2) ,WGTC2G(MXX*(MXX+1)/2,3:5), & + &WGTCLQ(MXX*(MXX+1)/2) ,WGTCLG(MXX*(MXX+1)/2,3:5), & + &WGTC3Q(MXX*(MXX+1)/2) ,YNTC2Q(MXX) + + COMMON/QCWADR/ IWADR(MXX,MXX) + + + REAL & + &WH_C0KG,WH_C1KG,WH_C1BKG, & + &WH_C1KQ,WH_C1BKQ,WH_D1KQ,WH_D1BKQ + + COMMON/QCHWGT/ & + &WH_C0KG(0:MXX,MQ2,4:7), & + &WH_C1KG(0:MXX,MQ2,4:7),WH_C1BKG(0:MXX,MQ2,4:7), & + &WH_C1KQ(0:MXX,MQ2,4:7),WH_C1BKQ(0:MXX,MQ2,4:7), & + &WH_D1KQ(0:MXX,MQ2,4:7),WH_D1BKQ(0:MXX,MQ2,4:7) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + CHARACTER*8 RHVERS,RHDATE + LOGICAL RWT1OK,RWT2OK,RWTFOK,RWFCOK + LOGICAL RWLCOK,RWFBOK,RWLBOK,RPLUS + LOGICAL LREADX,LREADQ,LREADB,LREADC + DIMENSION RMASS(6) + DIMENSION RXTAB(MXX),RQTAB(MQ2) + DIMENSION IRF2C(MQ2),IRF2B(MQ2),IRFLC(MQ2),IRFLB(MQ2) +! +! common added 18/3/05 by MRW + common/lhasilent/lhasilent + + CALL QTRACE('QNREAD ',0) + + REWIND LUN + +!-- Setup the weight adresses +!-- (Usually done in QNFILW, but this routine might not be called) + DO IX0 = 1,MXX + DO IX = IX0,MXX + IWADR(IX,IX0) = IWTAD(IX,IX0) + ENDDO + ENDDO + +!-- Read header information + READ(LUN,ERR=500) KXX,KQ2 + IF(KXX.NE.MXX.OR.KQ2.NE.MQ2) THEN + WRITE(6,'(/'' QNREAD: nxmax, nqmax on file '',2I5, & + & /'' nxmax, nqmax in QCDNUM'',2I5, & + & /'' Incompatible ---> STOP'')') & + & KXX,KQ2,MXX,MQ2 + STOP + ENDIF + READ(LUN,ERR=500) RHVERS,RHDATE + READ(RHVERS(1:2),'(I2)') IV + +!-- If ISTOP > 0 : stop when fileversion = QCDNUM15 or lower +!-- If ISTOP = 0 : read up to the weight tables + IF(IV.LE.15.AND.ISTOP.NE.0) THEN + WRITE(6,'(/'' QNREAD: file was written with QCDNUM'',A8, & + & '' Incompatible ---> STOP'')') & + & RHVERS + STOP + ENDIF + if(lhasilent.eq.0) & + & WRITE(6,'(/'' QNREAD: file was written with QCDNUM'',A8)') & + & RHVERS + + READ(LUN,ERR=500) RMASS + READ(LUN,ERR=500) RWT1OK,RWT2OK,RWTFOK,RWFCOK,RWLCOK,RWFBOK, & + & RWLBOK,RPLUS + READ(LUN,ERR=500) RXTAB,RQTAB, & + & NRX,NRQ,IRF2C,IRF2B,IRFLC,IRFLB + + IERR = 0 + LREADX = .FALSE. + LREADQ = .FALSE. + LREADC = .FALSE. + LREADB = .FALSE. + +!-- Check xgrid (if there is one already defined) + IF(NXX.NE.0) THEN + IF(NXX.NE.NRX) THEN + IERR = 1 + ELSE + DO IX = 1,NXX + IF(RXTAB(IX).NE.XXTAB(IX)) IERR = 1 + ENDDO + ENDIF + ENDIF + +!-- What to do when xgrid is different + IF(IERR.EQ.1) THEN + IF(ISTOP.EQ.1) THEN + WRITE(6,'(/ & + & '' QNREAD: X grid in memory different from that on file'', & + & '' ---> abandon reading'')') + RETURN + ENDIF + IF(ISTOP.EQ.2) THEN + WRITE(6,'(/ & + & '' QNREAD: X grid in memory different from that on file'', & + & '' ---> STOP'')') + STOP + ENDIF + ENDIF + + IF(IERR.EQ.1.OR.NXX.LE.0) LREADX = .TRUE. + +!-- Check Q2 grid if there is one already defined and if there are +!-- heavy quark weight tables on the file + IF(NQ2.NE.0.AND.(RWFCOK.OR.RWLCOK.OR.RWFBOK.OR.RWLBOK)) THEN + IF(NQ2.NE.NRQ) THEN + IERR = 2 + ELSE + DO IQ = 1,NQ2 + IF(RQTAB(IQ).NE.Q2TAB(IQ)) IERR = 2 + ENDDO + ENDIF + ENDIF + +!-- What to do when qgrid is different + IF(IERR.EQ.2) THEN + IF(ISTOP.EQ.1) THEN + WRITE(6,'(/ & + & '' QNREAD: Q2 grid in memory different from that on file'', & + & '' ---> abandon reading'')') + RETURN + ENDIF + IF(ISTOP.EQ.2) THEN + WRITE(6,'(/ & + & '' QNREAD: Q2 grid in memory different from that on file'', & + & '' ---> STOP'')') + STOP + ENDIF + ENDIF + + IF(IERR.EQ.2.OR.NQ2.LE.0) LREADQ = .TRUE. + +!-- Check charm mass if there are charm weight tables on the file + IF(RWFCOK.OR.RWLCOK) THEN + IF(IV.LE.15) THEN + IF(RMASS(4).NE.CBMSTF(4)) IERR = 3 + ELSE + IF(RMASS(1).NE.CBMSTF(4)) IERR = 3 + ENDIF + ENDIF + +!-- What to do when charm mass is different + IF(IERR.EQ.3) THEN + IF(ISTOP.EQ.1) THEN + WRITE(6,'(/ & + & '' QNREAD: Charm mass in memory different from that on file'',& + & '' ---> abandon reading'')') + RETURN + ENDIF + IF(ISTOP.EQ.2) THEN + WRITE(6,'(/ & + & '' QNREAD: Charm mass in memory different from that on'', & + & '' file ---> STOP'')') + STOP + ENDIF + LREADC = .TRUE. + ENDIF + +!-- Check bottom mass if there are bottom weight tables on the file + IF(RWFBOK.OR.RWLBOK) THEN + IF(IV.LE.15) THEN + IF(RMASS(5).NE.CBMSTF(6)) IERR = 4 + ELSE + IF(RMASS(2).NE.CBMSTF(6)) IERR = 4 + ENDIF + ENDIF + +!-- What to do when bottom mass is different + IF(IERR.EQ.4) THEN + IF(ISTOP.EQ.1) THEN + WRITE(6,'(/ & + & '' QNREAD: Bottom mass in memory different from that on'', & + & '' file ---> abandon reading'')') + RETURN + ENDIF + IF(ISTOP.EQ.2) THEN + WRITE(6,'(/ & + & '' QNREAD: Bottom mass in memory different from that on'', & + & '' file ---> STOP'')') + STOP + ENDIF + LREADB = .TRUE. + ENDIF + +!-- ok..... continue....... + LPLUS = RPLUS +!-- Invalidate all evolutions + CALL QNFALS(LEVDONE,MXX*10) + + IF(LREADX) THEN +!-- Copy xgrid to qcdnum common block + NXX = NRX + DO IX = 1,NXX+1 + XXTAB(IX) = RXTAB(IX) + ENDDO + WRITE(6,'(/ & + & '' QNREAD: xgrid table read in (original overwritten)'')') +!-- Invalidate all weight tables since the grid has changed + LWT1OK = .FALSE. + LWT2OK = .FALSE. + LWTFOK = .FALSE. + LWFCOK = .FALSE. + LWLCOK = .FALSE. + LWFBOK = .FALSE. + LWLBOK = .FALSE. + LMARK = .FALSE. + NGRVER = NGRVER+1 +!-- Invalidate all evolutions + CALL QNFALS(LEVDONE,MXX*10) +!--- Update IFAILC + CALL GRSETC +!--- Update NFMAP + CALL QNSETT +!--- Update heavy quark xgrid + CALL GXHDEF + ENDIF + + IF(LREADQ) THEN +!-- Copy q2 grid to common block + NQ2 = NRQ + DO IQ = 1,NQ2 + Q2TAB(IQ) = RQTAB(IQ) + ENDDO + WRITE(6,'(/ & + & '' QNREAD: qgrid table read in (original overwritten)'')') +!-- Invalidate hq weight tables since the grid has changed + LALFOK = .FALSE. + LDQ2OK = .FALSE. + LWFCOK = .FALSE. + LWLCOK = .FALSE. + LWFBOK = .FALSE. + LWLBOK = .FALSE. + LMARK = .FALSE. + NGRVER = NGRVER + 1 +!-- Invalidate all evolutions + CALL QNFALS(LEVDONE,MXX*10) +!--- Update IFAILC + CALL GRSETC +!--- Update NFMAP + CALL QNSETT + ENDIF + + IF(LREADC) THEN + IF(IV.LE.15) THEN + UDSCBT(4) = RMASS(4) + CBMSTF(4) = RMASS(4) + CBMSTF(5) = RMASS(4) + ELSE + CBMSTF(4) = RMASS(1) + CBMSTF(5) = RMASS(1) + ENDIF + WRITE(6,'(/ & + & '' QNREAD: charm mass read in (original overwritten)'')') +!-- Invalidate charm weight tables since charm mass has changed + LWFCOK = .FALSE. + LWLCOK = .FALSE. +!-- Invalidate alpha_s table + LALFOK = .FALSE. + ENDIF + + IF(LREADB) THEN + IF(IV.LE.15) THEN + UDSCBT(5) = RMASS(5) + CBMSTF(6) = RMASS(5) + CBMSTF(7) = RMASS(5) + ELSE + CBMSTF(6) = RMASS(2) + CBMSTF(7) = RMASS(2) + ENDIF + WRITE(6,'(/ & + & '' QNREAD: bottom mass read in (original overwritten)'')') +!-- Invalidate bottom weight tables since charm mass has changed + LWFBOK = .FALSE. + LWLBOK = .FALSE. +!-- Invalidate alpha_s table + LALFOK = .FALSE. + ENDIF + + IF(IV.LE.15) THEN + WRITE(6,'(/'' QNREAD: file was written with QCDNUM'',A8)') & + & RHVERS + WRITE(6,'( '' ------> Abandon reading the weight tables'')') + RETURN + ENDIF + + IF(RWT1OK) THEN + READ(LUN,ERR=500) WGTFF1,WGTFG1,WGTGF1,WGTGG1 + LWT1OK = .TRUE. + if(lhasilent.eq.0) & + & WRITE(6,'(/'' QNREAD: LO weight tables read in'')') + ENDIF + + IF(RWT2OK) THEN + READ(LUN,ERR=500) WGTPP2,WGTPM2,WGTNS2,WGTFF2,WGTFG2,WGTGF2, & + & WGTGG2 + LWT2OK = .TRUE. + if(lhasilent.eq.0) & + & WRITE(6,'(/'' QNREAD: NLO weight tables read in'')') + ENDIF + + IF(RWTFOK) THEN + READ(LUN,ERR=500) WGTC2Q,WGTC2G,YNTC2Q,WGTCLQ,WGTCLG,WGTC3Q + LWTFOK = .TRUE. + if(lhasilent.eq.0) & + & WRITE(6,'(/'' QNREAD: F2, FL weight tables read in'')') + ENDIF + + IF(RWFCOK.OR.RWLCOK.OR.RWFBOK.OR.RWLBOK) THEN + READ(LUN,ERR=500) WH_C0KG,WH_C1KG,WH_C1BKG, & + & WH_C1KQ,WH_C1BKQ,WH_D1KQ,WH_D1BKQ + LWFCOK = RWFCOK + LWLCOK = RWLCOK + LWFBOK = RWFBOK + LWLBOK = RWLBOK + if(lhasilent.eq.0) then + IF(RWFCOK) & + & WRITE(6,'(/'' QNREAD: F2C weight tables read in'')') + IF(RWLCOK) & + & WRITE(6,'(/'' QNREAD: FLC weight tables read in'')') + IF(RWFBOK) & + & WRITE(6,'(/'' QNREAD: F2B weight tables read in'')') + IF(RWLBOK) & + & WRITE(6,'(/'' QNREAD: FLB weight tables read in'')') + endif + ENDIF + + RETURN + + 500 CONTINUE + WRITE(6,'(/'' QNREAD: cannot read file on lun = '',I5, & + & '' ---> STOP'')') LUN + + CALL QTRACE('QNREAD ',1) + + STOP + + END + +!DECK ID>, QNPRIN. +! +! ====================== + SUBROUTINE QNPRIN(LUN) +! ====================== + +!--- QNPRIN: print default + current setting of QCDNUM parameters. +!--- Called by QPRINT +!--- Input parameter: LUN. To be opened by user unless LUN = 6. + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + IF(RS2CUT.GE.0.) THEN + RS2C = SQRT(RS2CUT) + ELSE + RS2C = RS2CUT + ENDIF + + WRITE(LUN,'(//'' +-------+---+-------+--------------+'', & + & ''------------------------------------+'')') + WRITE(LUN,'( '' | var |typ| deflt | value |'', & + & '' description |'')') + WRITE(LUN,'( '' +-------+---+-------+--------------+'', & + & ''------------------------------------+'')') + WRITE(LUN,'('' | W1ANA | L | T | '',6X,L1,5X, & + & '' | Analytical LO weight calculation |'')') LW1ANA + WRITE(LUN,'('' | W1NUM | L | F | '',6X,L1,5X, & + & '' | Numerical LO weight calculation |'')') LW1NUM + WRITE(LUN,'('' | W2NUM | L | T | '',6X,L1,5X, & + & '' | Numerical NLO weight calculation |'')') LW2NUM + WRITE(LUN,'('' | W2STF | L | T | '',6X,L1,5X, & + & '' | Structure function NLO weights |'')') LW2STF + WRITE(LUN,'('' | WTF2C | L | F | '',6X,L1,5X, & + & '' | F2_charm weight calculation |'')') LWF2C + WRITE(LUN,'('' | WTF2B | L | F | '',6X,L1,5X, & + & '' | F2_bottom weight calculation |'')') LWF2B + WRITE(LUN,'('' | WTFLC | L | F | '',6X,L1,5X, & + & '' | FL_charm weight calculation |'')') LWFLC + WRITE(LUN,'('' | WTFLB | L | F | '',6X,L1,5X, & + & '' | FL_bottom weight calculation |'')') LWFLB + WRITE(LUN,'('' | LIMCK | L | T | '',6X,L1,5X, & + & '' | Check x, Q2 limits and cuts |'')') LIMCK + WRITE(LUN,'('' | CLOWQ | L | T | '',6X,L1,5X, & + & '' | Heavy F2,FL only for Q2 > 1.5 GeV2 |'')') LCLOWQ + WRITE(LUN,'('' | ORDER | I | 2 | '',6X,I1,5X, & + & '' | LO (1) or NLO (2) calculations |'')') IORD + WRITE(LUN,'('' | SCAX0 | R | 0.20 | '',E12.5, & + & '' | x-grid scale from log --> linear |'')') SCAX0 + WRITE(LUN,'('' | SCAQ0 | R | +inf | '',E12.5, & + & '' | Q2-grid scale from log --> linear |'')') SCAQ0 + WRITE(LUN,'('' | MCSTF | R | 1.5 | '',E12.5, & + & '' | C mass for F2c, FLc (GeV) |'')') CBMSTF(4) + WRITE(LUN,'('' | MBSTF | R | 5.0 | '',E12.5, & + & '' | B mass for F2b, FLb (GeV) |'')') CBMSTF(6) + WRITE(LUN,'('' | MCALF | R | 1.5 | '',E12.5, & + & '' | C mass for alpha_s evolution (GeV) |'')') UDSCBT(4) + WRITE(LUN,'('' | MBALF | R | 5.0 | '',E12.5, & + & '' | B mass for alpha_s evolution (GeV) |'')') UDSCBT(5) + WRITE(LUN,'('' | MTALF | R | 188. | '',E12.5, & + & '' | T mass for alpha_s evolution (GeV) |'')') UDSCBT(6) + WRITE(LUN,'('' | ALFAS | R | 0.180 | '',E12.5, & + & '' | Value of alpha_s |'')') ALPHA0 + WRITE(LUN,'('' | ALFQ0 | R | 50. | '',E12.5, & + & '' | Q2 where alpha_s is given (GeV2) |'')') Q0ALFA + WRITE(LUN,'('' | AAAR2 | R | 1.0 | '',E12.5, & + & '' | R2 = A*M2 + B (ren. scale) |'')') AAAR2 + WRITE(LUN,'('' | BBBR2 | R | 0.0 | '',E12.5, & + & '' | R2 = A*M2 + B (ren. scale) |'')') BBBR2 + WRITE(LUN,'('' | AAM2L | R | 1.0 | '',E12.5, & + & '' | M2 = A*Q2 + B (light fact. scale) |'')') AAM2L + WRITE(LUN,'('' | BBM2L | R | 0.0 | '',E12.5, & + & '' | M2 = A*Q2 + B (light fact. scale) |'')') BBM2L + WRITE(LUN,'('' | AAM2H | R | 1.0 | '',E12.5, & + & '' | M2 = A*Q2 + B (heavy fact. scale) |'')') AAM2H + WRITE(LUN,'('' | BBM2H | R | 0.0 | '',E12.5, & + & '' | M2 = A*Q2 + B (heavy fact. scale) |'')') BBM2H + WRITE(LUN,'( '' +-------+---+-------+--------------+'', & + & ''------------------------------------+'')') + WRITE(LUN,'('' | TCHRM | R | -inf | '',E12.5, & + & '' | Charm threshold (GeV2) |'')') THRS34 + WRITE(LUN,'('' | TBOTT | R | +inf | '',E12.5, & + & '' | Bottom threshold (GeV2) |'')') THRS45 + WRITE(LUN,'('' | XMINC | R | 0.0 | '',E12.5, & + & '' | Xmin cut (.le.0 = no cut) |'')') XMICUT + WRITE(LUN,'('' | QMINC | R | 0.0 | '',E12.5, & + & '' | Qmin cut (.le.0 = no cut) |'')') QMICUT + WRITE(LUN,'('' | QMAXC | R | 0.0 | '',E12.5, & + & '' | Qmax cut (.le.0 = no cut) |'')') QMACUT + WRITE(LUN,'('' | ROOTS | R | 0.0 | '',E12.5, & + & '' | Roots cut (.le.0 = no cut) |'')') RS2C + WRITE(LUN,'('' | QMINA | R | 0.0 | '',E12.5, & + & '' | Lowest Q2 gridpoint above Lambda2 |'')') QMINAS + WRITE(LUN,'( '' +-------+---+-------+--------------+'', & + & ''------------------------------------+'')') + WRITE(LUN,'('' | ASOLD | L | F | '',6X,L1,5X, & + & '' | Use old (incorrect) a_s evolution |'')') LASOLD + WRITE(LUN,'('' | BMARK | L | F | '',6X,L1,5X, & + & '' | Do not use: for tests only |'')') LBMARK + WRITE(LUN,'('' | FLFAC | R | 0.0 | '',E12.5, & + & '' | Hands off : for experts only |'')') BBM2H + WRITE(LUN,'( '' +-------+---+-------+--------------+'', & + & ''------------------------------------+'')') + + RETURN + END + +!DECK ID>, QNVERS. +! +! ============================================== + SUBROUTINE QNVERS(VERSION,LDOUBLE,NXMAX,NQMAX) +! ============================================== + +!--- QNVERS: return version number, dp flag and max # of gridpoints. +!--- Called by user. +!--- Output variables: VERSION (character*8) +!--- LDOUBLE (logical) +!--- NXMAX, NQMAX (integer); set by parameter +!--- statement in common block QCNXQM. + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + CHARACTER*8 VERSION + LOGICAL LDOUBLE + + CHARACTER*8 CHVERS,CHDATE + COMMON/QCVERS/ CHVERS,CHDATE + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + CALL QTRACE('QNVERS ',0) + + VERSION = CHVERS + LDOUBLE = LDOUBL + NXMAX = MXX-1 + NQMAX = MQ2-1 + + RETURN + END + +!DECK ID>, QPRINT. + +! ========================== + SUBROUTINE QPRINT(LUN,OPT) +! ========================== + +!--- QPRINT: steering routine to print various QCDNUM info on +!-- logical unit number LUN (to be opened by the user). +!--- Called by user. +!--- Input integer LUN : locical unit number. +!--- character OPT: 'A' (All) print all info. +!--- 'B' (Booklist) print pdf definitions. +!--- 'P' (Parameters) Parameter/option list. +!--- 'S' (Statistics) # STF function calls. +!--- 'T' (Timelog) timelog. +!--- 'X' (Xq2grid) grid,thresholds,cuts. + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + CHARACTER*(*) OPT + CHARACTER*1 OPT1 + + + LOGICAL LTIME + REAL T_START,T_END,T_SPENT + COMMON/QCTIME/T_START(10),T_END(10),T_SPENT(10),N_CALLS(10), & + &E_CALLS(10),LTIME + COMMON/QCFCNT/IFCNT(-1:1,5) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + REAL & + &WGTFF1,WGTFG1, & + &WGTGF1,WGTGG1, & + &WGTPP2,WGTPM2,WGTNS2, & + &WGTFF2,WGTFG2, & + &WGTGF2,WGTGG2, & + &WGTC2Q,WGTC2G,YNTC2Q, & + &WGTCLQ,WGTCLG,WGTC3Q + + COMMON/QCWEIT/ & + &WGTFF1(MXX*(MXX+1)/2) ,WGTFG1(MXX*(MXX+1)/2,3:5), & + &WGTGF1(MXX*(MXX+1)/2) ,WGTGG1(MXX*(MXX+1)/2,3:5), & + &WGTPP2(MXX*(MXX+1)/2,3:5),WGTPM2(MXX*(MXX+1)/2,3:5), & + &WGTNS2(MXX*(MXX+1)/2,3:5), & + &WGTFF2(MXX*(MXX+1)/2,3:5),WGTFG2(MXX*(MXX+1)/2,3:5), & + &WGTGF2(MXX*(MXX+1)/2,3:5),WGTGG2(MXX*(MXX+1)/2,3:5), & + &WGTC2Q(MXX*(MXX+1)/2) ,WGTC2G(MXX*(MXX+1)/2,3:5), & + &WGTCLQ(MXX*(MXX+1)/2) ,WGTCLG(MXX*(MXX+1)/2,3:5), & + &WGTC3Q(MXX*(MXX+1)/2) ,YNTC2Q(MXX) + + COMMON/QCWADR/ IWADR(MXX,MXX) + + + CALL QTRACE('QPRINT ',0) + + IF(LENOCC_LHA(OPT).LT.1) GOTO 500 + OPT1 = OPT(1:1) + CALL CLTOU_LHA(OPT1) + + ! + IF(OPT1.EQ.'T') THEN + CALL QPTIME(LUN) + ELSEIF(OPT1.EQ.'P') THEN + CALL QNPRIN(LUN) + ELSEIF(OPT1.EQ.'B') THEN + CALL QNLIST(LUN) + ELSEIF(OPT1.EQ.'S') THEN + CALL QNSTAT(LUN) + ELSEIF(OPT1.EQ.'X') THEN + CALL QPGRID(LUN) + ELSEIF(OPT1.EQ.'A') THEN + CALL QNPRIN(LUN) + CALL QNLIST(LUN) + CALL QPGRID(LUN) + CALL QNSTAT(LUN) + CALL QPTIME(LUN) + ELSE + GOTO 500 + ENDIF + + RETURN + + 500 CONTINUE + + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r QPRINT ---> STOP'')') + WRITE(6,'( '' ------------------------------------'')') + WRITE(6,'( '' Input LUN :'',I5 )') LUN + WRITE(6,'( '' OPT :'',A )') OPT + WRITE(6,'(/'' Option should be A, B, P, S, T or X'')') + + STOP + + END + +!DECK ID>, QNTIME. + +! ====================== + SUBROUTINE QNTIME(OPT) +! ====================== + +!--- QNTIME: start/halt/continue the timelog. +!--- Called by user and by QPTIME. +!--- Input variable: 'Start' initialise and start the timelog. +!--- 'Hold' stop logging. +!--- 'Cont' continue logging. + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + CHARACTER*(*) OPT + CHARACTER*1 OPT1 + + + LOGICAL LTIME + REAL T_START,T_END,T_SPENT + COMMON/QCTIME/T_START(10),T_END(10),T_SPENT(10),N_CALLS(10), & + &E_CALLS(10),LTIME + COMMON/QCFCNT/IFCNT(-1:1,5) + + + CALL QTRACE('QNTIME ',0) + + IF(LENOCC_LHA(OPT).LT.1) GOTO 500 + OPT1 = OPT(1:1) + CALL CLTOU_LHA(OPT1) + + IF(OPT1.EQ.'S') THEN + + DO I = 1,10 + T_SPENT(I) = 0. + E_CALLS(I) = 0. + N_CALLS(I) = 0 + ENDDO + LTIME = .TRUE. + + N_CALLS(1) = N_CALLS(1)+1 + CALL TIMEX_LHA(T_START(1)) + + ELSEIF(OPT1.EQ.'H') THEN + + LTIME = .FALSE. + CALL TIMEX_LHA(T_END(1)) + T_SPENT(1) = T_SPENT(1)+T_END(1)-T_START(1) + T_START(1) = T_END(1) + + ELSEIF(OPT1.EQ.'C') THEN + + IF(.NOT.LTIME) THEN + LTIME = .TRUE. + N_CALLS(1) = N_CALLS(1)+1 + CALL TIMEX_LHA(T_START(1)) + ENDIF + + ELSE + + GOTO 500 + + ENDIF + + RETURN + + 500 CONTINUE + + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r QNTIME ---> STOP'')') + WRITE(6,'( '' ------------------------------------'')') + WRITE(6,'( '' Input OPT :'',A )') OPT + WRITE(6,'(/'' Option should be S, H or C '')') + + CALL QTRACE('QNTIME ',1) + + STOP + + END + +!DECK ID>, QPTIME. + +! ====================== + SUBROUTINE QPTIME(LUN) +! ====================== + +!--- QPTIME: start/print the timelog. +!--- Called by QPRINT. +!--- Input variable: LUN logical unit number + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + LOGICAL LTIME + REAL T_START,T_END,T_SPENT + COMMON/QCTIME/T_START(10),T_END(10),T_SPENT(10),N_CALLS(10), & + &E_CALLS(10),LTIME + COMMON/QCFCNT/IFCNT(-1:1,5) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + REAL & + &WGTFF1,WGTFG1, & + &WGTGF1,WGTGG1, & + &WGTPP2,WGTPM2,WGTNS2, & + &WGTFF2,WGTFG2, & + &WGTGF2,WGTGG2, & + &WGTC2Q,WGTC2G,YNTC2Q, & + &WGTCLQ,WGTCLG,WGTC3Q + + COMMON/QCWEIT/ & + &WGTFF1(MXX*(MXX+1)/2) ,WGTFG1(MXX*(MXX+1)/2,3:5), & + &WGTGF1(MXX*(MXX+1)/2) ,WGTGG1(MXX*(MXX+1)/2,3:5), & + &WGTPP2(MXX*(MXX+1)/2,3:5),WGTPM2(MXX*(MXX+1)/2,3:5), & + &WGTNS2(MXX*(MXX+1)/2,3:5), & + &WGTFF2(MXX*(MXX+1)/2,3:5),WGTFG2(MXX*(MXX+1)/2,3:5), & + &WGTGF2(MXX*(MXX+1)/2,3:5),WGTGG2(MXX*(MXX+1)/2,3:5), & + &WGTC2Q(MXX*(MXX+1)/2) ,WGTC2G(MXX*(MXX+1)/2,3:5), & + &WGTCLQ(MXX*(MXX+1)/2) ,WGTCLG(MXX*(MXX+1)/2,3:5), & + &WGTC3Q(MXX*(MXX+1)/2) ,YNTC2Q(MXX) + + COMMON/QCWADR/ IWADR(MXX,MXX) + + + CALL QNTIME('H') + + N_TOT = N_CALLS(3)+N_CALLS(4)+N_CALLS(5) + E_TOT = E_CALLS(3)+E_CALLS(4)+E_CALLS(5) + T_TOT = T_SPENT(3)+T_SPENT(4)+T_SPENT(5) + T_REST = T_SPENT(1)-T_TOT-T_SPENT(2)-T_SPENT(6) + DUMMY = 1. + F_FAST = 0. + DO J = 1,5 + F_FAST = F_FAST+IFCNT(1,J) + ENDDO + WRITE(LUN, & + & '(//'' -------------------------------------------------'')') + WRITE(LUN, & + & '( '' Routine # calls # evols CPU sec CPU/evol'')') + WRITE(LUN, & + & '( '' -------------------------------------------------'')') + WRITE(LUN, & + & '('' EVOLNM '',I10,2F10.1,F10.2)') N_CALLS(3), & + & E_CALLS(3),T_SPENT(3),T_SPENT(3)/MAX(E_CALLS(3),DUMMY) + WRITE(LUN, & + & '('' EVOLNP '',I10,2F10.1,F10.2)') N_CALLS(4), & + & E_CALLS(4),T_SPENT(4),T_SPENT(4)/MAX(E_CALLS(4),DUMMY) + WRITE(LUN, & + & '('' EVOLSG '',I10,2F10.1,F10.2)') N_CALLS(5), & + & E_CALLS(5),T_SPENT(5),T_SPENT(5)/MAX(E_CALLS(5),DUMMY) + WRITE(LUN, & + & '( '' -------------------------------------------------'')') + WRITE(LUN, & + & '('' AP total '',I10,2F10.1,F10.2)') N_TOT, & + & E_TOT,T_TOT,T_TOT/MAX(E_TOT,DUMMY) + WRITE(LUN,'('' '')') + WRITE(LUN, & + & '('' STFAST '',I10, 2F10.1)') N_CALLS(6),F_FAST,T_SPENT(6) + WRITE(LUN, & + & '('' QNFILW '',I10,10X,F10.1)') N_CALLS(2),T_SPENT(2) + WRITE(LUN, & + & '('' Other '',10X,10X,F10.1)') T_REST + WRITE(LUN, & + & '( '' -------------------------------------------------'')') + WRITE(LUN, & + & '('' Total '',10X,10X,F10.1)') T_SPENT(1) + WRITE(LUN, & + & '( '' -------------------------------------------------'')') + + + RETURN + END + +!DECK ID>, QNSTAT. + +! ====================== + SUBROUTINE QNSTAT(LUN) +! ====================== + +!--- QNSTAT: print number of structure function calculations. +!--- Called by user. +!--- Input parameter: LUN to be opened by user unless LUN = 6. + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + LOGICAL LTIME + REAL T_START,T_END,T_SPENT + COMMON/QCTIME/T_START(10),T_END(10),T_SPENT(10),N_CALLS(10), & + &E_CALLS(10),LTIME + COMMON/QCFCNT/IFCNT(-1:1,5) + + + DIMENSION ITOT(5) + + DO J = 1,5 + ITOT(J) = 0 + DO I = -1,1 + ITOT(J) = ITOT(J)+IFCNT(I,J) + ENDDO + ENDDO + + WRITE(LUN,'(//'' ------------------------------'', & + & ''--------------------------------------------'')') + WRITE(LUN,'( '' Structure function calls '', & + & '' F2 FL xF3'', & + & '' F2h FLh'')') + WRITE(LUN,'( '' ------------------------------'', & + & ''--------------------------------------------'')') + WRITE(LUN, & + & '('' Slow calculation '',5I9)') (IFCNT( 0,J),J=1,5) + WRITE(LUN, & + & '('' Fast calculation '',5I9)') (IFCNT( 1,J),J=1,5) + WRITE(LUN, & + & '('' Outside grid or cuts '',5I9)') (IFCNT(-1,J),J=1,5) + WRITE(LUN,'( '' ------------------------------'', & + & ''--------------------------------------------'')') + WRITE(LUN, & + & '('' Total '',5I9)') ( ITOT(J),J=1,5) + WRITE(LUN,'( '' ------------------------------'', & + & ''--------------------------------------------'')') + + RETURN + END + +!DECK ID>, QNIVAL. + +! ================================ + SUBROUTINE QNIVAL(OPT,FLAG,IVAL) +! ================================ + +!--- QNIVAL: set/get integer variable. +!--- Called by user or internally by s/r QNISET and QNIGET. +!--- Input parameters: 'OPT' = 'Set' or 'Get'. +!--- 'FLAG' = variable name to set or get. +!--- 'IVAL' (integer) input or output variable. + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + CHARACTER*(*) OPT + CHARACTER*1 OPT1 + CHARACTER*(*) FLAG + CHARACTER*5 FLAG5 + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + IF(LENOCC_LHA(OPT).LT.1) THEN + IERR = 1 + GOTO 500 + ENDIF + IF(LENOCC_LHA(FLAG).LT.5) THEN + IERR = 2 + GOTO 500 + ENDIF + OPT1 = OPT(1:1) + FLAG5 = FLAG(1:5) + CALL CLTOU_LHA(OPT1) + CALL CLTOU_LHA(FLAG5) + +! ---------------------- + ! + IF(OPT1.EQ.'S') THEN +! ---------------------- + + IF (FLAG5.EQ.'ORDER') THEN + IF(IVAL.LE.0.OR.IVAL.GE.3) THEN + IERR = 3 + GOTO 500 + ENDIF + IORD = IVAL +!-- Invalidate all evolutions + CALL QNFALS(LEVDONE,MXX*10) + LALFOK = .FALSE. + ELSE + IERR = 2 + GOTO 500 + ENDIF + +! -------------------------- + ! + ELSEIF(OPT1.EQ.'G') THEN +! -------------------------- + + IF (FLAG5.EQ.'ORDER') THEN + IVAL = IORD + ELSE + IERR = 2 + GOTO 500 + ENDIF + +! ------ + ! + ELSE +! ------ + + IERR = 1 + GOTO 500 + +! ------- + ! + ENDIF +! ------- + + RETURN + + 500 CONTINUE + + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r QNIVAL ---> STOP'')') + WRITE(6,'( '' ------------------------------------'')') + WRITE(6,'( '' Input OPT : '',A )') OPT + WRITE(6,'( '' VAR : '',A )') FLAG + WRITE(6,'( '' VAL : '',I10 )') IVAL + IF(IERR.EQ.1) THEN + WRITE(6,'(/'' OPT should be either SET or GET '')') + ELSEIF(IERR.EQ.2) THEN + WRITE(6,'(/'' Variable VAR not found'')') + ELSEIF(IERR.EQ.3) THEN + WRITE(6,'(/'' IVAL out of allowed range'')') + ENDIF + + CALL QTRACE('QNIVAL ',1) + + STOP + + END + +!DECK ID>, QNISET. + +! ============================ + SUBROUTINE QNISET(FLAG,IVAL) +! ============================ + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + CHARACTER*(*) FLAG + + CALL QTRACE('QNISET ',0) + + CALL QNIVAL('SET',FLAG,IVAL) + + RETURN + END + +!DECK ID>, QNIGET. + +! ============================ + SUBROUTINE QNIGET(FLAG,IVAL) +! ============================ + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + CHARACTER*(*) FLAG + + CALL QTRACE('QNIGET ',0) + + CALL QNIVAL('GET',FLAG,IVAL) + + RETURN + END + +!DECK ID>, QNRVAL. + +! =============================== + SUBROUTINE QNRVAL(OPT,FLAG,VAL) +! =============================== + +!--- QNRVAL: set/get floating point variable. +!--- Called by user or internally by s/r QNRSET and QNRGET. +!--- Input parameters: 'OPT' = 'Set' or 'Get'. +!--- 'FLAG' = variable name to set or get. +!--- 'VAL' (real or d.p.) input or output variable. + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + CHARACTER*(*) OPT + CHARACTER*1 OPT1 + CHARACTER*(*) FLAG + CHARACTER*5 FLAG5 + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + IF(LENOCC_LHA(OPT).LT.1) THEN + IERR = 1 + GOTO 500 + ENDIF + IF(LENOCC_LHA(FLAG).LT.5) THEN + IERR = 2 + GOTO 500 + ENDIF + OPT1 = OPT(1:1) + FLAG5 = FLAG(1:5) + CALL CLTOU_LHA(OPT1) + CALL CLTOU_LHA(FLAG5) + +! ---------------------- + ! + IF(OPT1.EQ.'S') THEN +! ---------------------- + + IF (FLAG5.EQ.'AAM2H'.OR.FLAG5.EQ.'AATQ2') THEN + IF(VAL.LE.0.) THEN + IERR = 3 + GOTO 500 + ENDIF + AAM2H = VAL + DO I = 1,30 + LFFCAL(4,I) = .FALSE. + LFFCAL(5,I) = .FALSE. + LFFCAL(6,I) = .FALSE. + LFFCAL(7,I) = .FALSE. + ENDDO + ELSEIF(FLAG5.EQ.'BBM2H'.OR.FLAG5.EQ.'PLUSB') THEN + BBM2H = VAL + DO I = 1,30 + LFFCAL(4,I) = .FALSE. + LFFCAL(5,I) = .FALSE. + LFFCAL(6,I) = .FALSE. + LFFCAL(7,I) = .FALSE. + ENDDO + ELSEIF(FLAG5.EQ.'AAM2L') THEN + IF(VAL.LE.0.) THEN + IERR = 3 + GOTO 500 + ENDIF + AAM2L = VAL + DO I = 1,30 + LFFCAL(1,I) = .FALSE. + LFFCAL(2,I) = .FALSE. + LFFCAL(3,I) = .FALSE. + ENDDO + ELSEIF(FLAG5.EQ.'BBM2L') THEN + BBM2L = VAL + DO I = 1,30 + LFFCAL(1,I) = .FALSE. + LFFCAL(2,I) = .FALSE. + LFFCAL(3,I) = .FALSE. + ENDDO + ELSEIF(FLAG5.EQ.'AAAR2') THEN + AAAR2 = VAL +!-- Invalidate all evolutions + CALL QNFALS(LEVDONE,MXX*10) + LALFOK = .FALSE. + DO I = 1,30 + DO J = 1,7 + LFFCAL(J,I) = .FALSE. + ENDDO + ENDDO + ELSEIF(FLAG5.EQ.'BBBR2') THEN + BBBR2 = VAL +!-- Invalidate all evolutions + CALL QNFALS(LEVDONE,MXX*10) + LALFOK = .FALSE. + DO I = 1,30 + DO J = 1,7 + LFFCAL(J,I) = .FALSE. + ENDDO + ENDDO + ELSEIF(FLAG5.EQ.'FLFAC') THEN + FL_FAC = VAL + DO I = 1,30 + LFFCAL(2,I) = .FALSE. + ENDDO + ELSEIF(FLAG5.EQ.'SCAX0') THEN + IF(VAL.LE.0.) THEN + IERR = 3 + GOTO 500 + ENDIF + SCAX0 = VAL + ELSEIF(FLAG5.EQ.'SCAQ0') THEN + IF(VAL.LE.0.) THEN + IERR = 3 + GOTO 500 + ENDIF + SCAQ0 = VAL + ELSE + IF(VAL.LE.0.) THEN + IERR = 3 + GOTO 500 + ENDIF +!-- Invalidate all evolutions + CALL QNFALS(LEVDONE,MXX*10) + !force alpha_s to be recalculated + LALFOK = .FALSE. + IF (FLAG5.EQ.'UMASS') THEN + UDSCBT(1) = VAL + ELSEIF(FLAG5.EQ.'DMASS') THEN + UDSCBT(2) = VAL + ELSEIF(FLAG5.EQ.'SMASS') THEN + UDSCBT(3) = VAL + ELSEIF(FLAG5.EQ.'CMASS') THEN + UDSCBT(4) = VAL + CBMSTF(4) = VAL + CBMSTF(5) = VAL + !invalidate F2C weight tables + LWFCOK = .FALSE. + !invalidate FLC weight tables + LWLCOK = .FALSE. + ELSEIF(FLAG5.EQ.'MCSTF') THEN + CBMSTF(4) = VAL + CBMSTF(5) = VAL + LWFCOK = .FALSE. + LWLCOK = .FALSE. + ELSEIF(FLAG5.EQ.'MCALF') THEN + UDSCBT(4) = VAL + ELSEIF(FLAG5.EQ.'BMASS') THEN + UDSCBT(5) = VAL + CBMSTF(6) = VAL + CBMSTF(7) = VAL + !invalidate F2B weight tables + LWFBOK = .FALSE. + !invalidate FLB weight tables + LWLBOK = .FALSE. + ELSEIF(FLAG5.EQ.'MBSTF') THEN + CBMSTF(6) = VAL + CBMSTF(7) = VAL + LWFBOK = .FALSE. + LWLBOK = .FALSE. + ELSEIF(FLAG5.EQ.'MBALF') THEN + UDSCBT(5) = VAL + ELSEIF(FLAG5.EQ.'MTALF') THEN + UDSCBT(6) = VAL + ELSEIF(FLAG5.EQ.'TMASS') THEN + UDSCBT(6) = VAL + ELSEIF(FLAG5.EQ.'ALFAS') THEN + ALPHA0 = VAL + ELSEIF(FLAG5.EQ.'ALFQ0') THEN + Q0ALFA = VAL + ELSE + IERR = 2 + GOTO 500 + ENDIF + ENDIF + +! -------------------------- + ! + ELSEIF(OPT1.EQ.'G') THEN +! -------------------------- + + IF (FLAG5.EQ.'SCAX0') THEN + VAL = SCAX0 + ELSEIF(FLAG5.EQ.'SCAQ0') THEN + VAL = SCAQ0 + ELSEIF(FLAG5.EQ.'AAM2H'.OR.FLAG5.EQ.'AATQ2') THEN + VAL = AAM2H + ELSEIF(FLAG5.EQ.'BBM2H'.OR.FLAG5.EQ.'PLUSB') THEN + VAL = BBM2H + ELSEIF(FLAG5.EQ.'AAM2L') THEN + VAL = AAM2L + ELSEIF(FLAG5.EQ.'BBM2L') THEN + VAL = BBM2L + ELSEIF(FLAG5.EQ.'AAAR2') THEN + VAL = AAAR2 + ELSEIF(FLAG5.EQ.'BBBR2') THEN + VAL = BBBR2 + ELSEIF(FLAG5.EQ.'FLFAC') THEN + VAL = FL_FAC + ELSEIF(FLAG5.EQ.'UMASS') THEN + VAL = UDSCBT(1) + ELSEIF(FLAG5.EQ.'DMASS') THEN + VAL = UDSCBT(2) + ELSEIF(FLAG5.EQ.'SMASS') THEN + VAL = UDSCBT(3) + ELSEIF(FLAG5.EQ.'CMASS') THEN + VAL = UDSCBT(4) + ELSEIF(FLAG5.EQ.'BMASS') THEN + VAL = UDSCBT(5) + ELSEIF(FLAG5.EQ.'TMASS') THEN + VAL = UDSCBT(6) + ELSEIF(FLAG5.EQ.'MCSTF') THEN + VAL = CBMSTF(4) + ELSEIF(FLAG5.EQ.'MBSTF') THEN + VAL = CBMSTF(6) + ELSEIF(FLAG5.EQ.'MCALF') THEN + VAL = UDSCBT(4) + ELSEIF(FLAG5.EQ.'MBALF') THEN + VAL = UDSCBT(5) + ELSEIF(FLAG5.EQ.'MTALF') THEN + VAL = UDSCBT(6) + ELSEIF(FLAG5.EQ.'ALFAS') THEN + VAL = ALPHA0 + ELSEIF(FLAG5.EQ.'ALFQ0') THEN + VAL = Q0ALFA + ELSEIF(FLAG5.EQ.'TCHRM') THEN + VAL = THRS34 + ELSEIF(FLAG5.EQ.'TBOTT') THEN + VAL = THRS45 + ELSEIF(FLAG5.EQ.'XMINC') THEN + VAL = XMICUT + ELSEIF(FLAG5.EQ.'QMINC') THEN + VAL = QMICUT + ELSEIF(FLAG5.EQ.'QMAXC') THEN + VAL = QMACUT + ELSEIF(FLAG5.EQ.'ROOTS') THEN + IF(RS2CUT.GE.0.) THEN + VAL = SQRT(RS2CUT) + ELSE + VAL = RS2CUT + ENDIF + ELSEIF(FLAG5.EQ.'QMINA') THEN + VAL = QMINAS + ELSE + IERR = 2 + GOTO 500 + ENDIF + +! ------ + ! + ELSE +! ------ + + IERR = 1 + GOTO 500 + +! ------- + ! + ENDIF +! ------- + + RETURN + + 500 CONTINUE + + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r QNRVAL ---> STOP'')') + WRITE(6,'( '' ------------------------------------'')') + WRITE(6,'( '' Input OPT : '',A )') OPT + WRITE(6,'( '' VAR : '',A )') FLAG + WRITE(6,'( '' VAL : '',E12.5)') RVAL + IF(IERR.EQ.1) THEN + WRITE(6,'(/'' OPT should be either SET or GET '')') + ELSEIF(IERR.EQ.2) THEN + WRITE(6,'(/'' Variable VAR not found'')') + ELSEIF(IERR.EQ.3) THEN + WRITE(6,'(/'' VAL should be .gt. 0 '')') + ENDIF + + CALL QTRACE('QNRVAL ',1) + + STOP + + END + +!DECK ID>, QNRSET. + +! ============================ + SUBROUTINE QNRSET(FLAG,RVAL) +! ============================ + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + CHARACTER*(*) FLAG + + CALL QTRACE('QNRSET ',0) + + CALL QNRVAL('SET',FLAG,RVAL) + + RETURN + END + +!DECK ID>, QNRGET. + +! ============================ + SUBROUTINE QNRGET(FLAG,RVAL) +! ============================ + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + CHARACTER*(*) FLAG + + CALL QTRACE('QNRGET ',0) + + CALL QNRVAL('GET',FLAG,RVAL) + + RETURN + END + +!DECK ID>, QNLVAL. + +! ================================ + SUBROUTINE QNLVAL(OPT,FLAG,LVAL) +! ================================ + +!--- QNLVAL: set/get logical variable. +!--- Called by user or internally by s/r QNLSET and QNLGET. +!--- Input parameters: 'OPT' = 'Set' or 'Get'. +!--- 'FLAG' = variable name to set or get. +!--- 'VAL' (logical) input or output variable. + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + CHARACTER*(*) OPT + CHARACTER*1 OPT1 + CHARACTER*(*) FLAG + CHARACTER*5 FLAG5 + LOGICAL LVAL + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + + + IF(LENOCC_LHA(OPT).LT.1) THEN + IERR = 1 + GOTO 500 + ENDIF + IF(LENOCC_LHA(FLAG).LT.5) THEN + IERR = 2 + GOTO 500 + ENDIF + OPT1 = OPT(1:1) + FLAG5 = FLAG(1:5) + CALL CLTOU_LHA(OPT1) + CALL CLTOU_LHA(FLAG5) + +! ---------------------- + ! + IF(OPT1.EQ.'S') THEN +! ---------------------- + + IF (FLAG5.EQ.'W1ANA' ) THEN + LW1ANA = LVAL + IF(LW1ANA) LW1NUM = .FALSE. + ELSEIF(FLAG5.EQ.'W1NUM' ) THEN + LW1NUM = LVAL + IF(LW1NUM) LW1ANA = .FALSE. + ELSEIF(FLAG5.EQ.'W2NUM' ) THEN + LW2NUM = LVAL + ELSEIF(FLAG5.EQ.'W2STF' ) THEN + LW2STF = LVAL + ELSEIF(FLAG5.EQ.'WTF2C' ) THEN + LWF2C = LVAL + ELSEIF(FLAG5.EQ.'WTFLC' ) THEN + LWFLC = LVAL + ELSEIF(FLAG5.EQ.'WTF2B' ) THEN + LWF2B = LVAL + ELSEIF(FLAG5.EQ.'WTFLB' ) THEN + LWFLB = LVAL + ELSEIF(FLAG5.EQ.'BMARK' ) THEN + LBMARK = LVAL + LALFOK = .FALSE. + ELSEIF(FLAG5.EQ.'LIMCK' ) THEN + LIMCK = LVAL + ELSEIF(FLAG5.EQ.'CLOWQ' ) THEN + LCLOWQ = LVAL + ELSEIF(FLAG5.EQ.'ASOLD' ) THEN + LASOLD = LVAL + LALFOK = .FALSE. + ELSE + IERR = 2 + GOTO 500 + ENDIF + +! -------------------------- + ! + ELSEIF(OPT1.EQ.'G') THEN +! -------------------------- + + IF (FLAG5.EQ.'W1ANA' ) THEN + LVAL = LW1ANA + ELSEIF(FLAG5.EQ.'W1NUM' ) THEN + LVAL = LW1NUM + ELSEIF(FLAG5.EQ.'W2NUM' ) THEN + LVAL = LW2NUM + ELSEIF(FLAG5.EQ.'W2STF' ) THEN + LVAL = LW2STF + ELSEIF(FLAG5.EQ.'WTF2C' ) THEN + LVAL = LWF2C + ELSEIF(FLAG5.EQ.'WTFLC' ) THEN + LVAL = LWFLC + ELSEIF(FLAG5.EQ.'WTF2B' ) THEN + LVAL = LWF2B + ELSEIF(FLAG5.EQ.'WTFLB' ) THEN + LVAL = LWFLB + ELSEIF(FLAG5.EQ.'BMARK' ) THEN + LVAL = LBMARK + ELSEIF(FLAG5.EQ.'LIMCK' ) THEN + LVAL = LIMCK + ELSEIF(FLAG5.EQ.'CLOWQ' ) THEN + LVAL = LCLOWQ + ELSEIF(FLAG5.EQ.'ASOLD' ) THEN + LVAL = LASOLD + ELSE + IERR = 2 + GOTO 500 + ENDIF + +! ------ + ! + ELSE +! ------ + + IERR = 1 + GOTO 500 + +! ------- + ! + ENDIF +! ------- + + RETURN + + 500 CONTINUE + + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r QNLVAL ---> STOP'')') + WRITE(6,'( '' ------------------------------------'')') + WRITE(6,'( '' Input OPT : '',A )') OPT + WRITE(6,'( '' VAR : '',A )') FLAG + WRITE(6,'( '' VAL : '',L2 )') LVAL + IF(IERR.EQ.1) THEN + WRITE(6,'(/'' OPT should be either SET or GET '')') + ELSEIF(IERR.EQ.2) THEN + WRITE(6,'(/'' Variable VAR not found'')') + ENDIF + + CALL QTRACE('QNLVAL ',1) + + STOP + + END + +!DECK ID>, QNLSET. + +! ============================ + SUBROUTINE QNLSET(FLAG,LVAL) +! ============================ + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + CHARACTER*(*) FLAG + LOGICAL LVAL + + CALL QTRACE('QNLSET ',0) + + CALL QNLVAL('SET',FLAG,LVAL) + + RETURN + END + +!DECK ID>, QNLGET. + +! ============================ + SUBROUTINE QNLGET(FLAG,LVAL) +! ============================ + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + CHARACTER*(*) FLAG + LOGICAL LVAL + + CALL QTRACE('QNLGET ',0) + + CALL QNLVAL('GET',FLAG,LVAL) + + RETURN + END + +!DECK ID>, GRMXMQ. + +! ============================ + SUBROUTINE GRMXMQ(NXMA,NQMA) +! ============================ + +!--- GRMXMQ: return max allowed number of x, Q2 gridpoints. +!--- Called by user. +!--- MXX and MQ2 are set by parameter statement in common QCNXQM. + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + CALL QTRACE('GRMXMQ ',0) + + NXMA = MXX-1 + NQMA = MQ2-1 + + RETURN + END + +!DECK ID>, GRGIVE. + +! ======================================== + SUBROUTINE GRGIVE(NX,XMI,XMA,NQ,QMI,QMA) +! ======================================== + +!--- GRGIVE: return current grid definition. +!--- Called by user. +!--- Output variables: NX (integer) number of x gridpoints. +!--- XMI (real or d.p.) lowest x value. +!--- XMA (real or d.p.) highest x value = 1. +!--- NQ (integer) number of Q2 gridpoints. +!--- QMI (real or d.p.) lowest Q2 value. +!--- QMA (real or d.p.) highest Q2 value. + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + CALL QTRACE('GRGIVE ',0) + + NX = NXX + XMI = XXTAB(1) + XMA = XXTAB(NXX+1) + NQ = NQ2 + QMI = Q2TAB(1) + QMA = Q2TAB(NQ2) + + RETURN + END + +!DECK ID>, GRXNUL. + +! ================= + SUBROUTINE GRXNUL +! ================= + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + CALL QTRACE('GRXNUL ',0) + +!--- Invalidate weight tables (validated by call to QNFILW) + LWT1OK = .FALSE. + LWT2OK = .FALSE. + LWTFOK = .FALSE. + LWFCOK = .FALSE. + LWLCOK = .FALSE. + LWFBOK = .FALSE. + LWLBOK = .FALSE. + LMARK = .FALSE. +!-- Invalidate all evolutions + CALL QNFALS(LEVDONE,MXX*10) + +!--- Set grid to zero + CALL QNVNUL(XXTAB,MXX) + CALL QNVNUL(XHTAB,MXX) + CALL QNINUL(IHTAB,MXX) + NXX = 0 + NGRVER = 0 + +!--- Update IFAILC + CALL GRSETC + +!--- Update NFMAP + CALL QNSETT + + + RETURN + END + +!DECK ID>, GRXINP. + +! ============================ + SUBROUTINE GRXINP(XARRAY,NX) +! ============================ + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + DIMENSION XARRAY(*) + + DATA EPSI /1.E-6/ + + CALL QTRACE('GRXINP ',0) + + IF(NX.LE.0) THEN + IERR = 1 + GOTO 500 + ENDIF + + IF((NX+NXX).GT.MXX-1) THEN + IERR = 2 + GOTO 500 + ENDIF + +!--- Invalidate weight tables (validated by call to QNFILW) + LWT1OK = .FALSE. + LWT2OK = .FALSE. + LWTFOK = .FALSE. + LWFCOK = .FALSE. + LWLCOK = .FALSE. + LWFBOK = .FALSE. + LWLBOK = .FALSE. + LMARK = .FALSE. +!-- Invalidate all evolutions + CALL QNFALS(LEVDONE,MXX*10) + +!--- if this number changes, QCDNUM knows that the grid has changed + NGRVER = NGRVER + 1 + + IF(NXX.EQ.0) THEN + DO 10 IX = 1,NX + X = XARRAY(IX) + IF(X.LE.0..OR.X.GT.1.) THEN + IERR = 3 + GOTO 500 + ENDIF + NXX = NXX+1 + XXTAB(IX) = X + 10 CONTINUE + IF(XXTAB(NXX).EQ.1.) THEN + NXX = NXX-1 + ELSE + XXTAB(NXX+1) = 1. + ENDIF + RETURN + ENDIF + + IF(XXTAB(NXX).EQ.1.) THEN + NXX = NXX-1 + ELSE + XXTAB(NXX+1) = 1. + ENDIF + + NXP = NXX+1 + + DO 100 IX = 1,NX + + X = XARRAY(IX) + + IF(X.LE.0..OR.X.GT.1.) THEN + IERR = 3 + GOTO 500 + ENDIF + +!mb IF(X.LT.XXTAB(1)-EPSI) THEN + IF(X/XXTAB(1).LT.1.-EPSI) THEN + + DO 20 JX = NXP,1,-1 + XXTAB(JX+1) = XXTAB(JX) + 20 CONTINUE + NXP = NXP+1 + XXTAB(1) = X + +!mb ELSEIF(X.GT.XXTAB(NXP)+EPSI) THEN + ELSEIF(X/XXTAB(NXP).GT.1.+EPSI) THEN + + NXP = NXP+1 + XXTAB(NXP) = X + + ELSE + + DO 30 I = 1,NXP +!mb IF(XXTAB(I).LE.X+EPSI) IX0 = I + IF(XXTAB(I)/X.LE.1.+EPSI) IX0 = I + 30 CONTINUE + +!mb IF(ABS(XXTAB(IX0)-X).LE.EPSI) THEN + IF(ABS(XXTAB(IX0)/X-1.).LE.EPSI) THEN + XXTAB(IX0) = X + ELSE + DO 40 JX = NXP,IX0+1,-1 + XXTAB(JX+1) = XXTAB(JX) + 40 CONTINUE + NXP = NXP+1 + XXTAB(IX0+1) = X + ENDIF + + ENDIF + + 100 END DO + + IF(XXTAB(NXP).EQ.1.) THEN + NXX = NXP-1 + ELSE + NXX = NXP + XXTAB(NXX+1) = 1. + ENDIF + +!--- Update IFAILC + CALL GRSETC + +!--- Update NFMAP + CALL QNSETT + +!--- Update heavy quark xgrid + CALL GXHDEF + + RETURN + + 500 CONTINUE + + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r GRXINP ---> STOP'')') + WRITE(6,'( '' ------------------------------------'')') + WRITE(6,'( '' Input X :'',E12.5)') X + WRITE(6,'( '' NX :'',I5 )') NX + IF(IERR.EQ.1) THEN + WRITE(6,'(/'' NX must be .ge. 1'')') + ELSEIF(IERR.EQ.2) THEN + WRITE(6,'(/'' Maximum number of gridpoints exceeded '')') + WRITE(6,'(/'' # existing x gridpoints ='',I5/ & + & '' # points to be added ='',I5/ & + & '' maximum # points allowed ='',I5)') & + & NXX, NX, MXX-1 + ELSEIF(IERR.EQ.3) THEN + WRITE(6,'(/'' Value of X outside allowed range (0,1]'')') + ENDIF + + CALL QTRACE('GRXINP ',1) + + STOP + + END + +!DECK ID>, GRXDEF. + +! ========================== + SUBROUTINE GRXDEF(NX,XMIN) +! ========================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + CALL QTRACE('GRXDEF ',0) + + IF(NX.LE.0) THEN + IERR = 1 + GOTO 500 + ENDIF + + IF(NX.GT.MXX-1) THEN + IERR = 2 + GOTO 500 + ENDIF + + IF(XMIN.LE.0.OR.XMIN.GE.1.) THEN + IERR = 3 + GOTO 500 + ENDIF + +!--- Invalidate weight tables (validated by call to QNFILW) + LWT1OK = .FALSE. + LWT2OK = .FALSE. + LWTFOK = .FALSE. + LWFCOK = .FALSE. + LWLCOK = .FALSE. + LWFBOK = .FALSE. + LWLBOK = .FALSE. + LMARK = .FALSE. +!-- Invalidate all evolutions + CALL QNFALS(LEVDONE,MXX*10) + +!--- if this number changes, QCDNUM knows that the grid has changed + NGRVER = NGRVER + 1 + + XMAX = 1. + YMIN = SYFROMX(XMIN) + YMAX = SYFROMX(XMAX) + BW = (YMAX-YMIN)/NX + DO I = 1,NX + YI = YMIN+(I-1)*BW + XXTAB(I) = SXFROMY(YI) + ENDDO + XXTAB(1) = XMIN + XXTAB(NX+1) = 1. + NXX = NX + +!--- Update IFAILC + CALL GRSETC + +!--- Update NFMAP + CALL QNSETT + +!--- Update heavy quark xgrid + CALL GXHDEF + + RETURN + + 500 CONTINUE + + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r GRXDEF ---> STOP'')') + WRITE(6,'( '' ------------------------------------'')') + WRITE(6,'( '' Input NX :'',I5 )') NX + WRITE(6,'( '' Xmin :'',E12.5)') XMIN + IF(IERR.EQ.1) THEN + WRITE(6,'(/'' NX must be .ge. 1'')') + ELSEIF(IERR.EQ.2) THEN + WRITE(6,'(/'' NX > max number of gridpoints'', & + & '' allowed:'',I5)') MXX-1 + ELSEIF(IERR.EQ.3) THEN + WRITE(6,'(/'' Xmin outside allowed range (0,1]'')') + ENDIF + + CALL QTRACE('GRXDEF ',1) + + STOP + + END + +!DECK ID>, GRXLIM. + +! ========================== + SUBROUTINE GRXLIM(NX,XMIN) +! ========================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + DATA EPSI / 1.E-6 / + + CALL QTRACE('GRXLIM ',0) + + IF(NX.LE.0) THEN + IERR = 1 + GOTO 500 + ENDIF + + IF(NX.GT.MXX-1) THEN + IERR = 2 + GOTO 500 + ENDIF + +!--- Invalidate weight tables (validated by call to QNFILW) + LWT1OK = .FALSE. + LWT2OK = .FALSE. + LWTFOK = .FALSE. + LWFCOK = .FALSE. + LWLCOK = .FALSE. + LWFBOK = .FALSE. + LWLBOK = .FALSE. + LMARK = .FALSE. +!-- Invalidate all evolutions + CALL QNFALS(LEVDONE,MXX*10) + + IF(XMIN.LE.0.OR.XMIN.GE.1.) THEN + IERR = 3 + GOTO 500 + ENDIF + +!--- if this number changes, QCDNUM knows that the grid has changed + NGRVER = NGRVER + 1 + + IF(NXX.EQ.0) THEN + XXTAB(1) = 1. + ELSEIF(XXTAB(NXX).EQ.1.) THEN + NXX = NXX-1 + ELSE + XXTAB(NXX+1) = 1. + ENDIF + + NXP = NXX+1 + +!mb IF(XMIN.LT.XXTAB(1)-EPSI) THEN + IF(XMIN/XXTAB(1).LT.1.-EPSI) THEN + DO 20 IX = NXP,1,-1 + XXTAB(IX+1) = XXTAB(IX) + 20 CONTINUE + NXP = NXP+1 + XXTAB(1) = XMIN + ENDIF + + IF(NX.GT.NXP-1) THEN + 30 CONTINUE + GAPMAX = 0. + DO 35 IX = 1,NXP-1 + GAP = SYFROMX(XXTAB(IX+1))-SYFROMX(XXTAB(IX)) + IF(GAP.GT.GAPMAX) THEN + GAPMAX = GAP + IX0 = IX + ENDIF + 35 CONTINUE + DO 40 IX = NXP,IX0+1,-1 + XXTAB(IX+1) = XXTAB(IX) + 40 CONTINUE + NXP = NXP+1 + XXTAB(IX0+1) = 0.5*(XXTAB(IX0)+XXTAB(IX0+2)) + IF(NXP-1.LT.NX) GOTO 30 + + ELSEIF(NX.LT.NXP-1) THEN + 50 CONTINUE + GAPMIN = 999999. + DO 55 IX = 2,NXP-1 + GAP = SYFROMX(XXTAB(IX+1))-SYFROMX(XXTAB(IX-1)) + IF(GAP.LE.GAPMIN) THEN + GAPMIN = GAP + IX0 = IX + ENDIF + 55 CONTINUE + DO 60 IX = IX0,NXP-1 + XXTAB(IX) = XXTAB(IX+1) + 60 CONTINUE + XXTAB(NXP) = 0. + NXP = NXP-1 + IF(NXP-1.GT.NX) GOTO 50 + ENDIF + + IF(XXTAB(NXP).EQ.1.) THEN + NXX = NXP-1 + ELSE + NXX = NXP + XXTAB(NXX+1) = 1. + ENDIF + +!--- Update IFAILC + CALL GRSETC + +!--- Update NFMAP + CALL QNSETT + +!--- Update heavy quark xgrid + CALL GXHDEF + + RETURN + + 500 CONTINUE + + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r GRXLIM ---> STOP'')') + WRITE(6,'( '' ------------------------------------'')') + WRITE(6,'( '' Input NX :'',I5 )') NX + WRITE(6,'( '' Xmin :'',E12.5)') XMIN + IF(IERR.EQ.1) THEN + WRITE(6,'(/'' NX must be .ge. 1'')') + ELSEIF(IERR.EQ.2) THEN + WRITE(6,'(/'' NX > max number of gridpoints'', & + & '' allowed:'',I5)') MXX-1 + ELSEIF(IERR.EQ.3) THEN + WRITE(6,'(/'' Xmin outside allowed range (0,1]'')') + ENDIF + + CALL QTRACE('GRXLIM ',1) + + STOP + + END + +!DECK ID>, GXHDEF. + +! ================= + SUBROUTINE GXHDEF +! ================= + +!-- Create a purely logarithmic grid in x (XHTAB) for use +!-- in the heavy quark structure function calculations. + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + IF(NXX.EQ.0.OR.NXX.GE.MXX) RETURN + IF(XXTAB(1).LE.0..OR.XXTAB(1).GE.1.) RETURN + + XL1 = LOG(XXTAB(1)) + XL2 = 0. + BW = (XL2-XL1)/NXX + + DO IX = 1,NXX + XL = XL1 + (IX-1)*BW + XHTAB(IX) = EXP(XL) + IHTAB(IX) = ABS(IXFROMX(XHTAB(IX))) + ENDDO + XHTAB(NXX+1) = 1. + IHTAB(NXX+1) = NXX+1 + + RETURN + END + + +!DECK ID>, SYFROMX. + +! ==================================== + DOUBLE PRECISION FUNCTION SYFROMX(X) +! ==================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + IF(X.LE.SCAX0) THEN + SYFROMX = LOG(X) + ELSE + SYFROMX = LOG(SCAX0) + (X-SCAX0)/SCAX0 + ENDIF + + RETURN + END + +!DECK ID>, SXFROMY. + +! ==================================== + DOUBLE PRECISION FUNCTION SXFROMY(Y) +! ==================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + IF(Y.LE.LOG(SCAX0)) THEN + SXFROMY = EXP(Y) + ELSE + SXFROMY = (Y-LOG(SCAX0)+1.) * SCAX0 + ENDIF + + RETURN + END + +!DECK ID>, GRXOUT. + +! ========================= + SUBROUTINE GRXOUT(XARRAY) +! ========================= + +!--- Copy XXTAB to XARRAY which should have been dimensioned +!--- to at least NXX+1 by the user. + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + DIMENSION XARRAY(*) + + CALL QTRACE('GRXOUT ',0) + + DO 10 IX = 1,NXX+1 + XARRAY(IX) = XXTAB(IX) + 10 END DO + + RETURN + END + +!DECK ID>, LOGXGR. + +! =============================== + LOGICAL FUNCTION LOGXGR(IDUMMY) +! =============================== + +!--- Figure out if xgrid is purely logarithmic + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + REAL RAT1,RAT + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + LOGXGR = .FALSE. + + IF(NXX.LE.0) RETURN + + RAT1 = XXTAB(2)/XXTAB(1) + LOGXGR = .TRUE. + DO IX = 1,NXX + RAT = XXTAB(IX+1)/XXTAB(IX) + IF(RAT.NE.RAT1) LOGXGR = .FALSE. + ENDDO + + RETURN + END + +!DECK ID>, GRQNUL. + +! ================= + SUBROUTINE GRQNUL +! ================= + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + CALL QTRACE('GRQNUL ',0) + +!--- Invalidate weight tables (validated by call to QNFILW) + LALFOK = .FALSE. + LDQ2OK = .FALSE. + LWFCOK = .FALSE. + LWLCOK = .FALSE. + LWFBOK = .FALSE. + LWLBOK = .FALSE. + LMARK = .FALSE. +!-- Invalidate all evolutions + CALL QNFALS(LEVDONE,MXX*10) + +!--- Set grid to zero + CALL QNVNUL(Q2TAB,MQ2) + NQ2 = 0 + NGRVER = 0 + +!--- Update IFAILC + CALL GRSETC + +!--- Update NFMAP + CALL QNSETT + + + RETURN + END + +!DECK ID>, GRQINP. +! +! ============================ + SUBROUTINE GRQINP(QARRAY,NQ) +! ============================ + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + DIMENSION QARRAY(*) + + DATA EPSI /1.E-6/ + + CALL QTRACE('GRQINP ',0) + + IF(NQ.LE.0) THEN + IERR = 1 + GOTO 500 + ENDIF + + IF((NQ+NQ2).GT.MQ2-1) THEN + IERR = 2 + GOTO 500 + ENDIF + +!--- Invalidate weight tables (validated by call to QNFILW) + LALFOK = .FALSE. + LDQ2OK = .FALSE. + LWFCOK = .FALSE. + LWLCOK = .FALSE. + LWFBOK = .FALSE. + LWLBOK = .FALSE. + LMARK = .FALSE. +!-- Invalidate all evolutions + CALL QNFALS(LEVDONE,MXX*10) + +!--- if this number changes, QCDNUM knows that the grid has changed + NGRVER = NGRVER + 1 + + IF(NQ2.EQ.0) THEN + DO 10 IQ = 1,NQ + Q = QARRAY(IQ) + IF(Q.LE.0.) THEN + IERR = 3 + GOTO 500 + ENDIF + NQ2 = NQ2+1 + Q2TAB(IQ) = Q + 10 CONTINUE + RETURN + ENDIF + + DO 100 IQ = 1,NQ + + Q = QARRAY(IQ) + + IF(Q.LE.0.) THEN + IERR = 3 + GOTO 500 + ENDIF + +!mb IF(Q.LT.Q2TAB(1)-EPSI) THEN + IF(Q/Q2TAB(1).LT.1.-EPSI) THEN + + DO 20 JQ = NQ2,1,-1 + Q2TAB(JQ+1) = Q2TAB(JQ) + 20 CONTINUE + NQ2 = NQ2+1 + Q2TAB(1) = Q + +!mb ELSEIF(Q.GT.Q2TAB(NQ2)+EPSI) THEN + ELSEIF(Q/Q2TAB(NQ2).GT.1.+EPSI) THEN + + NQ2 = NQ2+1 + Q2TAB(NQ2) = Q + + ELSE + + DO 30 I = 1,NQ2 +!mb IF(Q2TAB(I).LE.Q+EPSI) IQ0 = I + IF(Q2TAB(I)/Q.LE.1.+EPSI) IQ0 = I + 30 CONTINUE + +!mb IF(ABS(Q2TAB(IQ0)-Q).LE.EPSI) THEN + IF(ABS(Q2TAB(IQ0)/Q-1.).LE.EPSI) THEN + Q2TAB(IQ0) = Q + ELSE + DO 40 JQ = NQ2,IQ0+1,-1 + Q2TAB(JQ+1) = Q2TAB(JQ) + 40 CONTINUE + NQ2 = NQ2+1 + Q2TAB(IQ0+1) = Q + ENDIF + + ENDIF + + 100 END DO + +!--- Update IFAILC + CALL GRSETC + +!--- Update NFMAP + CALL QNSETT + + RETURN + + 500 CONTINUE + + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r GRQINP ---> STOP'')') + WRITE(6,'( '' ------------------------------------'')') + WRITE(6,'( '' Input Q2 :'',E12.5)') Q + WRITE(6,'( '' NQ :'',I5 )') NQ + IF(IERR.EQ.1) THEN + WRITE(6,'(/'' NQ must be .ge. 1'')') + ELSEIF(IERR.EQ.2) THEN + WRITE(6,'(/'' Maximum number of gridpoints exceeded '')') + WRITE(6,'(/'' # existing Q2 gridpoints ='',I5/ & + & '' # points to be added ='',I5/ & + & '' maximum # points allowed ='',I5)') & + & NQ2, NQ, MQ2-1 + ELSEIF(IERR.EQ.3) THEN + WRITE(6,'(/'' Value of Q2 outside allowed range > 0'')') + ENDIF + + CALL QTRACE('GRQINP ',1) + + STOP + + END + +!DECK ID>, GRQDEF. + +! =============================== + SUBROUTINE GRQDEF(NQ,QMIN,QMAX) +! =============================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + CALL QTRACE('GRQDEF ',0) + + IF(NQ.LE.1) THEN + IERR = 1 + GOTO 500 + ENDIF + + IF(NQ.GT.MQ2-1) THEN + IERR = 2 + GOTO 500 + ENDIF + + IF(QMIN.LE.0.OR.QMAX.LE.0.OR.QMIN.GE.QMAX) THEN + IERR = 3 + GOTO 500 + ENDIF + +!--- Invalidate weight tables (validated by call to QNFILW) + LALFOK = .FALSE. + LDQ2OK = .FALSE. + LWFCOK = .FALSE. + LWLCOK = .FALSE. + LWFBOK = .FALSE. + LWLBOK = .FALSE. + LMARK = .FALSE. +!-- Invalidate all evolutions + CALL QNFALS(LEVDONE,MXX*10) + +!--- if this number changes, QCDNUM knows that the grid has changed + NGRVER = NGRVER + 1 + + YMIN = SYFROMQ(QMIN) + YMAX = SYFROMQ(QMAX) + BW = (YMAX-YMIN)/(NQ-1) + DO I = 1,NQ + YI = YMIN+(I-1)*BW + Q2TAB(I) = SQFROMY(YI) + ENDDO + Q2TAB(1) = QMIN + Q2TAB(NQ) = QMAX + NQ2 = NQ + +!--- Update IFAILC + CALL GRSETC + +!--- Update NFMAP + CALL QNSETT + + RETURN + + 500 CONTINUE + + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r GRQDEF ---> STOP'')') + WRITE(6,'( '' ------------------------------------'')') + WRITE(6,'( '' Input NQ :'',I5 )') NQ + WRITE(6,'( '' Q2min :'',E12.5)') QMIN + WRITE(6,'( '' Q2max :'',E12.5)') QMAX + IF(IERR.EQ.1) THEN + WRITE(6,'(/'' NQ must be .ge. 2'')') + ELSEIF(IERR.EQ.2) THEN + WRITE(6,'(/'' NQ > max number of gridpoints'', & + & '' allowed:'',I5)') MQ2-1 + ELSEIF(IERR.EQ.3) THEN + WRITE(6,'(/'' Qmin and/or Qmax .le. 0 or Qmin .ge. Qmax'')') + ENDIF + + CALL QTRACE('GRQDEF ',1) + + STOP + + END + +!DECK ID>, GRQLIM. + +! =============================== + SUBROUTINE GRQLIM(NQ,QMIN,QMAX) +! =============================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + DATA EPSI /1.E-6/ + + CALL QTRACE('GRQLIM ',0) + + IF(NQ.LE.0) THEN + IERR = 1 + GOTO 500 + ENDIF + + IF(NQ.GT.MQ2-1) THEN + IERR = 2 + GOTO 500 + ENDIF + +!--- Invalidate weight tables (validated by call to QNFILW) + LALFOK = .FALSE. + LDQ2OK = .FALSE. + LWFCOK = .FALSE. + LWLCOK = .FALSE. + LWFBOK = .FALSE. + LWLBOK = .FALSE. + LMARK = .FALSE. +!-- Invalidate all evolutions + CALL QNFALS(LEVDONE,MXX*10) + +!--- if this number changes, QCDNUM knows that the grid has changed + NGRVER = NGRVER + 1 + + IF(NQ2.EQ.0) THEN + + IF(QMIN.LE.0..OR.QMAX.LE.0..OR.QMIN.GE.QMAX) THEN + IERR = 3 + GOTO 500 + ENDIF + + CALL GRQDEF(NQ,QMI,QMA) + + ELSE + + IF(QMIN.LE.0..OR.QMAX.LE.0..OR.QMIN.GE.QMAX) THEN + IERR = 3 + GOTO 500 + ENDIF + +!mb IF(QMIN.LT.Q2TAB(1)-EPSI) THEN + IF(QMIN/Q2TAB(1).LT.1.-EPSI) THEN + DO 20 IQ = NQ2,1,-1 + Q2TAB(IQ+1) = Q2TAB(IQ) + 20 CONTINUE + NQ2 = NQ2+1 + Q2TAB(1) = QMIN + ENDIF +!mb IF(QMAX.GT.Q2TAB(NQ2)+EPSI) THEN + IF(QMAX/Q2TAB(NQ2).GT.1.+EPSI) THEN + NQ2 = NQ2+1 + Q2TAB(NQ2) = QMAX + ENDIF + + IF(NQ.GT.NQ2) THEN + 30 CONTINUE + GAPMAX = 0. + DO 35 IQ = 1,NQ2-1 + GAP = SYFROMQ(Q2TAB(IQ+1))-SYFROMQ(Q2TAB(IQ)) + IF(GAP.GT.GAPMAX) THEN + GAPMAX = GAP + IQ0 = IQ + ENDIF + 35 CONTINUE + DO 40 IQ = NQ2,IQ0+1,-1 + Q2TAB(IQ+1) = Q2TAB(IQ) + 40 CONTINUE + NQ2 = NQ2+1 + Q2TAB(IQ0+1) = SQRT(Q2TAB(IQ0)*Q2TAB(IQ0+2)) + IF(NQ2.LT.NQ) GOTO 30 + + ELSEIF(NQ.LT.NQ2) THEN + 50 CONTINUE + GAPMIN = 999999. + DO 55 IQ = 2,NQ2-1 + GAP = SYFROMQ(Q2TAB(IQ+1))-SYFROMQ(Q2TAB(IQ-1)) + IF(GAP.LE.GAPMIN) THEN + GAPMIN = GAP + IQ0 = IQ + ENDIF + 55 CONTINUE + DO 60 IQ = IQ0,NQ2-1 + Q2TAB(IQ) = Q2TAB(IQ+1) + 60 CONTINUE + Q2TAB(NQ2) = 0. + NQ2 = NQ2-1 + IF(NQ2.GT.NQ) GOTO 50 + ENDIF + + ENDIF + +!--- Update IFAILC + CALL GRSETC + +!--- Update NFMAP + CALL QNSETT + + RETURN + + 500 CONTINUE + + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r GRQLIM ---> STOP'')') + WRITE(6,'( '' ------------------------------------'')') + WRITE(6,'( '' Input NQ :'',I5 )') NQ + WRITE(6,'( '' Q2min :'',E12.5)') QMIN + WRITE(6,'( '' Q2max :'',E12.5)') QMAX + IF(IERR.EQ.1) THEN + WRITE(6,'(/'' NQ must be .ge. 1'')') + ELSEIF(IERR.EQ.2) THEN + WRITE(6,'(/'' NQ > max number of gridpoints'', & + & '' allowed:'',I5)') MQ2-1 + ELSEIF(IERR.EQ.3) THEN + WRITE(6,'(/'' Qmin and/or Qmax .le. 0 or Qmin .ge. Qmax'')') + ENDIF + + CALL QTRACE('GRQLIM ',1) + + STOP + + END + +!DECK ID>, SYFROMQ. + +! ==================================== + DOUBLE PRECISION FUNCTION SYFROMQ(Q) +! ==================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + IF(Q.LE.SCAQ0) THEN + SYFROMQ = LOG(Q) + ELSE + SYFROMQ = LOG(SCAQ0) + (Q-SCAQ0)/SCAQ0 + ENDIF + + RETURN + END + +!DECK ID>, SQFROMY. + +! ==================================== + DOUBLE PRECISION FUNCTION SQFROMY(Y) +! ==================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + IF(Y.LE.LOG(SCAQ0)) THEN + SQFROMY = EXP(Y) + ELSE + SQFROMY = (Y-LOG(SCAQ0)+1.) * SCAQ0 + ENDIF + + RETURN + END + + +!DECK ID>, GRQOUT. + +! ========================= + SUBROUTINE GRQOUT(QARRAY) +! ========================= + +!--- Copy Q2TAB to QARRAY which should have been dimensioned +!--- to at least NQ2 by the user. + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + DIMENSION QARRAY(*) + + CALL QTRACE('GRQOUT ',0) + + DO 10 IQ = 1,NQ2 + QARRAY(IQ) = Q2TAB(IQ) + 10 END DO + + RETURN + END + +!DECK ID>, IXFROMX. + +! =========================== + INTEGER FUNCTION IXFROMX(X) +! =========================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +!--- Returns gridindex IX given a value for X. +!--- If X is outside the current gridboundary then IXFROMX = 0. +!--- If X corresponds to gridindex IX then IXFROMX = IX. +!--- If X lies above IX and below IX+1 then IXFROMX = -IX. + +!--- NB: X and XXTAB are different only if |X-XXTAB| < epsi. +!--- NB: If since the previous call the grid did not change +!--- (i.e. NGRVER is the same) and if X did not change, then +!--- IXFROMX just returns the result of the previous call. + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + SAVE XLAST,IXLAST,NGLAST + + DATA XLAST / 0. / + DATA IXLAST / 0 / + DATA NGLAST / 0 / + DATA EPSI /1.E-6/ + +! CALL QTRACE('IXFROMX',0) + + IF(X.EQ.XLAST.AND.NGRVER.EQ.NGLAST) THEN + IXFROMX = IXLAST + RETURN + ENDIF + + IX = 0 + IXLAST = 0 + NGLAST = NGRVER + XLAST = X + IXFROMX = 0 + + IF(X.GT.1..OR.NXX.LE.0) RETURN + IF(X/XXTAB(1).LT.1.-EPSI) RETURN + + DO 10 I = 1,NXX +!mb IF(XXTAB(I).LE.X+EPSI) IX = I + IF(XXTAB(I)/X.LE.1.+EPSI) IX = I + 10 END DO + +!mb IF(ABS(XXTAB(IX)-X).LE.EPSI) THEN + IF(ABS(XXTAB(IX)/X-1.).LE.EPSI) THEN + IXFROMX = IX + IXLAST = IX + ELSE + IXFROMX = -IX + IXLAST = -IX + ENDIF + + RETURN + END + +!------------------------------------------------ + +!- REAL XR,X1,X2,XLAST +!- +!-+SEQ,QCNXQM. +!-+SEQ,QCGRID. +!- +!- SAVE XLAST,IXLAST,NGLAST +!- +!- DATA XLAST / 0. / +!- DATA IXLAST / 0 / +!- DATA NGLAST / 0 / +!- +!-* CALL QTRACE('IXFROMX',0) +!- +!- XR = X +!- IF(XR.EQ.XLAST.AND.NGRVER.EQ.NGLAST) THEN +!- IXFROMX = IXLAST +!- RETURN +!- ENDIF +!- +!- IX = 0 +!- IXLAST = 0 +!- NGLAST = NGRVER +!- XLAST = X +!- IXFROMX = 0 +!- +!- IF(XR.GT.1..OR.NXX.LE.0) RETURN +!- X1 = XXTAB(1) +!- IF(XR.LT.X1) RETURN +!- +!- DO IX = 1,NXX +!- X2 = XXTAB(IX+1) +!- IF(X1.LE.XR.AND.XR.LT.X2) THEN +!- IXFROMX = -IX +!- IF(X1.EQ.XR) IXFROMX = IX +!- IXLAST = IX +!- RETURN +!- ENDIF +!- X1 = X2 +!- ENDDO +!- +!- RETURN +!- END + +!DECK ID>, IHFROMH. + +! =========================== + INTEGER FUNCTION IHFROMH(X) +! =========================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +!--- Returns gridindex IX of heavy quark grid given a value for X. +!--- If X is outside the current gridboundary then IHFROMH = 0. +!--- If X corresponds to gridindex IX then IHFROMH = IX. +!--- If X lies above IX and below IX+1 then IHFROMH = -IX. + +!--- NB: X and XHTAB are different only if |X-XHTAB| < epsi. +!--- NB: If since the previous call the grid did not change +!--- (i.e. NGRVER is the same) and if X did not change, then +!--- IHFROMH just returns the result of the previous call. + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + SAVE XLAST,IXLAST,NGLAST + + DATA XLAST / 0. / + DATA IXLAST / 0 / + DATA NGLAST / 0 / + DATA EPSI /1.E-6/ + +! CALL QTRACE('IHFROMH',0) + + IF(X.EQ.XLAST.AND.NGRVER.EQ.NGLAST) THEN + IHFROMH = IXLAST + RETURN + ENDIF + + IX = 0 + IXLAST = 0 + NGLAST = NGRVER + XLAST = X + IHFROMH = 0 + + IF(X.GT.1..OR.NXX.LE.0) RETURN + IF(X/XHTAB(1).LT.1.-EPSI) RETURN + + DO 10 I = 1,NXX +!mb IF(XHTAB(I).LE.X+EPSI) IX = I + IF(XHTAB(I)/X.LE.1.+EPSI) IX = I + 10 END DO + +!mb IF(ABS(XHTAB(IX)-X).LE.EPSI) THEN + IF(ABS(XHTAB(IX)/X-1.).LE.EPSI) THEN + IHFROMH = IX + IXLAST = IX + ELSE + IHFROMH = -IX + IXLAST = -IX + ENDIF + + RETURN + END + +!------------------------------------------------ + +!- REAL XR,X1,X2,XLAST +!- +!-+SEQ,QCNXQM. +!-+SEQ,QCGRID. +!- +!- SAVE XLAST,IXLAST,NGLAST +!- +!- DATA XLAST / 0. / +!- DATA IXLAST / 0 / +!- DATA NGLAST / 0 / +!- +!-* CALL QTRACE('IXFROMX',0) +!- +!- XR = X +!- IF(XR.EQ.XLAST.AND.NGRVER.EQ.NGLAST) THEN +!- IXFROMX = IXLAST +!- RETURN +!- ENDIF +!- +!- IX = 0 +!- IXLAST = 0 +!- NGLAST = NGRVER +!- XLAST = X +!- IXFROMX = 0 +!- +!- IF(XR.GT.1..OR.NXX.LE.0) RETURN +!- X1 = XHTAB(1) +!- IF(XR.LT.X1) RETURN +!- +!- DO IX = 1,NXX +!- X2 = XHTAB(IX+1) +!- IF(X1.LE.XR.AND.XR.LT.X2) THEN +!- IXFROMX = -IX +!- IF(X1.EQ.XR) IXFROMX = IX +!- IXLAST = IX +!- RETURN +!- ENDIF +!- X1 = X2 +!- ENDDO +!- +!- RETURN +!- END + +!DECK ID>, IXNEARX. + +! =========================== + INTEGER FUNCTION IXNEARX(X) +! =========================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +!--- Returns closest gridindex IX given a value for X. +!--- If X is outside the current gridboundary then IXNEARX = 0. +!--- If X corresponds to gridindex IX then IXNEARX = IX. +!--- If X lies above IX and below IX+1 then IXNEARX = -IX or -IX-1. + +!--- NB: X and XXTAB are different only if |X-XXTAB| < epsi. +!--- NB: If since the previous call the grid did not change +!--- (i.e. NGRVER is the same) and if X did not change, then +!--- IXNEARX just returns the result of the previous call. + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + SAVE XLAST,IXLAST,NGLAST + + DATA XLAST / 0. / + DATA IXLAST / 0 / + DATA NGLAST / 0 / + DATA EPSI /1.E-6/ + +! CALL QTRACE('IXNEARX',0) + + IF(X.EQ.XLAST.AND.NGRVER.EQ.NGLAST) THEN + IXNEARX = IXLAST + RETURN + ENDIF + + IX = 0 + IXLAST = 0 + NGLAST = NGRVER + XLAST = X + IXNEARX = 0 + + IF(X.GT.1..OR.NXX.LE.0) RETURN + IF(X/XXTAB(1).LT.1.-EPSI) RETURN + + DO 10 I = 1,NXX +!mb IF(XXTAB(I).LE.X+EPSI) IX = I + IF(XXTAB(I)/X.LE.1.+EPSI) IX = I + 10 END DO + +!mb IF(ABS(XXTAB(IX)-X).LE.EPSI) THEN + IF(ABS(XXTAB(IX)/X-1.).LE.EPSI) THEN + IXNEARX = IX + IXLAST = IX + ELSE + GAP = SYFROMX(XXTAB(IX+1))-SYFROMX(XXTAB(IX)) + DEL = SYFROMX(X)-SYFROMX(XXTAB(IX)) + IF(DEL/GAP.LE.0.5) THEN + IXNEARX = -IX + ELSE + IXNEARX = -MIN(IX+1,NXX) + ENDIF + IXLAST = IXNEARX + ENDIF + + RETURN + END + +!DECK ID>, IQFROMQ. + +! =========================== + INTEGER FUNCTION IQFROMQ(Q) +! =========================== + +!--- Returns gridindex IQ given a value for Q. +!--- If Q is outside the current gridboundary then IQFROMQ = 0. +!--- If Q corresponds to gridindex IQ then IQFROMQ = IQ. +!--- If Q lies above IQ and below IQ+1 then IQFROMQ = -IQ. + +!--- NB: Q and Q2TAB are different only if |Q-Q2TAB| < epsi. +!--- NB: If since the previous call the grid did not change +!--- (i.e. NGRVER is the same) and if Q did not change, then +!--- IQFROMQ just returns the result of the previous call. + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + SAVE QLAST,IQLAST,NGLAST + + DATA QLAST / 0. / + DATA IQLAST / 0 / + DATA NGLAST / 0 / + DATA EPSI /1.E-6/ + +! CALL QTRACE('IQFROMQ',0) + + IF(Q.EQ.QLAST.AND.NGRVER.EQ.NGLAST) THEN + IQFROMQ = IQLAST + RETURN + ENDIF + + IQ = 0 + IQLAST = 0 + NGLAST = NGRVER + QLAST = Q + IQFROMQ = 0 + + IF(NQ2.EQ.0) RETURN + IF(Q/Q2TAB(1).LT.1.-EPSI) RETURN + IF(Q/Q2TAB(NQ2).GT.1.+EPSI) RETURN + + DO 10 I = 1,NQ2 +!mb IF(Q2TAB(I).LE.Q+EPSI) IQ = I + IF(Q2TAB(I)/Q.LE.1.+EPSI) IQ = I + 10 END DO + +!mb IF(ABS(Q2TAB(IQ)-Q).LE.EPSI) THEN + IF(ABS(Q2TAB(IQ)/Q-1.).LE.EPSI) THEN + IQFROMQ = IQ + IQLAST = IQ + ELSE + IQFROMQ = -IQ + IQLAST = -IQ + ENDIF + + RETURN + END + +!------------------------------------------------ + +!- REAL QR,Q1,Q2,QLAST +!- +!-+SEQ,QCNXQM. +!-+SEQ,QCGRID. +!- +!- SAVE QLAST,IQLAST,NGLAST +!- +!- DATA QLAST / 0. / +!- DATA IQLAST / 0 / +!- DATA NGLAST / 0 / +!- +!-* CALL QTRACE('IQFROMQ',0) +!- +!- QR = Q +!- IF(QR.EQ.QLAST.AND.NGRVER.EQ.NGLAST) THEN +!- IQFROMQ = IQLAST +!- RETURN +!- ENDIF +!- +!- IQ = 0 +!- IQLAST = 0 +!- NGLAST = NGRVER +!- QLAST = Q +!- IQFROMQ = 0 +!- +!- +!- IF(NQ2.LE.0) RETURN +!- Q1 = Q2TAB(1) +!- IF(QR.LT.Q1) RETURN +!- Q2 = Q2TAB(NQ2) +!- IF(QR.GT.Q2) RETURN +!- IF(QR.EQ.Q2) THEN +!- IQFROMQ = NQ2 +!- IQLAST = NQ2 +!- RETURN +!- ENDIF +!- +!- DO IQ = 1,NQ2-1 +!- Q2 = Q2TAB(IQ+1) +!- IF(Q1.LE.QR.AND.QR.LT.Q2) THEN +!- IQFROMQ = -IQ +!- IF(Q1.EQ.QR) IQFROMQ = IQ +!- IQLAST = IQ +!- RETURN +!- ENDIF +!- Q1 = Q2 +!- ENDDO +!- +!- RETURN +!- END + +!DECK ID>, IQNEARQ. + +! =========================== + INTEGER FUNCTION IQNEARQ(Q) +! =========================== + +!--- Returns closest gridindex IQ given a value for Q. +!--- If Q is outside the current gridboundary then IQNEARQ = 0. +!--- If Q corresponds to gridindex IQ then IQNEARQ = IQ. +!--- If Q lies above IQ and below IQ+1 then IQNEARQ = -IQ or -IQ-1. + +!--- NB: Q and Q2TAB are different only if |Q-Q2TAB| < epsi. +!--- NB: If since the previous call the grid did not change +!--- (i.e. NGRVER is the same) and if Q did not change, then +!--- IQNEARQ just returns the result of the previous call. + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + SAVE QLAST,IQLAST,NGLAST + + DATA QLAST / 0. / + DATA IQLAST / 0 / + DATA NGLAST / 0 / + DATA EPSI /1.E-6/ + +! CALL QTRACE('IQNEARQ',0) + + IF(Q.EQ.QLAST.AND.NGRVER.EQ.NGLAST) THEN + IQNEARQ = IQLAST + RETURN + ENDIF + + IQ = 0 + IQLAST = 0 + NGLAST = NGRVER + QLAST = Q + IQNEARQ = 0 + + IF(NQ2.EQ.0) RETURN + IF(Q/Q2TAB(1).LT.1.-EPSI) RETURN + IF(Q/Q2TAB(NQ2).GT.1.+EPSI) RETURN + + DO 10 I = 1,NQ2 +!mb IF(Q2TAB(I).LE.Q+EPSI) IQ = I + IF(Q2TAB(I)/Q.LE.1.+EPSI) IQ = I + 10 END DO + +!mb IF(ABS(Q2TAB(IQ)-Q).LE.EPSI) THEN + IF(ABS(Q2TAB(IQ)/Q-1.).LE.EPSI) THEN + IQNEARQ = IQ + IQLAST = IQ + ELSE + GAP = LOG(Q2TAB(IQ+1)/Q2TAB(IQ)) + DEL = LOG(Q/Q2TAB(IQ)) + IF(DEL/GAP.LE.0.5) THEN + IQNEARQ = -IQ + ELSE + IQNEARQ = -MIN(IQ+1,NQ2) + ENDIF + IQLAST = IQNEARQ + ENDIF + + RETURN + END + +!DECK ID>, XFROMIX. + +! ===================================== + DOUBLE PRECISION FUNCTION XFROMIX(IX) +! ===================================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +!--- Returns x given the gridindex IX. +!--- If IX is out of range [1,NXX] then XFROMIX = 0. + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + +! CALL QTRACE('XFROMIX',0) + + IF(IX.LE.0) THEN + XFROMIX = 0. + ELSEIF(IX.GT.NXX) THEN + XFROMIX = 0. + ELSE + XFROMIX = XXTAB(IX) + ENDIF + + RETURN + END + +!DECK ID>, QFROMIQ. +! +! ===================================== + DOUBLE PRECISION FUNCTION QFROMIQ(IQ) +! ===================================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +!--- Returns Q2 given the gridindex IQ. +!--- If IQ is out of range [1,NQ2] then QFROMIQ = 0. + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + +! CALL QTRACE('QFROMIQ',0) + + IF(IQ.LE.0) THEN + QFROMIQ = 0. + ELSEIF(IQ.GT.NQ2) THEN + QFROMIQ = 0. + ELSE + QFROMIQ = Q2TAB(IQ) + ENDIF + + RETURN + END + +!DECK ID>, GRCUTS. + +! ==================================== + SUBROUTINE GRCUTS(XMI,QMI,QMA,ROOTS) +! ==================================== + +!--- GRCUTS: user input of cuts. +!--- Input : Double precision XMI: reject x .lt. XMI +!--- QMI: reject Q2 .lt. QMI +!--- QMA: reject Q2 .gt. QMA +!--- ROOTS: reject Q2 .gt. x * roots**2 +!--- Output: XMICUT, QMICUT, QMACUT, RS2CUT in +seq,QCGRID. +!--- NB : No cut is applied when XMI etc .le. 0 (XMICUT etc = -1.) + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + CALL QTRACE('GRCUTS ',0) + + IF(XMI.LE.0..OR.XMI.GE.1.) THEN + XMICUT = -1. + ELSE + XMICUT = XMI + ENDIF + + IF(QMI.LE.0.) THEN + QMICUT = -1. + ELSE + QMICUT = QMI + ENDIF + + IF(QMA.LE.0.) THEN + QMACUT = -0.5 + ELSE + QMACUT = QMA + ENDIF + + IF(ROOTS.LE.0.) THEN + RS2CUT = -1. + ELSE + RS2CUT = ROOTS*ROOTS + ENDIF + + IF(QMICUT.GE.QMACUT.AND.QMACUT.GT.0.) THEN + + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r GRCUTS ---> STOP'')') + WRITE(6,'( '' ------------------------------------'')') + WRITE(6,'( '' Input Xmin :'',E12.5)') XMI + WRITE(6,'( '' Q2min :'',E12.5)') QMI + WRITE(6,'( '' Q2max :'',E12.5)') QMA + WRITE(6,'( '' rootS :'',E12.5)') ROOTS + WRITE(6,'(/'' Value of Q2min .ge. Q2max'')') + + CALL QTRACE('GRCUTS ',1) + + STOP + + ENDIF + + CALL GRSETC + + RETURN + END + +!DECK ID>, GRSETC. + +! ================= + SUBROUTINE GRSETC +! ================= + +!--- Input: XMIN, QMIN, QMAX, RS2CUT + grid-definitions, all this +!--- as stored in QCGRID. +!--- Output: integer array IFAILC(IX,IQ) (see below). +!--- Called by GRCUTS (user input of cuts) and +!--- by all grid definition routines (update of IFAILC). + +!--- Fill the array IFAILC(IX,IQ) such that +!--- IFAILC = 0 : gridpoint passes all cuts +!--- IFAILC = ijkl : i = 0/1 no/yes fail roots cut +!--- j = 0/1 no/yes fail qmax cut +!--- k = 0/1 no/yes fail qmin cut +!--- l = 0/1 no/yes fail xmin cut + +!--- For any x,Q2 passing the cuts the four surrounding gridpoints +!--- will also be flagged as passing the cut. This then guarantees +!--- that parton distributions are available on the surrounding +!--- gridpoints for interpolation purposes. + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + DO IX = 1,MXX + DO IQ = 1,MQ2 + IFAILC(IX,IQ) = 11111 + ENDDO + ENDDO + IF(NXX.LE.0) RETURN + IF(NQ2.LE.0) RETURN + + DO IQ = 1,NQ2 + DO IX = 1,NXX + IXP1 = MIN(IX+1,NXX) + IQP1 = MIN(IQ+1,NQ2) + IQM1 = MAX(IQ-1,1) + IFAILC(IX,IQ) = 0 + IF(XXTAB(IXP1).LE.XMICUT.AND.XMICUT.GT.0.) & + & IFAILC(IX,IQ) = IFAILC(IX,IQ)+1 + IF(Q2TAB(IQP1).LE.QMICUT.AND.QMICUT.GT.0.) & + & IFAILC(IX,IQ) = IFAILC(IX,IQ)+10 + IF(Q2TAB(IQM1).GE.QMACUT.AND.QMACUT.GT.0.) & + & IFAILC(IX,IQ) = IFAILC(IX,IQ)+100 + IF(Q2TAB(IQM1).GE.XXTAB(IXP1)*RS2CUT.AND.RS2CUT.GT.0.) & + & IFAILC(IX,IQ) = IFAILC(IX,IQ)+1000 + IF(Q2TAB(IQP1).LE.QMINAS.AND.QMINAS.GT.0.) & + & IFAILC(IX,IQ) = IFAILC(IX,IQ)+10000 + + ENDDO + ENDDO + +!-- Invalidate all evolutions + CALL QNFALS(LEVDONE,MXX*10) + + RETURN + END + +!DECK ID>, IFAILXQ. + +! ============================= + INTEGER FUNCTION IFAILXQ(X,Q) +! ============================= + +!--- User interface to ICUTXQ + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + CALL QTRACE('IFAILXQ',0) + + IFAILXQ = ICUTXQ(X,Q,0) + + RETURN + END + +!DECK ID>, ICUTXQ. + +! ================================== + INTEGER FUNCTION ICUTXQ(X,Q,IPRIN) +! ================================== + +!--- ICUTXQ = ijkl : i = 0/1 no/yes fail ROOTS cut +!--- j = 0/1 no/yes fail QMAX cut +!--- k = 0/1 no/yes fail QMIN cut +!--- l = 0/1 no/yes fail XMIN cut + +!--- Input integer IPRIN = 0/1 no/yes printout. + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + CHARACTER*4 PASS(0:1) + + DATA PASS /'pass','fail'/ + +!-- No x-grid available + IF(NXX.LE.0) THEN + ICUTXQ = 11111 + RETURN + ENDIF +!-- No Q2 grid available + IF(NQ2.LE.0) THEN + ICUTXQ = 11111 + RETURN + ENDIF +!-- x > 1 + IF(X.GT.1.0) THEN + ICUTXQ = 11111 + RETURN + ENDIF + + I1 = 0 + I2 = 0 + I3 = 0 + I4 = 0 + I5 = 0 + + IF((X.LT.XXTAB(1)).OR.(X.LT.XMICUT.AND.XMICUT.GT.0.)) & + & I1 = 1 + IF((Q.LT.Q2TAB(1)).OR.(Q.LT.QMICUT.AND.QMICUT.GT.0.)) & + & I2 = 1 + IF((Q.GT.Q2TAB(NQ2)).OR.(Q.GT.QMACUT.AND.QMACUT.GT.0.)) & + & I3 = 1 + IF(Q.GT.X*RS2CUT.AND.RS2CUT.GT.0.) & + & I4 = 1 + IF((Q.LT.Q2TAB(1)).OR.(Q.LT.QMINAS.AND.QMINAS.GT.0.)) & + & I5 = 1 + + ICUTXQ = 10000*I5 + 1000*I4 + 100*I3 + 10*I2 + I1 + + IF(IPRIN.EQ.1) THEN + + XMIPR = XMICUT + IF(XMICUT.LE.0.) XMIPR = XXTAB(1) + QMIPR = QMICUT + IF(QMICUT.LE.0.) QMIPR = Q2TAB(1) + QMAPR = QMACUT + IF(QMACUT.LE.0.) QMAPR = Q2TAB(NQ2) + WRITE(6,'('' '')') + WRITE(6,'('' x ='',E12.5,'' xmin = '',E12.5, & + & '' pass/fail = '',A4)') X, XMIPR, PASS(I1) + WRITE(6,'('' Q2 ='',E12.5,'' Qmin = '',E12.5, & + & '' pass/fail = '',A4)') Q, QMIPR, PASS(I2) + WRITE(6,'('' Q2 ='',E12.5,'' Qmax = '',E12.5, & + & '' pass/fail = '',A4)') Q, QMAPR, PASS(I3) + WRITE(6,'('' s ='',E12.5,'' Smax = '',E12.5, & + & '' pass/fail = '',A4)') Q/X, RS2CUT, PASS(I4) + WRITE(6,'('' Q2 ='',E12.5,'' Qmin_alphas = '',E12.5, & + & '' pass/fail = '',A4)') Q, QMINAS, PASS(I5) + WRITE(6,'('' '')') + + ENDIF + + RETURN + END + +!DECK ID>, IFAILIJ. + +! =============================== + INTEGER FUNCTION IFAILIJ(IX,IQ) +! =============================== + +!--- User interface to ICUTIJ + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + CALL QTRACE('IFAILIJ',0) + + IFAILIJ = ICUTIJ(IX,IQ,0) + + RETURN + END + +!DECK ID>, ICUTIJ. + +! ==================================== + INTEGER FUNCTION ICUTIJ(JX,JQ,IPRIN) +! ==================================== + +!--- ICUTIJ = ijklm : i = 0/1 no/yes fail QMINA cut +!--- j = 0/1 no/yes fail ROOTS cut +!--- k = 0/1 no/yes fail QMAX cut +!--- l = 0/1 no/yes fail QMIN cut +!--- m = 0/1 no/yes fail XMIN cut + +!--- ijklm is taken from array IFAILC. +!--- IFAILC is set by s/r GRSETC + +!--- Input integer IPRIN = 0/1 no/yes printout. + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + CHARACTER*4 PASS(0:1) + + DATA PASS /'pass','fail'/ + + ICUTIJ = 11111 + +!-- No x-grid available + IF(NXX.LE.0) RETURN +!-- No Q2 grid available + IF(NQ2.LE.0) RETURN + + IX = ABS(JX) + IQ = ABS(JQ) + IF(IX.GE.1.AND.IX.LE.NXX.AND.IQ.GE.1.AND.IQ.LE.NQ2) & + & ICUTIJ = IFAILC(IX,IQ) + + IF(IPRIN.EQ.1) THEN + + IF(IX.GE.1.AND.IX.LE.NXX.AND.IQ.GE.1.AND.IQ.LE.NQ2) THEN + X = XXTAB(IX) + Q = Q2TAB(IQ) + ELSE + X = 0. + Q = 0. + ENDIF + I5 = ICUTIJ/10000. + I4 = (ICUTIJ-10000*I5)/1000. + I3 = (ICUTIJ-10000*I5-1000*I4)/100. + I2 = (ICUTIJ-10000*I5-1000*I4-100*I3)/10. + I1 = ICUTIJ-10000*I5-1000*I4-100*I3-10*I2 + + XMIPR = XMICUT + IF(XMICUT.LE.0.) XMIPR = XXTAB(1) + QMIPR = QMICUT + IF(QMICUT.LE.0.) QMIPR = Q2TAB(1) + QMAPR = QMACUT + IF(QMACUT.LE.0.) QMAPR = Q2TAB(NQ2) + WRITE(6,'('' '')') + WRITE(6,'('' IX = '',I5,'' x ='',E12.5,'' xmin = '', & + & E12.5,'' pass/fail = '',A4)') IX, X, XMIPR, PASS(I1) + WRITE(6,'('' IQ = '',I5,'' Q2 ='',E12.5,'' Qmin = '', & + & E12.5,'' pass/fail = '',A4)') IQ, Q, QMIPR, PASS(I2) + WRITE(6,'('' IQ = '',I5,'' Q2 ='',E12.5,'' Qmax = '', & + & E12.5,'' pass/fail = '',A4)') IQ, Q, QMAPR, PASS(I3) + WRITE(6,'('' '',5X,'' s ='',E12.5,'' Smax = '', & + & E12.5,'' pass/fail = '',A4)') Q/X, RS2CUT, PASS(I4) + WRITE(6,'('' IQ = '',I5,'' Q2 ='',E12.5,'' Qmin_alphas = '', & + & E12.5,'' pass/fail = '',A4)') IQ, Q, QMINAS, PASS(I5) + WRITE(6,'('' '')') + + ENDIF + + RETURN + END + +!DECK ID>, QTHRES. + +! ========================== + SUBROUTINE QTHRES(T34,T45) +! ========================== + +!--- QTHRES: user input of flavour thresholds. +!--- Input : Double precision T34: Q2 .lt. T34 --> f = 3 +!--- Q2 .ge. T34 --> f = 4 +!--- T45: Q2 .lt. T45 --> f = 4 +!--- Q2 .ge. T45 --> f = 5 +!--- Output: THRS34 and THRS45 in +seq,QCGRID. +!--- NB1 : Default THRS34 = -huge, THRS45 = +huge --> f = 4. +!--- NB2 : The array NFMAP(Q2) = 3,4,5 is setup here through a +!--- call to QNSETT and maintained further in the grid +!--- defining routines. + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + CALL QTRACE('QTHRES ',0) + + IF(T34.GE.T45) THEN + IERR = 1 + GOTO 500 + ENDIF + + THRS34 = T34 + THRS45 = T45 + +!--- Fill the flavour map + CALL QNSETT + + RETURN + + 500 CONTINUE + + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r QTHRES ---> STOP'')') + WRITE(6,'( '' ------------------------------------'')') + WRITE(6,'( '' Input Threshold34 :'',E12.5)') T34 + WRITE(6,'( '' Threshold45 :'',E12.5)') T45 + WRITE(6,'(/'' Value of T34 .ge. T45'')') + + CALL QTRACE('QTHRES ',1) + + STOP + + END + +!DECK ID>, QNSETT. + +! ================= + SUBROUTINE QNSETT +! ================= + +!--- Input: THRS34 and THRS45 + grid-definitions, all this +!--- as stored in QCGRID. +!--- Output: integer array NFMAP(IQ) = 3,4,5 +!--- Called by QTHRES (user input of thresholds) and +!--- by all grid definition routines (update of NFMAP). + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + IF(NQ2.LE.0) THEN + DO IQ = 1,MQ2 + NFMAP(IQ) = 4 + ENDDO + RETURN + ENDIF + + DO IQ = 1,NQ2 + NFMAP(IQ) = 4 + IF(Q2TAB(IQ).LT.THRS34) NFMAP(IQ) = 3 + IF(Q2TAB(IQ).GE.THRS45) NFMAP(IQ) = 5 + ENDDO + +!-- Invalidate all evolutions + CALL QNFALS(LEVDONE,MXX*10) + + RETURN + END + +!DECK ID>, QNFMAP. + +! ============================== + SUBROUTINE QNFMAP(OPT,T34,T45) +! ============================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + CHARACTER*(*) OPT + + +!--- Obsolete 17/07/96: use QTHRES instead + + CALL QTHRES(T34,T45) + + RETURN + + END + +!DECK ID>, QNFSET. + +! =========================== + SUBROUTINE QNFSET(IX,IQ,NF) +! =========================== + + WRITE(6,'(/'' QNFSET: this routine is not available'', & + & '' ---> STOP'')') + STOP + + END + +!DECK ID>, QNFNUL. + +! ================= + SUBROUTINE QNFNUL +! ================= + + WRITE(6,'(/'' QNFNUL: this routine is not available'', & + & '' ---> STOP'')') + STOP + + END + +!DECK ID>, NFLGET. + +! =========================== + INTEGER FUNCTION NFLGET(IQ) +! =========================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + CALL QTRACE('NFLGET ',0) + + NFLGET = 0 + IF(IQ.GE.1.AND.IQ.LE.NQ2) THEN + NFLGET = NFMAP(IQ) + ELSE + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r NFLGET ---> STOP'')') + WRITE(6,'( '' ------------------------------------'')') + WRITE(6,'( '' Input IQ :'',I10)') IQ + WRITE(6,'(/'' IQ outside grid boundary'')') + CALL QTRACE('NFLGET ',1) + STOP + ENDIF + + RETURN + END + +!DECK ID>, QPGRID. + +! ====================== + SUBROUTINE QPGRID(LUN) +! ====================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + +!-- Write x-Q2 evolution grid +!-- ------------------------- + + WRITE(LUN,'(/'' QCDNUM x-Q2 evolution grid'')') + WRITE(LUN,'( '' --------------------------'')') + + CALL GRGIVE(N_X,X_MI,X_MA,N_Q,Q_MI,Q_MA) + + WRITE(LUN,'(/'' nx xmin xmax'', & + & '' nq qmin qmax'')') + WRITE(LUN,'(I5,2F10.7,I5,2F10.2)') & + & N_X,X_MI,X_MA,N_Q,Q_MI,Q_MA + WRITE(LUN,'(/'' Xgrid (heavy quarks)'')') + WRITE(LUN,'(5(I4,E12.5))') (I,XHTAB(I),I=1,NXX) + WRITE(LUN,'(/'' Xgrid'')') + WRITE(LUN,'(5(I4,E12.5))') (I,XXTAB(I),I=1,NXX) + WRITE(LUN,'(/'' Qgrid'')') + WRITE(LUN,'(5(I4,E12.5))') (I,Q2TAB(I),I=1,NQ2) + IF(RS2CUT.GE.0.) THEN + RS2C = SQRT(RS2CUT) + ELSE + RS2C = RS2CUT + ENDIF + WRITE(LUN,'(/'' Thresholds and cuts''/ & + & '' Q2 charm .......: '',E12.5/ & + & '' Q2 bottom .......: '',E12.5/ & + & '' Xmin cut .......: '',E12.5/ & + & '' Qmin cut .......: '',E12.5/ & + & '' Qmax cut .......: '',E12.5/ & + & '' Roots cut .......: '',E12.5/ & + & '' Qmin alpha_s ...: '',E12.5/)') & + & THRS34,THRS45,XMICUT,QMICUT,QMACUT,RS2C,QMINAS + + RETURN + END + +!DECK ID>, QDELQ2. + +! ================= + SUBROUTINE QDELQ2 +! ================= + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + +!-- Pre-calculate log distance in Q2 for up and down evolution + + DO 10 IQ = 2,NQ2 + DELUP(IQ) = LOG(Q2TAB(IQ)/Q2TAB(IQ-1)) + 10 END DO + DO 20 IQ = NQ2-1,1,-1 + DELDN(IQ) = LOG(Q2TAB(IQ)/Q2TAB(IQ+1)) + 20 END DO + + LDQ2OK = .TRUE. + + RETURN + END + +!DECK ID>, QFMARK. + +! ====================== + SUBROUTINE QFMARK(X,Q) +! ====================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + CALL QTRACE('QFMARK ',0) + +!-- Mark gridpoints for fast structure function calculation + + IERR = 0 + IF(X.LE.0. .OR. X.GT.1.) THEN + IERR = 1 + GOTO 500 + ENDIF + IF(Q.LE.0.) THEN + IERR = 2 + GOTO 500 + ENDIF + +!-- Mark the evolution grid + + IX = IXFROMX(X) + IQ = IQFROMQ(Q) + IF(IX.EQ.0.OR.IQ.EQ.0) THEN + IERR = 3 + GOTO 500 + ELSEIF(IX.GT.0.AND.IQ.GT.0) THEN + MARKFF(IX,IQ) = 1 + MARKQQ(IQ) = 1 + LMARK = .TRUE. + ELSEIF(IX.LT.0.AND.IQ.GT.0) THEN + MARKFF(-IX,IQ) = 1 + MARKFF(-IX+1,IQ) = 1 + MARKQQ(IQ) = 1 + LMARK = .TRUE. + ELSEIF(IX.GT.0.AND.IQ.LT.0) THEN + MARKFF(IX,-IQ) = 1 + MARKFF(IX,-IQ+1) = 1 + MARKQQ(-IQ) = 1 + MARKQQ(-IQ+1) = 1 + LMARK = .TRUE. + ELSEIF(IX.LT.0.AND.IQ.LT.0) THEN + MARKFF(-IX,-IQ) = 1 + MARKFF(-IX+1,-IQ) = 1 + MARKFF(-IX,-IQ+1) = 1 + MARKFF(-IX+1,-IQ+1) = 1 + MARKQQ(-IQ) = 1 + MARKQQ(-IQ+1) = 1 + LMARK = .TRUE. + ENDIF + +!-- Mark the heavy quark grid + + IX = IHFROMH(X) + IQ = IQFROMQ(Q) + IF(IX.EQ.0.OR.IQ.EQ.0) THEN + IERR = 3 + GOTO 500 + ELSEIF(IX.GT.0.AND.IQ.GT.0) THEN + MARKFH(IX,IQ) = 1 + ELSEIF(IX.LT.0.AND.IQ.GT.0) THEN + MARKFH(-IX,IQ) = 1 + MARKFH(-IX+1,IQ) = 1 + ELSEIF(IX.GT.0.AND.IQ.LT.0) THEN + MARKFH(IX,-IQ) = 1 + MARKFH(IX,-IQ+1) = 1 + ELSEIF(IX.LT.0.AND.IQ.LT.0) THEN + MARKFH(-IX,-IQ) = 1 + MARKFH(-IX+1,-IQ) = 1 + MARKFH(-IX,-IQ+1) = 1 + MARKFH(-IX+1,-IQ+1) = 1 + ENDIF + + RETURN + + 500 CONTINUE + + DO I = 1,30 + DO J = 1,7 + LFFCAL(J,I) = .FALSE. + ENDDO + ENDDO + + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r QFMARK ---> STOP'')') + WRITE(6,'( '' ------------------------------------'')') + WRITE(6,'( '' Input x :'',E12.5)') X + WRITE(6,'( '' Input Q2 :'',E12.5)') Q + IF(IERR.EQ.1) THEN + WRITE(6,'(/'' Value of x outside allowed range [0,1]'')') + ELSEIF(IERR.EQ.2) THEN + WRITE(6,'(/'' Value of Q2 outside allowed range > 0'')') + ELSEIF(IERR.EQ.3) THEN + WRITE(6,'(/'' Value of x and/or Q2 outside grid'')') + IDUM = ICUTXQ(X,Q,1) + ENDIF + + CALL QTRACE('QFMARK ',1) + + STOP + + END + +!DECK ID>, QFMNUL. + +! ================= + SUBROUTINE QFMNUL +! ================= + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + CALL QTRACE('QFMNUL ',0) + +!-- Clear gridpoints for fast structure function calculation + + CALL QNINUL(MARKFF,MXX*MQ2) + CALL QNINUL(MARKQQ,MQ2) + CALL QNINUL(IDFAST,7*30) + NDFAST = 30 + LMARK = .FALSE. + + DO I = 1,30 + DO J = 1,7 + LFFCAL(J,I) = .FALSE. + ENDDO + ENDDO + + RETURN + END + +!DECK ID>, STFCLR. + +! ================= + SUBROUTINE STFCLR +! ================= + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + +!-- Clear memory allocation for STFAST + + CALL QTRACE('STFCLR ',0) + + CALL QNINUL(IDFAST,7*30) + NDFAST = 30 + + DO I = 1,30 + DO J = 1,7 + LFFCAL(J,I) = .FALSE. + ENDDO + ENDDO + + RETURN + END + +!DECK ID>, QNFILW. + +! ================================ + SUBROUTINE QNFILW(IQLIST,NQLIST) +! ================================ + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + LOGICAL LTIME + REAL T_START,T_END,T_SPENT + COMMON/QCTIME/T_START(10),T_END(10),T_SPENT(10),N_CALLS(10), & + &E_CALLS(10),LTIME + COMMON/QCFCNT/IFCNT(-1:1,5) + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + REAL & + &WGTFF1,WGTFG1, & + &WGTGF1,WGTGG1, & + &WGTPP2,WGTPM2,WGTNS2, & + &WGTFF2,WGTFG2, & + &WGTGF2,WGTGG2, & + &WGTC2Q,WGTC2G,YNTC2Q, & + &WGTCLQ,WGTCLG,WGTC3Q + + COMMON/QCWEIT/ & + &WGTFF1(MXX*(MXX+1)/2) ,WGTFG1(MXX*(MXX+1)/2,3:5), & + &WGTGF1(MXX*(MXX+1)/2) ,WGTGG1(MXX*(MXX+1)/2,3:5), & + &WGTPP2(MXX*(MXX+1)/2,3:5),WGTPM2(MXX*(MXX+1)/2,3:5), & + &WGTNS2(MXX*(MXX+1)/2,3:5), & + &WGTFF2(MXX*(MXX+1)/2,3:5),WGTFG2(MXX*(MXX+1)/2,3:5), & + &WGTGF2(MXX*(MXX+1)/2,3:5),WGTGG2(MXX*(MXX+1)/2,3:5), & + &WGTC2Q(MXX*(MXX+1)/2) ,WGTC2G(MXX*(MXX+1)/2,3:5), & + &WGTCLQ(MXX*(MXX+1)/2) ,WGTCLG(MXX*(MXX+1)/2,3:5), & + &WGTC3Q(MXX*(MXX+1)/2) ,YNTC2Q(MXX) + + COMMON/QCWADR/ IWADR(MXX,MXX) + + + DIMENSION IQLIST(*) + + IF(LTIME) CALL TIMEX_LHA(T_START(2)) + + CALL QTRACE('QNFILW ',0) + + IF(NXX.EQ.0.OR.NQ2.EQ.0) THEN + IERR = 1 + GOTO 500 + ENDIF + +!-- Invalidate all evolutions + CALL QNFALS(LEVDONE,MXX*10) + +!-- Setup the adresses + DO IX0 = 1,MXX + DO IX = IX0,MXX + IWADR(IX,IX0) = IWTAD(IX,IX0) + ENDDO + ENDDO + +!-- Now calculate weights + IF(LW1ANA) THEN + DO 30 NF = 3,5 + CALL FILLO1(NF) + 30 CONTINUE + LW1NUM = .FALSE. + LWT1OK = .TRUE. + WRITE(6,'(/'' QNFILW: Calculate LO weights analytically'')') + ENDIF + + I1 = 0 + I2 = 0 + I3 = 0 + IF(LW1NUM) THEN + I1 = 1 + LWT1OK = .TRUE. + WRITE(6,'(/'' QNFILW: Calculate LO weights numerically'')') + ENDIF + IF(LW2NUM) THEN + I2 = 1 + LWT2OK = .TRUE. + WRITE(6,'(/'' QNFILW: Calculate NLO weights'')') + ENDIF + IF(LW2STF) THEN + I3 = 1 + LWTFOK = .TRUE. + WRITE(6,'(/'' QNFILW: Calculate F2 weights'')') + ENDIF + + DO 40 NF = 3,5 + CALL FILLWF(I1,I2,I3,NF) + 40 END DO + + IF(LWF2C.OR.LWF2B.OR.LWFLC.OR.LWFLB) THEN + +!--- Check charm, bottom mass + IF(.NOT.(0..LT.CBMSTF(4) .AND. CBMSTF(4).EQ.CBMSTF(5) .AND. & + & CBMSTF(4).LT.CBMSTF(6) .AND. CBMSTF(6).EQ.CBMSTF(7))) THEN + IERR = 2 + GOTO 500 + ENDIF + + IF(LWF2C) THEN + LWFCOK = .TRUE. + CALL FIL_F2H(4) + WRITE(6,'(/'' QNFILW: Calculate F2c weights'')') + ENDIF + IF(LWF2B) THEN + LWFBOK = .TRUE. + CALL FIL_F2H(6) + WRITE(6,'(/'' QNFILW: Calculate F2b weights'')') + ENDIF + IF(LWFLC) THEN + LWLCOK = .TRUE. + CALL FIL_FLH(5) + WRITE(6,'(/'' QNFILW: Calculate FLc weights'')') + ENDIF + IF(LWFLB) THEN + LWLBOK = .TRUE. + CALL FIL_FLH(7) + WRITE(6,'(/'' QNFILW: Calculate FLb weights'')') + ENDIF + + ENDIF + + WRITE(6,'(/)') + + IF(LTIME) THEN + CALL TIMEX_LHA(T_END(2)) + T_SPENT(2) = T_SPENT(2)+T_END(2)-T_START(2) + N_CALLS(2) = N_CALLS(2)+1 + ENDIF + + RETURN + + 500 CONTINUE + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r QNFILW ---> STOP'')') + WRITE(6,'( '' ------------------------------------'')') + IF(IERR.EQ.1) THEN + WRITE(6,'(/'' No x-Q2 grid available'')') + ENDIF + IF(IERR.EQ.2) THEN + WRITE(6,'( '' Cmass (F2c,FLc) ='',2E12.5)') CBMSTF(4),CBMSTF(5) + WRITE(6,'( '' Bmass (F2b,FLb) ='',2E12.5)') CBMSTF(6),CBMSTF(7) + WRITE(6,'(/'' Masses not in ascending order or not equal'', & + & '' for F2 and FL'')') + ENDIF + + CALL QTRACE('QNFILW ',1) + + STOP + + END + +!DECK ID>, QNGETW. + +! =============================================== + DOUBLE PRECISION FUNCTION QNGETW(OPT,IX0,IX,IQ) +! =============================================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + REAL & + &WGTFF1,WGTFG1, & + &WGTGF1,WGTGG1, & + &WGTPP2,WGTPM2,WGTNS2, & + &WGTFF2,WGTFG2, & + &WGTGF2,WGTGG2, & + &WGTC2Q,WGTC2G,YNTC2Q, & + &WGTCLQ,WGTCLG,WGTC3Q + + COMMON/QCWEIT/ & + &WGTFF1(MXX*(MXX+1)/2) ,WGTFG1(MXX*(MXX+1)/2,3:5), & + &WGTGF1(MXX*(MXX+1)/2) ,WGTGG1(MXX*(MXX+1)/2,3:5), & + &WGTPP2(MXX*(MXX+1)/2,3:5),WGTPM2(MXX*(MXX+1)/2,3:5), & + &WGTNS2(MXX*(MXX+1)/2,3:5), & + &WGTFF2(MXX*(MXX+1)/2,3:5),WGTFG2(MXX*(MXX+1)/2,3:5), & + &WGTGF2(MXX*(MXX+1)/2,3:5),WGTGG2(MXX*(MXX+1)/2,3:5), & + &WGTC2Q(MXX*(MXX+1)/2) ,WGTC2G(MXX*(MXX+1)/2,3:5), & + &WGTCLQ(MXX*(MXX+1)/2) ,WGTCLG(MXX*(MXX+1)/2,3:5), & + &WGTC3Q(MXX*(MXX+1)/2) ,YNTC2Q(MXX) + + COMMON/QCWADR/ IWADR(MXX,MXX) + + + REAL & + &WH_C0KG,WH_C1KG,WH_C1BKG, & + &WH_C1KQ,WH_C1BKQ,WH_D1KQ,WH_D1BKQ + + COMMON/QCHWGT/ & + &WH_C0KG(0:MXX,MQ2,4:7), & + &WH_C1KG(0:MXX,MQ2,4:7),WH_C1BKG(0:MXX,MQ2,4:7), & + &WH_C1KQ(0:MXX,MQ2,4:7),WH_C1BKQ(0:MXX,MQ2,4:7), & + &WH_D1KQ(0:MXX,MQ2,4:7),WH_D1BKQ(0:MXX,MQ2,4:7) + + + CHARACTER*(*) OPT + CHARACTER*8 OPT8 + + CALL QTRACE('QNGETW ',0) + + IERR = 0 + IF(IX0.LE.0.OR.IX0.GT.MXX-1) THEN + IERR = 1 + GOTO 500 + ENDIF + IF(IX.LE.0.OR.IX.GT.MXX-1) THEN + IERR = 1 + GOTO 500 + ENDIF + IF(IQ.LE.0.OR.IQ.GT.MQ2-1) THEN + IERR = 1 + GOTO 500 + ENDIF + + NF = NFMAP(IQ) + IF(NF.LT.3.OR.NF.GT.5) THEN + IERR = 2 + GOTO 500 + ENDIF + + IF(IX.LT.IX0) THEN + QNGETW = 0. + RETURN + ENDIF + + LEN = MIN(LENOCC_LHA(OPT),8) + OPT8(1:LEN) = OPT(1:LEN) + CALL CLTOU_LHA(OPT8) + + IF(OPT8(1:6).EQ.'WGTFF1') THEN + QNGETW = WGTFF1(IWTAD(IX,IX0)) + ELSEIF(OPT8(1:6).EQ.'WGTFG1') THEN + QNGETW = WGTFG1(IWTAD(IX,IX0),NF) + ELSEIF(OPT8(1:6).EQ.'WGTGF1') THEN + QNGETW = WGTGF1(IWTAD(IX,IX0)) + ELSEIF(OPT8(1:6).EQ.'WGTGG1') THEN + QNGETW = WGTGG1(IWTAD(IX,IX0),NF) + ELSEIF(OPT8(1:6).EQ.'WGTPP2') THEN + QNGETW = WGTPP2(IWTAD(IX,IX0),NF) + ELSEIF(OPT8(1:6).EQ.'WGTPM2') THEN + QNGETW = WGTPM2(IWTAD(IX,IX0),NF) + ELSEIF(OPT8(1:6).EQ.'WGTNS2') THEN + QNGETW = WGTNS2(IWTAD(IX,IX0),NF) + ELSEIF(OPT8(1:6).EQ.'WGTFF2') THEN + QNGETW = WGTFF2(IWTAD(IX,IX0),NF) + ELSEIF(OPT8(1:6).EQ.'WGTFG2') THEN + QNGETW = WGTFG2(IWTAD(IX,IX0),NF) + ELSEIF(OPT8(1:6).EQ.'WGTGF2') THEN + QNGETW = WGTGF2(IWTAD(IX,IX0),NF) + ELSEIF(OPT8(1:6).EQ.'WGTGG2') THEN + QNGETW = WGTGG2(IWTAD(IX,IX0),NF) + ELSEIF(OPT8(1:6).EQ.'WGTC2Q') THEN + QNGETW = WGTC2Q(IWTAD(IX,IX0)) + ELSEIF(OPT8(1:6).EQ.'WGTC2G') THEN + QNGETW = WGTC2G(IWTAD(IX,IX0),NF) + ELSEIF(OPT8(1:6).EQ.'WGTCLQ') THEN + QNGETW = WGTCLQ(IWTAD(IX,IX0)) + ELSEIF(OPT8(1:6).EQ.'WGTCLG') THEN + QNGETW = WGTCLG(IWTAD(IX,IX0),NF) + ELSEIF(OPT8(1:6).EQ.'WGTC3Q') THEN + QNGETW = WGTC3Q(IWTAD(IX,IX0)) + ELSEIF(OPT8(1:7).EQ.'WH_C02G') THEN + QNGETW = WH_C0KG(IX-IX0,IQ,4) + ELSEIF(OPT8(1:7).EQ.'WH_C12G') THEN + QNGETW = WH_C1KG(IX-IX0,IQ,4) + ELSEIF(OPT8(1:8).EQ.'WH_C1B2G') THEN + QNGETW = WH_C1BKG(IX-IX0,IQ,4) + ELSEIF(OPT8(1:7).EQ.'WH_C12Q') THEN + QNGETW = WH_C1KQ(IX-IX0,IQ,4) + ELSEIF(OPT8(1:8).EQ.'WH_C1B2Q') THEN + QNGETW = WH_C1BKQ(IX-IX0,IQ,4) + ELSEIF(OPT8(1:7).EQ.'WH_D12Q') THEN + QNGETW = WH_D1KQ(IX-IX0,IQ,4) + ELSEIF(OPT8(1:8).EQ.'WH_D1B2Q') THEN + QNGETW = WH_D1BKQ(IX-IX0,IQ,4) + ELSEIF(OPT8(1:7).EQ.'WH_C0LG') THEN + QNGETW = WH_C0KG(IX-IX0,IQ,5) + ELSEIF(OPT8(1:7).EQ.'WH_C1LG') THEN + QNGETW = WH_C1KG(IX-IX0,IQ,5) + ELSEIF(OPT8(1:8).EQ.'WH_C1BLG') THEN + QNGETW = WH_C1BKG(IX-IX0,IQ,5) + ELSEIF(OPT8(1:7).EQ.'WH_C1LQ') THEN + QNGETW = WH_C1KQ(IX-IX0,IQ,5) + ELSEIF(OPT8(1:8).EQ.'WH_C1BLQ') THEN + QNGETW = WH_C1BKQ(IX-IX0,IQ,5) + ELSEIF(OPT8(1:7).EQ.'WH_D1LQ') THEN + QNGETW = WH_D1KQ(IX-IX0,IQ,5) + ELSEIF(OPT8(1:8).EQ.'WH_D1BLQ') THEN + QNGETW = WH_D1BKQ(IX-IX0,IQ,5) + ELSE + IERR = 3 + GOTO 500 + ENDIF + + RETURN + + 500 CONTINUE + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r QNGETW ---> STOP'')') + WRITE(6,'( '' ------------------------------------'')') + WRITE(6,'( '' Input OPT :'',A)') OPT + WRITE(6,'( '' IX0 :'',I10)') IX0 + WRITE(6,'( '' IX :'',I10)') IX + WRITE(6,'( '' IQ :'',I10)') IQ + IF(IERR.EQ.1) THEN + WRITE(6,'(/'' IX0, IX and/or IQ outside allowed range'')') + ELSEIF(IERR.EQ.2) THEN + WRITE(6,'(/'' NF(IX,IQ) ='',I3,'' outside allowed range'')') NF + ELSEIF(IERR.EQ.3) THEN + WRITE(6,'(/'' Unknown option'')') + ENDIF + + CALL QTRACE('QNGETW ',1) + + STOP + + END + +!DECK ID>, QSTRIP. + +! ================================= + SUBROUTINE QSTRIP(NAMEIN,NAMEOUT) +! ================================= + +!--- Truncate NAMEIN to 5 characters and convert to upper case + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + CHARACTER*(*) NAMEIN + CHARACTER*5 NAMEOUT + + LEN = MIN(LENOCC_LHA(NAMEIN),5) + NAMEOUT = ' ' + NAMEOUT(1:LEN) = NAMEIN(1:LEN) + CALL CLTOU_LHA(NAMEOUT) + + RETURN + END + +!DECK ID>, CHKNAM. + +! ==================================== + SUBROUTINE CHKNAM(ID,NAME,SNAME,NAM) +! ==================================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + CHARACTER*5 PNAM,STFNAM + LOGICAL LNFP + COMMON /QCLNFP/ LNFP(0:30,3:5) + COMMON /QCPNAM/ PNAM(0:30) + COMMON /QCPWGT/ PWGT(0:10,0:30,3:5) + COMMON /QCFNAM/ STFNAM(7) + + + CHARACTER*(*) NAME, SNAME + CHARACTER*5 NAM + + LEN = MIN(LENOCC_LHA(NAME),5) + NAM = ' ' + NAM(1:LEN) = NAME(1:LEN) + CALL CLTOU_LHA(NAM) + + IF(NAM.EQ.' ') THEN + IERR = 1 + GOTO 500 + ENDIF + + IF(NAM.EQ.'FREE ') THEN + PNAM(ID) = NAM + LNFP(ID,3) = .FALSE. + LNFP(ID,4) = .FALSE. + LNFP(ID,5) = .FALSE. + IF(ID.LE.10) THEN + DO JD = 0,30 + PWGT(ID,JD,3) = 0. + PWGT(ID,JD,4) = 0. + PWGT(ID,JD,5) = 0. + ENDDO + ELSE + DO JD = 0,10 + PWGT(JD,ID,3) = 0. + PWGT(JD,ID,4) = 0. + PWGT(JD,ID,5) = 0. + ENDDO + ENDIF + RETURN + ENDIF + + IF(PNAM(ID).NE.'FREE '.AND.PNAM(ID).NE.NAM) THEN + IERR = 2 + GOTO 500 + ENDIF + + DO JD = 0,30 + IF(JD.EQ.ID) EXIT + IF(PNAM(JD).EQ.NAM) THEN + IERR = 3 + GOTO 500 + ENDIF + END DO + + RETURN + + 500 CONTINUE + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r '',A,'' ---> STOP'')') & + & SNAME + WRITE(6,'( '' ------------------------------------'')') + WRITE(6,'( '' Input ID :'',I10)') ID + WRITE(6,'( '' Input NAME :'',A)') NAM + IF(IERR.EQ.1) THEN + WRITE(6,'(/'' Blank name not allowed'')') + ELSEIF(IERR.EQ.2) THEN + WRITE(6,'(/'' ID already booked'')') + ELSEIF(IERR.EQ.3) THEN + WRITE(6,'(/'' NAME already used'')') + ENDIF + + CALL QTRACE('CHKNAM ',1) + + STOP + + END + +!DECK ID>, QNBOOK. + +! ========================== + SUBROUTINE QNBOOK(ID,NAME) +! ========================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + CHARACTER*5 PNAM,STFNAM + LOGICAL LNFP + COMMON /QCLNFP/ LNFP(0:30,3:5) + COMMON /QCPNAM/ PNAM(0:30) + COMMON /QCPWGT/ PWGT(0:10,0:30,3:5) + COMMON /QCFNAM/ STFNAM(7) + + + CHARACTER*(*) NAME + CHARACTER*5 NAM + + CALL QTRACE('QNBOOK ',0) + + CALL CHKNAM(ID,NAME,'QNBOOK',NAM) + + PNAM(ID) = NAM + LNFP(ID,3) = .TRUE. + LNFP(ID,4) = .TRUE. + LNFP(ID,5) = .TRUE. + PWGT(ID,ID,3) = 1. + PWGT(ID,ID,4) = 1. + PWGT(ID,ID,5) = 1. + + RETURN + END + +!DECK ID>, QNLINC. + +! =================================== + SUBROUTINE QNLINC(ID,NAME,NF,WEITS) +! =================================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + CHARACTER*5 PNAM,STFNAM + LOGICAL LNFP + COMMON /QCLNFP/ LNFP(0:30,3:5) + COMMON /QCPNAM/ PNAM(0:30) + COMMON /QCPWGT/ PWGT(0:10,0:30,3:5) + COMMON /QCFNAM/ STFNAM(7) + + + CHARACTER*(*) NAME + CHARACTER*5 NAM + DIMENSION WEITS(10) + + CALL QTRACE('QNLINC ',0) + + IF(ID.LE.10.OR.ID.GE.31) THEN + IERR = 1 + GOTO 500 + ENDIF + + IF(NF.LT.3 .OR.NF.GT.5 ) THEN + IERR = 2 + GOTO 500 + ENDIF + + CALL CHKNAM(ID,NAME,'QNLINC',NAM) + + PNAM(ID) = NAM + LNFP(ID,NF) = .TRUE. + DO 20 I=1,10 + PWGT(I,ID,NF) = WEITS(I) + 20 END DO + + RETURN + + 500 CONTINUE + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r QNLINC ---> STOP'')') + WRITE(6,'( '' ------------------------------------'')') + WRITE(6,'( '' Input ID :'',I0)') ID + WRITE(6,'( '' NAME :'',A)') NAME + WRITE(6,'( '' NF :'',I0)') NF + WRITE(6,'( '' FACTORS(1):'',E12.5)') WEITS(1) + IF(IERR.EQ.1) THEN + WRITE(6,'(/'' ID outside allowed range [11,30]'')') + ELSEIF(IERR.EQ.2) THEN + WRITE(6,'(/'' NF outside allowed range [3,5]'')') + ENDIF + + CALL QTRACE('QNLINC ',1) + + STOP + + END + +!DECK ID>, QNGIVE. + +! =================================== + SUBROUTINE QNGIVE(ID,NF,NAME,WEITS) +! =================================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + CHARACTER*5 PNAM,STFNAM + LOGICAL LNFP + COMMON /QCLNFP/ LNFP(0:30,3:5) + COMMON /QCPNAM/ PNAM(0:30) + COMMON /QCPWGT/ PWGT(0:10,0:30,3:5) + COMMON /QCFNAM/ STFNAM(7) + + + CHARACTER*5 NAME + DIMENSION WEITS(10) + + CALL QTRACE('QNGIVE ',1) + + IF(ID.LT.0.OR.ID.GT.30.OR.NF.LT.3.OR.NF.GT.5) THEN + + NAME = 'NULL ' + DO 10 I=1,10 + WEITS(I) = 0. + 10 CONTINUE + + ELSE + + NAME = PNAM(ID) + DO 15 I=1,10 + WEITS(I) = PWGT(I,ID,NF) + 15 CONTINUE + + ENDIF + + RETURN + END + +!DECK ID>, IDCHEK. + +! ============================= + INTEGER FUNCTION IPDFID(UNAM) +! ============================= + +!--- IPDFID = identifier of memory resident quark distn + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + CHARACTER*(*) UNAM + CHARACTER*5 NAM + + + CHARACTER*5 PNAM,STFNAM + LOGICAL LNFP + COMMON /QCLNFP/ LNFP(0:30,3:5) + COMMON /QCPNAM/ PNAM(0:30) + COMMON /QCPWGT/ PWGT(0:10,0:30,3:5) + COMMON /QCFNAM/ STFNAM(7) + + + CALL QTRACE('IPDFID ',0) + + CALL QSTRIP(UNAM,NAM) + + IF(NAM.EQ.' '.OR.NAM.EQ.'FREE ') THEN + GOTO 500 + ENDIF + + ID = -1 + DO I = 1,10 + IF(NAM.EQ.PNAM(I)) ID = I + ENDDO + + IPDFID = ID + + IF(ID.EQ.-1) THEN + GOTO 500 + ENDIF + + RETURN + + 500 CONTINUE + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r IPDFID ---> STOP'')') + WRITE(6,'( '' ------------------------------------'')') + WRITE(6,'( '' Input NAME :'',A)') UNAM + WRITE(6,'(/'' NAME not booked at all or NAME does not refer''/ & + & '' to a memory resident quark distribution'')') + IF(NAM(1:1).EQ.' ') & + &WRITE(6,'(/'' WARNING: NAME has one or more leading blanks'')') + + CALL QTRACE('IPDFID ',1) + + STOP + END + + +!DECK ID>, IDCHEK. + +! ============================================ + INTEGER FUNCTION IDCHEK(NAM,NF,SRNAME,ISTOP) +! ============================================ + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + CHARACTER*6 SRNAME + CHARACTER*5 NAMLAST,NAM + + + CHARACTER*5 PNAM,STFNAM + LOGICAL LNFP + COMMON /QCLNFP/ LNFP(0:30,3:5) + COMMON /QCPNAM/ PNAM(0:30) + COMMON /QCPWGT/ PWGT(0:10,0:30,3:5) + COMMON /QCFNAM/ STFNAM(7) + + + SAVE IDLAST,NAMLAST + + DATA IDLAST / 0 / + DATA NAMLAST / ' ' / + + IDCHEK = -1 + + IF(NAM.EQ.' '.OR.NAM.EQ.'FREE '.OR. & + & NF.LT.3.OR.NF.GT.5) THEN + IF(ISTOP.EQ.1) THEN + IERR = 1 + GOTO 500 + ENDIF + RETURN + ENDIF + + ID = -1 + IF(NAM.EQ.NAMLAST.AND.LNFP(IDLAST,NF)) THEN + ID = IDLAST + ELSE + DO 10 I = 0,30 + IF(NAM.EQ.PNAM(I).AND.LNFP(I,NF)) ID = I + 10 CONTINUE + IDLAST = ID + NAMLAST = NAM + ENDIF + + IDCHEK = ID + + IF(ID.EQ.-1.AND.ISTOP.EQ.1) THEN + IERR = 2 + GOTO 500 + ENDIF + + RETURN + + 500 CONTINUE + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r '',A,'' ---> STOP'')') & + & SRNAME + WRITE(6,'( '' ------------------------------------'')') + WRITE(6,'( '' Input NAME :'',A)') NAM + WRITE(6,'( '' NF :'',I10)') NF + IF(IERR.EQ.1) THEN + WRITE(6,'(/'' Input name not allowed and/or NF outside'', & + & '' the allowed range [3,5]'')') + ELSEIF(IERR.EQ.2) THEN + WRITE(6,'(/'' NAME not booked at all or, if NAME refers to''/ & + & '' a linear combination, it might not have been''/ & + & '' booked for NF flavours'')') + IF(NAM(1:1).EQ.' ') & + & WRITE(6,'(/'' WARNING: NAME has one or more leading blanks'')') + ENDIF + + CALL QTRACE('IDCHEK ',1) + + STOP + END + +!DECK ID>, QNLIST. + +! ====================== + SUBROUTINE QNLIST(LUN) +! ====================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + CHARACTER*5 NAM + CHARACTER*3 II + + + CHARACTER*5 PNAM,STFNAM + LOGICAL LNFP + COMMON /QCLNFP/ LNFP(0:30,3:5) + COMMON /QCPNAM/ PNAM(0:30) + COMMON /QCPWGT/ PWGT(0:10,0:30,3:5) + COMMON /QCFNAM/ STFNAM(7) + + + WRITE(LUN,'(////)') + WRITE(LUN,'(1X,''+'',13(''-''),''+'',60(''-''),''+'')') + WRITE(LUN,'('' | | W_'',I2, & + & 9('' W_'',I2),'' |'')') (J, J=1,10) + WRITE(LUN,'('' | ID NAME nf | '',A4, & + & 9(2X,A4),'' |'')') (PNAM(J),J=1,10) + WRITE(LUN,'(1X,''+'',13(''-''),''+'',60(''-''),''+'')') + DO I = 0,10 + IF(IDCHEK(PNAM(I),3,' ',0).EQ.-1) EXIT + WRITE(LUN,'('' |'',I3,1X,A5,'' |'',F5.2, & + &9(F6.2),'' |'')') I, PNAM(I),(PWGT(J,I,3),J=1,10) + END DO + WRITE(LUN,'(1X,''+'',13(''-''),''+'',60(''-''),''+'')') + DO 20 I = 11,30 + NAM = PNAM(I) + WRITE(II,'(I3)') I + IF(IDCHEK(PNAM(I),3,' ',0).NE.-1) THEN + WRITE(LUN,'('' |'',A3,1X,A5,'' 3 |'',F5.2, & + & 9(F6.2),'' |'')') II, NAM,(PWGT(J,I,3),J=1,10) + NAM = ' ' + II = ' ' + ENDIF + IF(IDCHEK(PNAM(I),4,' ',0).NE.-1) THEN + WRITE(LUN,'('' |'',A3,1X,A5,'' 4 |'',F5.2, & + & 9(F6.2),'' |'')') II, NAM,(PWGT(J,I,4),J=1,10) + NAM = ' ' + II = ' ' + ENDIF + IF(IDCHEK(PNAM(I),5,' ',0).NE.-1) THEN + WRITE(LUN,'('' |'',A3,1X,A5,'' 5 |'',F5.2, & + & 9(F6.2),'' |'')') II, NAM, (PWGT(J,I,5),J=1,10) + NAM = ' ' + II = ' ' + ENDIF + 20 END DO + WRITE(LUN,'(1X,''+'',13(''-''),''+'',60(''-''),''+'')') + WRITE(LUN,'(////)') + + RETURN + END + +!DECK ID>, QNPSET. +! ================================= + SUBROUTINE QNPSET(UNAM,IX,IQ,VAL) +! ================================= + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + CHARACTER*(*) UNAM + CHARACTER*5 NAME + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + + + CHARACTER*5 PNAM,STFNAM + LOGICAL LNFP + COMMON /QCLNFP/ LNFP(0:30,3:5) + COMMON /QCPNAM/ PNAM(0:30) + COMMON /QCPWGT/ PWGT(0:10,0:30,3:5) + COMMON /QCFNAM/ STFNAM(7) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + CALL QTRACE('QNPSET ',0) + + IF(NXX.EQ.0.OR.NQ2.EQ.0) THEN + IERR = 1 + GOTO 500 + ENDIF + + CALL QSTRIP(UNAM,NAME) + + ID = IDCHEK(NAME,4,'QNPSET',1) + + IF(ID.EQ.-1) RETURN + + IF(IX.LT.1.OR.IX.GT.NXX) THEN + IERR = 2 + GOTO 500 + ENDIF + + IF(IQ.LT.1.OR.IQ.GT.NQ2) THEN + IERR = 2 + GOTO 500 + ENDIF + + IF(ID.LT.0.OR.ID.GT.10) THEN + IERR = 3 + GOTO 500 + ENDIF + +!-- If a different input value, invalidate evolution for this +!-- and all lower x-grid points + IF(VAL.NE.PDFQCD(IX,IQ,ID)) THEN + DO JX = 1,IX + LEVDONE(JX,MAX(ID,1)) = .FALSE. + ENDDO + ENDIF + + PDFQCD(IX,IQ,ID) = VAL + + DO I = 1,30 + DO J = 1,7 + LFFCAL(J,I) = .FALSE. + ENDDO + ENDDO + + RETURN + + 500 CONTINUE + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r QNPSET ---> STOP'')') + WRITE(6,'( '' ------------------------------------'')') + WRITE(6,'( '' Input NAME :'',A)') UNAM + WRITE(6,'( '' IX :'',I10)') IX + WRITE(6,'( '' IQ :'',I10)') IQ + WRITE(6,'( '' Value :'',E12.5)') VAL + IF(IERR.EQ.1) THEN + WRITE(6,'(/'' No x-Q2 grid available'')') + ELSEIF(IERR.EQ.2) THEN + WRITE(6,'(/'' IX and/or IQ outside grid boundary'')') + ELSEIF(IERR.EQ.3) THEN + WRITE(6,'(/'' Apparently you try to assign a value'', & + & '' to a linear combination: no thank you'')') + ENDIF + + CALL QTRACE('QNPSET ',1) + + STOP + + END + +!DECK ID>, QADDSI. + +! ================================= + SUBROUTINE QADDSI(UNAM,IQ,FACTOR) +! ================================= + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + CHARACTER*(*) UNAM + CHARACTER*5 NAME + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + + + CHARACTER*5 PNAM,STFNAM + LOGICAL LNFP + COMMON /QCLNFP/ LNFP(0:30,3:5) + COMMON /QCPNAM/ PNAM(0:30) + COMMON /QCPWGT/ PWGT(0:10,0:30,3:5) + COMMON /QCFNAM/ STFNAM(7) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + CALL QTRACE('QADDSI ',0) + + IF(NXX.EQ.0.OR.NQ2.EQ.0) THEN + IERR = 1 + GOTO 500 + ENDIF + + CALL QSTRIP(UNAM,NAME) + + ID = IDCHEK(NAME,4,'QADDSI',1) + + IF(ID.EQ.-1) RETURN + + IF(ID.EQ.0.OR.ID.EQ.1) THEN + IERR = 2 + GOTO 500 + ENDIF + + IF(IQ.LT.1.OR.IQ.GT.NQ2) THEN + IERR = 3 + GOTO 500 + ENDIF + + IF(ID.LT.0.OR.ID.GT.10) THEN + IERR = 4 + GOTO 500 + ENDIF + + DO IX = 1,NXX +!-- Invalidate evolution of this pdf + LEVDONE(IX,MAX(ID,1)) = .FALSE. + PDFQCD(IX,IQ,ID) = PDFQCD(IX,IQ,ID)+ & + & FACTOR*PDFQCD(IX,IQ,1) + ENDDO + + DO I = 1,30 + DO J = 1,7 + LFFCAL(J,I) = .FALSE. + ENDDO + ENDDO + + RETURN + + 500 CONTINUE + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r QADDSI ---> STOP'')') + WRITE(6,'( '' ------------------------------------'')') + WRITE(6,'( '' Input NAME :'',A)') UNAM + WRITE(6,'( '' IQ :'',I10)') IQ + WRITE(6,'( '' Factor :'',E12.5)') FACTOR + IF(IERR.EQ.1) THEN + WRITE(6,'(/'' No x-Q2 grid available'')') + ELSEIF(IERR.EQ.2) THEN + WRITE(6,'(/'' This routine cannot be used'', & + & '' for singlet or gluon'')') + ELSEIF(IERR.EQ.3) THEN + WRITE(6,'(/'' IX and/or IQ outside grid boundary'')') + ELSEIF(IERR.EQ.4) THEN + WRITE(6,'(/'' Apparently you try to assign a value'', & + & '' to a linear combination: no thank you'')') + ENDIF + + CALL QTRACE('QADDSI ',1) + + STOP + + END + +!DECK ID>, QNPNUL. + +! ======================= + SUBROUTINE QNPNUL(UNAM) +! ======================= + +!--- Set parton distribution 'NAME' to zero. +!--- Called by user. + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + CHARACTER*(*) UNAM + CHARACTER*5 NAME + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + + + CHARACTER*5 PNAM,STFNAM + LOGICAL LNFP + COMMON /QCLNFP/ LNFP(0:30,3:5) + COMMON /QCPNAM/ PNAM(0:30) + COMMON /QCPWGT/ PWGT(0:10,0:30,3:5) + COMMON /QCFNAM/ STFNAM(7) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + CALL QTRACE('QNPNUL ',0) + + CALL QSTRIP(UNAM,NAME) + + ID = IDCHEK(NAME,4,'QNPNUL',1) + + IF(ID.EQ.-1) RETURN + + IF(ID.LT.0.OR.ID.GT.10) THEN + GOTO 500 + ENDIF + + DO IX = 1,MXX + DO IQ = 1,MQ2 + PDFQCD(IX,IQ,ID) = 0. + ENDDO + ENDDO + +!-- Invalidate all evolutions + CALL QNFALS(LEVDONE,MXX*10) + + DO I = 1,30 + DO J = 1,7 + LFFCAL(J,I) = .FALSE. + ENDDO + ENDDO + + RETURN + + 500 CONTINUE + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r QNPNUL ---> STOP'')') + WRITE(6,'( '' ------------------------------------'')') + WRITE(6,'( '' Input NAME :'',A)') UNAM + WRITE(6,'(/'' Apparently you try to clear'', & + & '' a linear combination: no thank you'')') + + CALL QTRACE('QNPNUL ',1) + + STOP + + END + +!DECK ID>, IX1CHK. + +! ============================== + INTEGER FUNCTION IX1CHK(ISTOP) +! ============================== + +!--- Check all pdfs are zero at NXX+1 (x = 1). +!--- IX1CHK = 0 : All ok. +!--- = 1 : Nonzero entry in gluon or singlet. +!--- = 2-10 : Nonzero entry in PDF 2-10. +!--- Called by user. + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + + + CHARACTER*5 PNAM,STFNAM + LOGICAL LNFP + COMMON /QCLNFP/ LNFP(0:30,3:5) + COMMON /QCPNAM/ PNAM(0:30) + COMMON /QCPWGT/ PWGT(0:10,0:30,3:5) + COMMON /QCFNAM/ STFNAM(7) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + CALL QTRACE('IX1CHK ',0) + + IERR = -1 + JQ = 0 + + DO ID = 0,10 + DO IQ = 1,NQ2 + IF(ABS(PDFQCD(NXX+1,IQ,ID)).GT.1.E-11) THEN + IERR = ID + JQ = IQ + ENDIF + ENDDO + ENDDO + + IF(IERR.EQ.-1) THEN + IX1CHK = 0 + RETURN + ENDIF + + IX1CHK = MAX(IERR,1) + IF(ISTOP.EQ.0) RETURN + + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r IX1CHK ---> STOP'')') + WRITE(6,'( '' ------------------------------------'')') + WRITE(6,'( '' Pdf identifier ID :'',I5)') IERR + WRITE(6,'( '' X = 1 gridpoint IX :'',I5)') NXX+1 + WRITE(6,'( '' Q2 gridpoint IQ :'',I5)') JQ + WRITE(6,'(/'' Pdf nonzero at x = 1;''/ & + & '' this should never happen....'')') + + CALL QTRACE('IX1CHK ',1) + + STOP + + END + +!DECK ID>, EVOLSG. + +! ================================ + SUBROUTINE EVOLSG(IQ0,IUQL,IUQH) +! ================================ + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + LOGICAL LTIME + REAL T_START,T_END,T_SPENT + COMMON/QCTIME/T_START(10),T_END(10),T_SPENT(10),N_CALLS(10), & + &E_CALLS(10),LTIME + COMMON/QCFCNT/IFCNT(-1:1,5) + + + IF(LTIME) CALL TIMEX_LHA(T_START(5)) + + CALL QTRACE('EVOLSG ',0) + + IF(NXX.EQ.0.OR.NQ2.EQ.0) THEN + IERR = 1 + GOTO 500 + ENDIF + + IQL = IUQL + IQH = IUQH + + IXL = MAX(ABS(IXFROMX(XMICUT)),1) + IQD = ABS(IQFROMQ(QMICUT)) + IQD = MAX(IQD,ABS(IQFROMQ(QMINAS))) + IQU = ABS(IQFROMQ(QMACUT)) + IF(IQD.NE.0) IQL = MAX(IQD,IQL) + IF(IQU.NE.0) IQH = MIN(IQU+1,IQH) + + IF(IQL.LE.0) IQL = 1 + IF(IQH.LE.0.OR.IQH.GT.NQ2) IQH = NQ2 + IF(IQL.EQ.IQ0.AND.IQH.EQ.IQ0) RETURN + IF(IQL.GE.IQH) THEN + IERR = 2 + GOTO 500 + ENDIF + IF(IQL.LT.1.OR.IQL.GE.NQ2) THEN + IERR = 3 + GOTO 500 + ENDIF + IF(IQH.LE.1.OR.IQH.GT.NQ2) THEN + IERR = 3 + GOTO 500 + ENDIF + IF(IQ0.LT.IQL.OR.IQ0.GT.IQH) THEN + IERR = 4 + GOTO 500 + ENDIF + IF(.NOT.LWT1OK) THEN + IERR = 5 + GOTO 500 + ENDIF + IF(IORD.EQ.2.AND..NOT.LWT2OK) THEN + IERR = 6 + GOTO 500 + ENDIF + + IRUN = 0 + IF(.NOT.LALFOK) THEN + CALL QFILAS('EVOLSG') + IRUN = 1 + ENDIF + IF(.NOT.LDQ2OK) THEN + CALL QDELQ2 + IRUN = 1 + ENDIF + + DO IX = 1,NXX + LE_DONE(IX) = LEVDONE(IX,1) + DO IQ = 1,NQ2 + FGLQCD(IX,IQ) = PDFQCD(IX,IQ,0) + FSIQCD(IX,IQ) = PDFQCD(IX,IQ,1) + ENDDO + ENDDO + + IF(IQ0.NE.IQ0_LAST(1) .OR. & + & IQL.NE.IQL_LAST(1) .OR. & + & IQH.NE.IQH_LAST(1) ) IRUN = 1 + + CALL APSI(IXL,IQ0,IQL,IQH,IRUN,EVL) + + IQ0_LAST(1) = IQ0 + IQL_LAST(1) = IQL + IQH_LAST(1) = IQH + + DO IX = 1,NXX + LEVDONE(IX,1) = LE_DONE(IX) + DO IQ = 1,NQ2 + PDFQCD(IX,IQ,0) = FGLQCD(IX,IQ) + PDFQCD(IX,IQ,1) = FSIQCD(IX,IQ) + ENDDO + ENDDO + + DO I = 1,30 + DO J = 1,7 + LFFCAL(J,I) = .FALSE. + ENDDO + ENDDO + + IF(LTIME) THEN + CALL TIMEX_LHA(T_END(5)) + T_SPENT(5) = T_SPENT(5)+T_END(5)-T_START(5) + N_CALLS(5) = N_CALLS(5)+1 + E_CALLS(5) = E_CALLS(5)+EVL + ENDIF + + RETURN + + 500 CONTINUE + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r EVOLSG ---> STOP'')') + WRITE(6,'( '' ------------------------------------'')') + WRITE(6,'( '' Input IQ0 :'',I5)') IQ0 + WRITE(6,'( '' IQLow :'',I5)') IUQL + WRITE(6,'( '' IQHigh :'',I5)') IUQH + IF(IERR.NE.1) THEN + WRITE(6,'(/'' After cuts IQ0, Q20 :'',I5,E12.5)') IQ0,Q2TAB(IQ0) + WRITE(6,'( '' IQL, Q2L :'',I5,E12.5)') IQL,Q2TAB(IQL) + WRITE(6,'( '' IQH, Q2H :'',I5,E12.5)') IQH,Q2TAB(IQH) + ENDIF + IF(IERR.EQ.1) THEN + WRITE(6,'(/'' No x-Q2 grid available'')') + ELSEIF(IERR.EQ.2) THEN + WRITE(6,'(/'' Value of IQL .ge. IQH'', & + & '' (after applying Q2 cuts, if any)'')') + ELSEIF(IERR.EQ.3) THEN + WRITE(6,'(/'' IQL and/or IQH outside grid boundary'')') + ELSEIF(IERR.EQ.4) THEN + WRITE(6,'(/'' IQ0 outside the range [IQL,IQH]'', & + & '' (after applying Q2 cuts, if any)'')') + ELSEIF(IERR.EQ.5) THEN + WRITE(6,'(/'' No LO weight tables available'', & + & '' (please call s/r QNFILW)'')') + ELSEIF(IERR.EQ.6) THEN + WRITE(6,'(/'' No NLO weight tables available'', & + & '' (please call s/r QNFILW)'')') + ENDIF + + CALL QTRACE('EVOLSG ',1) + + STOP + + END + + +!DECK ID>, APSI. +! ========================================= + SUBROUTINE APSI(IXL,IQ0,IQL,IQH,IRUN,EVL) +! ========================================= + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + REAL & + &WGTFF1,WGTFG1, & + &WGTGF1,WGTGG1, & + &WGTPP2,WGTPM2,WGTNS2, & + &WGTFF2,WGTFG2, & + &WGTGF2,WGTGG2, & + &WGTC2Q,WGTC2G,YNTC2Q, & + &WGTCLQ,WGTCLG,WGTC3Q + + COMMON/QCWEIT/ & + &WGTFF1(MXX*(MXX+1)/2) ,WGTFG1(MXX*(MXX+1)/2,3:5), & + &WGTGF1(MXX*(MXX+1)/2) ,WGTGG1(MXX*(MXX+1)/2,3:5), & + &WGTPP2(MXX*(MXX+1)/2,3:5),WGTPM2(MXX*(MXX+1)/2,3:5), & + &WGTNS2(MXX*(MXX+1)/2,3:5), & + &WGTFF2(MXX*(MXX+1)/2,3:5),WGTFG2(MXX*(MXX+1)/2,3:5), & + &WGTGF2(MXX*(MXX+1)/2,3:5),WGTGG2(MXX*(MXX+1)/2,3:5), & + &WGTC2Q(MXX*(MXX+1)/2) ,WGTC2G(MXX*(MXX+1)/2,3:5), & + &WGTCLQ(MXX*(MXX+1)/2) ,WGTCLG(MXX*(MXX+1)/2,3:5), & + &WGTC3Q(MXX*(MXX+1)/2) ,YNTC2Q(MXX) + + COMMON/QCWADR/ IWADR(MXX,MXX) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + LOGICAL LTIME + REAL T_START,T_END,T_SPENT + COMMON/QCTIME/T_START(10),T_END(10),T_SPENT(10),N_CALLS(10), & + &E_CALLS(10),LTIME + COMMON/QCFCNT/IFCNT(-1:1,5) + + + EVL = 0. + + FSI = FSIQCD(NXX,IQ0) + FGL = FGLQCD(NXX,IQ0) +! ------------------------------------------- + ! + IF(.NOT.LE_DONE(NXX) .OR. IRUN.EQ.1) THEN +! ------------------------------------------- + + NF = NFMAP(IQ0) + + WQQ = ALFAPQ(IQ0) * WGTFF1(IWADR(NXX,NXX)) + & + & ALFA2Q(IQ0) * WGTFF2(IWADR(NXX,NXX),NF) + WQG = ALFAPQ(IQ0) * WGTFG1(IWADR(NXX,NXX),NF) + & + & ALFA2Q(IQ0) * WGTFG2(IWADR(NXX,NXX),NF) + WGQ = ALFAPQ(IQ0) * WGTGF1(IWADR(NXX,NXX)) + & + & ALFA2Q(IQ0) * WGTGF2(IWADR(NXX,NXX),NF) + WGG = ALFAPQ(IQ0) * WGTGG1(IWADR(NXX,NXX),NF) + & + & ALFA2Q(IQ0) * WGTGG2(IWADR(NXX,NXX),NF) + + DSI = WQQ*FSI+WQG*FGL + DGL = WGQ*FSI+WGG*FGL + + FSI0 = FSI + DSI0 = DSI + FGL0 = FGL + DGL0 = DGL + FSIQCD(NXX,IQ0) = FSI + DSIQCD(NXX,IQ0) = DSI + FGLQCD(NXX,IQ0) = FGL + DGGQCD(NXX,IQ0) = DGL + EVL = EVL+1. + + DO 100 IQ = IQ0+1,IQH + DEL = DELUP(IQ) + NF = NFMAP(IQ) + WQQ = ALFAPQ(IQ) * WGTFF1(IWADR(NXX,NXX)) + & + & ALFA2Q(IQ) * WGTFF2(IWADR(NXX,NXX),NF) + WQG = ALFAPQ(IQ) * WGTFG1(IWADR(NXX,NXX),NF) + & + & ALFA2Q(IQ) * WGTFG2(IWADR(NXX,NXX),NF) + WGQ = ALFAPQ(IQ) * WGTGF1(IWADR(NXX,NXX)) + & + & ALFA2Q(IQ) * WGTGF2(IWADR(NXX,NXX),NF) + WGG = ALFAPQ(IQ) * WGTGG1(IWADR(NXX,NXX),NF) + & + & ALFA2Q(IQ) * WGTGG2(IWADR(NXX,NXX),NF) + AAS = 2.*FSI + DSI*DEL + BBS = 2. - WQQ*DEL + AAG = 2.*FGL + DGL*DEL + BBG = 2. - WGG*DEL + FSI = (AAS*BBG+WQG*AAG*DEL) / (BBS*BBG-WQG*WGQ*DEL*DEL) + FGL = (AAG*BBS+WGQ*AAS*DEL) / (BBG*BBS-WGQ*WQG*DEL*DEL) + DSI = WQQ*FSI+WQG*FGL + DGL = WGQ*FSI+WGG*FGL + FSIQCD(NXX,IQ) = FSI + DSIQCD(NXX,IQ) = DSI + FGLQCD(NXX,IQ) = FGL + DGGQCD(NXX,IQ) = DGL + 100 CONTINUE + EVL = EVL+IQH-IQ0 + + FSI = FSI0 + DSI = DSI0 + FGL = FGL0 + DGL = DGL0 + + DO 200 IQ = IQ0-1,IQL,-1 + DEL = DELDN(IQ) + NF = NFMAP(IQ) + WQQ = ALFAPQ(IQ) * WGTFF1(IWADR(NXX,NXX)) + & + & ALFA2Q(IQ) * WGTFF2(IWADR(NXX,NXX),NF) + WQG = ALFAPQ(IQ) * WGTFG1(IWADR(NXX,NXX),NF) + & + & ALFA2Q(IQ) * WGTFG2(IWADR(NXX,NXX),NF) + WGQ = ALFAPQ(IQ) * WGTGF1(IWADR(NXX,NXX)) + & + & ALFA2Q(IQ) * WGTGF2(IWADR(NXX,NXX),NF) + WGG = ALFAPQ(IQ) * WGTGG1(IWADR(NXX,NXX),NF) + & + & ALFA2Q(IQ) * WGTGG2(IWADR(NXX,NXX),NF) + AAS = 2.*FSI + DSI*DEL + BBS = 2. - WQQ*DEL + AAG = 2.*FGL + DGL*DEL + BBG = 2. - WGG*DEL + FSI = (AAS*BBG+WQG*AAG*DEL) / (BBS*BBG-WQG*WGQ*DEL*DEL) + FGL = (AAG*BBS+WGQ*AAS*DEL) / (BBG*BBS-WGQ*WQG*DEL*DEL) + DSI = WQQ*FSI+WQG*FGL + DGL = WGQ*FSI+WGG*FGL + FSIQCD(NXX,IQ) = FSI + DSIQCD(NXX,IQ) = DSI + FGLQCD(NXX,IQ) = FGL + DGGQCD(NXX,IQ) = DGL + 200 CONTINUE + EVL = EVL+IQ0-IQL + +! ------- + ! + ENDIF +! ------- + +! --------------------------- + ! + DO IX0 = NXX-1,IXL,-1 +! --------------------------- + + FSI = FSIQCD(IX0,IQ0) + FGL = FGLQCD(IX0,IQ0) + IF(LE_DONE(IX0) .AND. IRUN.EQ.0) EXIT + ALF = ALFAPQ(IQ0) + AL2 = ALFA2Q(IQ0) + SQQ1 = 0. + SQG1 = 0. + SGQ1 = 0. + SGG1 = 0. + SQQ2 = 0. + SQG2 = 0. + SGQ2 = 0. + SGG2 = 0. + NF = NFMAP(IQ0) + DO 220 IX = NXX,IX0+1,-1 + IADR = IWADR(IX,IX0) + SQQ1 = SQQ1 + WGTFF1(IADR) * FSIQCD(IX,IQ0) + SQQ2 = SQQ2 + WGTFF2(IADR,NF) * FSIQCD(IX,IQ0) + SQG1 = SQG1 + WGTFG1(IADR,NF) * FGLQCD(IX,IQ0) + SQG2 = SQG2 + WGTFG2(IADR,NF) * FGLQCD(IX,IQ0) + SGQ1 = SGQ1 + WGTGF1(IADR) * FSIQCD(IX,IQ0) + SGQ2 = SGQ2 + WGTGF2(IADR,NF) * FSIQCD(IX,IQ0) + SGG1 = SGG1 + WGTGG1(IADR,NF) * FGLQCD(IX,IQ0) + SGG2 = SGG2 + WGTGG2(IADR,NF) * FGLQCD(IX,IQ0) + 220 CONTINUE + IAD = IWADR(IX0,IX0) + SQQ = ALF*SQQ1 + AL2*SQQ2 + SQG = ALF*SQG1 + AL2*SQG2 + SGQ = ALF*SGQ1 + AL2*SGQ2 + SGG = ALF*SGG1 + AL2*SGG2 + WQQ = ALF* WGTFF1(IAD) + AL2*WGTFF2(IAD,NF) + WQG = ALF* WGTFG1(IAD,NF) + AL2*WGTFG2(IAD,NF) + WGQ = ALF* WGTGF1(IAD) + AL2*WGTGF2(IAD,NF) + WGG = ALF* WGTGG1(IAD,NF) + AL2*WGTGG2(IAD,NF) + DSI = WQQ*FSI+SQQ+WQG*FGL+SQG + DGL = WGQ*FSI+SGQ+WGG*FGL+SGG + + FSI0 = FSI + DSI0 = DSI + FGL0 = FGL + DGL0 = DGL + FSIQCD(IX0,IQ0) = FSI + DSIQCD(IX0,IQ0) = DSI + FGLQCD(IX0,IQ0) = FGL + DGGQCD(IX0,IQ0) = DGL + EVL = EVL+NXX-IX0+1 + + DO 250 IQ = IQ0+1,IQH + IF(IFAILC(IX0,IQ).NE.0) GOTO 250 + ALF = ALFAPQ(IQ) + AL2 = ALFA2Q(IQ) + DEL = DELUP(IQ) + SQQ1 = 0. + SQG1 = 0. + SGQ1 = 0. + SGG1 = 0. + SQQ2 = 0. + SQG2 = 0. + SGQ2 = 0. + SGG2 = 0. + NF = NFMAP(IQ) + DO 230 IX = NXX,IX0+1,-1 + IADR = IWADR(IX,IX0) + SQQ1 = SQQ1 + WGTFF1(IADR) * FSIQCD(IX,IQ) + SQQ2 = SQQ2 + WGTFF2(IADR,NF) * FSIQCD(IX,IQ) + SQG1 = SQG1 + WGTFG1(IADR,NF) * FGLQCD(IX,IQ) + SQG2 = SQG2 + WGTFG2(IADR,NF) * FGLQCD(IX,IQ) + SGQ1 = SGQ1 + WGTGF1(IADR) * FSIQCD(IX,IQ) + SGQ2 = SGQ2 + WGTGF2(IADR,NF) * FSIQCD(IX,IQ) + SGG1 = SGG1 + WGTGG1(IADR,NF) * FGLQCD(IX,IQ) + SGG2 = SGG2 + WGTGG2(IADR,NF) * FGLQCD(IX,IQ) + 230 CONTINUE + IAD = IWADR(IX0,IX0) + SQQ = ALF*SQQ1 + AL2*SQQ2 + SQG = ALF*SQG1 + AL2*SQG2 + SGQ = ALF*SGQ1 + AL2*SGQ2 + SGG = ALF*SGG1 + AL2*SGG2 + WQQ = ALF* WGTFF1(IAD) + AL2*WGTFF2(IAD,NF) + WQG = ALF* WGTFG1(IAD,NF) + AL2*WGTFG2(IAD,NF) + WGQ = ALF* WGTGF1(IAD) + AL2*WGTGF2(IAD,NF) + WGG = ALF* WGTGG1(IAD,NF) + AL2*WGTGG2(IAD,NF) + AAS = 2.*FSI + (DSI+SQQ+SQG)*DEL + BBS = 2. - WQQ*DEL + AAG = 2.*FGL + (DGL+SGQ+SGG)*DEL + BBG = 2. - WGG*DEL + FSI = (AAS*BBG+WQG*AAG*DEL) / (BBS*BBG-WQG*WGQ*DEL*DEL) + FGL = (AAG*BBS+WGQ*AAS*DEL) / (BBG*BBS-WGQ*WQG*DEL*DEL) + DSI = WQQ*FSI+SQQ+WQG*FGL+SQG + DGL = WGQ*FSI+SGQ+WGG*FGL+SGG + FSIQCD(IX0,IQ) = FSI + DSIQCD(IX0,IQ) = DSI + FGLQCD(IX0,IQ) = FGL + DGGQCD(IX0,IQ) = DGL + EVL = EVL+NXX-IX0+1 + 250 CONTINUE + + FSI = FSI0 + DSI = DSI0 + FGL = FGL0 + DGL = DGL0 + + DO 270 IQ = IQ0-1,IQL,-1 + ALF = ALFAPQ(IQ) + AL2 = ALFA2Q(IQ) + DEL = DELDN(IQ) + SQQ1 = 0. + SQG1 = 0. + SGQ1 = 0. + SGG1 = 0. + SQQ2 = 0. + SQG2 = 0. + SGQ2 = 0. + SGG2 = 0. + NF = NFMAP(IQ) + DO 260 IX = NXX,IX0+1,-1 + IADR = IWADR(IX,IX0) + SQQ1 = SQQ1 + WGTFF1(IADR) * FSIQCD(IX,IQ) + SQQ2 = SQQ2 + WGTFF2(IADR,NF) * FSIQCD(IX,IQ) + SQG1 = SQG1 + WGTFG1(IADR,NF) * FGLQCD(IX,IQ) + SQG2 = SQG2 + WGTFG2(IADR,NF) * FGLQCD(IX,IQ) + SGQ1 = SGQ1 + WGTGF1(IADR) * FSIQCD(IX,IQ) + SGQ2 = SGQ2 + WGTGF2(IADR,NF) * FSIQCD(IX,IQ) + SGG1 = SGG1 + WGTGG1(IADR,NF) * FGLQCD(IX,IQ) + SGG2 = SGG2 + WGTGG2(IADR,NF) * FGLQCD(IX,IQ) + 260 CONTINUE + IAD = IWADR(IX0,IX0) + SQQ = ALF*SQQ1 + AL2*SQQ2 + SQG = ALF*SQG1 + AL2*SQG2 + SGQ = ALF*SGQ1 + AL2*SGQ2 + SGG = ALF*SGG1 + AL2*SGG2 + WQQ = ALF* WGTFF1(IAD) + AL2*WGTFF2(IAD,NF) + WQG = ALF* WGTFG1(IAD,NF) + AL2*WGTFG2(IAD,NF) + WGQ = ALF* WGTGF1(IAD) + AL2*WGTGF2(IAD,NF) + WGG = ALF* WGTGG1(IAD,NF) + AL2*WGTGG2(IAD,NF) + AAS = 2.*FSI + (DSI+SQQ+SQG)*DEL + BBS = 2. - WQQ*DEL + AAG = 2.*FGL + (DGL+SGQ+SGG)*DEL + BBG = 2. - WGG*DEL + FSI = (AAS*BBG+WQG*AAG*DEL) / (BBS*BBG-WQG*WGQ*DEL*DEL) + FGL = (AAG*BBS+WGQ*AAS*DEL) / (BBG*BBS-WGQ*WQG*DEL*DEL) + DSI = WQQ*FSI+SQQ+WQG*FGL+SQG + DGL = WGQ*FSI+SGQ+WGG*FGL+SGG + FSIQCD(IX0,IQ) = FSI + DSIQCD(IX0,IQ) = DSI + FGLQCD(IX0,IQ) = FGL + DGGQCD(IX0,IQ) = DGL + EVL = EVL+NXX-IX0+1 + 270 CONTINUE + +! ---------- + ! + END DO +! ---------- + + EVL = EVL*2./(NXX*(NXX+1)*NQ2) + + CALL QNTRUE(LE_DONE,NXX) + + RETURN + END + +!DECK ID>, EVOLNM. + +! ===================================== + SUBROUTINE EVOLNM(UNAM,IQ0,IUQL,IUQH) +! ===================================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + CHARACTER*(*) UNAM + CHARACTER*5 NAME + + + CHARACTER*5 PNAM,STFNAM + LOGICAL LNFP + COMMON /QCLNFP/ LNFP(0:30,3:5) + COMMON /QCPNAM/ PNAM(0:30) + COMMON /QCPWGT/ PWGT(0:10,0:30,3:5) + COMMON /QCFNAM/ STFNAM(7) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + REAL & + &WGTFF1,WGTFG1, & + &WGTGF1,WGTGG1, & + &WGTPP2,WGTPM2,WGTNS2, & + &WGTFF2,WGTFG2, & + &WGTGF2,WGTGG2, & + &WGTC2Q,WGTC2G,YNTC2Q, & + &WGTCLQ,WGTCLG,WGTC3Q + + COMMON/QCWEIT/ & + &WGTFF1(MXX*(MXX+1)/2) ,WGTFG1(MXX*(MXX+1)/2,3:5), & + &WGTGF1(MXX*(MXX+1)/2) ,WGTGG1(MXX*(MXX+1)/2,3:5), & + &WGTPP2(MXX*(MXX+1)/2,3:5),WGTPM2(MXX*(MXX+1)/2,3:5), & + &WGTNS2(MXX*(MXX+1)/2,3:5), & + &WGTFF2(MXX*(MXX+1)/2,3:5),WGTFG2(MXX*(MXX+1)/2,3:5), & + &WGTGF2(MXX*(MXX+1)/2,3:5),WGTGG2(MXX*(MXX+1)/2,3:5), & + &WGTC2Q(MXX*(MXX+1)/2) ,WGTC2G(MXX*(MXX+1)/2,3:5), & + &WGTCLQ(MXX*(MXX+1)/2) ,WGTCLG(MXX*(MXX+1)/2,3:5), & + &WGTC3Q(MXX*(MXX+1)/2) ,YNTC2Q(MXX) + + COMMON/QCWADR/ IWADR(MXX,MXX) + + + LOGICAL LTIME + REAL T_START,T_END,T_SPENT + COMMON/QCTIME/T_START(10),T_END(10),T_SPENT(10),N_CALLS(10), & + &E_CALLS(10),LTIME + COMMON/QCFCNT/IFCNT(-1:1,5) + + + IF(LTIME) CALL TIMEX_LHA(T_START(3)) + + CALL QTRACE('EVOLNM ',0) + + IF(NXX.EQ.0.OR.NQ2.EQ.0) THEN + IERR = 1 + GOTO 500 + ENDIF + + IQL = IUQL + IQH = IUQH + + IXL = MAX(ABS(IXFROMX(XMICUT)),1) + IQD = ABS(IQFROMQ(QMICUT)) + IQD = MAX(IQD,ABS(IQFROMQ(QMINAS))) + IQU = ABS(IQFROMQ(QMACUT)) + IF(IQD.NE.0) IQL = MAX(IQD,IQL) + IF(IQU.NE.0) IQH = MIN(IQU+1,IQH) + + IF(IQL.LE.0) IQL = 1 + IF(IQH.LE.0.OR.IQH.GT.NQ2) IQH = NQ2 + IF(IQL.EQ.IQ0.AND.IQH.EQ.IQ0) RETURN + IF(IQL.GE.IQH) THEN + IERR = 2 + GOTO 500 + ENDIF + IF(IQL.LT.1.OR.IQL.GE.NQ2) THEN + IERR = 3 + GOTO 500 + ENDIF + IF(IQH.LE.1.OR.IQH.GT.NQ2) THEN + IERR = 3 + GOTO 500 + ENDIF + IF(IQ0.LT.IQL.OR.IQ0.GT.IQH) THEN + IERR = 4 + GOTO 500 + ENDIF + IF(.NOT.LWT1OK) THEN + IERR = 5 + GOTO 500 + ENDIF + IF(IORD.EQ.2.AND..NOT.LWT2OK) THEN + IERR = 6 + GOTO 500 + ENDIF + + CALL QSTRIP(UNAM,NAME) + + NFMI = 9 + NFMA = 0 + DO 15 IQ = IQL,IQH + NFMI = MIN(NFMI,NFMAP(IQ)) + NFMA = MAX(NFMA,NFMAP(IQ)) + 15 END DO + + DO 16 NF = NFMI,NFMA + ID = IDCHEK(NAME,NF,'EVOLNM',1) + 16 END DO + + IRUN = 0 + IF(LPLUS) THEN + DO 19 NF = 3,5 + DO 18 IX0 = 1,NXX + DO 17 IX = IX0,NXX + WGTNS2(IWADR(IX,IX0),NF) = WGTPM2(IWADR(IX,IX0),NF) + 17 CONTINUE + 18 CONTINUE + 19 CONTINUE + IRUN = 1 + ENDIF + LPLUS = .FALSE. + + IF(.NOT.LALFOK) THEN + CALL QFILAS('EVOLNM') + IRUN = 1 + ENDIF + IF(.NOT.LDQ2OK) THEN + CALL QDELQ2 + IRUN = 1 + ENDIF + + DO IX = 1,NXX + LE_DONE(IX) = LEVDONE(IX,ID) + DO IQ = 1,NQ2 + FNSQCD(IX,IQ) = PDFQCD(IX,IQ,ID) + ENDDO + ENDDO + + IF(IQ0.NE.IQ0_LAST(ID) .OR. & + & IQL.NE.IQL_LAST(ID) .OR. & + & IQH.NE.IQH_LAST(ID) ) IRUN = 1 + + CALL APNS(IXL,IQ0,IQL,IQH,IRUN,EVL) + + IQ0_LAST(ID) = IQ0 + IQL_LAST(ID) = IQL + IQH_LAST(ID) = IQH + + DO IX = 1,NXX + LEVDONE(IX,ID) = LE_DONE(IX) + DO IQ = 1,NQ2 + PDFQCD(IX,IQ,ID) = FNSQCD(IX,IQ) + ENDDO + ENDDO + + DO I = 1,30 + DO J = 1,7 + LFFCAL(J,I) = .FALSE. + ENDDO + ENDDO + + IF(LTIME) THEN + CALL TIMEX_LHA(T_END(3)) + T_SPENT(3) = T_SPENT(3)+T_END(3)-T_START(3) + N_CALLS(3) = N_CALLS(3)+1 + E_CALLS(3) = E_CALLS(3)+EVL + ENDIF + + RETURN + + 500 CONTINUE + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r EVOLNM ---> STOP'')') + WRITE(6,'( '' ------------------------------------'')') + WRITE(6,'( '' Input NAME :'',A)') UNAM + WRITE(6,'( '' IQ0 :'',I5)') IQ0 + WRITE(6,'( '' IQLow :'',I5)') IUQL + WRITE(6,'( '' IQHigh :'',I5)') IUQH + IF(IERR.NE.1) THEN + WRITE(6,'(/'' After cuts IQ0, Q20 :'',I5,E12.5)') IQ0,Q2TAB(IQ0) + WRITE(6,'( '' IQL, Q2L :'',I5,E12.5)') IQL,Q2TAB(IQL) + WRITE(6,'( '' IQH, Q2H :'',I5,E12.5)') IQH,Q2TAB(IQH) + ENDIF + IF(IERR.EQ.1) THEN + WRITE(6,'(/'' No x-Q2 grid available'')') + ELSEIF(IERR.EQ.2) THEN + WRITE(6,'(/'' Value of IQL .ge. IQH'', & + & '' (after applying Q2 cuts, if any)'')') + ELSEIF(IERR.EQ.3) THEN + WRITE(6,'(/'' IQL and/or IQH outside grid boundary'')') + ELSEIF(IERR.EQ.4) THEN + WRITE(6,'(/'' IQ0 outside the range [IQL,IQH]'', & + & '' (after applying Q2 cuts, if any)'')') + ELSEIF(IERR.EQ.5) THEN + WRITE(6,'(/'' No LO weight tables available'', & + & '' (please call s/r QNFILW)'')') + ELSEIF(IERR.EQ.6) THEN + WRITE(6,'(/'' No NLO weight tables available'', & + & '' (please call s/r QNFILW)'')') + ENDIF + + CALL QTRACE('EVOLNM ',1) + + STOP + + END + +!DECK ID>, EVOLNP. + +! ===================================== + SUBROUTINE EVOLNP(UNAM,IQ0,IUQL,IUQH) +! ===================================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + CHARACTER*(*) UNAM + CHARACTER*5 NAME + + + CHARACTER*5 PNAM,STFNAM + LOGICAL LNFP + COMMON /QCLNFP/ LNFP(0:30,3:5) + COMMON /QCPNAM/ PNAM(0:30) + COMMON /QCPWGT/ PWGT(0:10,0:30,3:5) + COMMON /QCFNAM/ STFNAM(7) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + REAL & + &WGTFF1,WGTFG1, & + &WGTGF1,WGTGG1, & + &WGTPP2,WGTPM2,WGTNS2, & + &WGTFF2,WGTFG2, & + &WGTGF2,WGTGG2, & + &WGTC2Q,WGTC2G,YNTC2Q, & + &WGTCLQ,WGTCLG,WGTC3Q + + COMMON/QCWEIT/ & + &WGTFF1(MXX*(MXX+1)/2) ,WGTFG1(MXX*(MXX+1)/2,3:5), & + &WGTGF1(MXX*(MXX+1)/2) ,WGTGG1(MXX*(MXX+1)/2,3:5), & + &WGTPP2(MXX*(MXX+1)/2,3:5),WGTPM2(MXX*(MXX+1)/2,3:5), & + &WGTNS2(MXX*(MXX+1)/2,3:5), & + &WGTFF2(MXX*(MXX+1)/2,3:5),WGTFG2(MXX*(MXX+1)/2,3:5), & + &WGTGF2(MXX*(MXX+1)/2,3:5),WGTGG2(MXX*(MXX+1)/2,3:5), & + &WGTC2Q(MXX*(MXX+1)/2) ,WGTC2G(MXX*(MXX+1)/2,3:5), & + &WGTCLQ(MXX*(MXX+1)/2) ,WGTCLG(MXX*(MXX+1)/2,3:5), & + &WGTC3Q(MXX*(MXX+1)/2) ,YNTC2Q(MXX) + + COMMON/QCWADR/ IWADR(MXX,MXX) + + + LOGICAL LTIME + REAL T_START,T_END,T_SPENT + COMMON/QCTIME/T_START(10),T_END(10),T_SPENT(10),N_CALLS(10), & + &E_CALLS(10),LTIME + COMMON/QCFCNT/IFCNT(-1:1,5) + + + IF(LTIME) CALL TIMEX_LHA(T_START(4)) + + CALL QTRACE('EVOLNP ',0) + + IF(NXX.EQ.0.OR.NQ2.EQ.0) THEN + IERR = 1 + GOTO 500 + ENDIF + + IQL = IUQL + IQH = IUQH + + IXL = MAX(ABS(IXFROMX(XMICUT)),1) + IQD = ABS(IQFROMQ(QMICUT)) + IQD = MAX(IQD,ABS(IQFROMQ(QMINAS))) + IQU = ABS(IQFROMQ(QMACUT)) + IF(IQD.NE.0) IQL = MAX(IQD,IQL) + IF(IQU.NE.0) IQH = MIN(IQU+1,IQH) + + IF(IQL.LE.0) IQL = 1 + IF(IQH.LE.0.OR.IQH.GT.NQ2) IQH = NQ2 + IF(IQL.EQ.IQ0.AND.IQH.EQ.IQ0) RETURN + IF(IQL.GE.IQH) THEN + IERR = 2 + GOTO 500 + ENDIF + IF(IQL.LT.1.OR.IQL.GE.NQ2) THEN + IERR = 3 + GOTO 500 + ENDIF + IF(IQH.LE.1.OR.IQH.GT.NQ2) THEN + IERR = 3 + GOTO 500 + ENDIF + IF(IQ0.LT.IQL.OR.IQ0.GT.IQH) THEN + IERR = 4 + GOTO 500 + ENDIF + IF(.NOT.LWT1OK) THEN + IERR = 5 + GOTO 500 + ENDIF + IF(IORD.EQ.2.AND..NOT.LWT2OK) THEN + IERR = 6 + GOTO 500 + ENDIF + + CALL QSTRIP(UNAM,NAME) + + NFMI = 9 + NFMA = 0 + DO 15 IQ = IQL,IQH + NFMI = MIN(NFMI,NFMAP(IQ)) + NFMA = MAX(NFMA,NFMAP(IQ)) + 15 END DO + + DO 16 NF = NFMI,NFMA + ID = IDCHEK(NAME,NF,'EVOLNP',1) + 16 END DO + + IRUN = 0 + IF(.NOT.LPLUS) THEN + DO 19 NF = 3,5 + DO 18 IX0 = 1,NXX + DO 17 IX = IX0,NXX + WGTNS2(IWADR(IX,IX0),NF) = WGTPP2(IWADR(IX,IX0),NF) + 17 CONTINUE + 18 CONTINUE + 19 CONTINUE + IRUN = 1 + ENDIF + LPLUS = .TRUE. + + IF(.NOT.LALFOK) THEN + CALL QFILAS('EVOLNP') + IRUN = 1 + ENDIF + IF(.NOT.LDQ2OK) THEN + CALL QDELQ2 + IRUN = 1 + ENDIF + + DO 25 IX = 1,NXX + DO 20 IQ = 1,NQ2 + 20 END DO + 25 END DO + + DO IX = 1,NXX + LE_DONE(IX) = LEVDONE(IX,ID) + DO IQ = 1,NQ2 + FNSQCD(IX,IQ) = PDFQCD(IX,IQ,ID) + ENDDO + ENDDO + + IF(IQ0.NE.IQ0_LAST(ID) .OR. & + & IQL.NE.IQL_LAST(ID) .OR. & + & IQH.NE.IQH_LAST(ID) ) IRUN = 1 + + CALL APNS(IXL,IQ0,IQL,IQH,IRUN,EVL) + + IQ0_LAST(ID) = IQ0 + IQL_LAST(ID) = IQL + IQH_LAST(ID) = IQH + + DO IX = 1,NXX + LEVDONE(IX,ID) = LE_DONE(IX) + DO IQ = 1,NQ2 + PDFQCD(IX,IQ,ID) = FNSQCD(IX,IQ) + ENDDO + ENDDO + + DO I = 1,30 + DO J = 1,7 + LFFCAL(J,I) = .FALSE. + ENDDO + ENDDO + + IF(LTIME) THEN + CALL TIMEX_LHA(T_END(4)) + T_SPENT(4) = T_SPENT(4)+T_END(4)-T_START(4) + N_CALLS(4) = N_CALLS(4)+1 + E_CALLS(4) = E_CALLS(4)+EVL + ENDIF + + RETURN + + 500 CONTINUE + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r EVOLNP ---> STOP'')') + WRITE(6,'( '' ------------------------------------'')') + WRITE(6,'( '' Input NAME :'',A)') UNAM + WRITE(6,'( '' IQ0 :'',I5)') IQ0 + WRITE(6,'( '' IQLow :'',I5)') IUQL + WRITE(6,'( '' IQHigh :'',I5)') IUQH + IF(IERR.NE.1) THEN + WRITE(6,'(/'' After cuts IQ0, Q20 :'',I5,E12.5)') IQ0,Q2TAB(IQ0) + WRITE(6,'( '' IQL, Q2L :'',I5,E12.5)') IQL,Q2TAB(IQL) + WRITE(6,'( '' IQH, Q2H :'',I5,E12.5)') IQH,Q2TAB(IQH) + ENDIF + IF(IERR.EQ.1) THEN + WRITE(6,'(/'' No x-Q2 grid available'')') + ELSEIF(IERR.EQ.2) THEN + WRITE(6,'(/'' Value of IQL .ge. IQH'', & + & '' (after applying Q2 cuts, if any)'')') + ELSEIF(IERR.EQ.3) THEN + WRITE(6,'(/'' IQL and/or IQH outside grid boundary'')') + ELSEIF(IERR.EQ.4) THEN + WRITE(6,'(/'' IQ0 outside the range [IQL,IQH]'', & + & '' (after applying Q2 cuts, if any)'')') + ELSEIF(IERR.EQ.5) THEN + WRITE(6,'(/'' No LO weight tables available'', & + & '' (please call s/r QNFILW)'')') + ELSEIF(IERR.EQ.6) THEN + WRITE(6,'(/'' No NLO weight tables available'', & + & '' (please call s/r QNFILW)'')') + ENDIF + + CALL QTRACE('EVOLNP ',1) + + STOP + + END + +!DECK ID>, EVPLUS. + +! ===================================== + SUBROUTINE EVPLUS(UNAM,IQ0,IUQL,IUQH) +! ===================================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + CHARACTER*(*) UNAM + CHARACTER*5 NAME + + + CHARACTER*5 PNAM,STFNAM + LOGICAL LNFP + COMMON /QCLNFP/ LNFP(0:30,3:5) + COMMON /QCPNAM/ PNAM(0:30) + COMMON /QCPWGT/ PWGT(0:10,0:30,3:5) + COMMON /QCFNAM/ STFNAM(7) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + REAL & + &WGTFF1,WGTFG1, & + &WGTGF1,WGTGG1, & + &WGTPP2,WGTPM2,WGTNS2, & + &WGTFF2,WGTFG2, & + &WGTGF2,WGTGG2, & + &WGTC2Q,WGTC2G,YNTC2Q, & + &WGTCLQ,WGTCLG,WGTC3Q + + COMMON/QCWEIT/ & + &WGTFF1(MXX*(MXX+1)/2) ,WGTFG1(MXX*(MXX+1)/2,3:5), & + &WGTGF1(MXX*(MXX+1)/2) ,WGTGG1(MXX*(MXX+1)/2,3:5), & + &WGTPP2(MXX*(MXX+1)/2,3:5),WGTPM2(MXX*(MXX+1)/2,3:5), & + &WGTNS2(MXX*(MXX+1)/2,3:5), & + &WGTFF2(MXX*(MXX+1)/2,3:5),WGTFG2(MXX*(MXX+1)/2,3:5), & + &WGTGF2(MXX*(MXX+1)/2,3:5),WGTGG2(MXX*(MXX+1)/2,3:5), & + &WGTC2Q(MXX*(MXX+1)/2) ,WGTC2G(MXX*(MXX+1)/2,3:5), & + &WGTCLQ(MXX*(MXX+1)/2) ,WGTCLG(MXX*(MXX+1)/2,3:5), & + &WGTC3Q(MXX*(MXX+1)/2) ,YNTC2Q(MXX) + + COMMON/QCWADR/ IWADR(MXX,MXX) + + + LOGICAL LTIME + REAL T_START,T_END,T_SPENT + COMMON/QCTIME/T_START(10),T_END(10),T_SPENT(10),N_CALLS(10), & + &E_CALLS(10),LTIME + COMMON/QCFCNT/IFCNT(-1:1,5) + + + IF(LTIME) CALL TIMEX_LHA(T_START(4)) + + CALL QTRACE('EVPLUS ',0) + + IF(NXX.EQ.0.OR.NQ2.EQ.0) THEN + IERR = 1 + GOTO 500 + ENDIF + + IQL = IUQL + IQH = IUQH + + IXL = MAX(ABS(IXFROMX(XMICUT)),1) + IQD = ABS(IQFROMQ(QMICUT)) + IQD = MAX(IQD,ABS(IQFROMQ(QMINAS))) + IQU = ABS(IQFROMQ(QMACUT)) + IF(IQD.NE.0) IQL = MAX(IQD,IQL) + IF(IQU.NE.0) IQH = MIN(IQU+1,IQH) + + IF(IQL.LE.0) IQL = 1 + IF(IQH.LE.0.OR.IQH.GT.NQ2) IQH = NQ2 + IF(IQL.EQ.IQ0.AND.IQH.EQ.IQ0) RETURN + IF(IQL.GE.IQH) THEN + IERR = 2 + GOTO 500 + ENDIF + IF(IQL.LT.1.OR.IQL.GE.NQ2) THEN + IERR = 3 + GOTO 500 + ENDIF + IF(IQH.LE.1.OR.IQH.GT.NQ2) THEN + IERR = 3 + GOTO 500 + ENDIF + IF(IQ0.LT.IQL.OR.IQ0.GT.IQH) THEN + IERR = 4 + GOTO 500 + ENDIF + IF(NFMAP(IQL).NE.NFMAP(IQH-1)) THEN + IERR = 5 + GOTO 500 + ENDIF + IF(.NOT.LWT1OK) THEN + IERR = 6 + GOTO 500 + ENDIF + IF(IORD.EQ.2.AND..NOT.LWT2OK) THEN + IERR = 7 + GOTO 500 + ENDIF + + CALL QSTRIP(UNAM,NAME) + + NFMI = 9 + NFMA = 0 + DO 15 IQ = IQL,IQH + NFMI = MIN(NFMI,NFMAP(IQ)) + NFMA = MAX(NFMA,NFMAP(IQ)) + 15 END DO + + DO 16 NF = NFMI,NFMA + ID = IDCHEK(NAME,NF,'EVPLUS',1) + 16 END DO + + IRUN = 0 + IF(.NOT.LPLUS) THEN + DO 19 NF = 3,5 + DO 18 IX0 = 1,NXX + DO 17 IX = IX0,NXX + WGTNS2(IWADR(IX,IX0),NF) = WGTPP2(IWADR(IX,IX0),NF) + 17 CONTINUE + 18 CONTINUE + 19 CONTINUE + IRUN = 1 + ENDIF + LPLUS = .TRUE. + + IF(.NOT.LALFOK) THEN + CALL QFILAS('EVPLUS') + IRUN = 1 + ENDIF + IF(.NOT.LDQ2OK) THEN + CALL QDELQ2 + IRUN = 1 + ENDIF + + DO IX = 1,NXX + LE_DONE(IX) = LEVDONE(IX,ID) + DO IQ = 1,NQ2 + FNSQCD(IX,IQ) = PDFQCD(IX,IQ,ID) + ENDDO + ENDDO + + IF(IQ0.NE.IQ0_LAST(ID) .OR. & + & IQL.NE.IQL_LAST(ID) .OR. & + & IQH.NE.IQH_LAST(ID) ) IRUN = 1 + + CALL APNS(IXL,IQ0,IQL,IQH,IRUN,EVL) + + IQ0_LAST(ID) = IQ0 + IQL_LAST(ID) = IQL + IQH_LAST(ID) = IQH + + DO IX = 1,NXX + LEVDONE(IX,ID) = LE_DONE(IX) + DO IQ = 1,NQ2 + PDFQCD(IX,IQ,ID) = FNSQCD(IX,IQ) + ENDDO + ENDDO + + DO I = 1,30 + DO J = 1,7 + LFFCAL(J,I) = .FALSE. + ENDDO + ENDDO + + IF(LTIME) THEN + CALL TIMEX_LHA(T_END(4)) + T_SPENT(4) = T_SPENT(4)+T_END(4)-T_START(4) + N_CALLS(4) = N_CALLS(4)+1 + E_CALLS(4) = E_CALLS(4)+EVL + ENDIF + + RETURN + + 500 CONTINUE + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r EVPLUS ---> STOP'')') + WRITE(6,'( '' ------------------------------------'')') + WRITE(6,'( '' Input NAME :'',A)') UNAM + WRITE(6,'( '' Input IQ0 :'',I10)') IQ0 + WRITE(6,'( '' IQLow :'',I10)') IUQL + WRITE(6,'( '' IQHigh :'',I10)') IUQH + IF(IERR.NE.1) THEN + WRITE(6,'(/'' After cuts IQ0, Q20 :'',I5,E12.5)') IQ0,Q2TAB(IQ0) + WRITE(6,'( '' IQL, Q2L :'',I5,E12.5)') IQL,Q2TAB(IQL) + WRITE(6,'( '' IQH, Q2H :'',I5,E12.5)') IQH,Q2TAB(IQH) + ENDIF + IF(IERR.EQ.1) THEN + WRITE(6,'(/'' No x-Q2 grid available'')') + ELSEIF(IERR.EQ.2) THEN + WRITE(6,'(/'' Value of IQL .ge. IQH'', & + & '' (after applying Q2 cuts, if any)'')') + ELSEIF(IERR.EQ.3) THEN + WRITE(6,'(/'' IQL and/or IQH outside grid boundary'')') + ELSEIF(IERR.EQ.4) THEN + WRITE(6,'(/'' IQ0 outside the range [IQL,IQH]'')') + ELSEIF(IERR.EQ.5) THEN + WRITE(6,'(/'' [IQL,IQH} crosses a flavour threshold'')') + ELSEIF(IERR.EQ.6) THEN + WRITE(6,'(/'' No LO weight tables available'', & + & '' (please call s/r QNFILW)'')') + ELSEIF(IERR.EQ.7) THEN + WRITE(6,'(/'' No NLO weight tables available'', & + & '' (please call s/r QNFILW)'')') + ENDIF + + CALL QTRACE('EVPLUS ',1) + + STOP + + END + +!DECK ID>, APNS. + +! ========================================= + SUBROUTINE APNS(IXL,IQ0,IQL,IQH,IRUN,EVL) +! ========================================= + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + REAL & + &WGTFF1,WGTFG1, & + &WGTGF1,WGTGG1, & + &WGTPP2,WGTPM2,WGTNS2, & + &WGTFF2,WGTFG2, & + &WGTGF2,WGTGG2, & + &WGTC2Q,WGTC2G,YNTC2Q, & + &WGTCLQ,WGTCLG,WGTC3Q + + COMMON/QCWEIT/ & + &WGTFF1(MXX*(MXX+1)/2) ,WGTFG1(MXX*(MXX+1)/2,3:5), & + &WGTGF1(MXX*(MXX+1)/2) ,WGTGG1(MXX*(MXX+1)/2,3:5), & + &WGTPP2(MXX*(MXX+1)/2,3:5),WGTPM2(MXX*(MXX+1)/2,3:5), & + &WGTNS2(MXX*(MXX+1)/2,3:5), & + &WGTFF2(MXX*(MXX+1)/2,3:5),WGTFG2(MXX*(MXX+1)/2,3:5), & + &WGTGF2(MXX*(MXX+1)/2,3:5),WGTGG2(MXX*(MXX+1)/2,3:5), & + &WGTC2Q(MXX*(MXX+1)/2) ,WGTC2G(MXX*(MXX+1)/2,3:5), & + &WGTCLQ(MXX*(MXX+1)/2) ,WGTCLG(MXX*(MXX+1)/2,3:5), & + &WGTC3Q(MXX*(MXX+1)/2) ,YNTC2Q(MXX) + + COMMON/QCWADR/ IWADR(MXX,MXX) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + LOGICAL LTIME + REAL T_START,T_END,T_SPENT + COMMON/QCTIME/T_START(10),T_END(10),T_SPENT(10),N_CALLS(10), & + &E_CALLS(10),LTIME + COMMON/QCFCNT/IFCNT(-1:1,5) + + + EVL = 0. + + FNS = FNSQCD(NXX,IQ0) +! ------------------------------------------- + ! + IF(.NOT.LE_DONE(NXX) .OR. IRUN.EQ.1) THEN +! ------------------------------------------- + + NF = NFMAP(IQ0) + WGT = ALFAPQ(IQ0)*WGTFF1(IWADR(NXX,NXX)) + & + & ALFA2Q(IQ0)*WGTNS2(IWADR(NXX,NXX),NF) + DNS = WGT*FNS + FNS0 = FNS + DNS0 = DNS + FNSQCD(NXX,IQ0) = FNS + DNSQCD(NXX,IQ0) = DNS + EVL = EVL+1. + + DO 100 IQ = IQ0+1,IQH + NF = NFMAP(IQ) + WGT = ALFAPQ(IQ)*WGTFF1(IWADR(NXX,NXX)) + & + & ALFA2Q(IQ)*WGTNS2(IWADR(NXX,NXX),NF) + FNS = ( 2.*FNS + DNS*DELUP(IQ) ) / ( 2. - WGT*DELUP(IQ) ) + DNS = WGT*FNS + FNSQCD(NXX,IQ) = FNS + DNSQCD(NXX,IQ) = DNS + 100 CONTINUE + EVL = EVL+IQH-IQ0 + + FNS = FNS0 + DNS = DNS0 + + DO 200 IQ = IQ0-1,IQL,-1 + NF = NFMAP(IQ) + WGT = ALFAPQ(IQ)*WGTFF1(IWADR(NXX,NXX)) + & + & ALFA2Q(IQ)*WGTNS2(IWADR(NXX,NXX),NF) + FNS = ( 2.*FNS + DNS*DELDN(IQ) ) / ( 2. - WGT*DELDN(IQ) ) + DNS = WGT*FNS + FNSQCD(NXX,IQ) = FNS + DNSQCD(NXX,IQ) = DNS + 200 CONTINUE + EVL = EVL+IQ0-IQL + +! ------- + ! + ENDIF +! ------- + +! --------------------------- + ! + DO IX0 = NXX-1,IXL,-1 +! --------------------------- + + FNS = FNSQCD(IX0,IQ0) + IF(LE_DONE(IX0).AND.IRUN.EQ.0) EXIT + ALFAS = ALFAPQ(IQ0) + ALFA2 = ALFA2Q(IQ0) + SUM = 0. + NF = NFMAP(IQ0) + DO 220 IX = NXX,IX0+1,-1 + WFF1 = WGTFF1(IWADR(IX,IX0)) + WNS2 = WGTNS2(IWADR(IX,IX0),NF) + SUM = SUM + (ALFAS*WFF1+ALFA2*WNS2) * FNSQCD(IX,IQ0) + 220 CONTINUE + WGT = ALFAS*WGTFF1(IWADR(IX0,IX0)) + & + & ALFA2*WGTNS2(IWADR(IX0,IX0),NF) + DNS = WGT*FNS + SUM + + FNS0 = FNS + DNS0 = DNS + FNSQCD(IX0,IQ0) = FNS + DNSQCD(IX0,IQ0) = DNS + EVL = EVL+NXX-IX0+1 + + DO 250 IQ = IQ0+1,IQH + IF(IFAILC(IX0,IQ).NE.0) GOTO 250 + ALFAS = ALFAPQ(IQ) + ALFA2 = ALFA2Q(IQ) + DELIQ = DELUP(IQ) + SUM = 0. + NF = NFMAP(IQ) + DO 230 IX = NXX,IX0+1,-1 + WFF1 = WGTFF1(IWADR(IX,IX0)) + WNS2 = WGTNS2(IWADR(IX,IX0),NF) + SUM = SUM + (ALFAS*WFF1+ALFA2*WNS2) * FNSQCD(IX,IQ) + 230 CONTINUE + WGT = ALFAS*WGTFF1(IWADR(IX0,IX0)) + & + & ALFA2*WGTNS2(IWADR(IX0,IX0),NF) + FNS = ( 2.*FNS + (DNS+SUM)*DELIQ ) / ( 2. - WGT*DELIQ ) + DNS = WGT*FNS + SUM + FNSQCD(IX0,IQ) = FNS + DNSQCD(IX0,IQ) = DNS + EVL = EVL+NXX-IX0+1 + 250 CONTINUE + + FNS = FNS0 + DNS = DNS0 + + DO 270 IQ = IQ0-1,IQL,-1 + ALFAS = ALFAPQ(IQ) + ALFA2 = ALFA2Q(IQ) + DELIQ = DELDN(IQ) + SUM = 0. + NF = NFMAP(IQ) + DO 260 IX = NXX,IX0+1,-1 + WFF1 = WGTFF1(IWADR(IX,IX0)) + WNS2 = WGTNS2(IWADR(IX,IX0),NF) + SUM = SUM + (ALFAS*WFF1+ALFA2*WNS2) * FNSQCD(IX,IQ) + 260 CONTINUE + WGT = ALFAS*WGTFF1(IWADR(IX0,IX0)) + & + & ALFA2*WGTNS2(IWADR(IX0,IX0),NF) + FNS = ( 2.*FNS + (DNS+SUM)*DELIQ ) / ( 2. - WGT*DELIQ ) + DNS = WGT*FNS + SUM + FNSQCD(IX0,IQ) = FNS + DNSQCD(IX0,IQ) = DNS + EVL = EVL+NXX-IX0+1 + 270 CONTINUE + +! ---------- + ! + END DO +! ---------- + + EVL = EVL*2./(NXX*(NXX+1)*NQ2) + + CALL QNTRUE(LE_DONE,NXX) + + RETURN + END + +!DECK ID>, QNPGET. + +! ============================================ + DOUBLE PRECISION FUNCTION QNPGET(NAME,IX,IQ) +! ============================================ + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + CHARACTER*(*) NAME + +!--- Obsolete (21/05/96): use QPDFIJ instead + + QNPGET = QPDFIJ(NAME,IX,IQ,IFL) + + RETURN + END + +!DECK ID>, QPDFIJ. + +! ================================================ + DOUBLE PRECISION FUNCTION QPDFIJ(UNAM,IX,IQ,IFL) +! ================================================ + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +!--- Returns parton distribution 'NAME' at gridpoint IX,IQ +!--- Output IFL = 0 : Inside grid or cuts +!--- -1 : Outside grid or cuts + + CHARACTER*(*) UNAM + CHARACTER*5 NAME + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + + + CHARACTER*5 PNAM,STFNAM + LOGICAL LNFP + COMMON /QCLNFP/ LNFP(0:30,3:5) + COMMON /QCPNAM/ PNAM(0:30) + COMMON /QCPWGT/ PWGT(0:10,0:30,3:5) + COMMON /QCFNAM/ STFNAM(7) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + CALL QTRACE('QPDFIJ ',0) + + QPDFIJ = 0. + IERR = 0 + IFL = 0 + + IF(NXX.EQ.0.OR.NQ2.EQ.0) THEN + IERR = 1 + GOTO 500 + ENDIF + IF(IX.LT.1.OR.IX.GT.MXX-1 .OR. & + & IQ.LT.1.OR.IQ.GT.MQ2-1) THEN + IERR = 2 + IFL = -1 + IF(LIMCK) GOTO 500 + RETURN + ENDIF + IF(IFAILC(IX,IQ).NE.0) THEN + IERR = 2 + IFL = -1 + IF(LIMCK) GOTO 500 + RETURN + ENDIF + + CALL QSTRIP(UNAM,NAME) + + NF = NFMAP(IQ) + ID = IDCHEK(NAME,NF,'QPDFIJ',1) + + IF(ID.EQ.-1) RETURN + + QPDFIJ = GET_PDFIJ(ID,IX,IQ) + + RETURN + + 500 CONTINUE + + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r QPDFIJ ---> STOP'')') + WRITE(6,'( '' ------------------------------------'')') + WRITE(6,'( '' Input NAME : '',A)') UNAM + WRITE(6,'( '' IX : '',I5)') IX + WRITE(6,'( '' IQ : '',I5)') IQ + IF(IERR.EQ.1) THEN + WRITE(6,'(/'' No x-Q2 grid defined'')') + ELSEIF(IERR.EQ.2) THEN + WRITE(6,'(/'' IX and/or IQ outside grid or cuts'')') + IDUM = ICUTIJ(IX,IQ,1) + ENDIF + + CALL QTRACE('QPDFIJ ',1) + + STOP + + END + +!DECK ID>, PARTXQ. + +! =================================== + SUBROUTINE PARTXQ(NAME,X,Q,VAL,IFL) +! =================================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + CHARACTER*(*) NAME + +!--- Obsolete (21/05/96): use QPDFXQ instead + + VAL = QPDFXQ(NAME,X,Q,IFL) + + RETURN + END + +!DECK ID>, QPDFXQ. + +! ============================================== + DOUBLE PRECISION FUNCTION QPDFXQ(UNAM,X,Q,IFL) +! ============================================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +!--- Returns parton distribution 'NAME' at X,Q +!--- Output IFL = 0 : Inside grid +!--- -1 : Outside grid or cuts + + CHARACTER*(*) UNAM + CHARACTER*5 NAME + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + + + CHARACTER*5 PNAM,STFNAM + LOGICAL LNFP + COMMON /QCLNFP/ LNFP(0:30,3:5) + COMMON /QCPNAM/ PNAM(0:30) + COMMON /QCPWGT/ PWGT(0:10,0:30,3:5) + COMMON /QCFNAM/ STFNAM(7) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + CALL QTRACE('QPDFXQ ',0) + + VAL = 0. + IFL = 0 + QPDFXQ = 0. + + IF(NXX.EQ.0.OR.NQ2.EQ.0) THEN + IERR = 1 + IFL = -1 + GOTO 500 + ENDIF + JFL = ICUTXQ(X,Q,0) + IF(JFL.NE.0) THEN + IERR = 2 + IFL = -1 + IF(LIMCK) GOTO 500 + RETURN + ENDIF + + IX = ABS(IXFROMX(X)) + IQ = MIN(ABS(IQFROMQ(Q)),NQ2-1) + + CALL QSTRIP(UNAM,NAME) + + NF = NFMAP(IQ) + ID = IDCHEK(NAME,NF,'QPDFXQ',1) + + IF(.NOT.LDQ2OK) CALL QDELQ2 + + TX = (X-XXTAB(IX))/(XXTAB(IX+1)-XXTAB(IX)) + TQ = LOG(Q/Q2TAB(IQ))/LOG(Q2TAB(IQ+1)/Q2TAB(IQ)) + + QPDFXQ = GET_PDFXQ(ID,IX,IQ,TX,TQ) + + RETURN + + 500 CONTINUE + + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r QPDFXQ ---> STOP'')') + WRITE(6,'( '' ------------------------------------'')') + WRITE(6,'( '' Input NAME : '',A)') UNAM + WRITE(6,'( '' X : '',E12.5)') X + WRITE(6,'( '' Q2 : '',E12.5)') Q + IF(IERR.EQ.1) THEN + WRITE(6,'(/'' No x-Q2 grid defined'')') + ELSEIF(IERR.EQ.2) THEN + WRITE(6,'(/'' X and/or Q2 outside grid or cuts'')') + IDUM = ICUTXQ(X,Q,1) + ENDIF + + CALL QTRACE('QPDFXQ ',1) + + STOP + END + +!DECK ID>, GET_PDFIJ. + +! ============================================= + DOUBLE PRECISION FUNCTION GET_PDFIJ(ID,IX,IQ) +! ============================================= + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +!-- Return parton distribution ID at IX,IQ. +!-- IX should be in the range 1,...NXX. +!-- IQ should be in the range 1,...NQ2. + + + CHARACTER*5 PNAM,STFNAM + LOGICAL LNFP + COMMON /QCLNFP/ LNFP(0:30,3:5) + COMMON /QCPNAM/ PNAM(0:30) + COMMON /QCPWGT/ PWGT(0:10,0:30,3:5) + COMMON /QCFNAM/ STFNAM(7) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + GET_PDFIJ = 0. + + NF = NFMAP(IQ) + + DO I = 0,10 + GET_PDFIJ = GET_PDFIJ + PWGT(I,ID,NF)*PDFQCD(IX,IQ,I) + ENDDO + + RETURN + END + +!DECK ID>, GET_PDFXQ. + +! =================================================== + DOUBLE PRECISION FUNCTION GET_PDFXQ(ID,IX,IQ,TX,TQ) +! =================================================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +!-- Return parton distribution ID at X,Q. +!-- IX gridpoint at or below x; should be in the range 1,...NXX. +!-- IQ gridpoint at or below Q; should be in the range 1,...NQ2-1. + + + CHARACTER*5 PNAM,STFNAM + LOGICAL LNFP + COMMON /QCLNFP/ LNFP(0:30,3:5) + COMMON /QCPNAM/ PNAM(0:30) + COMMON /QCPWGT/ PWGT(0:10,0:30,3:5) + COMMON /QCFNAM/ STFNAM(7) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + F11 = GET_PDFIJ(ID,IX,IQ) + F12 = GET_PDFIJ(ID,IX,IQ+1) + F21 = GET_PDFIJ(ID,IX+1,IQ) + F22 = GET_PDFIJ(ID,IX+1,IQ+1) + F1 = (1.-TQ)*F11 + TQ*F12 + F2 = (1.-TQ)*F21 + TQ*F22 + + GET_PDFXQ = (1.-TX)*F1 + TX*F2 + + RETURN + END + +!DECK ID>, BKFAST. + +! ============================== + SUBROUTINE BKFAST(IDF,ID,IERR) +! ============================== + +!--- Book the NDFMAX arrays available for STFAST storage. +!--- Called by STFAST. +!--- Input : IDF = structure function identifier; +!--- 1 2 3 4 5 6 7 +!--- F2 FL xF3 F2c Flc F2b Flb +!--- ID = parton dist identifier (1-30). +!--- Output : set IDFAST(IDF,ID) = j; the results of +!--- STFAST for the combination IDF,ID are +!--- stored in FSTORE(ix,iq,j). +!--- If j.gt.NDFMAX (no more space) then BKFAST +!--- acts as a do-nothing & sets ierr .ne. 0. + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + IERR = 0 + IF(IDFAST(IDF,ID).EQ.0) THEN + IF(NDFAST.EQ.30+NDFMAX) THEN + IERR = 1 + RETURN + ENDIF + NDFAST = NDFAST + 1 + IDFAST(IDF,ID) = NDFAST + ISTFID(NDFAST) = IDF + IPDFID(NDFAST) = ID + ENDIF + + RETURN + END + +!DECK ID>, STFAST. + +! =========================== + SUBROUTINE STFAST(OPT,UNAM) +! =========================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + CHARACTER*(*) OPT,UNAM + CHARACTER*5 NAME + CHARACTER*5 OPT5 + + + LOGICAL LTIME + REAL T_START,T_END,T_SPENT + COMMON/QCTIME/T_START(10),T_END(10),T_SPENT(10),N_CALLS(10), & + &E_CALLS(10),LTIME + COMMON/QCFCNT/IFCNT(-1:1,5) + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + IF(LTIME) CALL TIMEX_LHA(T_START(6)) + + CALL QTRACE('STFAST ',0) + + IERR = 0 + IF(.NOT.LMARK) THEN + IERR = 1 + GOTO 500 + ENDIF + + CALL QSTRIP(UNAM,NAME) + CALL QSTRIP(OPT ,OPT5) + + JX = 0 + JQ = 0 + XX = 0. + QQ = 0. + IDF = IFCHEK(OPT5,NAME,JX,JQ,XX,QQ,'STFAST',1,ID) + + IF(.NOT.LALFOK) CALL QFILAS('STFAST') + IF(.NOT.LDQ2OK) CALL QDELQ2 + + IF(IDF.GE.1.AND.IDF.LE.7) THEN + CALL BKFAST(IDF,ID,IERR) + IF(IERR.NE.0) THEN + LFFCAL(IDF,ID) = .FALSE. + RETURN + ENDIF + ELSE + IERR = 10 + GOTO 500 + ENDIF + + IF (IDF.EQ.1) THEN + CALL FASTF2(ID) + ELSEIF(IDF.EQ.2) THEN + CALL FASTFL(ID) + ELSEIF(IDF.EQ.3) THEN + CALL FASTF3(ID) + ELSE + CALL FASTFKH(IDF,ID) + ENDIF + + IF(LTIME) THEN + CALL TIMEX_LHA(T_END(6)) + T_SPENT(6) = T_SPENT(6)+T_END(6)-T_START(6) + N_CALLS(6) = N_CALLS(6)+1 + ENDIF + + RETURN + + 500 CONTINUE + + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r STFAST ---> STOP'')') + WRITE(6,'( '' ------------------------------------'')') + WRITE(6,'( '' Input OPT : '',A)') OPT + WRITE(6,'( '' Input NAME : '',A)') UNAM + IF(IERR.EQ.1) THEN + WRITE(6, & + & '(/'' No gridpoints marked for fast calculation''/ & + & '' Please call s/r QFMARK before STFAST'')') + ELSEIF(IERR.EQ.10) THEN + WRITE(6,'(/'' Unknown input option OPT'')') + ENDIF + + CALL QTRACE('STFAST ',1) + + STOP + + END + +!DECK ID>, FASTF2. + +! ===================== + SUBROUTINE FASTF2(ID) +! ===================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + + + CHARACTER*5 PNAM,STFNAM + LOGICAL LNFP + COMMON /QCLNFP/ LNFP(0:30,3:5) + COMMON /QCPNAM/ PNAM(0:30) + COMMON /QCPWGT/ PWGT(0:10,0:30,3:5) + COMMON /QCFNAM/ STFNAM(7) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + REAL & + &WGTFF1,WGTFG1, & + &WGTGF1,WGTGG1, & + &WGTPP2,WGTPM2,WGTNS2, & + &WGTFF2,WGTFG2, & + &WGTGF2,WGTGG2, & + &WGTC2Q,WGTC2G,YNTC2Q, & + &WGTCLQ,WGTCLG,WGTC3Q + + COMMON/QCWEIT/ & + &WGTFF1(MXX*(MXX+1)/2) ,WGTFG1(MXX*(MXX+1)/2,3:5), & + &WGTGF1(MXX*(MXX+1)/2) ,WGTGG1(MXX*(MXX+1)/2,3:5), & + &WGTPP2(MXX*(MXX+1)/2,3:5),WGTPM2(MXX*(MXX+1)/2,3:5), & + &WGTNS2(MXX*(MXX+1)/2,3:5), & + &WGTFF2(MXX*(MXX+1)/2,3:5),WGTFG2(MXX*(MXX+1)/2,3:5), & + &WGTGF2(MXX*(MXX+1)/2,3:5),WGTGG2(MXX*(MXX+1)/2,3:5), & + &WGTC2Q(MXX*(MXX+1)/2) ,WGTC2G(MXX*(MXX+1)/2,3:5), & + &WGTCLQ(MXX*(MXX+1)/2) ,WGTCLG(MXX*(MXX+1)/2,3:5), & + &WGTC3Q(MXX*(MXX+1)/2) ,YNTC2Q(MXX) + + COMMON/QCWADR/ IWADR(MXX,MXX) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + DIMENSION QUARKS(MXX),GLUONS(MXX) + +!-- Get adress where to store F2 + JD = IDFAST(1,ID) + +!-- Loop over all Q2 gridpoints + DO 100 IQ = 1,NQ2 + +!-- Initialise FSTORE and get minimum value of x + IXMIN = 999999 + DO IX = 1,NXX + FSTORE(IX,IQ,JD) = -401. + IF(MARKFF(IX,IQ).EQ.1) IXMIN = MIN(IXMIN,IX) + ENDDO + +!-- Is this Q2 gridpoint marked? + IF(MARKQQ(IQ).NE.1) EXIT + +!-- Get scale and check if inside Q2 gridboundaries + QMU = Q2TAB(IQ)*AAM2L + BBM2L + IMU = MIN(ABS(IQFROMQ(QMU)),NQ2-1) + IF(IMU.EQ.0) EXIT + QR2 = QMU*AAAR2 + BBBR2 + IR2 = MIN(ABS(IQFROMQ(QR2)),NQ2-1) + IF(IR2.EQ.0) EXIT + +!-- Calculate F2 for all marked gridpoints + FACT = LOG(Q2TAB(IQ)/QMU) + NF = NFMAP(IMU) + TX = 0. + TQ = LOG(QMU/Q2TAB(IMU))/LOG(Q2TAB(IMU+1)/Q2TAB(IMU)) + TR = LOG(QR2/Q2TAB(IR2))/LOG(Q2TAB(IR2+1)/Q2TAB(IR2)) + AS = GET_AS(IR2,TR) + DO IX0 = NXX,IXMIN,-1 + GLUONS(IX0) = GET_PDFXQ( 0,IX0,IMU,TX,TQ) + QUARKS(IX0) = GET_PDFXQ(ID,IX0,IMU,TX,TQ) + IF(MARKFF(IX0,IQ).EQ.1) THEN + FFF0 = QUARKS(IX0) + IF(IORD.EQ.1) THEN + FSTORE(IX0,IQ,JD) = FFF0 + ELSE + FF = 0. + DO IX = IX0,NXX + FF = FF + & + & (WGTC2Q(IWADR(IX,IX0))+ & + & WGTFF1(IWADR(IX,IX0))*FACT)*QUARKS(IX) + & + & (WGTC2G(IWADR(IX,IX0),NF)+ & + & WGTFG1(IWADR(IX,IX0),NF)*FACT)* & + & GLUONS(IX)*PWGT(1,ID,NF) + ENDDO + FSTORE(IX0,IQ,JD) = FFF0 + AS*FF + ENDIF + ENDIF + ENDDO + FSTORE(NXX+1,IQ,JD) = 0. + + 100 END DO + +!-- Mark F2 calculated for pdf ID + LFFCAL(1,ID) = .TRUE. + + RETURN + END + +!DECK ID>, FASTFL. + +! ===================== + SUBROUTINE FASTFL(ID) +! ===================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + + + CHARACTER*5 PNAM,STFNAM + LOGICAL LNFP + COMMON /QCLNFP/ LNFP(0:30,3:5) + COMMON /QCPNAM/ PNAM(0:30) + COMMON /QCPWGT/ PWGT(0:10,0:30,3:5) + COMMON /QCFNAM/ STFNAM(7) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + REAL & + &WGTFF1,WGTFG1, & + &WGTGF1,WGTGG1, & + &WGTPP2,WGTPM2,WGTNS2, & + &WGTFF2,WGTFG2, & + &WGTGF2,WGTGG2, & + &WGTC2Q,WGTC2G,YNTC2Q, & + &WGTCLQ,WGTCLG,WGTC3Q + + COMMON/QCWEIT/ & + &WGTFF1(MXX*(MXX+1)/2) ,WGTFG1(MXX*(MXX+1)/2,3:5), & + &WGTGF1(MXX*(MXX+1)/2) ,WGTGG1(MXX*(MXX+1)/2,3:5), & + &WGTPP2(MXX*(MXX+1)/2,3:5),WGTPM2(MXX*(MXX+1)/2,3:5), & + &WGTNS2(MXX*(MXX+1)/2,3:5), & + &WGTFF2(MXX*(MXX+1)/2,3:5),WGTFG2(MXX*(MXX+1)/2,3:5), & + &WGTGF2(MXX*(MXX+1)/2,3:5),WGTGG2(MXX*(MXX+1)/2,3:5), & + &WGTC2Q(MXX*(MXX+1)/2) ,WGTC2G(MXX*(MXX+1)/2,3:5), & + &WGTCLQ(MXX*(MXX+1)/2) ,WGTCLG(MXX*(MXX+1)/2,3:5), & + &WGTC3Q(MXX*(MXX+1)/2) ,YNTC2Q(MXX) + + COMMON/QCWADR/ IWADR(MXX,MXX) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + DIMENSION QUARKS(MXX),GLUONS(MXX) + +!-- Get adress where to store FL + JD = IDFAST(2,ID) + +!-- Loop over all Q2 gridpoints + DO 100 IQ = 1,NQ2 + +!-- Initialise FSTORE and get minimum value of x + IXMIN = 999999 + DO IX = 1,NXX + FSTORE(IX,IQ,JD) = -401. + IF(MARKFF(IX,IQ).EQ.1) IXMIN = MIN(IXMIN,IX) + ENDDO + +!-- Is this Q2 gridpoint marked? + IF(MARKQQ(IQ).NE.1) EXIT + +!-- Get scale and check if inside Q2 gridboundaries + QMU = Q2TAB(IQ)*AAM2L + BBM2L + IMU = MIN(ABS(IQFROMQ(QMU)),NQ2-1) + IF(IMU.EQ.0) EXIT + QR2 = QMU*AAAR2 + BBBR2 + IR2 = MIN(ABS(IQFROMQ(QR2)),NQ2-1) + IF(IR2.EQ.0) EXIT + +!-- Calculate FL for all marked gridpoints + FACT = LOG(Q2TAB(IQ)/QMU)*FL_FAC + NF = NFMAP(IMU) + TX = 0. + TQ = LOG(QMU/Q2TAB(IMU))/LOG(Q2TAB(IMU+1)/Q2TAB(IMU)) + TR = LOG(QR2/Q2TAB(IR2))/LOG(Q2TAB(IR2+1)/Q2TAB(IR2)) + AS = GET_AS(IR2,TR) + DO IX0 = NXX,IXMIN,-1 + GLUONS(IX0) = GET_PDFXQ( 0,IX0,IMU,TX,TQ) + QUARKS(IX0) = GET_PDFXQ(ID,IX0,IMU,TX,TQ) + IF(MARKFF(IX0,IQ).EQ.1) THEN + FFF0 = 0. + IF(IORD.EQ.1) THEN + FSTORE(IX0,IQ,JD) = 0. + ELSE + FF = 0. + DO IX = IX0,NXX + FF = FF + & + & (WGTCLQ(IWADR(IX,IX0))+ & + & WGTFF1(IWADR(IX,IX0))*FACT)*QUARKS(IX) + & + & (WGTCLG(IWADR(IX,IX0),NF)+ & + & WGTFG1(IWADR(IX,IX0),NF)*FACT)* & + & GLUONS(IX)*PWGT(1,ID,NF) + ENDDO + FSTORE(IX0,IQ,JD) = FFF0 + AS*FF + ENDIF + ENDIF + ENDDO + FSTORE(NXX+1,IQ,JD) = 0. + + 100 END DO + +!-- Mark FL calculated for pdf ID + LFFCAL(2,ID) = .TRUE. + + RETURN + END + +!DECK ID>, FASTF3. + +! ===================== + SUBROUTINE FASTF3(ID) +! ===================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + + + CHARACTER*5 PNAM,STFNAM + LOGICAL LNFP + COMMON /QCLNFP/ LNFP(0:30,3:5) + COMMON /QCPNAM/ PNAM(0:30) + COMMON /QCPWGT/ PWGT(0:10,0:30,3:5) + COMMON /QCFNAM/ STFNAM(7) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + REAL & + &WGTFF1,WGTFG1, & + &WGTGF1,WGTGG1, & + &WGTPP2,WGTPM2,WGTNS2, & + &WGTFF2,WGTFG2, & + &WGTGF2,WGTGG2, & + &WGTC2Q,WGTC2G,YNTC2Q, & + &WGTCLQ,WGTCLG,WGTC3Q + + COMMON/QCWEIT/ & + &WGTFF1(MXX*(MXX+1)/2) ,WGTFG1(MXX*(MXX+1)/2,3:5), & + &WGTGF1(MXX*(MXX+1)/2) ,WGTGG1(MXX*(MXX+1)/2,3:5), & + &WGTPP2(MXX*(MXX+1)/2,3:5),WGTPM2(MXX*(MXX+1)/2,3:5), & + &WGTNS2(MXX*(MXX+1)/2,3:5), & + &WGTFF2(MXX*(MXX+1)/2,3:5),WGTFG2(MXX*(MXX+1)/2,3:5), & + &WGTGF2(MXX*(MXX+1)/2,3:5),WGTGG2(MXX*(MXX+1)/2,3:5), & + &WGTC2Q(MXX*(MXX+1)/2) ,WGTC2G(MXX*(MXX+1)/2,3:5), & + &WGTCLQ(MXX*(MXX+1)/2) ,WGTCLG(MXX*(MXX+1)/2,3:5), & + &WGTC3Q(MXX*(MXX+1)/2) ,YNTC2Q(MXX) + + COMMON/QCWADR/ IWADR(MXX,MXX) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + DIMENSION QUARKS(MXX) + +!-- Get adress where to store F3 + JD = IDFAST(3,ID) + +!-- Loop over all Q2 gridpoints + DO 100 IQ = 1,NQ2 + +!-- Initialise FSTORE and get minimum value of x + IXMIN = 999999 + DO IX = 1,NXX + FSTORE(IX,IQ,JD) = -401. + IF(MARKFF(IX,IQ).EQ.1) IXMIN = MIN(IXMIN,IX) + ENDDO + +!-- Is this Q2 gridpoint marked? + IF(MARKQQ(IQ).NE.1) EXIT + +!-- Get scale and check if inside Q2 gridboundaries + QMU = Q2TAB(IQ)*AAM2L + BBM2L + IMU = MIN(ABS(IQFROMQ(QMU)),NQ2-1) + IF(IMU.EQ.0) EXIT + QR2 = QMU*AAAR2 + BBBR2 + IR2 = MIN(ABS(IQFROMQ(QR2)),NQ2-1) + IF(IR2.EQ.0) EXIT + +!-- Calculate F3 for all marked gridpoints + FACT = LOG(Q2TAB(IQ)/QMU) + TX = 0. + TQ = LOG(QMU/Q2TAB(IMU))/LOG(Q2TAB(IMU+1)/Q2TAB(IMU)) + TR = LOG(QR2/Q2TAB(IR2))/LOG(Q2TAB(IR2+1)/Q2TAB(IR2)) + AS = GET_AS(IR2,TR) + DO IX0 = NXX,IXMIN,-1 + QUARKS(IX0) = GET_PDFXQ(ID,IX0,IMU,TX,TQ) + IF(MARKFF(IX0,IQ).EQ.1) THEN + FFF0 = QUARKS(IX0) + IF(IORD.EQ.1) THEN + FSTORE(IX0,IQ,JD) = FFF0 + ELSE + FF = 0. + DO IX = IX0,NXX + FF = FF + & + & (WGTC3Q(IWADR(IX,IX0))+ & + & WGTFF1(IWADR(IX,IX0))*FACT)*QUARKS(IX) + ENDDO + FSTORE(IX0,IQ,JD) = FFF0 + AS*FF + ENDIF + ENDIF + ENDDO + FSTORE(NXX+1,IQ,JD) = 0. + + 100 END DO + +!-- Mark F3 calculated for pdf ID + LFFCAL(3,ID) = .TRUE. + + RETURN + END + +!DECK ID>, FASTFKH. + +! ========================== + SUBROUTINE FASTFKH(IDF,ID) +! ========================== + +!-- IDF = 4,5,6,7 for F2c,FLc,F2b,FLb + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + + + CHARACTER*5 PNAM,STFNAM + LOGICAL LNFP + COMMON /QCLNFP/ LNFP(0:30,3:5) + COMMON /QCPNAM/ PNAM(0:30) + COMMON /QCPWGT/ PWGT(0:10,0:30,3:5) + COMMON /QCFNAM/ STFNAM(7) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + REAL & + &WH_C0KG,WH_C1KG,WH_C1BKG, & + &WH_C1KQ,WH_C1BKQ,WH_D1KQ,WH_D1BKQ + + COMMON/QCHWGT/ & + &WH_C0KG(0:MXX,MQ2,4:7), & + &WH_C1KG(0:MXX,MQ2,4:7),WH_C1BKG(0:MXX,MQ2,4:7), & + &WH_C1KQ(0:MXX,MQ2,4:7),WH_C1BKQ(0:MXX,MQ2,4:7), & + &WH_D1KQ(0:MXX,MQ2,4:7),WH_D1BKQ(0:MXX,MQ2,4:7) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + DIMENSION QU(MXX),GL(MXX),SI(MXX) + +!-- Correct quark mass + QMASS = CBMSTF(IDF) + CCCC = CHARGE(IDF) + +!-- Get adress where to store FKH + JD = IDFAST(IDF,ID) + +!-- FKH in LO + IF(IORD.EQ.1) THEN + + DO 100 IQ = 1,NQ2 + IXMIN = 999999 + DO IX = 1,NXX + FSTORE(IX,IQ,JD) = -401. + IF(MARKFH(IX,IQ).EQ.1) IXMIN = MIN(IXMIN,IX) + ENDDO + IF(MARKQQ(IQ).NE.1) GOTO 100 + QMU = Q2TAB(IQ)*AAM2H + BBM2H + IMU = MIN(ABS(IQFROMQ(QMU)),NQ2-1) + IF(IMU.EQ.0) GOTO 100 + QR2 = QMU*AAAR2 + BBBR2 + IR2 = MIN(ABS(IQFROMQ(QR2)),NQ2-1) + IF(IR2.EQ.0) GOTO 100 + TQ = LOG(QMU/Q2TAB(IMU))/LOG(Q2TAB(IMU+1)/Q2TAB(IMU)) + TR = LOG(QR2/Q2TAB(IR2))/LOG(Q2TAB(IR2+1)/Q2TAB(IR2)) + AS = GET_AS(IR2,TR) + DO IX0 = NXX,IXMIN,-1 + IXL = IHTAB(IX0) + X = XHTAB(IX0) + TX = (X-XXTAB(IXL))/(XXTAB(IXL+1)-XXTAB(IXL)) + GL(IX0) = GET_PDFXQ( 0,IXL,IMU,TX,TQ) + IF(MARKFH(IX0,IQ).EQ.1) THEN + FF = 0. + DO IX = IX0,NXX + FF = FF + & + & WH_C0KG(IX-IX0,IQ,IDF)*GL(IX) + ENDDO + FSTORE(IX0,IQ,JD) = CCCC*AS*FF + ENDIF + ENDDO + FSTORE(NXX+1,IQ,JD) = 0. + 100 CONTINUE + + +!-- FKH in NLO + ELSE + + DO 200 IQ = 1,NQ2 + IXMIN = 999999 + DO IX = 1,NXX + FSTORE(IX,IQ,JD) = -401. + IF(MARKFH(IX,IQ).EQ.1) IXMIN = MIN(IXMIN,IX) + ENDDO + IF(MARKQQ(IQ).NE.1) GOTO 200 + QMU = Q2TAB(IQ)*AAM2H + BBM2H + IMU = MIN(ABS(IQFROMQ(QMU)),NQ2-1) + IF(IMU.EQ.0) GOTO 200 + QR2 = QMU*AAAR2 + BBBR2 + IR2 = MIN(ABS(IQFROMQ(QR2)),NQ2-1) + IF(IR2.EQ.0) GOTO 200 + TQ = LOG(QMU/Q2TAB(IMU))/LOG(Q2TAB(IMU+1)/Q2TAB(IMU)) + TR = LOG(QR2/Q2TAB(IR2))/LOG(Q2TAB(IR2+1)/Q2TAB(IR2)) + AS = GET_AS(IR2,TR) + FACT = LOG(QMU/(QMASS*QMASS)) + DO IX0 = NXX,IXMIN,-1 + IXL = IHTAB(IX0) + X = XHTAB(IX0) + TX = (X-XXTAB(IXL))/(XXTAB(IXL+1)-XXTAB(IXL)) + GL(IX0) = GET_PDFXQ( 0,IXL,IMU,TX,TQ) + SI(IX0) = GET_PDFXQ( 1,IXL,IMU,TX,TQ) + QU(IX0) = GET_PDFXQ(ID,IXL,IMU,TX,TQ) + IF(MARKFH(IX0,IQ).EQ.1) THEN + F1 = 0. + F2 = 0. + F3 = 0. + F4 = 0. + DO IX = IX0,NXX + I = IX-IX0 + F1 = F1 + & + & WH_C0KG(I,IQ,IDF)*GL(IX) + F2 = F2 + & + & (WH_C1KG(I,IQ,IDF)+WH_C1BKG(I,IQ,IDF)*FACT)*GL(IX) + F3 = F3 + & + & (WH_C1KQ(I,IQ,IDF)+WH_C1BKQ(I,IQ,IDF)*FACT)*SI(IX) + F4 = F4 + & + & (WH_D1KQ(I,IQ,IDF)+WH_D1BKQ(I,IQ,IDF)*FACT)*QU(IX) + ENDDO + FSTORE(IX0,IQ,JD) = CCCC * & + & (AS*F1+AS*AS*(F2+F3)) + AS*AS*F4 + ENDIF + ENDDO + FSTORE(NXX+1,IQ,JD) = 0. + 200 CONTINUE + + ENDIF + + LFFCAL(IDF,ID) = .TRUE. + + + RETURN + END + +!DECK ID>, QNFGET. + +! ================================================ + DOUBLE PRECISION FUNCTION QNFGET(OPT,NAME,IX,IQ) +! ================================================ + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + CHARACTER*(*) OPT,NAME + +!--- Obsolete (16/07/96): use QSTFIJ instead + + QNFGET = QSTFIJ(OPT,NAME,IX,IQ,IFL) + + RETURN + END + +!DECK ID>, QSTFIJ. + +! ==================================================== + DOUBLE PRECISION FUNCTION QSTFIJ(OPT,UNAM,IX,IQ,IFL) +! ==================================================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +!--- Returns stf 'OPT' from pdf 'NAME' at gridpoint IX,IQ +!--- IFL = 0 : F2 sucessfully calculated +!--- 1 : Fast calculation +!--- -1 : Scale mu outside grid + + CHARACTER*(*) OPT,UNAM + CHARACTER*5 NAME + CHARACTER*5 OPT5 + + + LOGICAL LTIME + REAL T_START,T_END,T_SPENT + COMMON/QCTIME/T_START(10),T_END(10),T_SPENT(10),N_CALLS(10), & + &E_CALLS(10),LTIME + COMMON/QCFCNT/IFCNT(-1:1,5) + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + + + CHARACTER*5 PNAM,STFNAM + LOGICAL LNFP + COMMON /QCLNFP/ LNFP(0:30,3:5) + COMMON /QCPNAM/ PNAM(0:30) + COMMON /QCPWGT/ PWGT(0:10,0:30,3:5) + COMMON /QCFNAM/ STFNAM(7) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + CALL QTRACE('QSTFIJ ',0) + + CALL QSTRIP(UNAM,NAME) + CALL QSTRIP(OPT ,OPT5) + + QSTFIJ = 0. + IFL = 0 + X = 0. + Q = 0. + IERR = IFCHEK(OPT5,NAME,IX,IQ,X,Q,'QSTFIJ',1,ID) + +!-- Outside grid or cuts? + IF(IERR.EQ.-2) THEN + IFL = -1 + RETURN + ENDIF + + IF(.NOT.LALFOK) CALL QFILAS('QSTFIJ') + IF(.NOT.LDQ2OK) CALL QDELQ2 + + IF(IERR.EQ.1) THEN + QSTFIJ = GET_F2(ID,IX,IQ,IFL) + IFCNT(IFL,1) = IFCNT(IFL,1)+1 + ELSEIF(IERR.EQ.2) THEN + QSTFIJ = GET_FL(ID,IX,IQ,IFL) + IFCNT(IFL,2) = IFCNT(IFL,2)+1 + ELSEIF(IERR.EQ.3) THEN + QSTFIJ = GET_F3(ID,IX,IQ,IFL) + IFCNT(IFL,3) = IFCNT(IFL,3)+1 +!--- Use GETFKH instead of GET_FKH for the heavy quarks since +!--- we have to interpolate on the heavy quark grid. + ELSEIF(IERR.EQ.4) THEN + CALL GETFKH(4,ID,XXTAB(IX),Q2TAB(IQ),QSTFIJ,IFL) + IFCNT(IFL,4) = IFCNT(IFL,4)+1 + ELSEIF(IERR.EQ.5) THEN + CALL GETFKH(5,ID,XXTAB(IX),Q2TAB(IQ),QSTFIJ,IFL) + IFCNT(IFL,5) = IFCNT(IFL,5)+1 + ELSEIF(IERR.EQ.6) THEN + CALL GETFKH(6,ID,XXTAB(IX),Q2TAB(IQ),QSTFIJ,IFL) + IFCNT(IFL,4) = IFCNT(IFL,4)+1 + ELSEIF(IERR.EQ.7) THEN + CALL GETFKH(7,ID,XXTAB(IX),Q2TAB(IQ),QSTFIJ,IFL) + IFCNT(IFL,5) = IFCNT(IFL,5)+1 + ENDIF + + RETURN + + END + +!DECK ID>, STRFXQ. + +! ======================================= + SUBROUTINE STRFXQ(OPT,NAME,X,Q,VAL,IFL) +! ======================================= + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + CHARACTER*(*) OPT,NAME + +!--- Obsolete (16/07/96): use QSTFXQ instead + + VAL = QSTFXQ(OPT,NAME,X,Q,IFL) + + RETURN + END + +!DECK ID>, QSTFXQ. + +! ================================================== + DOUBLE PRECISION FUNCTION QSTFXQ(OPT,UNAM,X,Q,IFL) +! ================================================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + +!--- IFL = 0 : F2 sucessfully calculated +!--- 1 : Fast calculation +!--- -1 : Scale mu outside grid + + CHARACTER*(*) OPT,UNAM + CHARACTER*5 NAME + CHARACTER*5 OPT5 + + + LOGICAL LTIME + REAL T_START,T_END,T_SPENT + COMMON/QCTIME/T_START(10),T_END(10),T_SPENT(10),N_CALLS(10), & + &E_CALLS(10),LTIME + COMMON/QCFCNT/IFCNT(-1:1,5) + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + CALL QTRACE('QSTFXQ ',0) + + CALL QSTRIP(UNAM,NAME) + CALL QSTRIP(OPT ,OPT5) + + QSTFXQ = 0. + IFL = 0 + IERR = IFCHEK(OPT5,NAME,0,0,X,Q,'QSTFXQ',1,ID) + +!-- Outside grid or cuts? + IF(IERR.EQ.-2) THEN + IFL = -1 + RETURN + ENDIF + + IF(.NOT.LALFOK) CALL QFILAS('QSTFXQ') + IF(.NOT.LDQ2OK) CALL QDELQ2 + + IF (IERR.EQ.1) THEN + CALL GETF2(ID,X,Q,STRF,IFL) + IFCNT(IFL,1) = IFCNT(IFL,1)+1 + ELSEIF(IERR.EQ.2) THEN + CALL GETFL(ID,X,Q,STRF,IFL) + IFCNT(IFL,2) = IFCNT(IFL,2)+1 + ELSEIF(IERR.EQ.3) THEN + CALL GETF3(ID,X,Q,STRF,IFL) + IFCNT(IFL,3) = IFCNT(IFL,3)+1 + ELSEIF(IERR.EQ.4) THEN + CALL GETFKH(4,ID,X,Q,STRF,IFL) + IFCNT(IFL,4) = IFCNT(IFL,4)+1 + ELSEIF(IERR.EQ.5) THEN + CALL GETFKH(5,ID,X,Q,STRF,IFL) + IFCNT(IFL,5) = IFCNT(IFL,5)+1 + ELSEIF(IERR.EQ.6) THEN + CALL GETFKH(6,ID,X,Q,STRF,IFL) + IFCNT(IFL,4) = IFCNT(IFL,4)+1 + ELSEIF(IERR.EQ.7) THEN + CALL GETFKH(7,ID,X,Q,STRF,IFL) + IFCNT(IFL,5) = IFCNT(IFL,5)+1 + ENDIF + + QSTFXQ = STRF + + RETURN + + END + +!DECK ID>, IFCHEK. + +! ============================================================ + INTEGER FUNCTION IFCHEK(OPT,NAME,JX,JQ,XX,QQ,SRNAM,ISTOP,ID) +! ============================================================ + +!--- Check for structure function calculation + +!--- IFCHEK = -5: Q2 < 1.5 GeV2 for heavy quark stfs +!--- -4: No weight tables +!--- -3: Input NAME corresponds to gluon +!--- -2: x,Q2,M2,R2 outside grid or cuts +!--- -1: No x,Q2 grid available +!--- 0: Unknown option +!--- 1-7: F2, FL, xF3, F2c, FLc, F2b, FLb + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + CHARACTER*5 OPT + CHARACTER*5 NAME + CHARACTER*6 SRNAM + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + LOGICAL LTIME + REAL T_START,T_END,T_SPENT + COMMON/QCTIME/T_START(10),T_END(10),T_SPENT(10),N_CALLS(10), & + &E_CALLS(10),LTIME + COMMON/QCFCNT/IFCNT(-1:1,5) + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + +!-- Check if valid option + IERR = IDFCHK(OPT) + IF(IERR.EQ.0) GOTO 500 + JJ = IERR + IF(IERR.EQ.6) JJ = 4 + IF(IERR.EQ.7) JJ = 5 + +!-- Check x,Q2 grid available + IF(NXX.EQ.0.OR.NQ2.EQ.0) THEN + IERR = -1 + GOTO 500 + ENDIF + + IF(SRNAM.NE.'STFAST') THEN +!-- -------------------------- + +!-- Get x, Q2 + IF(SRNAM.EQ.'QSTFIJ') THEN + X = XFROMIX(JX) + Q = QFROMIQ(JQ) + ELSE + X = XX + Q = QQ + ENDIF + +!-- Check x,Q2 inside grid + QP = Q + IX = ABS(IXFROMX(X)) + IQ = MIN(ABS(IQFROMQ(Q)),NQ2-1) + IF(IX.EQ.0.OR.IQ.EQ.0) THEN + IFCNT(-1,JJ) = IFCNT(-1,JJ)+1 + IERR = -2 + GOTO 500 + ENDIF + +!-- Check factorisation scale inside grid or cuts + IF(IERR.LE.3) THEN + QM = AAM2L*Q + BBM2L + ELSE + QM = AAM2H*Q + BBM2H + ENDIF + QP = QM + IFLG = ICUTXQ(X,QP,0) + IF(IFLG.NE.0) THEN + IFCNT(-1,JJ) = IFCNT(-1,JJ)+1 + IERR = -2 + GOTO 500 + ENDIF + IM2 = MIN(ABS(IQFROMQ(QM)),NQ2-1) + +!-- Check renormalisation scale inside grid and above Lamba2 + QR = AAAR2*QM + BBBR2 + QP = QR + IR2 = MIN(ABS(IQFROMQ(QR)),NQ2-1) + IF(IR2.EQ.0 .OR. IFLG.GE.10000) THEN + IFCNT(-1,JJ) = IFCNT(-1,JJ)+1 + IERR = -2 + GOTO 500 + ENDIF + +!-- Check if the parton distribution is booked + ID = IDCHEK(NAME,NFMAP(IQ) ,SRNAM,1) + ID = IDCHEK(NAME,NFMAP(IQ+1) ,SRNAM,1) + ID = IDCHEK(NAME,NFMAP(IM2) ,SRNAM,1) + ID = IDCHEK(NAME,NFMAP(IM2+1),SRNAM,1) + ID = IDCHEK(NAME,NFMAP(IR2) ,SRNAM,1) + ID = IDCHEK(NAME,NFMAP(IR2+1),SRNAM,1) + + ELSE +!-- ---- + +!-- Check if the parton distribution is booked + NFMIN = NFMAP(1) + NFMAX = NFMAP(NQ2) + DO NF = NFMIN,NFMAX + ID = IDCHEK(NAME,NF,'STFAST',1) + ENDDO + + ENDIF +!-- ----- + +!-- No structure functions from the gluon + IF(ID.EQ.0) THEN + IERR = -3 + GOTO 500 + ENDIF + +!-- Check if the weight tables are available + IF(IERR.LE.3) THEN + IF(IORD.EQ.2.AND..NOT.LWTFOK) THEN + IERR = -4 + GOTO 500 + ENDIF + ELSEIF(IERR.EQ.4) THEN + IF(.NOT.LWFCOK) THEN + IERR = -4 + GOTO 500 + ENDIF + ELSEIF(IERR.EQ.5) THEN + IF(.NOT.LWLCOK) THEN + IERR = -4 + GOTO 500 + ENDIF + ELSEIF(IERR.EQ.6) THEN + IF(.NOT.LWFBOK) THEN + IERR = -4 + GOTO 500 + ENDIF + ELSEIF(IERR.EQ.7) THEN + IF(.NOT.LWLBOK) THEN + IERR = -4 + GOTO 500 + ENDIF + ENDIF + +!-- Check low Q2 for heavy quarks + IF(SRNAM.NE.'STFAST') THEN + IF(IERR.GE.4) THEN + IF(LCLOWQ.AND.Q.LE.1.5) THEN + IERR = -5 + GOTO 500 + ENDIF + ENDIF + ENDIF + + IFCHEK = IERR + + RETURN + + 500 CONTINUE + + IFCHEK = IERR + +!-- Stop? + IF(ISTOP.EQ.0) RETURN + IF(.NOT.LIMCK.AND.IERR.EQ.-2) RETURN + + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r '',A6,'' ---> STOP'')') & + & SRNAM + WRITE(6,'( '' ------------------------------------'')') + WRITE(6,'( '' Input Opt : '',A)') OPT + WRITE(6,'( '' Name : '',A)') NAME + IF(SRNAM.NE.'STFAST') THEN + IF(SRNAM.EQ.'QSTFIJ') THEN + WRITE(6,'( '' IX : '',I10 )') JX + WRITE(6,'( '' IQ : '',I10 )') JQ + ELSE + WRITE(6,'( '' x : '',E12.5)') XX + WRITE(6,'( '' Q2 : '',E12.5)') QQ + ENDIF + ENDIF + IF(IERR.EQ.0) THEN + WRITE(6,'(/'' Unknown option'')') + ELSEIF(IERR.EQ.-1) THEN + WRITE(6,'(/'' No x-Q2 grid available'')') + ELSEIF(IERR.EQ.-2) THEN + WRITE(6,'(/'' X, Q2 or mu2 outside grid or cuts'')') + IDUM = ICUTXQ(X,QP,1) + ELSEIF(IERR.EQ.-3) THEN + WRITE(6,'(/'' Strf from the gluon, no thank you'')') + ELSEIF(IERR.EQ.-4) THEN + WRITE(6,'(/'' No weight tables available'')') + ELSEIF(IERR.EQ.-5) THEN + WRITE(6,'(/'' Cannot calculate F2h, FLh for Q2 < 1.5 GeV2'')') + ENDIF + + CALL QTRACE('IFCHEK ',1) + + STOP + + END + +!DECK ID>, IDFCHK. + +! ============================= + INTEGER FUNCTION IDFCHK(OPT5) +! ============================= + +!-- Returns 1,2,3,4,5,6,7 for F2,Fl,xF3,F2c,FLc,F2b,FLb. +!-- Returns 0 if no valid OPT is given on input. + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + CHARACTER*5 OPT5 + + IDFCHK = 0 + + IF (OPT5(1:3).EQ.'F2 ') THEN + IDFCHK = 1 + ELSEIF(OPT5(1:3).EQ.'FL ') THEN + IDFCHK = 2 + ELSEIF(OPT5(1:3).EQ.'XF3') THEN + IDFCHK = 3 + ELSEIF(OPT5(1:3).EQ.'F2C') THEN + IDFCHK = 4 + ELSEIF(OPT5(1:3).EQ.'FLC') THEN + IDFCHK = 5 + ELSEIF(OPT5(1:3).EQ.'F2B') THEN + IDFCHK = 6 + ELSEIF(OPT5(1:3).EQ.'FLB') THEN + IDFCHK = 7 + ENDIF + + RETURN + END + +!DECK ID>, GETF2. + +! ================================ + SUBROUTINE GETF2(ID,X,Q,VAL,IFL) +! ================================ + +!--- IFL = 0 : F2 sucessfully calculated +!--- 1 : Fast calculation +!--- -1 : Scale mu outside grid + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + + + CHARACTER*5 PNAM,STFNAM + LOGICAL LNFP + COMMON /QCLNFP/ LNFP(0:30,3:5) + COMMON /QCPNAM/ PNAM(0:30) + COMMON /QCPWGT/ PWGT(0:10,0:30,3:5) + COMMON /QCFNAM/ STFNAM(7) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + REAL & + &WGTFF1,WGTFG1, & + &WGTGF1,WGTGG1, & + &WGTPP2,WGTPM2,WGTNS2, & + &WGTFF2,WGTFG2, & + &WGTGF2,WGTGG2, & + &WGTC2Q,WGTC2G,YNTC2Q, & + &WGTCLQ,WGTCLG,WGTC3Q + + COMMON/QCWEIT/ & + &WGTFF1(MXX*(MXX+1)/2) ,WGTFG1(MXX*(MXX+1)/2,3:5), & + &WGTGF1(MXX*(MXX+1)/2) ,WGTGG1(MXX*(MXX+1)/2,3:5), & + &WGTPP2(MXX*(MXX+1)/2,3:5),WGTPM2(MXX*(MXX+1)/2,3:5), & + &WGTNS2(MXX*(MXX+1)/2,3:5), & + &WGTFF2(MXX*(MXX+1)/2,3:5),WGTFG2(MXX*(MXX+1)/2,3:5), & + &WGTGF2(MXX*(MXX+1)/2,3:5),WGTGG2(MXX*(MXX+1)/2,3:5), & + &WGTC2Q(MXX*(MXX+1)/2) ,WGTC2G(MXX*(MXX+1)/2,3:5), & + &WGTCLQ(MXX*(MXX+1)/2) ,WGTCLG(MXX*(MXX+1)/2,3:5), & + &WGTC3Q(MXX*(MXX+1)/2) ,YNTC2Q(MXX) + + COMMON/QCWADR/ IWADR(MXX,MXX) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + VAL = 0. + JER = 1 + IFL = -1 + IX = IXFROMX(X) + IQ = IQFROMQ(Q) + + IF(IX.GT.0.AND.IQ.GT.0) THEN + VAL = GET_F2(ID,IX,IQ,IERR) + JER = MIN(JER,IERR) + ELSEIF(IX.GT.0.AND.IQ.LT.0.AND.IQ.NE.-NQ2) THEN + IQ = -IQ + VAL1 = GET_F2(ID,IX,IQ,IERR) + JER = MIN(JER,IERR) + VAL2 = GET_F2(ID,IX,IQ+1,IERR) + JER = MIN(JER,IERR) + TQ = LOG(Q/Q2TAB(IQ))/LOG(Q2TAB(IQ+1)/Q2TAB(IQ)) + VAL = (1.-TQ)*VAL1 + TQ*VAL2 + ELSEIF(IX.LT.0.AND.IQ.GT.0) THEN + IX = -IX + VAL1 = GET_F2(ID,IX,IQ,IERR) + JER = MIN(JER,IERR) + VAL2 = GET_F2(ID,IX+1,IQ,IERR) + JER = MIN(JER,IERR) + TX = (X-XXTAB(IX))/(XXTAB(IX+1)-XXTAB(IX)) + VAL = (1.-TX)*VAL1 + TX*VAL2 + ELSEIF(IX.LT.0.AND.IQ.LT.0.AND.IQ.NE.-NQ2) THEN + IX = -IX + IQ = -IQ + VAL1 = GET_F2(ID,IX,IQ,IERR) + JER = MIN(JER,IERR) + VAL2 = GET_F2(ID,IX,IQ+1,IERR) + JER = MIN(JER,IERR) + VAL3 = GET_F2(ID,IX+1,IQ,IERR) + JER = MIN(JER,IERR) + VAL4 = GET_F2(ID,IX+1,IQ+1,IERR) + JER = MIN(JER,IERR) + TQ = LOG(Q/Q2TAB(IQ))/LOG(Q2TAB(IQ+1)/Q2TAB(IQ)) + VAL1 = (1.-TQ)*VAL1 + TQ*VAL2 + VAL2 = (1.-TQ)*VAL3 + TQ*VAL4 + TX = (X-XXTAB(IX))/(XXTAB(IX+1)-XXTAB(IX)) + VAL = (1.-TX)*VAL1 + TX*VAL2 + ELSE + VAL = 0. + JER = -1 + ENDIF + + IFL = JER + + RETURN + END + +!DECK ID>, GET_F2. + +! ================================================ + DOUBLE PRECISION FUNCTION GET_F2(ID,IX0,IQ,IERR) +! ================================================ + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +!-- Input: ID parton distribution identifier +!-- IX0 x gridpoint +!-- Q Q2 value +!-- Output: IERR = 0 F2 successfully calculated +!-- = 1 Fast calculation +!-- = -1 Scale mu outside grid + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + + + CHARACTER*5 PNAM,STFNAM + LOGICAL LNFP + COMMON /QCLNFP/ LNFP(0:30,3:5) + COMMON /QCPNAM/ PNAM(0:30) + COMMON /QCPWGT/ PWGT(0:10,0:30,3:5) + COMMON /QCFNAM/ STFNAM(7) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + REAL & + &WGTFF1,WGTFG1, & + &WGTGF1,WGTGG1, & + &WGTPP2,WGTPM2,WGTNS2, & + &WGTFF2,WGTFG2, & + &WGTGF2,WGTGG2, & + &WGTC2Q,WGTC2G,YNTC2Q, & + &WGTCLQ,WGTCLG,WGTC3Q + + COMMON/QCWEIT/ & + &WGTFF1(MXX*(MXX+1)/2) ,WGTFG1(MXX*(MXX+1)/2,3:5), & + &WGTGF1(MXX*(MXX+1)/2) ,WGTGG1(MXX*(MXX+1)/2,3:5), & + &WGTPP2(MXX*(MXX+1)/2,3:5),WGTPM2(MXX*(MXX+1)/2,3:5), & + &WGTNS2(MXX*(MXX+1)/2,3:5), & + &WGTFF2(MXX*(MXX+1)/2,3:5),WGTFG2(MXX*(MXX+1)/2,3:5), & + &WGTGF2(MXX*(MXX+1)/2,3:5),WGTGG2(MXX*(MXX+1)/2,3:5), & + &WGTC2Q(MXX*(MXX+1)/2) ,WGTC2G(MXX*(MXX+1)/2,3:5), & + &WGTCLQ(MXX*(MXX+1)/2) ,WGTCLG(MXX*(MXX+1)/2,3:5), & + &WGTC3Q(MXX*(MXX+1)/2) ,YNTC2Q(MXX) + + COMMON/QCWADR/ IWADR(MXX,MXX) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + GET_F2 = 0. + + IF(LFFCAL(1,ID)) THEN + IERR = 1 + JD = IDFAST(1,ID) + GET_F2 = FSTORE(IX0,IQ,JD) + IF(GET_F2.GE.-99.) RETURN + ENDIF + + IERR = 0 + QMU = AAM2L*Q2TAB(IQ) + BBM2L + IMU = MIN(ABS(IQFROMQ(QMU)),NQ2-1) + IF(IMU.EQ.0) THEN + IERR = -1 + RETURN + ENDIF + + TX = 0. + TQ = LOG(QMU/Q2TAB(IMU))/LOG(Q2TAB(IMU+1)/Q2TAB(IMU)) + FFF0 = GET_PDFXQ(ID,IX0,IMU,TX,TQ) + + IF(IORD.EQ.1) THEN + GET_F2 = FFF0 + RETURN + ENDIF + + QR2 = QMU*AAAR2 + BBBR2 + IR2 = MIN(ABS(IQFROMQ(QR2)),NQ2-1) + IF(IR2.EQ.0) THEN + IERR = -1 + RETURN + ENDIF + TR = LOG(QR2/Q2TAB(IR2))/LOG(Q2TAB(IR2+1)/Q2TAB(IR2)) + + NF = NFMAP(IMU) + FACT = LOG(Q2TAB(IQ)/QMU) + F2 = 0. + DO IX = IX0,NXX + QU = GET_PDFXQ(ID,IX,IMU,TX,TQ) + GL = GET_PDFXQ( 0,IX,IMU,TX,TQ) + F2 = F2 + & + & (WGTC2Q(IWADR(IX,IX0))+ & + & WGTFF1(IWADR(IX,IX0))*FACT)*QU + & + & (WGTC2G(IWADR(IX,IX0),NF)+ & + & WGTFG1(IWADR(IX,IX0),NF)*FACT)*GL*PWGT(1,ID,NF) + ENDDO + GET_F2 = FFF0 + GET_AS(IR2,TR)*F2 + + RETURN + END + +!DECK ID>, GETFL. + +! ================================ + SUBROUTINE GETFL(ID,X,Q,VAL,IFL) +! ================================ + + +!--- IFL = 0 : F2 sucessfully calculated +!--- 1 : Fast calculation +!--- -1 : Scale mu outside grid + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + + + CHARACTER*5 PNAM,STFNAM + LOGICAL LNFP + COMMON /QCLNFP/ LNFP(0:30,3:5) + COMMON /QCPNAM/ PNAM(0:30) + COMMON /QCPWGT/ PWGT(0:10,0:30,3:5) + COMMON /QCFNAM/ STFNAM(7) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + REAL & + &WGTFF1,WGTFG1, & + &WGTGF1,WGTGG1, & + &WGTPP2,WGTPM2,WGTNS2, & + &WGTFF2,WGTFG2, & + &WGTGF2,WGTGG2, & + &WGTC2Q,WGTC2G,YNTC2Q, & + &WGTCLQ,WGTCLG,WGTC3Q + + COMMON/QCWEIT/ & + &WGTFF1(MXX*(MXX+1)/2) ,WGTFG1(MXX*(MXX+1)/2,3:5), & + &WGTGF1(MXX*(MXX+1)/2) ,WGTGG1(MXX*(MXX+1)/2,3:5), & + &WGTPP2(MXX*(MXX+1)/2,3:5),WGTPM2(MXX*(MXX+1)/2,3:5), & + &WGTNS2(MXX*(MXX+1)/2,3:5), & + &WGTFF2(MXX*(MXX+1)/2,3:5),WGTFG2(MXX*(MXX+1)/2,3:5), & + &WGTGF2(MXX*(MXX+1)/2,3:5),WGTGG2(MXX*(MXX+1)/2,3:5), & + &WGTC2Q(MXX*(MXX+1)/2) ,WGTC2G(MXX*(MXX+1)/2,3:5), & + &WGTCLQ(MXX*(MXX+1)/2) ,WGTCLG(MXX*(MXX+1)/2,3:5), & + &WGTC3Q(MXX*(MXX+1)/2) ,YNTC2Q(MXX) + + COMMON/QCWADR/ IWADR(MXX,MXX) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + VAL = 0. + JER = 1 + IFL = -1 + IX = IXFROMX(X) + IQ = IQFROMQ(Q) + + IF(IX.GT.0.AND.IQ.GT.0) THEN + VAL = GET_FL(ID,IX,IQ,IERR) + JER = MIN(JER,IERR) + ELSEIF(IX.GT.0.AND.IQ.LT.0.AND.IQ.NE.-NQ2) THEN + IQ = -IQ + VAL1 = GET_FL(ID,IX,IQ,IERR) + JER = MIN(JER,IERR) + VAL2 = GET_FL(ID,IX,IQ+1,IERR) + JER = MIN(JER,IERR) + TQ = LOG(Q/Q2TAB(IQ))/LOG(Q2TAB(IQ+1)/Q2TAB(IQ)) + VAL = (1.-TQ)*VAL1 + TQ*VAL2 + ELSEIF(IX.LT.0.AND.IQ.GT.0) THEN + IX = -IX + VAL1 = GET_FL(ID,IX,IQ,IERR) + JER = MIN(JER,IERR) + VAL2 = GET_FL(ID,IX+1,IQ,IERR) + JER = MIN(JER,IERR) + TX = (X-XXTAB(IX))/(XXTAB(IX+1)-XXTAB(IX)) + VAL = (1.-TX)*VAL1 + TX*VAL2 + ELSEIF(IX.LT.0.AND.IQ.LT.0.AND.IQ.NE.-NQ2) THEN + IX = -IX + IQ = -IQ + VAL1 = GET_FL(ID,IX,IQ,IERR) + JER = MIN(JER,IERR) + VAL2 = GET_FL(ID,IX,IQ+1,IERR) + JER = MIN(JER,IERR) + VAL3 = GET_FL(ID,IX+1,IQ,IERR) + JER = MIN(JER,IERR) + VAL4 = GET_FL(ID,IX+1,IQ+1,IERR) + JER = MIN(JER,IERR) + TQ = LOG(Q/Q2TAB(IQ))/LOG(Q2TAB(IQ+1)/Q2TAB(IQ)) + VAL1 = (1.-TQ)*VAL1 + TQ*VAL2 + VAL2 = (1.-TQ)*VAL3 + TQ*VAL4 + TX = (X-XXTAB(IX))/(XXTAB(IX+1)-XXTAB(IX)) + VAL = (1.-TX)*VAL1 + TX*VAL2 + ELSE + VAL = 0. + JER = -1 + ENDIF + + IFL = JER + + RETURN + END + +!DECK ID>, GET_FL. + +! ================================================ + DOUBLE PRECISION FUNCTION GET_FL(ID,IX0,IQ,IERR) +! ================================================ + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +!-- Input: ID parton distribution identifier +!-- IX0 x gridpoint +!-- Q Q2 value +!-- Output: IERR = 0 FL successfully calculated +!-- = 1 Fast calculation +!-- = -1 Scale mu outside grid + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + + + CHARACTER*5 PNAM,STFNAM + LOGICAL LNFP + COMMON /QCLNFP/ LNFP(0:30,3:5) + COMMON /QCPNAM/ PNAM(0:30) + COMMON /QCPWGT/ PWGT(0:10,0:30,3:5) + COMMON /QCFNAM/ STFNAM(7) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + REAL & + &WGTFF1,WGTFG1, & + &WGTGF1,WGTGG1, & + &WGTPP2,WGTPM2,WGTNS2, & + &WGTFF2,WGTFG2, & + &WGTGF2,WGTGG2, & + &WGTC2Q,WGTC2G,YNTC2Q, & + &WGTCLQ,WGTCLG,WGTC3Q + + COMMON/QCWEIT/ & + &WGTFF1(MXX*(MXX+1)/2) ,WGTFG1(MXX*(MXX+1)/2,3:5), & + &WGTGF1(MXX*(MXX+1)/2) ,WGTGG1(MXX*(MXX+1)/2,3:5), & + &WGTPP2(MXX*(MXX+1)/2,3:5),WGTPM2(MXX*(MXX+1)/2,3:5), & + &WGTNS2(MXX*(MXX+1)/2,3:5), & + &WGTFF2(MXX*(MXX+1)/2,3:5),WGTFG2(MXX*(MXX+1)/2,3:5), & + &WGTGF2(MXX*(MXX+1)/2,3:5),WGTGG2(MXX*(MXX+1)/2,3:5), & + &WGTC2Q(MXX*(MXX+1)/2) ,WGTC2G(MXX*(MXX+1)/2,3:5), & + &WGTCLQ(MXX*(MXX+1)/2) ,WGTCLG(MXX*(MXX+1)/2,3:5), & + &WGTC3Q(MXX*(MXX+1)/2) ,YNTC2Q(MXX) + + COMMON/QCWADR/ IWADR(MXX,MXX) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + GET_FL = 0. + + IF(LFFCAL(2,ID)) THEN + IERR = 1 + JD = IDFAST(2,ID) + GET_FL = FSTORE(IX0,IQ,JD) + IF(GET_FL.GE.-99.) RETURN + ENDIF + + IERR = 0 + + IF(IORD.EQ.1) THEN + GET_FL = 0. + RETURN + ENDIF + + QMU = AAM2L*Q2TAB(IQ) + BBM2L + IMU = MIN(ABS(IQFROMQ(QMU)),NQ2-1) + IF(IMU.EQ.0) THEN + IERR = -1 + RETURN + ENDIF + + QR2 = QMU*AAAR2 + BBBR2 + IR2 = MIN(ABS(IQFROMQ(QR2)),NQ2-1) + IF(IR2.EQ.0) THEN + IERR = -1 + RETURN + ENDIF + + TX = 0. + TQ = LOG(QMU/Q2TAB(IMU))/LOG(Q2TAB(IMU+1)/Q2TAB(IMU)) + TR = LOG(QR2/Q2TAB(IR2))/LOG(Q2TAB(IR2+1)/Q2TAB(IR2)) + + NF = NFMAP(IMU) + FACT = LOG(Q2TAB(IQ)/QMU)*FL_FAC + FL = 0. + DO IX = IX0,NXX + QU = GET_PDFXQ(ID,IX,IMU,TX,TQ) + GL = GET_PDFXQ( 0,IX,IMU,TX,TQ) + FL = FL + & + & (WGTCLQ(IWADR(IX,IX0))+ & + & WGTFF1(IWADR(IX,IX0))*FACT)*QU + & + & (WGTCLG(IWADR(IX,IX0),NF)+ & + & WGTFG1(IWADR(IX,IX0),NF)*FACT)*GL*PWGT(1,ID,NF) + ENDDO + GET_FL = GET_AS(IR2,TR)*FL + + RETURN + END + +!DECK ID>, GETF3. + +! ================================ + SUBROUTINE GETF3(ID,X,Q,VAL,IFL) +! ================================ + + +!--- IFL = 0 : F2 sucessfully calculated +!--- 1 : Fast calculation +!--- -1 : Scale mu outside grid + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + + + CHARACTER*5 PNAM,STFNAM + LOGICAL LNFP + COMMON /QCLNFP/ LNFP(0:30,3:5) + COMMON /QCPNAM/ PNAM(0:30) + COMMON /QCPWGT/ PWGT(0:10,0:30,3:5) + COMMON /QCFNAM/ STFNAM(7) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + REAL & + &WGTFF1,WGTFG1, & + &WGTGF1,WGTGG1, & + &WGTPP2,WGTPM2,WGTNS2, & + &WGTFF2,WGTFG2, & + &WGTGF2,WGTGG2, & + &WGTC2Q,WGTC2G,YNTC2Q, & + &WGTCLQ,WGTCLG,WGTC3Q + + COMMON/QCWEIT/ & + &WGTFF1(MXX*(MXX+1)/2) ,WGTFG1(MXX*(MXX+1)/2,3:5), & + &WGTGF1(MXX*(MXX+1)/2) ,WGTGG1(MXX*(MXX+1)/2,3:5), & + &WGTPP2(MXX*(MXX+1)/2,3:5),WGTPM2(MXX*(MXX+1)/2,3:5), & + &WGTNS2(MXX*(MXX+1)/2,3:5), & + &WGTFF2(MXX*(MXX+1)/2,3:5),WGTFG2(MXX*(MXX+1)/2,3:5), & + &WGTGF2(MXX*(MXX+1)/2,3:5),WGTGG2(MXX*(MXX+1)/2,3:5), & + &WGTC2Q(MXX*(MXX+1)/2) ,WGTC2G(MXX*(MXX+1)/2,3:5), & + &WGTCLQ(MXX*(MXX+1)/2) ,WGTCLG(MXX*(MXX+1)/2,3:5), & + &WGTC3Q(MXX*(MXX+1)/2) ,YNTC2Q(MXX) + + COMMON/QCWADR/ IWADR(MXX,MXX) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + VAL = 0. + JER = 1 + IFL = -1 + IX = IXFROMX(X) + IQ = IQFROMQ(Q) + + IF(IX.GT.0.AND.IQ.GT.0) THEN + VAL = GET_F3(ID,IX,IQ,IERR) + JER = MIN(JER,IERR) + ELSEIF(IX.GT.0.AND.IQ.LT.0.AND.IQ.NE.-NQ2) THEN + IQ = -IQ + VAL1 = GET_F3(ID,IX,IQ,IERR) + JER = MIN(JER,IERR) + VAL2 = GET_F3(ID,IX,IQ+1,IERR) + JER = MIN(JER,IERR) + TQ = LOG(Q/Q2TAB(IQ))/LOG(Q2TAB(IQ+1)/Q2TAB(IQ)) + VAL = (1.-TQ)*VAL1 + TQ*VAL2 + ELSEIF(IX.LT.0.AND.IQ.GT.0) THEN + IX = -IX + VAL1 = GET_F3(ID,IX,IQ,IERR) + JER = MIN(JER,IERR) + VAL2 = GET_F3(ID,IX+1,IQ,IERR) + JER = MIN(JER,IERR) + TX = (X-XXTAB(IX))/(XXTAB(IX+1)-XXTAB(IX)) + VAL = (1.-TX)*VAL1 + TX*VAL2 + ELSEIF(IX.LT.0.AND.IQ.LT.0.AND.IQ.NE.-NQ2) THEN + IX = -IX + IQ = -IQ + VAL1 = GET_F3(ID,IX,IQ,IERR) + JER = MIN(JER,IERR) + VAL2 = GET_F3(ID,IX,IQ+1,IERR) + JER = MIN(JER,IERR) + VAL3 = GET_F3(ID,IX+1,IQ,IERR) + JER = MIN(JER,IERR) + VAL4 = GET_F3(ID,IX+1,IQ+1,IERR) + JER = MIN(JER,IERR) + TQ = LOG(Q/Q2TAB(IQ))/LOG(Q2TAB(IQ+1)/Q2TAB(IQ)) + VAL1 = (1.-TQ)*VAL1 + TQ*VAL2 + VAL2 = (1.-TQ)*VAL3 + TQ*VAL4 + TX = (X-XXTAB(IX))/(XXTAB(IX+1)-XXTAB(IX)) + VAL = (1.-TX)*VAL1 + TX*VAL2 + ELSE + VAL = 0. + JER = -1 + ENDIF + + IFL = JER + + RETURN + END + +!DECK ID>, GET_F3. + +! ================================================ + DOUBLE PRECISION FUNCTION GET_F3(ID,IX0,IQ,IERR) +! ================================================ + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +!-- Input: ID parton distribution identifier +!-- IX0 x gridpoint +!-- Q Q2 value +!-- Output: IERR = 0 F3 successfully calculated +!-- = 1 Fast calculation +!-- = -1 Scale mu outside grid + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + + + CHARACTER*5 PNAM,STFNAM + LOGICAL LNFP + COMMON /QCLNFP/ LNFP(0:30,3:5) + COMMON /QCPNAM/ PNAM(0:30) + COMMON /QCPWGT/ PWGT(0:10,0:30,3:5) + COMMON /QCFNAM/ STFNAM(7) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + REAL & + &WGTFF1,WGTFG1, & + &WGTGF1,WGTGG1, & + &WGTPP2,WGTPM2,WGTNS2, & + &WGTFF2,WGTFG2, & + &WGTGF2,WGTGG2, & + &WGTC2Q,WGTC2G,YNTC2Q, & + &WGTCLQ,WGTCLG,WGTC3Q + + COMMON/QCWEIT/ & + &WGTFF1(MXX*(MXX+1)/2) ,WGTFG1(MXX*(MXX+1)/2,3:5), & + &WGTGF1(MXX*(MXX+1)/2) ,WGTGG1(MXX*(MXX+1)/2,3:5), & + &WGTPP2(MXX*(MXX+1)/2,3:5),WGTPM2(MXX*(MXX+1)/2,3:5), & + &WGTNS2(MXX*(MXX+1)/2,3:5), & + &WGTFF2(MXX*(MXX+1)/2,3:5),WGTFG2(MXX*(MXX+1)/2,3:5), & + &WGTGF2(MXX*(MXX+1)/2,3:5),WGTGG2(MXX*(MXX+1)/2,3:5), & + &WGTC2Q(MXX*(MXX+1)/2) ,WGTC2G(MXX*(MXX+1)/2,3:5), & + &WGTCLQ(MXX*(MXX+1)/2) ,WGTCLG(MXX*(MXX+1)/2,3:5), & + &WGTC3Q(MXX*(MXX+1)/2) ,YNTC2Q(MXX) + + COMMON/QCWADR/ IWADR(MXX,MXX) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + GET_F3 = 0. + + IF(LFFCAL(3,ID)) THEN + IERR = 1 + JD = IDFAST(3,ID) + GET_F3 = FSTORE(IX0,IQ,JD) + IF(GET_F3.GE.-99.) RETURN + ENDIF + + IERR = 0 + + QMU = AAM2L*Q2TAB(IQ) + BBM2L + IMU = MIN(ABS(IQFROMQ(QMU)),NQ2-1) + IF(IMU.EQ.0) THEN + IERR = -1 + RETURN + ENDIF + + TX = 0. + TQ = LOG(QMU/Q2TAB(IMU))/LOG(Q2TAB(IMU+1)/Q2TAB(IMU)) + FFF0 = GET_PDFXQ(ID,IX0,IMU,TX,TQ) + + IF(IORD.EQ.1) THEN + GET_F3 = FFF0 + RETURN + ENDIF + + QR2 = QMU*AAAR2 + BBBR2 + IR2 = MIN(ABS(IQFROMQ(QR2)),NQ2-1) + IF(IR2.EQ.0) THEN + IERR = -1 + RETURN + ENDIF + TR = LOG(QR2/Q2TAB(IR2))/LOG(Q2TAB(IR2+1)/Q2TAB(IR2)) + + F3 = 0. + FACT = LOG(Q2TAB(IQ)/QMU) + DO IX = IX0,NXX + QU = GET_PDFXQ(ID,IX,IMU,TX,TQ) + F3 = F3 + & + & (WGTC3Q(IWADR(IX,IX0))+ & + & WGTFF1(IWADR(IX,IX0))*FACT)*QU + ENDDO + GET_F3 = FFF0 + GET_AS(IR2,TR)*F3 + + RETURN + END + +!DECK ID>, GETFKH. + +! ===================================== + SUBROUTINE GETFKH(IDF,ID,X,Q,VAL,IFL) +! ===================================== + +!--- Input : IDF = 4,5,6,7 for F2c,FLc,F2b,Flb +!--- ID = parton distribution identifier +!--- X = x value +!--- Q = Q2 value + +!--- Output: VAL = heavy quark structure function +!--- IFL = 0 : F2 sucessfully calculated +!--- 1 : Fast calculation +!--- -1 : Scale mu outside grid + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + + + CHARACTER*5 PNAM,STFNAM + LOGICAL LNFP + COMMON /QCLNFP/ LNFP(0:30,3:5) + COMMON /QCPNAM/ PNAM(0:30) + COMMON /QCPWGT/ PWGT(0:10,0:30,3:5) + COMMON /QCFNAM/ STFNAM(7) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + REAL & + &WGTFF1,WGTFG1, & + &WGTGF1,WGTGG1, & + &WGTPP2,WGTPM2,WGTNS2, & + &WGTFF2,WGTFG2, & + &WGTGF2,WGTGG2, & + &WGTC2Q,WGTC2G,YNTC2Q, & + &WGTCLQ,WGTCLG,WGTC3Q + + COMMON/QCWEIT/ & + &WGTFF1(MXX*(MXX+1)/2) ,WGTFG1(MXX*(MXX+1)/2,3:5), & + &WGTGF1(MXX*(MXX+1)/2) ,WGTGG1(MXX*(MXX+1)/2,3:5), & + &WGTPP2(MXX*(MXX+1)/2,3:5),WGTPM2(MXX*(MXX+1)/2,3:5), & + &WGTNS2(MXX*(MXX+1)/2,3:5), & + &WGTFF2(MXX*(MXX+1)/2,3:5),WGTFG2(MXX*(MXX+1)/2,3:5), & + &WGTGF2(MXX*(MXX+1)/2,3:5),WGTGG2(MXX*(MXX+1)/2,3:5), & + &WGTC2Q(MXX*(MXX+1)/2) ,WGTC2G(MXX*(MXX+1)/2,3:5), & + &WGTCLQ(MXX*(MXX+1)/2) ,WGTCLG(MXX*(MXX+1)/2,3:5), & + &WGTC3Q(MXX*(MXX+1)/2) ,YNTC2Q(MXX) + + COMMON/QCWADR/ IWADR(MXX,MXX) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + VAL = 0. + IFL = -1 + + JER = 1 + IX = IHFROMH(X) + IQ = IQFROMQ(Q) + + IF(IX.GT.0.AND.IQ.GT.0) THEN + VAL = GET_FKH(IDF,ID,IX,IQ,IERR) + JER = MIN(JER,IERR) + ELSEIF(IX.GT.0.AND.IQ.LT.0.AND.IQ.NE.-NQ2) THEN + IQ = -IQ + VAL1 = GET_FKH(IDF,ID,IX,IQ,IERR) + JER = MIN(JER,IERR) + VAL2 = GET_FKH(IDF,ID,IX,IQ+1,IERR) + JER = MIN(JER,IERR) + TQ = LOG(Q/Q2TAB(IQ))/LOG(Q2TAB(IQ+1)/Q2TAB(IQ)) + VAL = (1.-TQ)*VAL1 + TQ*VAL2 + ELSEIF(IX.LT.0.AND.IQ.GT.0) THEN + IX = -IX + VAL1 = GET_FKH(IDF,ID,IX,IQ,IERR) + JER = MIN(JER,IERR) + VAL2 = GET_FKH(IDF,ID,IX+1,IQ,IERR) + JER = MIN(JER,IERR) + TX = (X-XHTAB(IX))/(XHTAB(IX+1)-XHTAB(IX)) + VAL = (1.-TX)*VAL1 + TX*VAL2 + ELSEIF(IX.LT.0.AND.IQ.LT.0.AND.IQ.NE.-NQ2) THEN + IX = -IX + IQ = -IQ + VAL1 = GET_FKH(IDF,ID,IX,IQ,IERR) + JER = MIN(JER,IERR) + VAL2 = GET_FKH(IDF,ID,IX,IQ+1,IERR) + JER = MIN(JER,IERR) + VAL3 = GET_FKH(IDF,ID,IX+1,IQ,IERR) + JER = MIN(JER,IERR) + VAL4 = GET_FKH(IDF,ID,IX+1,IQ+1,IERR) + JER = MIN(JER,IERR) + TQ = LOG(Q/Q2TAB(IQ))/LOG(Q2TAB(IQ+1)/Q2TAB(IQ)) + VAL1 = (1.-TQ)*VAL1 + TQ*VAL2 + VAL2 = (1.-TQ)*VAL3 + TQ*VAL4 + TX = (X-XHTAB(IX))/(XHTAB(IX+1)-XHTAB(IX)) + VAL = (1.-TX)*VAL1 + TX*VAL2 + ELSE + VAL = 0. + JER = -1 + ENDIF + + IFL = JER + + + RETURN + END + +!DECK ID>, FILLWF. + +! ==================================== + SUBROUTINE FILLWF(IO1,IO2,IF2,NFLAV) +! ==================================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + REAL & + &WGTFF1,WGTFG1, & + &WGTGF1,WGTGG1, & + &WGTPP2,WGTPM2,WGTNS2, & + &WGTFF2,WGTFG2, & + &WGTGF2,WGTGG2, & + &WGTC2Q,WGTC2G,YNTC2Q, & + &WGTCLQ,WGTCLG,WGTC3Q + + COMMON/QCWEIT/ & + &WGTFF1(MXX*(MXX+1)/2) ,WGTFG1(MXX*(MXX+1)/2,3:5), & + &WGTGF1(MXX*(MXX+1)/2) ,WGTGG1(MXX*(MXX+1)/2,3:5), & + &WGTPP2(MXX*(MXX+1)/2,3:5),WGTPM2(MXX*(MXX+1)/2,3:5), & + &WGTNS2(MXX*(MXX+1)/2,3:5), & + &WGTFF2(MXX*(MXX+1)/2,3:5),WGTFG2(MXX*(MXX+1)/2,3:5), & + &WGTGF2(MXX*(MXX+1)/2,3:5),WGTGG2(MXX*(MXX+1)/2,3:5), & + &WGTC2Q(MXX*(MXX+1)/2) ,WGTC2G(MXX*(MXX+1)/2,3:5), & + &WGTCLQ(MXX*(MXX+1)/2) ,WGTCLG(MXX*(MXX+1)/2,3:5), & + &WGTC3Q(MXX*(MXX+1)/2) ,YNTC2Q(MXX) + + COMMON/QCWADR/ IWADR(MXX,MXX) + + + EXTERNAL C2Q, C2QX0, C2G, CLQ, CLG, D3Q + EXTERNAL PQGLO, PGQLO, PQQLO, PQQX0, PGGLO, PGGX0 + EXTERNAL PP1SFUN, PP1SX0, PM1SFUN, PM1SX0 + EXTERNAL FF1SFUN, FF1SX0, GF1SFUN, XP1TFUN + EXTERNAL GG1SFUN, GG1SX0, FG1SFUN, XG1TFUN + + COMMON /QCWGTC/ YWGT,QPCG,QMASS,EGAUSS,NF + + EGAUSS = 0.0001 + NF = NFLAV + + CWFGG = 6.*(11./12.-NF/18.) - 6. + + DO 90 IX0 = 1,NXX + + X0 = XXTAB(IX0) + + YNTC2Q(IX0) = DGAUSS_LHA(C2Q,0.D0,X0,EGAUSS) + + SI = X0/XXTAB(IX0) + SP = X0/XXTAB(IX0+1) + + IF(IO1.NE.0) THEN + CALL S1FUNC(PQGLO ,SP,SI,S1PQG) + WGTFG1(IWADR(IX0,IX0),NF) = S1PQG + CALL S1FUNC(PGQLO ,SP,SI,S1PGQ) + WGTGF1(IWADR(IX0,IX0)) = S1PGQ + CALL S1FUNC(PQQX0 ,SP,SI,S1PQQ) + WGTFF1(IWADR(IX0,IX0)) = S1PQQ+2.+(8./3.)*LOG(1.-SP) + CALL S1FUNC(PGGX0 ,SP,SI,S1PGG) + WGTGG1(IWADR(IX0,IX0),NF) = S1PGG+6.*LOG(1.-SP)+CWFGG + ENDIF + + IF(IO2.NE.0) THEN + TERM1 = DGAUSS_LHA(PM1SFUN,0.D0,SP,EGAUSS) + TERM2 = DGAUSS_LHA(XP1TFUN,0.D0,SP,EGAUSS) + TERM3 = DGAUSS_LHA(XG1TFUN,0.D0,SP,EGAUSS) + CALL S1FUNC(PP1SX0 ,SP,SI,S1NS2) + WGTPP2(IWADR(IX0,IX0),NF) = S1NS2 - TERM1 + WGTNS2(IWADR(IX0,IX0),NF) = S1NS2 - TERM1 + LPLUS = .TRUE. + CALL S1FUNC(PM1SX0 ,SP,SI,S1F32) + WGTPM2(IWADR(IX0,IX0),NF) = S1F32 - TERM1 + CALL S1FUNC(FF1SX0 ,SP,SI,S1FF2) + WGTFF2(IWADR(IX0,IX0),NF) = S1FF2 - TERM2 + CALL S1FUNC(GF1SFUN,SP,SI,S1FG2) + WGTFG2(IWADR(IX0,IX0),NF) = S1FG2 + CALL S1FUNC(GG1SX0 ,SP,SI,S1GG2) + WGTGG2(IWADR(IX0,IX0),NF) = S1GG2 - TERM3 + CALL S1FUNC(FG1SFUN,SP,SI,S1GF2) + WGTGF2(IWADR(IX0,IX0),NF) = S1GF2 + ENDIF + + IF(IF2.NE.0) THEN + TERM = DGAUSS_LHA(C2Q,0.D0,SP,EGAUSS) + CALL S1FUNC(C2QX0 ,SP,SI,S1C2Q) + WGTC2Q(IWADR(IX0,IX0)) = S1C2Q - TERM + CALL S1FUNC(C2G ,SP,SI,S1C2G) + WGTC2G(IWADR(IX0,IX0),NF) = S1C2G + CALL S1FUNC(CLQ ,SP,SI,S1CLQ) + WGTCLQ(IWADR(IX0,IX0)) = S1CLQ + CALL S1FUNC(CLG ,SP,SI,S1CLG) + WGTCLG(IWADR(IX0,IX0),NF) = S1CLG + CALL S1FUNC(D3Q ,SP,SI,S1D3Q) + WGTC3Q(IWADR(IX0,IX0)) = S1C2Q - TERM - S1D3Q + ENDIF + + DO 80 IX = IX0+1,NXX + + SI = X0/XXTAB(IX) + SP = X0/XXTAB(IX+1) + SM = X0/XXTAB(IX-1) + + IF(IO1.NE.0) THEN + CALL S1FUNC(PQGLO ,SP,SI,S1PQG) + CALL S2FUNC(PQGLO ,SI,SM,S2PQG) + WGTFG1(IWADR(IX,IX0),NF) = (S1PQG-S2PQG) + CALL S1FUNC(PGQLO ,SP,SI,S1PGQ) + CALL S2FUNC(PGQLO ,SI,SM,S2PGQ) + WGTGF1(IWADR(IX,IX0)) = S1PGQ-S2PGQ + CALL S1FUNC(PQQLO ,SP,SI,S1PQQ) + CALL S2FUNC(PQQLO ,SI,SM,S2PQQ) + WGTFF1(IWADR(IX,IX0)) = S1PQQ-S2PQQ + CALL S1FUNC(PGGLO ,SP,SI,S1PGG) + CALL S2FUNC(PGGLO ,SI,SM,S2PGG) + WGTGG1(IWADR(IX,IX0),NF) = S1PGG-S2PGG + ENDIF + + IF(IO2.NE.0) THEN + CALL S1FUNC(PP1SFUN,SP,SI,S1NS2) + CALL S2FUNC(PP1SFUN,SI,SM,S2NS2) + WGTPP2(IWADR(IX,IX0),NF) = S1NS2-S2NS2 + WGTNS2(IWADR(IX,IX0),NF) = S1NS2-S2NS2 + CALL S1FUNC(PM1SFUN,SP,SI,S1F32) + CALL S2FUNC(PM1SFUN,SI,SM,S2F32) + WGTPM2(IWADR(IX,IX0),NF) = S1F32-S2F32 + CALL S1FUNC(FF1SFUN,SP,SI,S1FF2) + CALL S2FUNC(FF1SFUN,SI,SM,S2FF2) + WGTFF2(IWADR(IX,IX0),NF) = S1FF2-S2FF2 + CALL S1FUNC(GF1SFUN,SP,SI,S1FG2) + CALL S2FUNC(GF1SFUN,SI,SM,S2FG2) + WGTFG2(IWADR(IX,IX0),NF) = S1FG2-S2FG2 + CALL S1FUNC(GG1SFUN,SP,SI,S1GG2) + CALL S2FUNC(GG1SFUN,SI,SM,S2GG2) + WGTGG2(IWADR(IX,IX0),NF) = S1GG2-S2GG2 + CALL S1FUNC(FG1SFUN,SP,SI,S1GF2) + CALL S2FUNC(FG1SFUN,SI,SM,S2GF2) + WGTGF2(IWADR(IX,IX0),NF) = S1GF2-S2GF2 + ENDIF + + IF(IF2.NE.0) THEN + CALL S1FUNC(C2Q ,SP,SI,S1C2Q) + CALL S2FUNC(C2Q ,SI,SM,S2C2Q) + WGTC2Q(IWADR(IX,IX0)) = S1C2Q-S2C2Q + CALL S1FUNC(C2G ,SP,SI,S1C2G) + CALL S2FUNC(C2G ,SI,SM,S2C2G) + WGTC2G(IWADR(IX,IX0),NF) = S1C2G-S2C2G + CALL S1FUNC(CLQ ,SP,SI,S1CLQ) + CALL S2FUNC(CLQ ,SI,SM,S2CLQ) + WGTCLQ(IWADR(IX,IX0)) = S1CLQ-S2CLQ + CALL S1FUNC(CLG ,SP,SI,S1CLG) + CALL S2FUNC(CLG ,SI,SM,S2CLG) + WGTCLG(IWADR(IX,IX0),NF) = S1CLG-S2CLG + CALL S1FUNC(D3Q ,SP,SI,S1D3Q) + CALL S2FUNC(D3Q ,SI,SM,S2D3Q) + WGTC3Q(IWADR(IX,IX0)) = S1C2Q-S2C2Q-S1D3Q+S2D3Q + ENDIF + + 80 CONTINUE + + 90 END DO + + YWGT = 0. + + RETURN + END + +!DECK ID>, IWTADR. + + INTEGER FUNCTION IWTADR(I,J,K) + +!--- Upper diagonal storage: I .ge. J (!) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + IWTADR = 1 + (J-1)*(MXX+1) - & + & (J*(J-1))/2 + (I-J) + (K-1)*(MXX*(MXX+1))/2 + + RETURN + END + +!DECK ID>, IWTAD. + + INTEGER FUNCTION IWTAD(I,J) + +!--- Upper diagonal storage: I .ge. J (!) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + IWTAD = 1 + (J-1)*(MXX+1) - (J*(J-1))/2 + (I-J) + + RETURN + END + +!DECK ID>, S1FUNC. + +! ================================ + SUBROUTINE S1FUNC(FUN,U,V,S1FUN) +! ================================ + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + EXTERNAL FUN + + COMMON /QCWGTC/ YWGT,QPCG,QMASS,EGAUSS,NF + + YWGT = U + S1FUN = DGAUSS_LHA(FUN,U,V,EGAUSS)*V/(V-U) + + YWGT = 0. + + RETURN + END + +!DECK ID>, S2FUNC. + +! ================================ + SUBROUTINE S2FUNC(FUN,U,V,S2FUN) +! ================================ + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + EXTERNAL FUN + + COMMON /QCWGTC/ YWGT,QPCG,QMASS,EGAUSS,NF + + YWGT = V + S2FUN = DGAUSS_LHA(FUN,U,V,EGAUSS)*U/(V-U) + + YWGT = 0. + + RETURN + END + +!DECK ID>, FILLO1. + +! ===================== + SUBROUTINE FILLO1(NF) +! ===================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +!----- | F | | WGTFF WGTFG | | F | +!----- d/dLnQ2 | | = | | | | +!----- | G | | WGTGF WGTGG | | G | + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + REAL & + &WGTFF1,WGTFG1, & + &WGTGF1,WGTGG1, & + &WGTPP2,WGTPM2,WGTNS2, & + &WGTFF2,WGTFG2, & + &WGTGF2,WGTGG2, & + &WGTC2Q,WGTC2G,YNTC2Q, & + &WGTCLQ,WGTCLG,WGTC3Q + + COMMON/QCWEIT/ & + &WGTFF1(MXX*(MXX+1)/2) ,WGTFG1(MXX*(MXX+1)/2,3:5), & + &WGTGF1(MXX*(MXX+1)/2) ,WGTGG1(MXX*(MXX+1)/2,3:5), & + &WGTPP2(MXX*(MXX+1)/2,3:5),WGTPM2(MXX*(MXX+1)/2,3:5), & + &WGTNS2(MXX*(MXX+1)/2,3:5), & + &WGTFF2(MXX*(MXX+1)/2,3:5),WGTFG2(MXX*(MXX+1)/2,3:5), & + &WGTGF2(MXX*(MXX+1)/2,3:5),WGTGG2(MXX*(MXX+1)/2,3:5), & + &WGTC2Q(MXX*(MXX+1)/2) ,WGTC2G(MXX*(MXX+1)/2,3:5), & + &WGTCLQ(MXX*(MXX+1)/2) ,WGTCLG(MXX*(MXX+1)/2,3:5), & + &WGTC3Q(MXX*(MXX+1)/2) ,YNTC2Q(MXX) + + COMMON/QCWADR/ IWADR(MXX,MXX) + + + DO 100 IX0=1,NXX + X0 = XXTAB(IX0) + + DO 100 IXI=IX0,NXX + SI = X0 / XXTAB(IXI) + SP = X0 / XXTAB(IXI+1) + IF(IXI.EQ.IX0) THEN + SSP = LOG(SP) / (1.-SP) + WPQQV = SP + 4.*LOG(1.-SP)+ 2.*SP*SSP + WPQGV = 3. - (1.-SP)**2 + 3.*SP*SSP + WPGQV = - 7. - SP - 4.*(1.+SP)*SSP + WPGGV = - 12.5 - NF/3. + 6.*LOG(1.-SP) + (1.-SP)**2 & + & - 6.*(1.+SP)*SSP + ELSEIF(IXI.EQ.IX0+1) THEN + SSI = LOG(SI) / (1.-SI) + WPQQV = SP-1. + SQQ(SI,SP) - 2.*SSI + WPQGV = (SP-1.)*(2.-SI-SP) - 3.*SP*LOG(SP/SI)/(SP-SI) - 3.*SSI + WPGQV = 1.-SP + 4.*(SP+1.)*LOG(SP/SI)/(SP-SI) + 8.*SSI + WPGGV = (1.-SP)*(2.-SI-SP) + 6.*SGG(SI,SP) + 12.*SSI + ELSE + SM = X0 / XXTAB(IXI-1) + WPQQV = SP-SM + SQQ(SI,SP) - SQQ(SI,SM) + WPQGV = (SP-SM)*(3.-SM-SI-SP) - 3.*SP*LOG(SP/SI)/(SP-SI) & + & + 3.*SM*LOG(SM/SI)/(SM-SI) + WPGQV = SM-SP + 4.*(SP+1.)*LOG(SP/SI)/(SP-SI) & + & - 4.*(SM+1.)*LOG(SM/SI)/(SM-SI) + WPGGV = (SM-SP)*(3.-SM-SI-SP) + 6.*( SGG(SI,SP) - SGG(SI,SM) ) + ENDIF + + WGTFF1(IWADR(IXI,IX0)) = 2./3. * SI * WPQQV + + WGTFG1(IWADR(IXI,IX0),NF) = 1./6. * SI * WPQGV * 2.*NF + + WGTGF1(IWADR(IXI,IX0)) = 2./3. * SI * WPGQV + + WGTGG1(IWADR(IXI,IX0),NF) = SI * WPGGV + + 100 CONTINUE + + RETURN + END + +!DECK ID>, SQQ. + +! ================================== + DOUBLE PRECISION FUNCTION SQQ(X,Y) +! ================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + SQQ = 2./(Y-X) * ( 2.*(Y-1.)*LOG((1.-Y)/(1.-X)) - Y*LOG(Y/X) ) + + RETURN + END + +!DECK ID>, SGG. + +! ================================== + DOUBLE PRECISION FUNCTION SGG(X,Y) +! ================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + SGG = ( (1.+Y)*LOG(Y/X) - (1.-Y)*LOG((1.-Y)/(1.-X)) ) / (Y-X) + + RETURN + END + +!DECK ID>, QNSPLF. + +! =============================================== + DOUBLE PRECISION FUNCTION QNSPLF(OPT,X,Q,NFLAV) +! =============================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + CHARACTER*(*) OPT + CHARACTER*10 OPT1 + + COMMON /QCWGTC/ YWGT,QPGC,QMASS,EGAUSS,NF + + DATA OPT1 /' '/ + + YWGT = 0. + NF = NFLAV + QNSPLF = 0. + QPCG = Q + CALL QNRGET('CMASS',QMASS) + + LEN = LENOCC_LHA(OPT) + IF(LEN.GT.10 .OR. LEN.LE.0) GOTO 550 +!-- Avoid changing input parameter + OPT1(1:LEN) = OPT(1:LEN) + CALL CLTOU_LHA(OPT1) + + IF (LEN.GE.4.AND.OPT1(1:4).EQ.'PFF1') THEN + IF(X.GE.1..OR.X.LT.0.) RETURN + QNSPLF = PQQLO(X) + ELSEIF(LEN.GE.4.AND.OPT1(1:4).EQ.'PFG1') THEN + IF(NF.LE.0) GOTO 500 + IF(X.GT.1..OR.X.LT.0.) RETURN + QNSPLF = PQGLO(X) + ELSEIF(LEN.GE.4.AND.OPT1(1:4).EQ.'PGF1') THEN + IF(X.GT.1..OR.X.LT.0.) RETURN + QNSPLF = PGQLO(X) + ELSEIF(LEN.GE.4.AND.OPT1(1:4).EQ.'PGG1') THEN + IF(X.GE.1..OR.X.LT.0.) RETURN + QNSPLF = PGGLO(X) + ELSEIF(LEN.GE.4.AND.OPT1(1:4).EQ.'PPL2') THEN + IF(NF.LE.0) GOTO 500 + IF(X.GE.1..OR.X.LT.0.) RETURN + QNSPLF = PP1SFUN(X) + ELSEIF(LEN.GE.4.AND.OPT1(1:4).EQ.'PMI2') THEN + IF(NF.LE.0) GOTO 500 + IF(X.GE.1..OR.X.LT.0.) RETURN + QNSPLF = PM1SFUN(X) + ELSEIF(LEN.GE.4.AND.OPT1(1:4).EQ.'PFF2') THEN + IF(NF.LE.0) GOTO 500 + IF(X.GE.1..OR.X.LT.0.) RETURN + QNSPLF = FF1SFUN(X) + ELSEIF(LEN.GE.4.AND.OPT1(1:4).EQ.'PFG2') THEN + IF(NF.LE.0) GOTO 500 + IF(X.GE.1..OR.X.LT.0.) RETURN + QNSPLF = FG1SFUN(X) + ELSEIF(LEN.GE.4.AND.OPT1(1:4).EQ.'PGF2') THEN + IF(NF.LE.0) GOTO 500 + IF(X.GE.1..OR.X.LT.0.) RETURN + QNSPLF = GF1SFUN(X) + ELSEIF(LEN.GE.4.AND.OPT1(1:4).EQ.'PGG2') THEN + IF(NF.LE.0) GOTO 500 + IF(X.GE.1..OR.X.LT.0.) RETURN + QNSPLF = GG1SFUN(X) + ELSEIF(LEN.GE.3.AND.OPT1(1:3).EQ.'C1Q') THEN + IF(X.GE.1..OR.X.LT.0.) RETURN + QNSPLF = C2Q(X)-CLQ(X) + ELSEIF(LEN.GE.3.AND.OPT1(1:3).EQ.'C1G') THEN + IF(NF.LE.0) GOTO 500 + IF(X.GE.1..OR.X.LT.0.) RETURN + QNSPLF = C2G(X)-CLG(X) + ELSEIF(LEN.GE.3.AND.OPT1(1:3).EQ.'C2Q') THEN + IF(X.GE.1..OR.X.LT.0.) RETURN + QNSPLF = C2Q(X) + ELSEIF(LEN.GE.3.AND.OPT1(1:3).EQ.'C2G') THEN + IF(NF.LE.0) GOTO 500 + IF(X.GE.1..OR.X.LT.0.) RETURN + QNSPLF = C2G(X) + ELSEIF(LEN.GE.3.AND.OPT1(1:3).EQ.'CLQ') THEN + IF(X.GE.1..OR.X.LT.0.) RETURN + QNSPLF = CLQ(X) + ELSEIF(LEN.GE.3.AND.OPT1(1:3).EQ.'CLG') THEN + IF(NF.LE.0) GOTO 500 + IF(X.GE.1..OR.X.LT.0.) RETURN + QNSPLF = CLG(X) + ELSEIF(LEN.GE.3.AND.OPT1(1:3).EQ.'C3Q') THEN + IF(X.GE.1..OR.X.LT.0.) RETURN + QNSPLF = C2Q(X)-D3Q(X) + ELSEIF(LEN.GE.4.AND.OPT1(1:4).EQ.'C02G') THEN + IF(X.GE.1..OR.X.LT.0.) RETURN + QNSPLF = X*C02G_FUN(X) + ELSEIF(LEN.GE.4.AND.OPT1(1:4).EQ.'C12G') THEN + IF(X.GE.1..OR.X.LT.0.) RETURN + QNSPLF = X*C12G_FUN(X) + ELSEIF(LEN.GE.5.AND.OPT1(1:5).EQ.'C1B2G') THEN + IF(X.GE.1..OR.X.LT.0.) RETURN + QNSPLF = X*C1B2G_FUN(X) + ELSEIF(LEN.GE.4.AND.OPT1(1:4).EQ.'C12Q') THEN + IF(X.GE.1..OR.X.LT.0.) RETURN + QNSPLF = X*C12Q_FUN(X) + ELSEIF(LEN.GE.5.AND.OPT1(1:5).EQ.'C1B2Q') THEN + IF(X.GE.1..OR.X.LT.0.) RETURN + QNSPLF = X*C1B2Q_FUN(X) + ELSEIF(LEN.GE.4.AND.OPT1(1:4).EQ.'D12Q') THEN + IF(X.GE.1..OR.X.LT.0.) RETURN + QNSPLF = X*D12Q_FUN(X) + ELSEIF(LEN.GE.5.AND.OPT1(1:5).EQ.'D1B2Q') THEN + IF(X.GE.1..OR.X.LT.0.) RETURN + QNSPLF = X*D1B2Q_FUN(X) + ELSE + GOTO 550 + ENDIF + + RETURN + + 500 CONTINUE + WRITE(6,'('' QNSPLF: NF not allowed'',I10, & + & '' ---> STOP'')') NF + STOP + + 550 CONTINUE + WRITE(6,'('' QNSPLF: undefined option '',A, & + & '' ---> STOP'')') OPT + STOP + + END + +!DECK ID>, PQGLO. + +! ================================== + DOUBLE PRECISION FUNCTION PQGLO(X) +! ================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + COMMON /QCWGTC/ YWGT,QPGC,QMASS,EGAUSS,NF + + PQG = NF * ( X*X + (1.-X)*(1.-X) ) + + PQGLO = (X-YWGT)*PQG/X + + RETURN + END + +!DECK ID>, PGQLO. + +! ================================== + DOUBLE PRECISION FUNCTION PGQLO(X) +! ================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + COMMON /QCWGTC/ YWGT,QPGC,QMASS,EGAUSS,NF + + PGQ = 4. * ( 1. + (1.-X)*(1.-X) ) / ( 3.*X ) + + PGQLO = (X-YWGT)*PGQ/X + + RETURN + END + +!DECK ID>, PQQLO. +! +! ================================== + DOUBLE PRECISION FUNCTION PQQLO(X) +! ================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) +! + COMMON /QCWGTC/ YWGT,QPGC,QMASS,EGAUSS,NF +! + PQQ = (4./3.) * ( 1. + X*X ) / (1.-X) +! + PQQLO = (X-YWGT)*PQQ/X +! + RETURN + END + +!DECK ID>, PQQX0. +! +! ================================== + DOUBLE PRECISION FUNCTION PQQX0(X) +! ================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) +! + COMMON /QCWGTC/ YWGT,QPGC,QMASS,EGAUSS,NF +! + PQQX0 = (4./3.) * ( (X-YWGT)*(1.+X*X)/X - 2.*(1.-YWGT) ) / (1.-X) +! + RETURN + END + +!DECK ID>, PGGLO. +! +! ================================== + DOUBLE PRECISION FUNCTION PGGLO(X) +! ================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) +! + COMMON /QCWGTC/ YWGT,QPGC,QMASS,EGAUSS,NF +! + PGG = 6. * ( X/(1.-X) + (1.-X)/X + X*(1.-X) ) +! + PGGLO = (X-YWGT)*PGG/X +! + RETURN + END + +!DECK ID>, PGGX0. +! +! ================================== + DOUBLE PRECISION FUNCTION PGGX0(X) +! ================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) +! + COMMON /QCWGTC/ YWGT,QPGC,QMASS,EGAUSS,NF +! + PGGX0 = 6. * (X-YWGT) * ( (1.-X)/(X*X) + 1. - X ) +! + RETURN + END + +!DECK ID>, PP1SFUN. +! +! ==================================== + DOUBLE PRECISION FUNCTION PP1SFUN(X) +! ==================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) +! + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + +! + COMMON /QCWGTC/ YWGT,QPGC,QMASS,EGAUSS,NF +! + CX2 = X**2 + C1PX = 1.+X + C1MX = 1.-X + CLX = LOG(X) + CLX2 = CLX**2 + CL1MX = LOG(C1MX) + CL1PX = LOG(C1PX) + CPFFX = (1.+CX2) / C1MX + CPFFMX = (1.+CX2) / C1PX + CS3X = -DDILOG_LHA(-X) + CS2X = .5*(CLX2-CPI2S3) + 2.*(CS3X-CLX*CL1PX) +! + AAA = - CPFFX*2.*CLX*CL1MX - (2.*X+3./C1MX)*CLX - .5*C1PX*CLX2 & + & - 5.*C1MX + BBB = CPFFX*(.5*CLX2+C11S6*CLX+CPIA) + C1PX*CLX + C20S3*C1MX + CCC = - CPFFX*C2S3*(C5S3+CLX) - C4S3*C1MX +! + PQQ = C16S9*AAA + 4.*BBB + C2S3*NF*CCC + PQQB = - C4S9 * ( CPFFMX*CS2X + C1PX*CLX + 2.*C1MX ) +! + PP1S = PQQ + PQQB + PP1SFUN = (X-YWGT)*PP1S/X +! + RETURN + END + +!DECK ID>, PP1SX0. +! +! =================================== + DOUBLE PRECISION FUNCTION PP1SX0(X) +! =================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) +! + COMMON /QCWGTC/ YWGT,QPGC,QMASS,EGAUSS,NF +! + YREM = YWGT + YWGT = 0. + PPLUS = PP1SFUN(X) + PMINU = PM1SFUN(X) + YWGT = YREM + PP1SX0 = (X-YWGT)*PPLUS/X - (1.-YWGT)*PMINU +! + RETURN + END + +!DECK ID>, PM1SFUN. +! +! ==================================== + DOUBLE PRECISION FUNCTION PM1SFUN(X) +! ==================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) +! + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + +! + COMMON /QCWGTC/ YWGT,QPGC,QMASS,EGAUSS,NF +! + CX2 = X**2 + C1PX = 1.+X + C1MX = 1.-X + CLX = LOG(X) + CLX2 = CLX**2 + CL1MX = LOG(C1MX) + CL1PX = LOG(C1PX) + CPFFX = (1.+CX2) / C1MX + CPFFMX = (1.+CX2) / C1PX + CS3X = -DDILOG_LHA(-X) + CS2X = .5*(CLX2-CPI2S3) + 2.*(CS3X-CLX*CL1PX) +! + AAA = - CPFFX*2.*CLX*CL1MX - (2.*X+3./C1MX)*CLX - .5*C1PX*CLX2 & + & - 5.*C1MX + BBB = CPFFX*(.5*CLX2+C11S6*CLX+CPIA) + C1PX*CLX + C20S3*C1MX + CCC = - CPFFX*C2S3*(C5S3+CLX) - C4S3*C1MX +! + PQQ = C16S9*AAA + 4.*BBB + C2S3*NF*CCC + PQQB = - C4S9 * ( CPFFMX*CS2X + C1PX*CLX + 2.*C1MX ) +! + PM1S = PQQ - PQQB + PM1SFUN = (X-YWGT)*PM1S/X +! + RETURN + END + +!DECK ID>, PM1SX0. +! +! =================================== + DOUBLE PRECISION FUNCTION PM1SX0(X) +! =================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) +! + COMMON /QCWGTC/ YWGT,QPGC,QMASS,EGAUSS,NF +! + YREM = YWGT + YWGT = 0. + PMINU = PM1SFUN(X) + YWGT = YREM + PM1SX0 = (X-YWGT)*PMINU/X - (1.-YWGT)*PMINU +! + RETURN + END + +!DECK ID>, FF1SFUN. +! +! ==================================== + DOUBLE PRECISION FUNCTION FF1SFUN(X) +! ==================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) +! + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + +! + COMMON /QCWGTC/ YWGT,QPGC,QMASS,EGAUSS,NF +! + CX2 = X**2 + C1PX = 1.+X + C1MX = 1.-X + CLX = LOG(X) + CLX2 = CLX**2 + CL1MX = LOG(C1MX) + CL1PX = LOG(C1PX) + CPFFX = (1.+CX2) / C1MX + CPFFMX = (1.+CX2) / C1PX + CS3X = -DDILOG_LHA(-X) + CS2X = .5*(CLX2-CPI2S3) + 2.*(CS3X-CLX*CL1PX) +! + AAA = - CPFFX*CLX*(1.5+2.*CL1MX) + 2.*CPFFMX*CS2X & + & - 1. + X + (.5-1.5*X)*CLX - .5*C1PX*CLX2 + BBB = CPFFX*(C11S6*CLX+.5*CLX2+CPIA) - CPFFMX*CS2X & + & + C14S3*C1MX + CCC = - CPFFX*(C10S9+C2S3*CLX) + C40S9/X - 2.*C1PX*CLX2 & + & - C16S3 + C40S3*X + (10.*X+C16S3*CX2+2.)*CLX & + & - C112S9*CX2 +! + FF1S = C16S9*AAA + 4.*BBB + C2S3*NF*CCC + FF1SFUN = (X-YWGT)*FF1S/X +! + RETURN + END + +!DECK ID>, FF1SX0. +! +! =================================== + DOUBLE PRECISION FUNCTION FF1SX0(X) +! =================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) +! + COMMON /QCWGTC/ YWGT,QPGC,QMASS,EGAUSS,NF +! + YREM = YWGT + YWGT = 0. + FF1S = FF1SFUN(X) + XP1T = XP1TFUN(X) + YWGT = YREM + FF1SX0 = (X-YWGT)*FF1S/X - (1.-YWGT)*XP1T +! + RETURN + END + +!DECK ID>, GF1SFUN. +! +! ==================================== + DOUBLE PRECISION FUNCTION GF1SFUN(X) +! ==================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) +! + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + +! + COMMON /QCWGTC/ YWGT,QPGC,QMASS,EGAUSS,NF +! + CX2 = X**2 + C1PX = 1.+X + C1MX = 1.-X + CLX = LOG(X) + CLX2 = CLX**2 + CL1MX = LOG(C1MX) + CL1PX = LOG(C1PX) + CL1MX2 = CL1MX**2 + CPGFX = CX2 + C1MX**2 + CPGFMX = CX2 + C1PX**2 + CS3X = -DDILOG_LHA(-X) + CS2X = .5*(CLX2-CPI2S3) + 2.*(CS3X-CLX*CL1PX) +! + AAA = 4. - 9.*X + (4.*X-1.)*CLX + (2.*X-1.)*CLX2 & + & + 4.*CL1MX & + & + (2.*CLX-2.*CLX*CL1MX+CLX2-2.*CL1MX+CL1MX2+CPIE) & + & * 2. * CPGFX + DDD = C182S9 + C14S9*X + C40S9/X + (C136S3*X-C38S3)*CLX & + & - 4.*CL1MX - (2.+8.*X)*CLX2 + 2.*CS2X*CPGFMX & + & + (C44S3*CLX-CLX2-2.*CL1MX2+4.*CL1MX+CPIF) * CPGFX +! + GF1S = C2S3*NF*AAA + 1.5*NF*DDD + GF1SFUN = (X-YWGT)*GF1S/X +! + RETURN + END + +!DECK ID>, XP1TFUN. +! +! ==================================== + DOUBLE PRECISION FUNCTION XP1TFUN(X) +! ==================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) +! + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + +! + COMMON /QCWGTC/ YWGT,QPGC,QMASS,EGAUSS,NF +! + CX2 = X**2 + C1PX = 1.+X + C1MX = 1.-X + CLX = LOG(X) + CLX2 = CLX**2 + CL1MX = LOG(C1MX) + CL1PX = LOG(C1PX) + CL1MX2 = CL1MX**2 + CPFFX = (1.+CX2) / C1MX + CPFFMX = (1.+CX2) / C1PX + CPFGX = (1.+C1MX**2) / X + CPFGMX = - (1.+C1PX**2) / X + CS1X = -DDILOG_LHA(1.D0-X) + CS3X = -DDILOG_LHA(-X) + CS2X = .5*(CLX2-CPI2S3) + 2.*(CS3X-CLX*CL1PX) +! + AAA = CPFFX*(1.5*CLX-2.*CLX2+2.*CLX*CL1MX) + 2.*CPFFMX*CS2X & + & - 1. + X + (-1.5+.5*X)*CLX + .5*C1PX*CLX2 + BBB = CPFFX*(C11S6*CLX+.5*CLX2+CPIA) - CPFFMX*CS2X & + & + C14S3*C1MX + CCC = - CPFFX*(C2S3*CLX+C10S9) & + & - C52S3 + C28S3*X + C112S9*CX2 - C40S9/X & + & - (10.+18.*X+C16S3*CX2)*CLX + 2.*C1PX*CLX2 + PFF1T = C16S9*AAA + 4.*BBB + C2S3*NF*CCC +! + AAA = -.5 + 4.5*X + (-8.+.5*X)*CLX + 2.*X*CL1MX & + & + (1.-.5*X)*CLX2 & + & + (CL1MX2+4.*CLX*CL1MX-8.*CS1X-CPIB) * CPFGX + BBB = C62S9 - C35S18*X - C44S9*CX2 & + & + (2.+12.*X+C8S3*CX2) * CLX & + & - 2.*X*CL1MX - (4.+X)*CLX2 + CPFGMX*CS2X & + & + ( - 2.*CLX*CL1MX - 3.*CLX - 1.5*CLX2 & + & - CL1MX2 + 8.*CS1X + CPIC ) * CPFGX + PFG1T = C16S9*AAA + 4.*BBB +! + XP1T = X * ( PFF1T + PFG1T ) + XP1TFUN = (X-YWGT)*XP1T/X +! + RETURN + END + +!DECK ID>, GG1SFUN. +! +! ==================================== + DOUBLE PRECISION FUNCTION GG1SFUN(X) +! ==================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) +! + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + +! + COMMON /QCWGTC/ YWGT,QPGC,QMASS,EGAUSS,NF +! + CX2 = X**2 + C1PX = 1.+X + C1MX = 1.-X + CLX = LOG(X) + CLX2 = CLX**2 + CL1MX = LOG(C1MX) + CL1PX = LOG(C1PX) + CL1MX2 = CL1MX**2 + CS3X = -DDILOG_LHA(-X) + CS2X = .5*(CLX2-CPI2S3) + 2.*(CS3X-CLX*CL1PX) +! + CPGG = 1./C1MX + 1./X -2. + X - CX2 + CMPGG = 1./C1PX - 1./X -2. - X - CX2 +! +! AAA = -16.+ 8.*X+ C20S3*CX2 + C4S3/X + (-6.-10.*X)*CLX + + AAA = -16.+ 8.*X+ C20S3*CX2 + C4S3/X + (-6.-10.*X)*CLX & + & -2.*C1PX*CLX2 + BBB = 2.* C1MX + 26./9.*(CX2-1./X) - C4S3*C1PX*CLX - & + & 20./9.*CPGG + CCC = 27./2.*C1MX + 67./9.*(CX2-1./X)+(-25./3.+11./3.*x- & + & 44./3.*CX2)*CLX+4.*C1PX*CLX2+(67./9.-4.*CLX*CL1MX + & + & CLX2-CPI2S3)*CPGG + 2.*CMPGG*CS2X +! + GG1S = C2S3*NF*AAA + 1.5*NF*BBB + 9.* CCC + GG1SFUN = (X-YWGT)*GG1S/X +! + RETURN + END + +!DECK ID>, GG1SX0. +! +! =================================== + DOUBLE PRECISION FUNCTION GG1SX0(X) +! =================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) +! + COMMON /QCWGTC/ YWGT,QPGC,QMASS,EGAUSS,NF +! + YREM = YWGT + YWGT = 0. + GG1S = GG1SFUN(X) + XG1T = XG1TFUN(X) + YWGT = YREM + GG1SX0 = (X-YWGT)*GG1S/X - (1.-YWGT)*XG1T +! + RETURN + END + +!DECK ID>, FG1SFUN. +! +! ==================================== + DOUBLE PRECISION FUNCTION FG1SFUN(X) +! ==================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) +! + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + +! + COMMON /QCWGTC/ YWGT,QPGC,QMASS,EGAUSS,NF +! + CX2 = X**2 + C1PX = 1.+X + C1MX = 1.-X + CLX = LOG(X) + CLX2 = CLX**2 + CL1MX = LOG(C1MX) + CL1PX = LOG(C1PX) + CL1MX2 = CL1MX**2 + CPFGX = (1.+C1MX**2) / X + CPFGMX = - (1.+C1PX**2) / X + CS3X = -DDILOG_LHA(-X) + CS2X = .5*(CLX2-CPI2S3) + 2.*(CS3X-CLX*CL1PX) +! + AAA = -5./2.- 7./2.*X+(2.+7./2.*X)*CLX+(-1.+0.5*X)*CLX2 & + & -2.*X*CL1MX+ (-3.*CL1MX-CL1MX2)*CPFGX + BBB = 28./9.+65./18.*X+44./9.*CX2+(-12.-5.*X-8./3.*CX2)*CLX+ & + & (4.+X)*CLX2+2.*X*CL1MX+ (-2.*CLX*CL1MX+0.5*CLX2+ & + & 11./3.*CL1MX+CL1MX2-0.5*CPI2S3+0.5)*CPFGX+CPFGMX*CS2X + CCC = -C4S3*X- (20./9.+C4S3*CL1MX)*CPFGX +! + FG1S = C16S9*AAA+4.*BBB+2./3.*NF*CCC + FG1SFUN = (X-YWGT)*FG1S/X +! + RETURN + END + +!DECK ID>, XG1TFUN. +! +! ==================================== + DOUBLE PRECISION FUNCTION XG1TFUN(X) +! ==================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) +! + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + +! + COMMON /QCWGTC/ YWGT,QPGC,QMASS,EGAUSS,NF +! + CX2 = X**2 + C1PX = 1.+X + C1MX = 1.-X + CLX = LOG(X) + CLX2 = CLX**2 + CL1MX = LOG(C1MX) + CL1PX = LOG(C1PX) + CL1MX2 = CL1MX**2 + CPGFX = CX2 + C1MX**2 + CPGFMX = CX2 + C1PX**2 + CS1X = -DDILOG_LHA(1.D0-X) + CS3X = -DDILOG_LHA(-X) + CS2X = .5*(CLX2-CPI2S3) + 2.*(CS3X-CLX*CL1PX) +! + CPGG = 1./C1MX + 1./X -2. + X - CX2 + CMPGG = 1./C1PX - 1./X -2. - X - CX2 +! + AAA = -4.+12.*x-164./9.*CX2+92./9./X+(10.+14.*X+C16S3*CX2+ & + & C16S3/X)*CLX + 2.*C1PX*CLX2 + BBB = 2.-2.*X+26./9.*(CX2-1./X)-C4S3*C1PX*CLX- & + & (20./9.+8./3.*CLX)*CPGG + CCC = 27./2.*(C1MX)+67./9.*(CX2-1./X)+(11./3.-25./3.*X- & + & 44./3./X)*CLX -4.*(C1PX) * CLX2 + (4.*CLX*CL1MX - & + & 3.*CLX2+22./3.*CLX-CPI2S3+67./9.)*CPGG+ & + & 2.*CMPGG*CS2X + PGG1T = 2./3.*NF*AAA+3./2.*NF*BBB+9.*CCC +! + AAA = -8./3.-(16./9.+8./3.*CLX+8./3.*CL1MX)*CPGFX + BBB = -2.+3.*X+(-7.+8.*X)*CLX-4.*CL1MX + (1.-2.*X)*CLX2 & + & +(-4.*CLX*CL1MX-2.*CLX2-2.*CL1MX+2.*CLX-2.*CL1MX2 & + & +16.*CS1X+ 2.*PI*PI - 10.)*CPGFX + CCC = -152./9.+166./9.*X-40./9./X+ (-C4S3-76./3.*X)*CLX+ & + & 4.*CL1MX + (2.+8.*X)*CLX2+ (8.*CLX*CL1MX-CLX2- & + & C4S3*CLX+10./3.*CL1MX+2.*CL1MX2-16.*CS1X-7.*CPI2S3+ & + & 178./9.)*CPGFX+2.*CPGFMX*CS2X + PGF1T = (0.5*NF)**2*AAA+2./3.*NF*BBB+3./2.*NF*CCC +! + XG1T = X * ( PGG1T + PGF1T ) + XG1TFUN = (X-YWGT)*XG1T/X +! + RETURN + END + +!DECK ID>, C2Q. + +! ================================ + DOUBLE PRECISION FUNCTION C2Q(X) +! ================================ + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + + + COMMON /QCWGTC/ YWGT,QPGC,QMASS,EGAUSS,NF + + C1MX = 1.-X + C2Q = 3. + C5S3*X + (C4S3*LOG(C1MX/X)-1.) * (1.+X**2) / C1MX + C2Q = (X-YWGT)*C2Q/X + + RETURN + END + +!DECK ID>, C2QX0. + + +! ================================== + DOUBLE PRECISION FUNCTION C2QX0(X) +! ================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + + + COMMON /QCWGTC/ YWGT,QPGC,QMASS,EGAUSS,NF + + C1MX = 1.-X + C2Q = 3. + C5S3*X + (C4S3*LOG(C1MX/X)-1.) * (1.+X**2) / C1MX + + C2QX0 = ((X-YWGT)/X+YWGT-1.)*C2Q + + RETURN + END + +!DECK ID>, C2G. + +! ================================ + DOUBLE PRECISION FUNCTION C2G(X) +! ================================ + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + COMMON /QCWGTC/ YWGT,QPGC,QMASS,EGAUSS,NF + + C1MX = 1. - X + C2G = -.5 + 4.*X*C1MX + .5 * (X**2+C1MX**2) * LOG(C1MX/X) + C2G = 2.*NF*(X-YWGT)*C2G/X + + RETURN + END + +!DECK ID>, CLQ. + +! ================================ + DOUBLE PRECISION FUNCTION CLQ(X) +! ================================ + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + + + COMMON /QCWGTC/ YWGT,QPGC,QMASS,EGAUSS,NF + + CLQ = C8S3*X + CLQ = (X-YWGT)*CLQ/X + + RETURN + END + +!DECK ID>, CLG. + +! ================================ + DOUBLE PRECISION FUNCTION CLG(X) +! ================================ + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + + + COMMON /QCWGTC/ YWGT,QPGC,QMASS,EGAUSS,NF + + CLG = NF*4.*X*(1.-X) + CLG = (X-YWGT)*CLG/X + + RETURN + END + +!DECK ID>, D3Q. + +! ================================ + DOUBLE PRECISION FUNCTION D3Q(X) +! ================================ + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + + +!-- C3Q = C2Q - D3Q + + COMMON /QCWGTC/ YWGT,QPGC,QMASS,EGAUSS,NF + + D3Q = C4S3*(1.+X) +!-- Fixed this bug in QCDNUM16.11 17-01-98 +! D3Q = (X-YWGT)*C3Q/X + D3Q = (X-YWGT)*D3Q/X + + RETURN + END + +!DECK ID>, PCGFUN. + +! =================================== + DOUBLE PRECISION FUNCTION PCGFUN(X) +! =================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +!-- Pcg (heavy quark) splitting function taken from +!-- Glueck, Hoffmann and Reya, Z. Phys. C13(1982)119 eq. (2.6). +!-- Notice that if YWGT is set to zero, PCGFUN(X) returns Pcg(x). +!-- Q2 and the quark mass are passed through the common block +!-- /QCWGTC/ as QPCG and QMASS respectively. + + COMMON /QCWGTC/ YWGT,QPCG,QMASS,EGAUSS,NF + + FACTOR = QMASS*QMASS/QPCG + PCG = 0. + IF(X.LT.(1./(1.+4.*FACTOR))) THEN + U = 1.-X + V = SQRT(1.-4.*FACTOR*X/(1.-X)) + PCG = (1./V)*(0.5-X*U+FACTOR*X*(3.-4.*X)/U & + & -16.*FACTOR*FACTOR*X*X) - & + & (2.*FACTOR*X*(1.-3.*X)-8.*FACTOR*FACTOR*X*X) & + & *LOG((1.+V)/(1.-V)) + ENDIF + PCGFUN = (X-YWGT)*PCG/X + + RETURN + END + +!DECK ID>, QASTOL. + +! ============================== + SUBROUTINE LFROMA(AS,Q2,QL,NF) +! ============================== + +!--- Calculate Lambda^(nf) given alpha_s(Q^2) + + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r LFROMA ---> STOP'')') + WRITE(6,'( '' ------------------------------------'')') + WRITE(6,'(/'' This s/r is not available...... '')') + + STOP + END + + +!DECK ID>, AFROML. + +! ============================== + SUBROUTINE AFROML(QL,NF,AS,Q2) +! ============================== + +!--- Calculate alpha_s(Q^2) given Lambda^(nf) + + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r AFROML ---> STOP'')') + WRITE(6,'( '' ------------------------------------'')') + WRITE(6,'(/'' This s/r is not available...... '')') + + STOP + END + +!DECK ID>, QNALFA. + +! ===================================== + DOUBLE PRECISION FUNCTION QNALFA(QQ2) +! ===================================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + IF(LBMARK) THEN +! fix for rgr + call rgras(qnalfa,qq2) +! print *,' 1 rgras called and NF is ',nf +! F = 4. +! QCDL = 0.250 +! QNALFA = QNALAM(F,QQ2,QCDL,IORD) + ELSEIF(LASOLD) THEN + QNALFA = A0TOA1_OLD(QQ2,Q0ALFA,ALPHA0,IORD,NF,IERR) + ELSE + QNALFA = A0TOA1(QQ2,Q0ALFA,ALPHA0,IORD,NF,IERR) + ENDIF + + RETURN + END + +!DECK ID>, QALFAS. + +! =================================================== + DOUBLE PRECISION FUNCTION QALFAS(QQ2,QLAMB,NF,IERR) +! =================================================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + IF(LBMARK) THEN +! fix for rgr alphas +! print *,' 2 rgras called and NF is ' + call rgras(qalfas,qq2) + QLAMB = SQRT(Q_LAMB2(QQ2,QALFAS,NF,IORD)) +! F = 4. +! QCDL = 0.250 +! QALFAS = QNALAM(F,QQ2,QCDL,IORD) +! NF = F +! QLAMB = 0. + ELSEIF(LASOLD) THEN + QALFAS = A0TOA1_OLD(QQ2,Q0ALFA,ALPHA0,IORD,NF,IERR) + QLAMB = SQRT(Q_LAMB2(QQ2,QALFAS,NF,IORD)) + IF(IERR.NE.0) QLAMB = 0. + ELSE + QALFAS = A0TOA1(QQ2,Q0ALFA,ALPHA0,IORD,NF,IERR) + QLAMB = SQRT(Q_LAMB2(QQ2,QALFAS,NF,IORD)) + IF(IERR.NE.0) QLAMB = 0. + ENDIF + + RETURN + END + +!DECK ID>, QFILAS. + +! ======================== + SUBROUTINE QFILAS(SRNAM) +! ======================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + CHARACTER*6 SRNAM + +!-- Check quark masses + IF(.NOT.(0.LE.UDSCBT(1) .AND. UDSCBT(1).LE.UDSCBT(2) .AND. & + & UDSCBT(2).LE.UDSCBT(3) .AND. UDSCBT(3).LT.UDSCBT(4) .AND. & + & UDSCBT(4).LT.UDSCBT(5) .AND. UDSCBT(5).LT.UDSCBT(6))) THEN + IERR = 1 + GOTO 500 + ENDIF + + IF(LBMARK) THEN +!-- This is a fix to put in the RGR alphas + DO IQ = 1,NQ2 + +!-- Alphas at the renormalistion scale + QQ2 = Q2TAB(IQ)*AAAR2 + BBBR2 +! print *,' 3 rgras called and iord is ',iord + call rgras(ALF,QQ2) +! print *,nf,iord,alf,qq2 + BET0 = 11.-2*NF/3. + ALFASQ(IQ) = ALF + ALFAPQ(IQ) = ALF/(2.*PI) + ALFA2Q(IQ) = 0. + IF(IORD.GE.2) THEN + ALFA2Q(IQ) = ALFAPQ(IQ)*ALFAPQ(IQ) + FACT = LOG(QQ2/Q2TAB(IQ))*BET0*0.5 + ALFAPQ(IQ) = ALFAPQ(IQ)*(1.+FACT*ALFAPQ(IQ)) + ENDIF + + ENDDO + + +!C-- Alphas for benchmark tests (HERA workshop) +! +! F = 4. +! QCDL = 0.250 +! +! DO IQ = 1,NQ2 +! +!C-- Alphas at the renormalistion scale +! QQ2 = Q2TAB(IQ)*AAAR2 + BBBR2 +! ALFASQ(IQ) = QNALAM(F,QQ2,QCDL,IORD) +! BET0 = 11.-2.*F/3. +! ALFAPQ(IQ) = ALFASQ(IQ) /(2.*PI) +! ALFA2Q(IQ) = 0. +! IEALFA(IQ) = 0 +! IF(IORD.GE.2) THEN +! ALFA2Q(IQ) = ALFAPQ(IQ)*ALFAPQ(IQ) +! FACT = LOG(QQ2/Q2TAB(IQ))*BET0*0.5 +! ALFAPQ(IQ) = ALFAPQ(IQ)*(1.+FACT*ALFAPQ(IQ)) +! ENDIF +! +! ENDDO + + ELSEIF(LASOLD) THEN + +!-- Alphas from old routine (for backwards compatibility) + + DO IQ = 1,NQ2 + +!-- Alphas at the renormalistion scale + QQ2 = Q2TAB(IQ)*AAAR2 + BBBR2 + ALFASQ(IQ) = A0TOA1_OLD(QQ2,Q0ALFA,ALPHA0,IORD,NF,IERR) + BET0 = 11.-2*NF/3. + IEALFA(IQ) = IERR + ALFAPQ(IQ) = ALFASQ(IQ) /(2.*PI) + ALFA2Q(IQ) = 0. + IF(IORD.GE.2) THEN + ALFA2Q(IQ) = ALFAPQ(IQ)*ALFAPQ(IQ) + FACT = LOG(QQ2/Q2TAB(IQ))*BET0*0.5 + ALFAPQ(IQ) = ALFAPQ(IQ)*(1.+FACT*ALFAPQ(IQ)) + ENDIF + + ENDDO + + ELSE + +!-- This is the alphas to be used + + DO IQ = 1,NQ2 + +!-- Alphas at the renormalistion scale + QQ2 = Q2TAB(IQ)*AAAR2 + BBBR2 + ALF = A0TOA1(QQ2,Q0ALFA,ALPHA0,IORD,NF,IERR) +! print *,iord,nf,qq2,alf + BET0 = 11.-2*NF/3. + IEALFA(IQ) = IERR + ALFASQ(IQ) = ALF + ALFAPQ(IQ) = ALF/(2.*PI) + ALFA2Q(IQ) = 0. + IF(IORD.GE.2) THEN + ALFA2Q(IQ) = ALFAPQ(IQ)*ALFAPQ(IQ) + FACT = LOG(QQ2/Q2TAB(IQ))*BET0*0.5 + ALFAPQ(IQ) = ALFAPQ(IQ)*(1.+FACT*ALFAPQ(IQ)) + ENDIF + + ENDDO + + ENDIF + + LALFOK = .TRUE. +!-- Invalidate all evolutions + CALL QNFALS(LEVDONE,MXX*10) + +!-- Find lowest Q2 for which alpha_s is calculated + QMINAS = Q2TAB(NQ2) + DO IQ = NQ2,1,-1 + IF(IEALFA(IQ).EQ.0) QMINAS = Q2TAB(IQ) + ENDDO + + RETURN + + 500 CONTINUE + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r '',A,'' ---> STOP'')') & + & SRNAM + WRITE(6,'( '' ------------------------------------'')') + WRITE(6,'( '' Umass :'',E12.5)') UDSCBT(1) + WRITE(6,'( '' Dmass :'',E12.5)') UDSCBT(2) + WRITE(6,'( '' Smass :'',E12.5)') UDSCBT(3) + WRITE(6,'( '' Cmass :'',E12.5)') UDSCBT(4) + WRITE(6,'( '' Bmass :'',E12.5)') UDSCBT(5) + WRITE(6,'( '' Tmass :'',E12.5)') UDSCBT(6) + IF(IERR.EQ.1) THEN + WRITE(6,'(/'' Quark masses not in ascending order'')') + ENDIF + + CALL QTRACE('QFILAS ',1) + + STOP + + END + +!DECK ID>, GET_AS. + +! ======================================= + DOUBLE PRECISION FUNCTION GET_AS(IQ,TQ) +! ======================================= + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +!-- Interpolation of alpha_s table: returns alpha_s/(2pi) +!-- Input IQ must be in the range 1,...,NQ2-1 + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + + GET_AS = ((1.-TQ)*ALFASQ(IQ)+TQ*ALFASQ(IQ+1))/(2.*PI) + + RETURN + END + +!DECK ID>, QNALAM. + +! ================================================= + DOUBLE PRECISION FUNCTION QNALAM (F,Q2,QCDL,IORD) +! ================================================= + + IMPLICIT DOUBLE PRECISION (A - Z) + INTEGER IORD + + DATA PI / 3.14159265359 / + +!--- Calculation of alpha strong (Q**2) in NLO : +!--- F = number of flavours +!--- Q2 = Q**2 in GeV**2 +!--- QCDL = Lambda(MSbar) in GeV + + B0 = 11.D0 - 2.D0/3.D0 * F + B0S = B0 * B0 + B1 = 102.D0 - 38.D0/3.D0 * F + LAM2 = QCDL * QCDL + LQ2 = DLOG (Q2/LAM2) + QNALAM = 1.D0/(B0 * LQ2) + IF(IORD.GE.2) QNALAM = QNALAM - 1.D0/(B0 * LQ2) * & + & (B1/B0S * DLOG(LQ2)/LQ2) + QNALAM = QNALAM*4.D0*PI + + RETURN + END + +!DECK ID>, A0TOA1. + +! =========================================================== + DOUBLE PRECISION FUNCTION A0TOA1(QSU,QS0,AS0,IORD,NFF,IERR) +! =========================================================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + QS1 = QSU + + QMU0 = SQRT(QS0) + QMU1 = SQRT(QS1) + + DO 10 I=1,6 + IF(QMU0.GE.UDSCBT(I)) NF0 = I + IF(QMU1.GE.UDSCBT(I)) NF1 = I + 10 END DO + + IF(NF1.LT.NF0) THEN + IST = -1 + JST = 0 + ELSE + IST = 1 + JST = 1 + ENDIF + + ALFA0 = AS0 + Q00 = QS0 + + DO 50 NF = NF0,NF1,IST + + IF(NF.NE.NF1) THEN + Q21 = UDSCBT(NF+JST)*UDSCBT(NF+JST) + ELSE + Q21 = QS1 + ENDIF + ALFA1 = ALPHAR(Q21,Q00,ALFA0,NF,IORD,JERR) + ALFA0 = ALFA1 + Q00 = Q21 + + 50 END DO + + A0TOA1 = ALFA0 + NFF = NF1 + IERR = JERR + + RETURN + END + +! =============================================================== + DOUBLE PRECISION FUNCTION A0TOA1_OLD(QSU,QS0,AS0,IORD,NFF,IERR) +! =============================================================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + QS1 = QSU + + QMU0 = SQRT(QS0) + QMU1 = SQRT(QS1) + + DO 10 I=1,6 + IF(QMU0.GE.UDSCBT(I)) NF0 = I + IF(QMU1.GE.UDSCBT(I)) NF1 = I + 10 END DO + + IF(NF1.LT.NF0) THEN + IST = -1 + JST = 0 + ELSE + IST = 1 + JST = 1 + ENDIF + + ALFA0 = AS0 + Q00 = QS0 + + DO 50 NF = NF0,NF1,IST + + IF(NF.NE.NF1) THEN + Q21 = UDSCBT(NF+JST)*UDSCBT(NF+JST) + ELSE + Q21 = QS1 + ENDIF + ALFA0 = ALPHAR_OLD(Q21,Q00,ALFA0,NF,IORD,JERR) + Q00 = Q21 + + 50 END DO + + A0TOA1_OLD = ALFA0 + NFF = NF1 + IERR = JERR + + RETURN + END + +!DECK ID>, ALPHAR. + +! ========================================================== + DOUBLE PRECISION FUNCTION ALPHAR(QSQ,QS0,AS0,NF,IORD,IERR) +! ========================================================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +!-- ALPHAS FROM RGE GIVEN AS0 AT QS0 + + DATA PI / 3.14159265359 / + + BET0 = 11.-2*NF/3. + BET1 = 102.-38*NF/3. + B0 = BET0/(4.*PI) + B1 = BET1/(4.*PI*BET0) + IERR = 0 + + TERM0 = 1./AS0+B0*LOG(QSQ/QS0) + IF(TERM0.LE.0.) THEN + ALPHAR = 100. + IERR = 1 + RETURN + ENDIF + ALFA0 = 1./TERM0 + IF(IORD.EQ.1) THEN + ALPHAR = ALFA0 + RETURN + ENDIF + 20 CONTINUE + ARG = (1./ALFA0+B1)/(1./AS0+B1) + IF(ARG.LE.0.) THEN + ALPHAR = 100. + IERR = 1 + RETURN + ELSE + TERM = TERM0+B1*LOG(ARG) + IF(TERM.LE.0) THEN + ALPHAR = 100. + IERR = 1 + RETURN + ELSE + ALFA1 = 1./TERM + ENDIF + ENDIF + IF(ABS(ALFA1-ALFA0).GT.1.E-6) THEN + ALFA0 = ALFA1 + GOTO 20 + ENDIF + + ALPHAR = ALFA1 + + RETURN + END + +! ============================================================== + DOUBLE PRECISION FUNCTION ALPHAR_OLD(QSQ,QS0,AS0,NF,IORD,IERR) +! ============================================================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +!-----MARCHIANO: ALPHAS FROM RGE GIVEN AS0 AT QS0 +!-----This routine uses an incorrect truncation --> +!-----alpha_s is about 0.4% too low. + + DATA PI / 3.1415927 / + + QMU = SQRT(QSQ) + QM0 = SQRT(QS0) + + B3 = -(11.-2.*NF/3.)/(2.*PI) + B33 = -(51.-19.*NF/3.)/(4.*PI*PI) + B333 = -(2857.-5033.*NF/9.+325.*NF*NF/27.)/(64.*PI*PI*PI) + IERR = 0 + + TERM0 = 1./AS0-B3*LOG(QMU/QM0) + ALFA0 = 1./TERM0 + IF(IORD.EQ.1) THEN + ALPHAR_OLD = ALFA0 + RETURN + ENDIF + 20 CONTINUE + TERM = TERM0-B33*LOG(ALFA0/AS0)/B3 + IF(IORD.EQ.3) TERM = TERM-(B333*B3-B33*B33)*(ALFA0-AS0)/(B3*B3) + ALFA1 = 1./TERM + IF(ABS(ALFA1-ALFA0).GT.1.E-6) THEN + ALFA0 = ALFA1 + GOTO 20 + ENDIF + + ALPHAR_OLD = ALFA1 + + RETURN + END + +!DECK ID>, Q_LAMB2. + +! ================================================== + DOUBLE PRECISION FUNCTION Q_LAMB2(QS0,AS0,NF,IORD) +! ================================================== + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +!-- Calculate lambda**2 given AS0 at QS0 + + DATA PI / 3.14159265359 / + + BET0 = 11.-2*NF/3. + BET1 = 102.-38*NF/3. + AS = AS0/(4.*PI) + + Q_LAMB2 = QS0*EXP(-1./(BET0*AS)) + + IF(IORD.EQ.1) RETURN + + ARG = 1. + BET0/(BET1*AS) + POW = BET1/(BET0*BET0) + Q_LAMB2 = Q_LAMB2*ARG**POW + + RETURN + END + +!DECK ID>, QHEAVY. + +! Heavy quark structure functions. +! Heavy quark coefficient functions up to NLO are taken from the code +! of S. Riemersma. For reference, see S. Riemersma, J. Smith and +! W.L. van Neerven, Phys. Lett. B347(1995)143. + +!DECK ID>, GET_FKH. + +! ===================================================== + DOUBLE PRECISION FUNCTION GET_FKH(IDF,ID,IX0,IQ,IERR) +! ===================================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + +!-- Input: IDF = 4,5,6,7 for F2c,Flc,F2b,Flb +!-- Input: ID parton distribution identifier +!-- IX0 x gridpoint of heavy quark grid +!-- IQ Q2 gridpoint +!-- Output: IERR = 0 FKH successfully calculated +!-- = 1 Fast calculation +!-- = -1 Scale mu outside grid + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + LOGICAL & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL,LASOLD + + COMMON/QCFLAG/ & + &IORD,IOLAST, & + &LDOUBL,LBMARK,LWF2C,LWF2B,LWFLC,LWFLB, & + &LW1ANA,LW1NUM,LW2NUM,LW2STF,LIMCK,LPLUS, & + &LALFOK,LDQ2OK,LWT1OK,LWT2OK, & + &LWTFOK,LWFCOK,LWLCOK,LWFBOK,LWLBOK,LMARK,LCLOWQ, & + &LFFCAL(7,30),LASOLD + + + CHARACTER*5 PNAM,STFNAM + LOGICAL LNFP + COMMON /QCLNFP/ LNFP(0:30,3:5) + COMMON /QCPNAM/ PNAM(0:30) + COMMON /QCPWGT/ PWGT(0:10,0:30,3:5) + COMMON /QCFNAM/ STFNAM(7) + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + REAL & + &WH_C0KG,WH_C1KG,WH_C1BKG, & + &WH_C1KQ,WH_C1BKQ,WH_D1KQ,WH_D1BKQ + + COMMON/QCHWGT/ & + &WH_C0KG(0:MXX,MQ2,4:7), & + &WH_C1KG(0:MXX,MQ2,4:7),WH_C1BKG(0:MXX,MQ2,4:7), & + &WH_C1KQ(0:MXX,MQ2,4:7),WH_C1BKQ(0:MXX,MQ2,4:7), & + &WH_D1KQ(0:MXX,MQ2,4:7),WH_D1BKQ(0:MXX,MQ2,4:7) + + + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) + + LOGICAL LEVDONE,LE_DONE + COMMON/QCLEVL/ & + &LEVDONE(MXX,10),LE_DONE(MXX) + + +!-- Correct quark mass + QMASS = CBMSTF(IDF) + CCCC = CHARGE(IDF) + + GET_FKH = 0. + + IF(LFFCAL(IDF,ID)) THEN + IERR = 1 + JD = IDFAST(IDF,ID) + GET_FKH = FSTORE(IX0,IQ,JD) + IF(GET_FKH.GE.-99.) RETURN + ENDIF + + QMU = Q2TAB(IQ)*AAM2H + BBM2H + IMU = MIN(ABS(IQFROMQ(QMU)),NQ2-1) + IF(IMU.EQ.0) THEN + IERR = -1 + RETURN + ENDIF + QR2 = QMU*AAAR2 + BBBR2 + IR2 = MIN(ABS(IQFROMQ(QR2)),NQ2-1) + IF(IR2.EQ.0) THEN + IERR = -1 + RETURN + ENDIF + + IERR = 0 + TQ = LOG(QMU/Q2TAB(IMU))/LOG(Q2TAB(IMU+1)/Q2TAB(IMU)) + TR = LOG(QR2/Q2TAB(IR2))/LOG(Q2TAB(IR2+1)/Q2TAB(IR2)) + + IF(IORD.EQ.1) THEN + + FF = 0. + DO IX = IX0,NXX + IXL = IHTAB(IX) + X = XHTAB(IX) + TX = (X-XXTAB(IXL))/(XXTAB(IXL+1)-XXTAB(IXL)) + GL = GET_PDFXQ(0,IXL,IMU,TX,TQ) + FF = FF + WH_C0KG(IX-IX0,IQ,IDF)*GL + ENDDO + GET_FKH = CCCC * GET_AS(IR2,TR) * FF + + ELSE + + AS = GET_AS(IR2,TR) + F1 = 0. + F2 = 0. + F3 = 0. + F4 = 0. + FACT = LOG(QMU/(QMASS*QMASS)) + DO IX = IX0,NXX + IXL = IHTAB(IX) + X = XHTAB(IX) + TX = (X-XXTAB(IXL))/(XXTAB(IXL+1)-XXTAB(IXL)) + GL = GET_PDFXQ( 0,IXL,IMU,TX,TQ) + SI = GET_PDFXQ( 1,IXL,IMU,TX,TQ) + QU = GET_PDFXQ(ID,IXL,IMU,TX,TQ) + I = IX-IX0 + F1 = F1 + WH_C0KG(I,IQ,IDF)*GL + F2 = F2 + (WH_C1KG(I,IQ,IDF)+WH_C1BKG(I,IQ,IDF)*FACT)*GL + F3 = F3 + (WH_C1KQ(I,IQ,IDF)+WH_C1BKQ(I,IQ,IDF)*FACT)*SI + F4 = F4 + (WH_D1KQ(I,IQ,IDF)+WH_D1BKQ(I,IQ,IDF)*FACT)*QU + ENDDO + GET_FKH = CCCC * (AS*F1+AS*AS*(F2+F3)) + AS*AS*F4 + ENDIF + + RETURN + END + +!DECK ID>, FIL_F2H. + +! ======================= + SUBROUTINE FIL_F2H(IDF) +! ======================= + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + EXTERNAL C02G_FUN, C12G_FUN, C1B2G_FUN + EXTERNAL C12Q_FUN, C1B2Q_FUN + EXTERNAL D12Q_FUN, D1B2Q_FUN + + COMMON /QCWGTC/ YWGT,QPCG,QMASS,EGAUSS,NF + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + REAL & + &WH_C0KG,WH_C1KG,WH_C1BKG, & + &WH_C1KQ,WH_C1BKQ,WH_D1KQ,WH_D1BKQ + + COMMON/QCHWGT/ & + &WH_C0KG(0:MXX,MQ2,4:7), & + &WH_C1KG(0:MXX,MQ2,4:7),WH_C1BKG(0:MXX,MQ2,4:7), & + &WH_C1KQ(0:MXX,MQ2,4:7),WH_C1BKQ(0:MXX,MQ2,4:7), & + &WH_D1KQ(0:MXX,MQ2,4:7),WH_D1BKQ(0:MXX,MQ2,4:7) + + + QMASS = CBMSTF(IDF) + + EGAUSS = 0.001 + + DO 400 IQ = 1,NQ2 + + QPCG = Q2TAB(IQ) + APCG = 1.+4.*QMASS*QMASS/QPCG + + IX0 = 1 + X0 = XHTAB(IX0) + +! WRITE(6,'('' Calculate F2H weights for IX ='',I4)') IX0 + + DO 200 IX = IX0,NXX + + XI = XHTAB(IX) + XIP1 = XHTAB(IX+1) + IF(IX.GT.IX0) XIM1 = XHTAB(IX-1) + IF(XIP1.LE.X0*APCG) GOTO 200 + XI = MAX(XI,X0*APCG) + SIP1 = X0/XIP1 + SI = X0/XI + + CALL S1FUNC(C02G_FUN,SIP1,SI,S1FUN) + IF(IX.EQ.IX0) THEN + WH_C0KG(IX-IX0,IQ,IDF) = S1FUN + ELSE + SIM1 = X0/XIM1 + CALL S2FUNC(C02G_FUN,SI,SIM1,S2FUN) + WH_C0KG(IX-IX0,IQ,IDF) = S1FUN-S2FUN + ENDIF + + CALL S1FUNC(C12G_FUN,SIP1,SI,S1FUN) + IF(IX.EQ.IX0) THEN + WH_C1KG(IX-IX0,IQ,IDF) = S1FUN + ELSE + SIM1 = X0/XIM1 + CALL S2FUNC(C12G_FUN,SI,SIM1,S2FUN) + WH_C1KG(IX-IX0,IQ,IDF) = S1FUN-S2FUN + ENDIF + + CALL S1FUNC(C1B2G_FUN,SIP1,SI,S1FUN) + IF(IX.EQ.IX0) THEN + WH_C1BKG(IX-IX0,IQ,IDF) = S1FUN + ELSE + SIM1 = X0/XIM1 + CALL S2FUNC(C1B2G_FUN,SI,SIM1,S2FUN) + WH_C1BKG(IX-IX0,IQ,IDF) = S1FUN-S2FUN + ENDIF + + CALL S1FUNC(C12Q_FUN,SIP1,SI,S1FUN) + IF(IX.EQ.IX0) THEN + WH_C1KQ(IX-IX0,IQ,IDF) = S1FUN + ELSE + SIM1 = X0/XIM1 + CALL S2FUNC(C12Q_FUN,SI,SIM1,S2FUN) + WH_C1KQ(IX-IX0,IQ,IDF) = S1FUN-S2FUN + ENDIF + + CALL S1FUNC(C1B2Q_FUN,SIP1,SI,S1FUN) + IF(IX.EQ.IX0) THEN + WH_C1BKQ(IX-IX0,IQ,IDF) = S1FUN + ELSE + SIM1 = X0/XIM1 + CALL S2FUNC(C1B2Q_FUN,SI,SIM1,S2FUN) + WH_C1BKQ(IX-IX0,IQ,IDF) = S1FUN-S2FUN + ENDIF + + CALL S1FUNC(D12Q_FUN,SIP1,SI,S1FUN) + IF(IX.EQ.IX0) THEN + WH_D1KQ(IX-IX0,IQ,IDF) = S1FUN + ELSE + SIM1 = X0/XIM1 + CALL S2FUNC(D12Q_FUN,SI,SIM1,S2FUN) + WH_D1KQ(IX-IX0,IQ,IDF) = S1FUN-S2FUN + ENDIF + + CALL S1FUNC(D1B2Q_FUN,SIP1,SI,S1FUN) + IF(IX.EQ.IX0) THEN + WH_D1BKQ(IX-IX0,IQ,IDF) = S1FUN + ELSE + SIM1 = X0/XIM1 + CALL S2FUNC(D1B2Q_FUN,SI,SIM1,S2FUN) + WH_D1BKQ(IX-IX0,IQ,IDF) = S1FUN-S2FUN + ENDIF + + 200 CONTINUE + + 400 END DO + + RETURN + END + +!DECK ID>, C02G_FUN. + +! ===================================== + DOUBLE PRECISION FUNCTION C02G_FUN(X) +! ===================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + COMMON /QCWGTC/ YWGT,QPCG,QMASS,EGAUSS,NF + + DATA PI /3.14159265359/ + + FACTOR = QMASS*QMASS/QPCG + C02G = 0. + IF(X.LT.(1./(1.+4.*FACTOR))) THEN + XI = 1./FACTOR + ETA = XI * (1.-X)/(4.*X) - 1. + C02G = (C0_LG(ETA,XI)+C0_TG(ETA,XI)) * XI / (2.*PI) + ENDIF + C02G_FUN = (X-YWGT)*C02G/(X*X) + + RETURN + END + +!DECK ID>, C12G_FUN. + +! ===================================== + DOUBLE PRECISION FUNCTION C12G_FUN(X) +! ===================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + COMMON /QCWGTC/ YWGT,QPCG,QMASS,EGAUSS,NF + + FACTOR = QMASS*QMASS/QPCG + C12G = 0. + IF(X.LT.(1./(1.+4.*FACTOR))) THEN + XI = 1./FACTOR + ETA = XI * (1.-X)/(4.*X) - 1. + BET = SQRT(ETA/(1.+ETA)) + RHO = 1./(1.+ETA) + C12G = CATF * (H1_ALG(ETA,XI)+H1_ATG(ETA,XI)) + & + & CFTF * (H1_FLG(ETA,XI)+H1_FTG(ETA,XI)) + & + & CATF * BET * (GFUN_L(ETA,XI)+GFUN_T(ETA,XI)) + & + & CATF * RHO * (EFUN_LA(ETA,XI)+EFUN_TA(ETA,XI)) + & + & CFTF * RHO * (EFUN_LF(ETA,XI)+EFUN_TF(ETA,XI)) + C12G = C12G*4.*PI/FACTOR + ENDIF + C12G_FUN = (X-YWGT)*C12G/(X*X) + + RETURN + END + +!DECK ID>, C1B2G_FUN. + +! ====================================== + DOUBLE PRECISION FUNCTION C1B2G_FUN(X) +! ====================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + COMMON /QCWGTC/ YWGT,QPCG,QMASS,EGAUSS,NF + + FACTOR = QMASS*QMASS/QPCG + C1B2G = 0. + IF(X.LT.(1./(1.+4.*FACTOR))) THEN + XI = 1./FACTOR + ETA = XI * (1.-X)/(4.*X) - 1. + BET = SQRT(ETA/(1.+ETA)) + RHO = 1./(1.+ETA) + C1B2G = CATF * (H1BAR_LG(ETA,XI)+H1BAR_TG(ETA,XI)) + & + & CATF * BET * (GBAR_L(ETA,XI)+GBAR_T(ETA,XI)) + & + & CATF * RHO * (EBAR_LA(ETA,XI)+EBAR_TA(ETA,XI)) + C1B2G = C1B2G*4.*PI/FACTOR + ENDIF + C1B2G_FUN = (X-YWGT)*C1B2G/(X*X) + + RETURN + END + +!DECK ID>, C12Q_FUN. + +! ===================================== + DOUBLE PRECISION FUNCTION C12Q_FUN(X) +! ===================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + COMMON /QCWGTC/ YWGT,QPCG,QMASS,EGAUSS,NF + + FACTOR = QMASS*QMASS/QPCG + C12Q = 0. + IF(X.LT.(1./(1.+4.*FACTOR))) THEN + XI = 1./FACTOR + ETA = XI * (1.-X)/(4.*X) - 1. + BET = SQRT(ETA/(1.+ETA)) + BET3 = BET*BET*BET + RHO = 1./(1.+ETA) + C12Q = CFTF * (H1_HLQ(ETA,XI)+H1_HTQ(ETA,XI)) + & + & CFTF * BET3 * (GFUN_L(ETA,XI)+GFUN_T(ETA,XI)) + C12Q = C12Q*4.*PI/FACTOR + ENDIF + C12Q_FUN = (X-YWGT)*C12Q/(X*X) + + RETURN + END + +!DECK ID>, C1B2Q_FUN. + +! ====================================== + DOUBLE PRECISION FUNCTION C1B2Q_FUN(X) +! ====================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + COMMON /QCWGTC/ YWGT,QPCG,QMASS,EGAUSS,NF + + FACTOR = QMASS*QMASS/QPCG + C1B2Q = 0. + IF(X.LT.(1./(1.+4.*FACTOR))) THEN + XI = 1./FACTOR + ETA = XI * (1.-X)/(4.*X) - 1. + BET = SQRT(ETA/(1.+ETA)) + BET3 = BET*BET*BET + RHO = 1./(1.+ETA) + C1B2Q = CFTF * (H1BAR_HLQ(ETA,XI)+H1BAR_HTQ(ETA,XI)) + & + & CFTF * BET3 * (GBAR_L(ETA,XI)+GBAR_T(ETA,XI)) + C1B2Q = C1B2Q*4.*PI/FACTOR + ENDIF + C1B2Q_FUN = (X-YWGT)*C1B2Q/(X*X) + + RETURN + END + +!DECK ID>, D12Q_FUN. + +! ===================================== + DOUBLE PRECISION FUNCTION D12Q_FUN(X) +! ===================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + COMMON /QCWGTC/ YWGT,QPCG,QMASS,EGAUSS,NF + + FACTOR = QMASS*QMASS/QPCG + D12Q = 0. + IF(X.LT.(1./(1.+4.*FACTOR))) THEN + XI = 1./FACTOR + ETA = XI * (1.-X)/(4.*X) - 1. + IF(QPCG.LE.1.5) THEN + D12Q = CFTF * (H1F_LLQ(ETA,XI)+H1F_LTQ(ETA,XI)) + ELSE + D12Q = CFTF * (H1_LLQ(ETA,XI)+H1_LTQ(ETA,XI)) + ENDIF + D12Q = D12Q*4.*PI/FACTOR + ENDIF + D12Q_FUN = (X-YWGT)*D12Q/(X*X) + + RETURN + END + +!DECK ID>, D1B2Q_FUN. + +! ====================================== + DOUBLE PRECISION FUNCTION D1B2Q_FUN(X) +! ====================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + COMMON /QCWGTC/ YWGT,QPCG,QMASS,EGAUSS,NF + + FACTOR = QMASS*QMASS/QPCG + D1B2Q = 0. + IF(X.LT.(1./(1.+4.*FACTOR))) THEN + XI = 1./FACTOR + ETA = XI * (1.-X)/(4.*X) - 1. + IF(QPCG.LE.1.5) THEN + D1B2Q = CFTF * H1BAR_LTQ(ETA,XI) + ELSE + D1B2Q = 0. + ENDIF + D1B2Q = D1B2Q*4.*PI/FACTOR + ENDIF + D1B2Q_FUN = (X-YWGT)*D1B2Q/(X*X) + + RETURN + END + +!DECK ID>, FIL_FLH. + +! ======================= + SUBROUTINE FIL_FLH(IDF) +! ======================= + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + EXTERNAL C0LG_FUN, C1LG_FUN, C1BLG_FUN + EXTERNAL C1LQ_FUN, C1BLQ_FUN + EXTERNAL D1LQ_FUN, D1BLQ_FUN + + COMMON /QCWGTC/ YWGT,QPCG,QMASS,EGAUSS,NF + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif + +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) + + + COMMON/QCGRID/ & + &SCAX0,SCAQ0,XMICUT,QMICUT,QMACUT,RS2CUT,QMINAS, & + &XXTAB(MXX),Q2TAB(MQ2),XHTAB(MXX),THRS34,THRS45, & + &NXX,NQ2,NGRVER,IHTAB(MXX),NFMAP(MQ2),IQF2C(MQ2), & + &IQF2B(MQ2),IQFLC(MQ2),IQFLB(MQ2),IFAILC(MXX,MQ2) + + + REAL & + &WH_C0KG,WH_C1KG,WH_C1BKG, & + &WH_C1KQ,WH_C1BKQ,WH_D1KQ,WH_D1BKQ + + COMMON/QCHWGT/ & + &WH_C0KG(0:MXX,MQ2,4:7), & + &WH_C1KG(0:MXX,MQ2,4:7),WH_C1BKG(0:MXX,MQ2,4:7), & + &WH_C1KQ(0:MXX,MQ2,4:7),WH_C1BKQ(0:MXX,MQ2,4:7), & + &WH_D1KQ(0:MXX,MQ2,4:7),WH_D1BKQ(0:MXX,MQ2,4:7) + + + QMASS = CBMSTF(IDF) + + EGAUSS = 0.001 + + DO 400 IQ = 1,NQ2 + + QPCG = Q2TAB(IQ) + APCG = 1.+4.*QMASS*QMASS/QPCG + + IX0 = 1 + X0 = XHTAB(IX0) + +! WRITE(6,'('' Calculate FLH weights for IX ='',I4)') IX0 + + DO 200 IX = IX0,NXX + + XI = XHTAB(IX) + XIP1 = XHTAB(IX+1) + IF(IX.GT.IX0) XIM1 = XHTAB(IX-1) + IF(XIP1.LE.X0*APCG) GOTO 200 + XI = MAX(XI,X0*APCG) + SIP1 = X0/XIP1 + SI = X0/XI + + CALL S1FUNC(C0LG_FUN,SIP1,SI,S1FUN) + IF(IX.EQ.IX0) THEN + WH_C0KG(IX-IX0,IQ,IDF) = S1FUN + ELSE + SIM1 = X0/XIM1 + CALL S2FUNC(C0LG_FUN,SI,SIM1,S2FUN) + WH_C0KG(IX-IX0,IQ,IDF) = S1FUN-S2FUN + ENDIF + + CALL S1FUNC(C1LG_FUN,SIP1,SI,S1FUN) + IF(IX.EQ.IX0) THEN + WH_C1KG(IX-IX0,IQ,IDF) = S1FUN + ELSE + SIM1 = X0/XIM1 + CALL S2FUNC(C1LG_FUN,SI,SIM1,S2FUN) + WH_C1KG(IX-IX0,IQ,IDF) = S1FUN-S2FUN + ENDIF + + CALL S1FUNC(C1BLG_FUN,SIP1,SI,S1FUN) + IF(IX.EQ.IX0) THEN + WH_C1BKG(IX-IX0,IQ,IDF) = S1FUN + ELSE + SIM1 = X0/XIM1 + CALL S2FUNC(C1BLG_FUN,SI,SIM1,S2FUN) + WH_C1BKG(IX-IX0,IQ,IDF) = S1FUN-S2FUN + ENDIF + + CALL S1FUNC(C1LQ_FUN,SIP1,SI,S1FUN) + IF(IX.EQ.IX0) THEN + WH_C1KQ(IX-IX0,IQ,IDF) = S1FUN + ELSE + SIM1 = X0/XIM1 + CALL S2FUNC(C1LQ_FUN,SI,SIM1,S2FUN) + WH_C1KQ(IX-IX0,IQ,IDF) = S1FUN-S2FUN + ENDIF + + CALL S1FUNC(C1BLQ_FUN,SIP1,SI,S1FUN) + IF(IX.EQ.IX0) THEN + WH_C1BKQ(IX-IX0,IQ,IDF) = S1FUN + ELSE + SIM1 = X0/XIM1 + CALL S2FUNC(C1BLQ_FUN,SI,SIM1,S2FUN) + WH_C1BKQ(IX-IX0,IQ,IDF) = S1FUN-S2FUN + ENDIF + + CALL S1FUNC(D1LQ_FUN,SIP1,SI,S1FUN) + IF(IX.EQ.IX0) THEN + WH_D1KQ(IX-IX0,IQ,IDF) = S1FUN + ELSE + SIM1 = X0/XIM1 + CALL S2FUNC(D1LQ_FUN,SI,SIM1,S2FUN) + WH_D1KQ(IX-IX0,IQ,IDF) = S1FUN-S2FUN + ENDIF + +! CALL S1FUNC(D1BLQ_FUN,SIP1,SI,S1FUN) +! IF(IX.EQ.IX0) THEN +! WH_D1BKQ(IX-IX0,IQ,IDF) = S1FUN +! ELSE +! SIM1 = X0/XIM1 +! CALL S2FUNC(D1BLQ_FUN,SI,SIM1,S2FUN) +! WH_D1BKQ(IX-IX0,IQ,IDF) = S1FUN-S2FUN +! ENDIF + WH_D1BKQ(IX-IX0,IQ,IDF) = 0. + + 200 CONTINUE + + 400 END DO + + RETURN + END + +!DECK ID>, C0LG_FUN. + +! ===================================== + DOUBLE PRECISION FUNCTION C0LG_FUN(X) +! ===================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + COMMON /QCWGTC/ YWGT,QPCG,QMASS,EGAUSS,NF + + DATA PI /3.14159265359/ + + FACTOR = QMASS*QMASS/QPCG + C0LG = 0. + IF(X.LT.(1./(1.+4.*FACTOR))) THEN + XI = 1./FACTOR + ETA = XI * (1.-X)/(4.*X) - 1. + C0LG = C0_LG(ETA,XI) * XI / (2.*PI) + ENDIF + C0LG_FUN = (X-YWGT)*C0LG/(X*X) + + RETURN + END + +!DECK ID>, C1LG_FUN. + +! ===================================== + DOUBLE PRECISION FUNCTION C1LG_FUN(X) +! ===================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + COMMON /QCWGTC/ YWGT,QPCG,QMASS,EGAUSS,NF + + FACTOR = QMASS*QMASS/QPCG + C1LG = 0. + IF(X.LT.(1./(1.+4.*FACTOR))) THEN + XI = 1./FACTOR + ETA = XI * (1.-X)/(4.*X) - 1. + BET = SQRT(ETA/(1.+ETA)) + RHO = 1./(1.+ETA) + C1LG = CATF * H1_ALG(ETA,XI) + & + & CFTF * H1_FLG(ETA,XI) + & + & CATF * BET * GFUN_L(ETA,XI) + & + & CATF * RHO * EFUN_LA(ETA,XI) + & + & CFTF * RHO * EFUN_LF(ETA,XI) + C1LG = C1LG*4.*PI/FACTOR + ENDIF + C1LG_FUN = (X-YWGT)*C1LG/(X*X) + + RETURN + END + +!DECK ID>, C1BLG_FUN. + +! ====================================== + DOUBLE PRECISION FUNCTION C1BLG_FUN(X) +! ====================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + COMMON /QCWGTC/ YWGT,QPCG,QMASS,EGAUSS,NF + + FACTOR = QMASS*QMASS/QPCG + C1BLG = 0. + IF(X.LT.(1./(1.+4.*FACTOR))) THEN + XI = 1./FACTOR + ETA = XI * (1.-X)/(4.*X) - 1. + BET = SQRT(ETA/(1.+ETA)) + RHO = 1./(1.+ETA) + C1BLG = CATF * H1BAR_LG(ETA,XI) + & + & CATF * BET * GBAR_L(ETA,XI) + & + & CATF * RHO * EBAR_LA(ETA,XI) + C1BLG = C1BLG*4.*PI/FACTOR + ENDIF + C1BLG_FUN = (X-YWGT)*C1BLG/(X*X) + + RETURN + END + +!DECK ID>, C1LQ_FUN. + +! ===================================== + DOUBLE PRECISION FUNCTION C1LQ_FUN(X) +! ===================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + COMMON /QCWGTC/ YWGT,QPCG,QMASS,EGAUSS,NF + + FACTOR = QMASS*QMASS/QPCG + C1LQ = 0. + IF(X.LT.(1./(1.+4.*FACTOR))) THEN + XI = 1./FACTOR + ETA = XI * (1.-X)/(4.*X) - 1. + BET = SQRT(ETA/(1.+ETA)) + BET3 = BET*BET*BET + RHO = 1./(1.+ETA) + C1LQ = CFTF * H1_HLQ(ETA,XI) + & + & CFTF * BET3 * GFUN_L(ETA,XI) + C1LQ = C1LQ*4.*PI/FACTOR + ENDIF + C1LQ_FUN = (X-YWGT)*C1LQ/(X*X) + + RETURN + END + +!DECK ID>, C1BLQ_FUN. + +! ====================================== + DOUBLE PRECISION FUNCTION C1BLQ_FUN(X) +! ====================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + COMMON /QCWGTC/ YWGT,QPCG,QMASS,EGAUSS,NF + + FACTOR = QMASS*QMASS/QPCG + C1BLQ = 0. + IF(X.LT.(1./(1.+4.*FACTOR))) THEN + XI = 1./FACTOR + ETA = XI * (1.-X)/(4.*X) - 1. + BET = SQRT(ETA/(1.+ETA)) + BET3 = BET*BET*BET + RHO = 1./(1.+ETA) + C1BLQ = CFTF * H1BAR_HLQ(ETA,XI) + & + & CFTF * BET3 * GBAR_L(ETA,XI) + C1BLQ = C1BLQ*4.*PI/FACTOR + ENDIF + C1BLQ_FUN = (X-YWGT)*C1BLQ/(X*X) + + RETURN + END + +!DECK ID>, D1LQ_FUN. + +! ===================================== + DOUBLE PRECISION FUNCTION D1LQ_FUN(X) +! ===================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + COMMON /QCWGTC/ YWGT,QPCG,QMASS,EGAUSS,NF + + FACTOR = QMASS*QMASS/QPCG + D1LQ = 0. + IF(X.LT.(1./(1.+4.*FACTOR))) THEN + XI = 1./FACTOR + ETA = XI * (1.-X)/(4.*X) - 1. + IF(QPCG.LE.1.5) THEN + D1LQ = CFTF * H1F_LLQ(ETA,XI) + ELSE + D1LQ = CFTF * H1_LLQ(ETA,XI) + ENDIF + D1LQ = D1LQ*4.*PI/FACTOR + ENDIF + D1LQ_FUN = (X-YWGT)*D1LQ/(X*X) + + RETURN + END + +!DECK ID>, D1BLQ_FUN. + +! ====================================== + DOUBLE PRECISION FUNCTION D1BLQ_FUN(X) +! ====================================== + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + + COMMON/QCCONS/ & + &PI,PROTON,EUTRON,UCLEON,UDSCBT(6),AAM2H,BBM2H,AAM2L,BBM2L, & + &AAAR2,BBBR2,FL_FAC,CBMSTF(4:7),CHARGE(4:7), & + &C1S3,C2S3,C4S3,C5S3,C8S3,C11S3,C14S3,C16S3,C20S3,C22S3,C28S3, & + &C38S3,C40S3,C44S3,C52S3,C136S3,C11S6,C2S9,C4S9,C10S9,C14S9,C16S9, & + &C40S9,C44S9,C62S9,C112S9,C182S9,C11S12,C35S18,C61S12,C215S1, & + &C29S12,CPI2S3,CPIA,CPIB,CPIC,CPID,CPIE,CPIF,CCA,CCF,CTF,CATF,CFTF + + + + COMMON /QCWGTC/ YWGT,QPCG,QMASS,EGAUSS,NF + + D1BLQ_FUN = 0. + + RETURN + END + +!DECK ID>, BORN. + +! This gives the Born coefficients +! For QCD take tf = 1d0/2d0, for QED take tf = 1d0. +! eta = (s - 4d0*m2)/4d0/m2, s is the gamma* gluon (gamma) CM Energy +! xi = Q^2/m2 + +! ======================================= + double precision function C0_Lg(eta,xi) +! ======================================= + +! Longitudinal coefficient function: PL B347(1995)143 eq. (7). +! This function is called born_l in the original code. + + implicit none + double precision eta, xi, pi, tf +! common/group/ca, cf, tf + parameter(tf = 0.5d0) + parameter(pi = 3.14159265359d0) + + C0_Lg = 0.5d0*pi*tf*xi*(1.d0 + eta + 0.25d0*xi)**(-3.d0)* & + & (2.d0*dsqrt(eta*(1.d0 + eta)) - & + & dlog((dsqrt(1.d0 + eta) + dsqrt(eta))/ & + & (dsqrt(1.d0 + eta) - dsqrt(eta)))) + + return + END + +! ======================================= + double precision function C0_Tg(eta,xi) +! ======================================= + +! Transverse coefficient function: PL B347(1995)143 eq. (8). +! This function is called born_t in the original code. + + implicit none + double precision eta, xi, pi, tf +! common/group/ca, cf, tf + parameter(tf = 0.5d0) + parameter(pi = 3.14159265359d0) + + C0_Tg = 0.5d0*pi*tf*(1.d0 + eta + 0.25d0*xi)**(-3)* & + & (-2.d0*((1.d0 + eta - 0.25d0*xi)**2 + eta + 1.d0)* & + & dsqrt(eta/(1.d0 + eta)) + (2.d0*(1.d0 + eta)**2 + & + & 0.125d0*xi**2 + 2.d0*eta + 1.d0)* & + & dlog((dsqrt(1.d0 + eta) + dsqrt(eta))/ & + & (dsqrt(1.d0 + eta) - dsqrt(eta)))) + + return + END + +!DECK ID>, ASYMP. + +! These are the functions that give the asymptotic dependence of the +! coefficient functions with the appropriate factors. xi = mq2/m2 (Q^2/m +! If xi is small, the regular routines have convergence +! problems and we take the limit. (not anymore after code update 03/06/9 + +! ========================================== + double precision function Gfun_L(dummy,xi) +! ========================================== + +! Longitudinal: equation (19) in PLB347 (1995) 143 - 151 +! This function is called asymp_l in the original code. + + implicit none + double precision xilast, store + double precision dummy + double precision xi, pi, term1 + double precision fii, fjj +! double precision fii_lim, fjj_lim + parameter (pi = 3.14159265359d0) + + save xilast, store + + data xilast, store /0.D0, 0.D0/ + + if(xi.eq.xilast) then + Gfun_L = store + return + endif + +! term1 = 1.d0/(1.d0 + 0.25d0*xi) + +! if (xi .le. 1.d-1) then +! Gfun_L = 1.d0/6.d0/pi*(-4.d0/3.d0*term1 + +! + (1.d0 - 1.d0/6.d0*term1)*fjj_lim(xi) - +! + 2.d0* (-1.d0/3.d0 + xi/15.d0 - xi**2/70.d0) + +! + 0.25d0*term1*fii_lim(xi) - +! + 3.d0* (1.d0/3.d0 - xi/10.d0 + 11.d0*xi**2/420.d0)) +! else +! Gfun_L = 1.d0/6.d0/pi*(4.d0/xi - 4.d0/3.d0*term1 +! + + (1.d0 - 2.d0/xi - 1.d0/6.d0*term1)*fjj(xi) +! + - (3.d0/xi + 0.25d0*term1)*fii(xi)) +! endif + + term1 = 1.d0/(1.d0 + 0.25d0*xi) + + Gfun_L = 1.d0/6.d0/pi*(4.d0/xi - 4.d0/3.d0*term1 & + & + (1.d0 - 2.d0/xi - 1.d0/6.d0*term1)*fjj(xi) & + & - (3.d0/xi + 0.25d0*term1)*fii(xi)) + + xilast = xi + store = Gfun_L + + return + END + +! ========================================== + double precision function Gfun_T(dummy,xi) +! ========================================== + +! Transverse: equation (20) in PLB347 (1995) 143 - 151 +! This function is called asymp_t in the original code. + + implicit none + double precision xilast, store + double precision dummy + double precision xi, pi, term1 + double precision fii, fjj +! double precision fii_lim, fjj_lim + parameter (pi = 3.14159265359d0) + + save xilast, store + + data xilast, store /0.D0, 0.D0/ + + if(xi.eq.xilast) then + Gfun_T = store + return + endif + +! term1 = 1.d0/(1.d0 + 0.25d0*xi) + +! if (xi .le. 1.d-1) then +! Gfun_T = 1.d0/6.d0/pi*(4.d0/3.d0*term1 + (7.d0/6.d0 + +! + 1.d0/6.d0*term1)*fjj_lim(xi) + 1/3.d0* +! + (-1.d0/3.d0 + xi/15.d0 - xi**2/70.d0) + +! + (1.d0 + 0.25d0*term1)*fii_lim(xi) + 2.d0* +! + (1.d0/3.d0 - xi/10.d0 + 11.d0*xi**2/420.d0)) +! else +! Gfun_T = 1.d0/6.d0/pi*(-2.d0/3.d0/xi + 4.d0/3.d0*term1 +! + + (7.d0/6.d0 + 1.d0/3.d0/xi + 1.d0/6.d0*term1)*fjj(xi) +! + + (1.d0 + 2.d0/xi + 0.25d0*term1)*fii(xi)) +! endif + + term1 = 1.d0/(1.d0 + 0.25d0*xi) + + Gfun_t = 1.d0/6.d0/pi*(-2.d0/3.d0/xi + 4.d0/3.d0*term1 & + & + (7.d0/6.d0 + 1.d0/3.d0/xi + 1.d0/6.d0*term1)*fjj(xi) & + & + (1.d0 + 2.d0/xi + 0.25d0*term1)*fii(xi)) + + xilast = xi + store = Gfun_T + + return + END + +! ========================================== + double precision function Gbar_L(dummy,xi) +! ========================================== + +! Longitudinal mass factorization: (21) in PLB347 (1995) 143 - 151 +! This function is called asympbar_l in the original code. + + implicit none + double precision xilast, store + double precision dummy + double precision xi, pi, term1 + double precision fjj +! double precision fjj_lim + parameter (pi = 3.14159265359d0) + + save xilast, store + + data xilast, store /0.D0, 0.D0/ + + if(xi.eq.xilast) then + Gbar_L = store + return + endif + +! term1 = 1.d0/(1.d0 + 0.25d0*xi) + +! if (xi .le. 1.d-1) then +! Gbar_L = 1.d0/6.d0/pi*(0.5d0*term1 + +! + 0.25d0*term1*fjj_lim(xi) + +! + 3.d0* (-1.d0/3.d0 + xi/15.d0 - xi**2/70.d0)) +! else +! Gbar_L = 1.d0/6.d0/pi*(-6.d0/xi + 0.5d0*term1 +! + + (3.d0/xi + 0.25d0*term1)*fjj(xi)) +! endif + + term1 = 1.d0/(1.d0 + 0.25d0*xi) + + Gbar_L = 1.d0/6.d0/pi*(-6.d0/xi + 0.5d0*term1 & + & + (3.d0/xi + 0.25d0*term1)*fjj(xi)) + + xilast = xi + store = Gbar_L + + return + END + +! ========================================== + double precision function Gbar_T(dummy,xi) +! ========================================== + +! transverse mass factorization: (22) in PLB347 (1995) 143 - 151 +! This function is called asympbar_t in the original code. + + implicit none + double precision xilast, store + double precision dummy + double precision xi, pi, term1 + double precision fjj +! double precision fjj_lim + parameter (pi = 3.14159265359d0) + + save xilast, store + + data xilast, store /0.D0, 0.D0/ + + if(xi.eq.xilast) then + Gbar_T = store + return + endif + +! term1 = 1.d0/(1.d0 + 0.25d0*xi) + +! if (xi .le. 1.d-1) then +! Gbar_T = 1.d0/6.d0/pi*(-.5d0*term1 - +! + (1.d0 + 0.25d0*term1)*fjj_lim(xi) - +! + 2.d0* (-1.d0/3.d0 + xi/15.d0 - xi**2/70.d0)) +! else +! Gbar_T = 1.d0/6.d0/pi*(4.d0/xi - 0.5d0*term1 +! + - (1.d0 + 2.d0/xi + 0.25d0*term1)*fjj(xi)) +! endif + + term1 = 1.d0/(1.d0 + 0.25d0*xi) + + Gbar_T = 1.d0/6.d0/pi*(4.d0/xi - 0.5d0*term1 & + & - (1.d0 + 2.d0/xi + 0.25d0*term1)*fjj(xi)) + + xilast = xi + store = Gbar_T + + return + END + +! ================================= + double precision function fii(xi) +! ================================= + +! Equation (24) in PLB347 (1995) 143 - 151 + + implicit none + double precision pi, term1, term2, xi, di_log + parameter (pi = 3.14159265359d0) + + term1 = dsqrt(xi) + term2 = dsqrt(4.d0 + xi) + fii = 4.d0/term1/term2*(-pi*pi/6.d0 & + & - 0.5d0*(dlog((term2 + term1)/(term2 - term1)))**2 & + & + (dlog(0.5d0*(1.d0 - term1/term2)))**2 & + & + 2.d0*di_log(0.5d0*(1.d0 - term1/term2))) + + return + END + +! ================================= + double precision function fjj(xi) +! ================================= + +! Equation (23) in PLB347 (1995) 143 - 151 + + implicit none + double precision pi, xi, term1, term2 + parameter (pi = 3.14159265359d0) + + term1 = dsqrt(xi) + term2 = dsqrt(4.d0 + xi) + fjj = 4.d0/term1/term2*dlog((term2 + term1)/(term2 - term1)) + + return + END + +! ===================================== + double precision function fii_lim(xi) +! ===================================== + +! this gives fii(xi) in the limit that xi -> 0 up to xi**2 + + implicit none + double precision xi + + fii_lim = xi/3.d0 - xi**2/10.d0 + + return + END + +! ===================================== + double precision function fjj_lim(xi) +! ===================================== + +! this gives fjj(xi) in the limit that xi -> 0 up to xi**2 + + implicit none + double precision xi + + fjj_lim = 2.d0 - xi/3.d0 + xi**2/15.d0 + + return + END + +! =================================== + double precision function di_log(x) +! =================================== + +! Equation (25) in PLB347 (1995) 143 - 151 + + implicit double precision (a-z) + dimension b(8) + integer ncall + data ncall/0/,pi6/1.644934066848226d+00/,een,vier/1.d+00,.25d+00/ + + ncall = 0 + if(ncall.eq.0)goto 2 + 1 if(x.lt.0)goto 3 + if(x.gt.0.5)goto 4 + z=-dlog(1.-x) + 7 z2=z*z + di_log=z*(z2*(z2*(z2*(z2*(z2*(z2*(z2*b(8)+b(7))+b(6)) & + & +b(5))+b(4))+b(3))+b(2))+een)-z2*vier + if(x.gt.een)di_log=-di_log-.5*u*u+2.*pi6 + return + 2 b(1)=een + b(2)=een/36. + b(3)=-een/3600. + b(4)=een/211680. + b(5)=-een/(30.*362880.d+00) + b(6)=5./(66.*39916800.d+00) + b(7)=-691./(2730.*39916800.d+00*156.) + b(8)=een/(39916800.d+00*28080.) + ncall=1 + goto 1 + 3 if(x.gt.-een)goto 5 + y=een/(een-x) + z=-dlog(een-y) + z2=z*z + u=dlog(y) + di_log=z*(z2*(z2*(z2*(z2*(z2*(z2*(z2*b(8)+b(7))+b(6)) & + & +b(5))+b(4))+b(3))+b(2))+een)-z2*vier-u*(z+.5*u)-pi6 + return + 4 if(x.ge.een)goto 10 + y=een-x + z=-dlog(x) + 6 u=dlog(y) + z2=z*z + di_log=-z*(z2*(z2*(z2*(z2*(z2*(z2*(z2*b(8)+b(7))+b(6)) & + & +b(5))+b(4))+b(3))+b(2))+een-u)+z2*vier+pi6 + if(x.gt.een)di_log=-di_log-.5*z*z+pi6*2. + return + 5 y=een/(een-x) + z=-dlog(y) + z2=z*z + di_log=-z*(z2*(z2*(z2*(z2*(z2*(z2*(z2*b(8)+b(7))+b(6)) & + & +b(5))+b(4))+b(3))+b(2))+een)-z2*vier + return + 10 if(x.eq.een)goto 20 + xx=1./x + if(x.gt.2.)goto 11 + z=dlog(x) + y=1.-xx + goto 6 + 11 u=dlog(x) + z=-dlog(1.-xx) + goto 7 + 20 di_log=pi6 + + return + END + +!DECK ID>, THRESH. + +! These are the functions that give the threshold dependence of the +! coefficient functions with the appropriate factors. +! eta = (W^2 - 4d0*m2)/4d0/m2 where W is the CM energy of the +! gamma* parton system. xi = mq2/m2 (Q^2/m2) + +! ========================================= + double precision function Efun_LF(eta,xi) +! ========================================= + +! Longitudinal CF group structure: eq (13) in PLB347 (195) 143 - 151 +! This function is called threshf_l in the original code. + + implicit none + double precision pi, eta, xi, beta, term1 + parameter (pi = 3.14159265359d0) + + beta = dsqrt(eta/(1.d0 + eta)) + term1 = 1.d0/(1.d0 + 0.25d0*xi) + Efun_LF = 1.d0/6.d0/pi*xi*term1**3*beta*beta*pi*pi/2.d0 + + return + END + +! ========================================= + double precision function Efun_TF(eta,xi) +! ========================================= + +! Transverse CF group structure: eq (14) in PLB347 (195) 143 - 151 +! This function is called threshf_t in the original code. + + implicit none + double precision pi, eta, xi, beta, term1 + parameter (pi = 3.14159265359d0) + + beta = dsqrt(eta/(1.d0 + eta)) + term1 = 1.d0/(1.d0 + 0.25d0*xi) + Efun_TF = 0.25d0/pi*term1*pi*pi/2.d0 + + return + END + +! ========================================= + double precision function Efun_LA(eta,xi) +! ========================================= + +! Longitudinal CA group structure: eq (15) in PLB347 (195) 143 - 151 +! This function is called thresha_l in the original code. + + implicit none + double precision pi, eta, xi, beta, term1 + parameter (pi = 3.14159265359d0) + + beta = dsqrt(eta/(1.d0 + eta)) + term1 = 1.d0/(1.d0 + 0.25d0*xi) + Efun_LA = 1.d0/6.d0/pi*xi*term1**3*beta**2* & + & (beta*(dlog(8.d0*beta*beta))**2 & + & - 5.d0*beta*dlog(8.d0*beta*beta) - 0.25d0*pi*pi) + + return + END + +! ========================================= + double precision function Efun_TA(eta,xi) +! ========================================= + +! Transverse CA group structure: eq (16) in PLB347 (195) 143 - 151 +! This function is called thresha_t in the original code. + implicit none + double precision pi, eta, xi, beta, term1 + parameter (pi = 3.14159265359d0) + + beta = dsqrt(eta/(1.d0 + eta)) + term1 = 1.d0/(1.d0 + 0.25d0*xi) + Efun_TA = 0.25d0/pi*term1*(beta*(dlog(8.d0*beta*beta))**2 & + & - 5.d0*beta*dlog(8.d0*beta*beta) - 0.25d0*pi*pi) + + return + END + +! ========================================= + double precision function Ebar_LA(eta,xi) +! ========================================= + +! Longitudinal CA group structure for the mass factorization piece: +! equation (17) in PLB347 (195) 143 - 151 +! This function is called threshbar_l in the original code. + + implicit none + double precision pi, eta, xi, beta, term1 + parameter (pi = 3.14159265359d0) + + beta = dsqrt(eta/(1.d0 + eta)) + term1 = 1.d0/(1.d0 + 0.25d0*xi) + Ebar_LA = 1.d0/6.d0/pi*xi*term1**3*beta**3* & + & (-dlog(4.d0*beta*beta)) + + return + END + +! ========================================= + double precision function Ebar_TA(eta,xi) +! ========================================= + +! Transverse CA group structure for the mass factorization piece: +! equation (18) in PLB347 (195) 143 - 151 +! This function is called threshbar_t in the original code. + + implicit none + double precision pi, eta, xi, beta, term1 + parameter (pi = 3.14159265359d0) + + beta = dsqrt(eta/(1.d0 + eta)) + term1 = 1.d0/(1.d0 + 0.25d0*xi) + Ebar_TA = 0.25d0/pi*term1*beta*(-dlog(4.d0*beta*beta)) + + return + END + +!DECK ID>, LOCATE. + +! =========================== + Subroutine Locate(xx,n,x,j) +! =========================== +! routine taken out of Numerical Recipes + + Integer j,n + Double Precision x,xx(n) + Integer jl,ju,jm + + jl = 0 + ju = n+1 + 10 If (ju - jl .gt. 1) then + jm = (ju + jl)/2 + If ((xx(n) .gt. xx(1)) .eqv. (x .gt. xx(jm))) then + jl = jm + else + ju = jm + endif + goto 10 + endif + j = jl + + return + END + +!DECK ID>, GCORRT. + +! ======================================== + double precision function h1_ATg(eta,xi) +! ======================================== + +! eq (9) in PLB347 (1995) 143 - 151 for the transverse piece +! MSbar scheme +! This routine is called subctca in the original code. +! Called sctca in updated code (03/06/96). + + implicit none + integer neta, nxi + parameter (neta = 73, nxi = 49) + double precision calcpts(neta, nxi), dlaeta(neta), dlaxi(nxi) + double precision eta, xi, dleta, dlxi + double precision pxi, peta, f(-1:1), delxi, deleta + integer j, ieta, ixi + + data (calcpts(j, 1), j = 1,neta) /0.4323D-03, 0.5138D-03, & + & 0.6270D-03, 0.7996D-03, 0.9331D-03, 0.1128D-02, 0.1413D-02, & + & 0.1683D-02, 0.2046D-02, 0.2457D-02, 0.2961D-02, 0.3609D-02, & + & 0.4386D-02, 0.5294D-02, 0.6434D-02, 0.7763D-02, 0.9365D-02, & + & 0.1136D-01, 0.1370D-01, 0.1657D-01, 0.2004D-01, 0.2424D-01, & + & 0.2932D-01, 0.3548D-01, 0.4293D-01, 0.5192D-01, 0.6267D-01, & + & 0.7534D-01, 0.8988D-01, 0.1058D+00, 0.1217D+00, 0.1351D+00, & + & 0.1421D+00, 0.1379D+00, 0.1184D+00, 0.8306D-01, 0.3588D-01, & + & -.1530D-01, -.6227D-01, -.9944D-01, -.1244D+00, -.1372D+00, & + & -.1396D+00, -.1341D+00, -.1233D+00, -.1096D+00, -.9476D-01, & + & -.8013D-01, -.6655D-01, -.5451D-01, -.4402D-01, -.3519D-01, & + & -.2786D-01, -.2194D-01, -.1711D-01, -.1324D-01, -.1021D-01, & + & -.7860D-02, -.6008D-02, -.4529D-02, -.3433D-02, -.2592D-02, & + & -.1943D-02, -.1488D-02, -.1096D-02, -.8350D-03, -.6387D-03, & + & -.4413D-03, -.3097D-03, -.2442D-03, -.1783D-03, -.1122D-03, & + & -.1126D-03/ + + data (calcpts(j, 2), j = 1,neta) /0.4112D-03, 0.5596D-03, & + & 0.6731D-03, 0.7794D-03, 0.9800D-03, 0.1176D-02, 0.1394D-02, & + & 0.1665D-02, 0.2028D-02, 0.2507D-02, 0.3011D-02, 0.3593D-02, & + & 0.4371D-02, 0.5280D-02, 0.6421D-02, 0.7751D-02, 0.9354D-02, & + & 0.1135D-01, 0.1370D-01, 0.1656D-01, 0.2004D-01, 0.2424D-01, & + & 0.2932D-01, 0.3547D-01, 0.4293D-01, 0.5191D-01, 0.6265D-01, & + & 0.7532D-01, 0.8986D-01, 0.1057D+00, 0.1217D+00, 0.1351D+00, & + & 0.1421D+00, 0.1379D+00, 0.1184D+00, 0.8304D-01, 0.3587D-01, & + & -.1531D-01, -.6227D-01, -.9945D-01, -.1244D+00, -.1372D+00, & + & -.1396D+00, -.1341D+00, -.1233D+00, -.1096D+00, -.9475D-01, & + & -.8011D-01, -.6660D-01, -.5450D-01, -.4401D-01, -.3518D-01, & + & -.2791D-01, -.2193D-01, -.1710D-01, -.1329D-01, -.1019D-01, & + & -.7845D-02, -.5992D-02, -.4581D-02, -.3485D-02, -.2577D-02, & + & -.1927D-02, -.1473D-02, -.1081D-02, -.8195D-03, -.6233D-03, & + & -.4258D-03, -.3609D-03, -.2288D-03, -.1629D-03, -.1634D-03, & + & -.9715D-04/ + + data (calcpts(j, 3), j = 1,neta) /0.4469D-03, 0.5291D-03, & + & 0.6430D-03, 0.8165D-03, 0.9509D-03, 0.1147D-02, 0.1366D-02, & + & 0.1705D-02, 0.2069D-02, 0.2482D-02, 0.2987D-02, 0.3637D-02, & + & 0.4350D-02, 0.5326D-02, 0.6402D-02, 0.7734D-02, 0.9338D-02, & + & 0.1133D-01, 0.1370D-01, 0.1656D-01, 0.2003D-01, 0.2423D-01, & + & 0.2931D-01, 0.3547D-01, 0.4292D-01, 0.5190D-01, 0.6264D-01, & + & 0.7531D-01, 0.8984D-01, 0.1057D+00, 0.1216D+00, 0.1351D+00, & + & 0.1420D+00, 0.1378D+00, 0.1184D+00, 0.8300D-01, 0.3585D-01, & + & -.1532D-01, -.6227D-01, -.9944D-01, -.1244D+00, -.1372D+00, & + & -.1396D+00, -.1341D+00, -.1233D+00, -.1095D+00, -.9473D-01, & + & -.8016D-01, -.6658D-01, -.5447D-01, -.4405D-01, -.3522D-01, & + & -.2789D-01, -.2190D-01, -.1708D-01, -.1326D-01, -.1024D-01, & + & -.7822D-02, -.5970D-02, -.4558D-02, -.3462D-02, -.2621D-02, & + & -.1972D-02, -.1450D-02, -.1125D-02, -.7969D-03, -.6007D-03, & + & -.4699D-03, -.3383D-03, -.2728D-03, -.2069D-03, -.1408D-03, & + & -.7452D-04/ + + data (calcpts(j, 4), j = 1,neta) /0.4681D-03, 0.5509D-03, & + & 0.6654D-03, 0.7730D-03, 0.9749D-03, 0.1172D-02, 0.1392D-02, & + & 0.1665D-02, 0.2031D-02, 0.2445D-02, 0.3018D-02, 0.3603D-02, & + & 0.4384D-02, 0.5296D-02, 0.6441D-02, 0.7775D-02, 0.9382D-02, & + & 0.1131D-01, 0.1370D-01, 0.1656D-01, 0.2003D-01, 0.2422D-01, & + & 0.2930D-01, 0.3546D-01, 0.4290D-01, 0.5188D-01, 0.6262D-01, & + & 0.7528D-01, 0.8980D-01, 0.1057D+00, 0.1216D+00, 0.1350D+00, & + & 0.1420D+00, 0.1378D+00, 0.1183D+00, 0.8296D-01, 0.3582D-01, & + & -.1534D-01, -.6228D-01, -.9945D-01, -.1244D+00, -.1372D+00, & + & -.1396D+00, -.1341D+00, -.1233D+00, -.1096D+00, -.9477D-01, & + & -.8013D-01, -.6655D-01, -.5451D-01, -.4402D-01, -.3519D-01, & + & -.2786D-01, -.2194D-01, -.1711D-01, -.1323D-01, -.1020D-01, & + & -.7856D-02, -.6003D-02, -.4525D-02, -.3429D-02, -.2588D-02, & + & -.1938D-02, -.1483D-02, -.1092D-02, -.8303D-03, -.6341D-03, & + & -.4366D-03, -.3050D-03, -.2395D-03, -.1737D-03, -.1076D-03, & + & -.1079D-03/ + + data (calcpts(j, 5), j = 1,neta) /0.4681D-03, 0.5517D-03, & + & 0.6672D-03, 0.7759D-03, 0.9790D-03, 0.1178D-02, 0.1399D-02, & + & 0.1674D-02, 0.2041D-02, 0.2457D-02, 0.2967D-02, 0.3621D-02, & + & 0.4405D-02, 0.5319D-02, 0.6400D-02, 0.7738D-02, 0.9348D-02, & + & 0.1135D-01, 0.1369D-01, 0.1655D-01, 0.2002D-01, 0.2421D-01, & + & 0.2928D-01, 0.3544D-01, 0.4288D-01, 0.5185D-01, 0.6259D-01, & + & 0.7523D-01, 0.8975D-01, 0.1056D+00, 0.1215D+00, 0.1349D+00, & + & 0.1419D+00, 0.1377D+00, 0.1182D+00, 0.8289D-01, 0.3577D-01, & + & -.1536D-01, -.6229D-01, -.9945D-01, -.1244D+00, -.1371D+00, & + & -.1396D+00, -.1341D+00, -.1233D+00, -.1095D+00, -.9472D-01, & + & -.8015D-01, -.6657D-01, -.5446D-01, -.4404D-01, -.3521D-01, & + & -.2788D-01, -.2189D-01, -.1713D-01, -.1325D-01, -.1022D-01, & + & -.7874D-02, -.6021D-02, -.4543D-02, -.3447D-02, -.2605D-02, & + & -.1956D-02, -.1501D-02, -.1109D-02, -.8482D-03, -.5853D-03, & + & -.4545D-03, -.3229D-03, -.2574D-03, -.1916D-03, -.1254D-03, & + & -.1258D-03/ + + data (calcpts(j, 6), j = 1,neta) /0.4370D-03, 0.5219D-03, & + & 0.6388D-03, 0.8157D-03, 0.9540D-03, 0.1155D-02, 0.1379D-02, & + & 0.1656D-02, 0.2026D-02, 0.2445D-02, 0.2957D-02, 0.3615D-02, & + & 0.4403D-02, 0.5255D-02, 0.6408D-02, 0.7750D-02, 0.9365D-02, & + & 0.1130D-01, 0.1368D-01, 0.1653D-01, 0.2000D-01, 0.2419D-01, & + & 0.2926D-01, 0.3541D-01, 0.4285D-01, 0.5181D-01, 0.6253D-01, & + & 0.7518D-01, 0.8967D-01, 0.1055D+00, 0.1214D+00, 0.1348D+00, & + & 0.1418D+00, 0.1375D+00, 0.1181D+00, 0.8279D-01, 0.3571D-01, & + & -.1540D-01, -.6231D-01, -.9945D-01, -.1244D+00, -.1371D+00, & + & -.1396D+00, -.1341D+00, -.1233D+00, -.1096D+00, -.9473D-01, & + & -.8015D-01, -.6657D-01, -.5446D-01, -.4403D-01, -.3520D-01, & + & -.2787D-01, -.2188D-01, -.1712D-01, -.1324D-01, -.1022D-01, & + & -.7869D-02, -.6016D-02, -.4538D-02, -.3442D-02, -.2601D-02, & + & -.1951D-02, -.1496D-02, -.1105D-02, -.8434D-03, -.5804D-03, & + & -.4497D-03, -.3181D-03, -.2526D-03, -.1867D-03, -.1206D-03, & + & -.1210D-03/ + + data (calcpts(j, 7), j = 1,neta) /0.4271D-03, 0.5137D-03, & + & 0.6327D-03, 0.8119D-03, 0.9528D-03, 0.1156D-02, 0.1384D-02, & + & 0.1664D-02, 0.2038D-02, 0.2462D-02, 0.2979D-02, 0.3643D-02, & + & 0.4369D-02, 0.5295D-02, 0.6387D-02, 0.7736D-02, 0.9359D-02, & + & 0.1131D-01, 0.1367D-01, 0.1652D-01, 0.1998D-01, 0.2417D-01, & + & 0.2923D-01, 0.3537D-01, 0.4280D-01, 0.5175D-01, 0.6246D-01, & + & 0.7509D-01, 0.8956D-01, 0.1054D+00, 0.1212D+00, 0.1346D+00, & + & 0.1415D+00, 0.1373D+00, 0.1179D+00, 0.8265D-01, 0.3561D-01, & + & -.1546D-01, -.6233D-01, -.9945D-01, -.1243D+00, -.1371D+00, & + & -.1395D+00, -.1341D+00, -.1233D+00, -.1095D+00, -.9470D-01, & + & -.8012D-01, -.6654D-01, -.5449D-01, -.4400D-01, -.3517D-01, & + & -.2790D-01, -.2191D-01, -.1709D-01, -.1327D-01, -.1025D-01, & + & -.7831D-02, -.5978D-02, -.4566D-02, -.3470D-02, -.2629D-02, & + & -.1980D-02, -.1458D-02, -.1066D-02, -.8051D-03, -.6089D-03, & + & -.4781D-03, -.3465D-03, -.6143D-03, -.1485D-03, -.1490D-03, & + & -.8274D-04/ + + data (calcpts(j, 8), j = 1,neta) /0.4171D-03, 0.5064D-03, & + & 0.6284D-03, 0.8110D-03, 0.9558D-03, 0.1164D-02, 0.1396D-02, & + & 0.1682D-02, 0.2062D-02, 0.2492D-02, 0.2950D-02, 0.3621D-02, & + & 0.4356D-02, 0.5291D-02, 0.6392D-02, 0.7752D-02, 0.9319D-02, & + & 0.1128D-01, 0.1365D-01, 0.1650D-01, 0.1995D-01, 0.2413D-01, & + & 0.2919D-01, 0.3531D-01, 0.4273D-01, 0.5167D-01, 0.6235D-01, & + & 0.7495D-01, 0.8940D-01, 0.1052D+00, 0.1210D+00, 0.1343D+00, & + & 0.1413D+00, 0.1370D+00, 0.1177D+00, 0.8245D-01, 0.3546D-01, & + & -.1554D-01, -.6236D-01, -.9945D-01, -.1243D+00, -.1371D+00, & + & -.1395D+00, -.1340D+00, -.1232D+00, -.1095D+00, -.9470D-01, & + & -.8011D-01, -.6653D-01, -.5448D-01, -.4398D-01, -.3522D-01, & + & -.2788D-01, -.2189D-01, -.1707D-01, -.1325D-01, -.1023D-01, & + & -.7811D-02, -.6025D-02, -.4546D-02, -.3450D-02, -.2609D-02, & + & -.1959D-02, -.1438D-02, -.1113D-02, -.7847D-03, -.5884D-03, & + & -.4576D-03, -.3260D-03, -.2605D-03, -.1947D-03, -.1285D-03, & + & -.1289D-03/ + + data (calcpts(j, 9), j = 1,neta) /0.4435D-03, 0.5367D-03, & + & 0.6631D-03, 0.7841D-03, 0.9344D-03, 0.1148D-02, 0.1388D-02, & + & 0.1681D-02, 0.2003D-02, 0.2443D-02, 0.2978D-02, 0.3594D-02, & + & 0.4342D-02, 0.5289D-02, 0.6406D-02, 0.7714D-02, 0.9296D-02, & + & 0.1127D-01, 0.1362D-01, 0.1646D-01, 0.1991D-01, 0.2407D-01, & + & 0.2912D-01, 0.3524D-01, 0.4263D-01, 0.5155D-01, 0.6220D-01, & + & 0.7476D-01, 0.8916D-01, 0.1049D+00, 0.1206D+00, 0.1339D+00, & + & 0.1408D+00, 0.1366D+00, 0.1173D+00, 0.8214D-01, 0.3525D-01, & + & -.1566D-01, -.6242D-01, -.9946D-01, -.1243D+00, -.1371D+00, & + & -.1395D+00, -.1340D+00, -.1232D+00, -.1095D+00, -.9470D-01, & + & -.8011D-01, -.6651D-01, -.5446D-01, -.4403D-01, -.3520D-01, & + & -.2786D-01, -.2194D-01, -.1711D-01, -.1323D-01, -.1020D-01, & + & -.7853D-02, -.6000D-02, -.4521D-02, -.3425D-02, -.2584D-02, & + & -.1934D-02, -.1480D-02, -.1088D-02, -.8263D-03, -.6301D-03, & + & -.4326D-03, -.3010D-03, -.2355D-03, -.1696D-03, -.1035D-03, & + & -.1039D-03/ + + data (calcpts(j,10), j = 1,neta) /0.4611D-03, 0.4933D-03, & + & 0.6262D-03, 0.7544D-03, 0.9129D-03, 0.1136D-02, 0.1386D-02, & + & 0.1691D-02, 0.2025D-02, 0.2479D-02, 0.2963D-02, 0.3595D-02, & + & 0.4361D-02, 0.5262D-02, 0.6332D-02, 0.7662D-02, 0.9268D-02, & + & 0.1120D-01, 0.1357D-01, 0.1641D-01, 0.1984D-01, 0.2399D-01, & + & 0.2902D-01, 0.3512D-01, 0.4249D-01, 0.5136D-01, 0.6198D-01, & + & 0.7448D-01, 0.8881D-01, 0.1045D+00, 0.1201D+00, 0.1333D+00, & + & 0.1402D+00, 0.1360D+00, 0.1167D+00, 0.8169D-01, 0.3495D-01, & + & -.1584D-01, -.6249D-01, -.9946D-01, -.1243D+00, -.1370D+00, & + & -.1394D+00, -.1339D+00, -.1231D+00, -.1095D+00, -.9468D-01, & + & -.8007D-01, -.6653D-01, -.5441D-01, -.4398D-01, -.3521D-01, & + & -.2787D-01, -.2188D-01, -.1711D-01, -.1323D-01, -.1021D-01, & + & -.7857D-02, -.6004D-02, -.4525D-02, -.3429D-02, -.2588D-02, & + & -.1938D-02, -.1483D-02, -.1091D-02, -.8300D-03, -.6337D-03, & + & -.4363D-03, -.3047D-03, -.2392D-03, -.1733D-03, -.1072D-03, & + & -.1076D-03/ + + data (calcpts(j,11), j = 1,neta) /0.4058D-03, 0.5130D-03, & + & 0.6553D-03, 0.7941D-03, 0.9646D-03, 0.1135D-02, 0.1399D-02, & + & 0.1654D-02, 0.2007D-02, 0.2415D-02, 0.2921D-02, 0.3578D-02, & + & 0.4303D-02, 0.5233D-02, 0.6333D-02, 0.7629D-02, 0.9268D-02, & + & 0.1117D-01, 0.1351D-01, 0.1632D-01, 0.1975D-01, 0.2388D-01, & + & 0.2888D-01, 0.3494D-01, 0.4227D-01, 0.5110D-01, 0.6164D-01, & + & 0.7406D-01, 0.8831D-01, 0.1038D+00, 0.1194D+00, 0.1325D+00, & + & 0.1393D+00, 0.1350D+00, 0.1159D+00, 0.8103D-01, 0.3450D-01, & + & -.1609D-01, -.6259D-01, -.9947D-01, -.1242D+00, -.1369D+00, & + & -.1393D+00, -.1339D+00, -.1231D+00, -.1094D+00, -.9458D-01, & + & -.8003D-01, -.6648D-01, -.5441D-01, -.4397D-01, -.3513D-01, & + & -.2786D-01, -.2187D-01, -.1710D-01, -.1322D-01, -.1019D-01, & + & -.7843D-02, -.5989D-02, -.4577D-02, -.3481D-02, -.2572D-02, & + & -.1990D-02, -.1468D-02, -.1076D-02, -.8148D-03, -.6185D-03, & + & -.4210D-03, -.3561D-03, -.2239D-03, -.1580D-03, -.1586D-03, & + & -.9227D-04/ + + data (calcpts(j,12), j = 1,neta) /0.4531D-03, 0.5058D-03, & + & 0.6618D-03, 0.7494D-03, 0.9372D-03, 0.1127D-02, 0.1346D-02, & + & 0.1625D-02, 0.2005D-02, 0.2442D-02, 0.2914D-02, 0.3540D-02, & + & 0.4304D-02, 0.5208D-02, 0.6287D-02, 0.7563D-02, 0.9184D-02, & + & 0.1107D-01, 0.1341D-01, 0.1621D-01, 0.1961D-01, 0.2371D-01, & + & 0.2867D-01, 0.3469D-01, 0.4195D-01, 0.5071D-01, 0.6116D-01, & + & 0.7347D-01, 0.8757D-01, 0.1029D+00, 0.1183D+00, 0.1313D+00, & + & 0.1379D+00, 0.1337D+00, 0.1147D+00, 0.8008D-01, 0.3385D-01, & + & -.1646D-01, -.6275D-01, -.9949D-01, -.1242D+00, -.1368D+00, & + & -.1392D+00, -.1337D+00, -.1230D+00, -.1093D+00, -.9456D-01, & + & -.7998D-01, -.6642D-01, -.5441D-01, -.4396D-01, -.3518D-01, & + & -.2783D-01, -.2190D-01, -.1707D-01, -.1325D-01, -.1022D-01, & + & -.7808D-02, -.5954D-02, -.4542D-02, -.3445D-02, -.2604D-02, & + & -.1954D-02, -.1499D-02, -.1107D-02, -.8456D-03, -.5826D-03, & + & -.4518D-03, -.3202D-03, -.2547D-03, -.1888D-03, -.1227D-03, & + & -.1231D-03/ + + data (calcpts(j,13), j = 1,neta) /0.4062D-03, 0.5431D-03, & + & 0.6522D-03, 0.7622D-03, 0.9086D-03, 0.1126D-02, 0.1377D-02, & + & 0.1625D-02, 0.1977D-02, 0.2390D-02, 0.2910D-02, 0.3520D-02, & + & 0.4273D-02, 0.5104D-02, 0.6247D-02, 0.7524D-02, 0.9082D-02, & + & 0.1098D-01, 0.1327D-01, 0.1605D-01, 0.1941D-01, 0.2347D-01, & + & 0.2837D-01, 0.3432D-01, 0.4151D-01, 0.5015D-01, 0.6047D-01, & + & 0.7261D-01, 0.8651D-01, 0.1017D+00, 0.1168D+00, 0.1295D+00, & + & 0.1360D+00, 0.1318D+00, 0.1130D+00, 0.7871D-01, 0.3290D-01, & + & -.1700D-01, -.6298D-01, -.9950D-01, -.1241D+00, -.1367D+00, & + & -.1390D+00, -.1336D+00, -.1228D+00, -.1092D+00, -.9446D-01, & + & -.7991D-01, -.6638D-01, -.5436D-01, -.4389D-01, -.3511D-01, & + & -.2782D-01, -.2189D-01, -.1705D-01, -.1324D-01, -.1021D-01, & + & -.7855D-02, -.6000D-02, -.4521D-02, -.3424D-02, -.2582D-02, & + & -.1932D-02, -.1477D-02, -.1085D-02, -.8239D-03, -.6275D-03, & + & -.4300D-03, -.3650D-03, -.2329D-03, -.1670D-03, -.1009D-03, & + & -.1012D-03/ + + data (calcpts(j,14), j = 1,neta) /0.4179D-03, 0.5134D-03, & + & 0.5844D-03, 0.7266D-03, 0.9092D-03, 0.1101D-02, 0.1331D-02, & + & 0.1629D-02, 0.1970D-02, 0.2379D-02, 0.2833D-02, 0.3451D-02, & + & 0.4151D-02, 0.5069D-02, 0.6103D-02, 0.7411D-02, 0.8938D-02, & + & 0.1082D-01, 0.1308D-01, 0.1581D-01, 0.1912D-01, 0.2311D-01, & + & 0.2795D-01, 0.3380D-01, 0.4086D-01, 0.4935D-01, 0.5947D-01, & + & 0.7138D-01, 0.8499D-01, 0.9979D-01, 0.1146D+00, 0.1270D+00, & + & 0.1333D+00, 0.1290D+00, 0.1105D+00, 0.7672D-01, 0.3154D-01, & + & -.1778D-01, -.6329D-01, -.9952D-01, -.1239D+00, -.1364D+00, & + & -.1388D+00, -.1333D+00, -.1226D+00, -.1090D+00, -.9429D-01, & + & -.7975D-01, -.6632D-01, -.5426D-01, -.4385D-01, -.3505D-01, & + & -.2783D-01, -.2182D-01, -.1705D-01, -.1323D-01, -.1020D-01, & + & -.7844D-02, -.5988D-02, -.4575D-02, -.3478D-02, -.2569D-02, & + & -.1986D-02, -.1464D-02, -.1072D-02, -.8103D-03, -.6139D-03, & + & -.4831D-03, -.3514D-03, -.2192D-03, -.1533D-03, -.1539D-03, & + & -.8758D-04/ + + data (calcpts(j,15), j = 1,neta) /0.3832D-03, 0.5148D-03, & + & 0.6265D-03, 0.7480D-03, 0.9156D-03, 0.1099D-02, 0.1326D-02, & + & 0.1563D-02, 0.1918D-02, 0.2281D-02, 0.2765D-02, 0.3356D-02, & + & 0.4104D-02, 0.4945D-02, 0.5978D-02, 0.7226D-02, 0.8765D-02, & + & 0.1059D-01, 0.1280D-01, 0.1547D-01, 0.1871D-01, 0.2261D-01, & + & 0.2733D-01, 0.3305D-01, 0.3994D-01, 0.4821D-01, 0.5807D-01, & + & 0.6963D-01, 0.8283D-01, 0.9717D-01, 0.1114D+00, 0.1234D+00, & + & 0.1294D+00, 0.1251D+00, 0.1069D+00, 0.7389D-01, 0.2959D-01, & + & -.1888D-01, -.6375D-01, -.9952D-01, -.1236D+00, -.1361D+00, & + & -.1384D+00, -.1330D+00, -.1223D+00, -.1087D+00, -.9407D-01, & + & -.7959D-01, -.6617D-01, -.5415D-01, -.4378D-01, -.3503D-01, & + & -.2772D-01, -.2184D-01, -.1700D-01, -.1317D-01, -.1021D-01, & + & -.7786D-02, -.5996D-02, -.4515D-02, -.3418D-02, -.2575D-02, & + & -.1925D-02, -.1470D-02, -.1077D-02, -.8160D-03, -.6195D-03, & + & -.4219D-03, -.3569D-03, -.2247D-03, -.1588D-03, -.1594D-03, & + & -.9305D-04/ + + data (calcpts(j,16), j = 1,neta) /0.3814D-03, 0.4972D-03, & + & 0.5997D-03, 0.7195D-03, 0.8268D-03, 0.1025D-02, 0.1277D-02, & + & 0.1550D-02, 0.1884D-02, 0.2238D-02, 0.2726D-02, 0.3265D-02, & + & 0.3976D-02, 0.4791D-02, 0.5810D-02, 0.7055D-02, 0.8466D-02, & + & 0.1027D-01, 0.1241D-01, 0.1500D-01, 0.1813D-01, 0.2191D-01, & + & 0.2647D-01, 0.3199D-01, 0.3864D-01, 0.4661D-01, 0.5610D-01, & + & 0.6719D-01, 0.7983D-01, 0.9351D-01, 0.1071D+00, 0.1184D+00, & + & 0.1239D+00, 0.1197D+00, 0.1020D+00, 0.6990D-01, 0.2683D-01, & + & -.2045D-01, -.6437D-01, -.9952D-01, -.1233D+00, -.1355D+00, & + & -.1378D+00, -.1324D+00, -.1218D+00, -.1083D+00, -.9371D-01, & + & -.7932D-01, -.6596D-01, -.5402D-01, -.4368D-01, -.3491D-01, & + & -.2772D-01, -.2176D-01, -.1698D-01, -.1321D-01, -.1018D-01, & + & -.7819D-02, -.5961D-02, -.4545D-02, -.3447D-02, -.2604D-02, & + & -.1953D-02, -.1431D-02, -.1105D-02, -.8437D-03, -.5805D-03, & + & -.4495D-03, -.3178D-03, -.2523D-03, -.1863D-03, -.1202D-03, & + & -.1205D-03/ + + data (calcpts(j,17), j = 1,neta) /0.3666D-03, 0.4863D-03, & + & 0.5352D-03, 0.6784D-03, 0.8203D-03, 0.9984D-03, 0.1178D-02, & + & 0.1458D-02, 0.1748D-02, 0.2142D-02, 0.2619D-02, 0.3166D-02, & + & 0.3768D-02, 0.4559D-02, 0.5569D-02, 0.6687D-02, 0.8117D-02, & + & 0.9818D-02, 0.1186D-01, 0.1434D-01, 0.1733D-01, 0.2093D-01, & + & 0.2528D-01, 0.3053D-01, 0.3685D-01, 0.4441D-01, 0.5339D-01, & + & 0.6385D-01, 0.7572D-01, 0.8853D-01, 0.1012D+00, 0.1116D+00, & + & 0.1165D+00, 0.1122D+00, 0.9512D-01, 0.6438D-01, 0.2300D-01, & + & -.2262D-01, -.6522D-01, -.9947D-01, -.1227D+00, -.1347D+00, & + & -.1370D+00, -.1316D+00, -.1211D+00, -.1077D+00, -.9331D-01, & + & -.7897D-01, -.6564D-01, -.5376D-01, -.4350D-01, -.3483D-01, & + & -.2762D-01, -.2171D-01, -.1692D-01, -.1315D-01, -.1017D-01, & + & -.7809D-02, -.5949D-02, -.4532D-02, -.3432D-02, -.2588D-02, & + & -.1938D-02, -.1482D-02, -.1089D-02, -.8271D-03, -.6305D-03, & + & -.4328D-03, -.3010D-03, -.2354D-03, -.1695D-03, -.1033D-03, & + & -.1037D-03/ + + data (calcpts(j,18), j = 1,neta) /0.3296D-03, 0.4115D-03, & + & 0.5016D-03, 0.6332D-03, 0.7788D-03, 0.9104D-03, 0.1128D-02, & + & 0.1399D-02, 0.1634D-02, 0.1996D-02, 0.2463D-02, 0.2957D-02, & + & 0.3596D-02, 0.4314D-02, 0.5208D-02, 0.6295D-02, 0.7644D-02, & + & 0.9209D-02, 0.1113D-01, 0.1344D-01, 0.1625D-01, 0.1962D-01, & + & 0.2368D-01, 0.2858D-01, 0.3446D-01, 0.4148D-01, 0.4977D-01, & + & 0.5941D-01, 0.7029D-01, 0.8195D-01, 0.9335D-01, 0.1026D+00, & + & 0.1068D+00, 0.1023D+00, 0.8599D-01, 0.5694D-01, 0.1780D-01, & + & -.2557D-01, -.6633D-01, -.9933D-01, -.1218D+00, -.1335D+00, & + & -.1357D+00, -.1305D+00, -.1201D+00, -.1069D+00, -.9263D-01, & + & -.7842D-01, -.6529D-01, -.5351D-01, -.4325D-01, -.3460D-01, & + & -.2749D-01, -.2163D-01, -.1689D-01, -.1311D-01, -.1012D-01, & + & -.7758D-02, -.5895D-02, -.4542D-02, -.3441D-02, -.2596D-02, & + & -.1945D-02, -.1488D-02, -.1095D-02, -.8333D-03, -.6366D-03, & + & -.4388D-03, -.3069D-03, -.2413D-03, -.1753D-03, -.1091D-03, & + & -.1095D-03/ + + data (calcpts(j,19), j = 1,neta) /0.2951D-03, 0.3689D-03, & + & 0.4670D-03, 0.5583D-03, 0.6835D-03, 0.8831D-03, 0.1059D-02, & + & 0.1247D-02, 0.1494D-02, 0.1828D-02, 0.2232D-02, 0.2694D-02, & + & 0.3265D-02, 0.3947D-02, 0.4766D-02, 0.5738D-02, 0.6961D-02, & + & 0.8415D-02, 0.1017D-01, 0.1228D-01, 0.1484D-01, 0.1791D-01, & + & 0.2160D-01, 0.2605D-01, 0.3136D-01, 0.3769D-01, 0.4513D-01, & + & 0.5373D-01, 0.6336D-01, 0.7359D-01, 0.8345D-01, 0.9125D-01, & + & 0.9436D-01, 0.8964D-01, 0.7425D-01, 0.4728D-01, 0.1099D-01, & + & -.2944D-01, -.6772D-01, -.9898D-01, -.1205D+00, -.1318D+00, & + & -.1339D+00, -.1288D+00, -.1187D+00, -.1057D+00, -.9161D-01, & + & -.7767D-01, -.6468D-01, -.5304D-01, -.4296D-01, -.3438D-01, & + & -.2730D-01, -.2148D-01, -.1678D-01, -.1305D-01, -.1006D-01, & + & -.7689D-02, -.5888D-02, -.4466D-02, -.3430D-02, -.2584D-02, & + & -.1931D-02, -.1474D-02, -.1081D-02, -.8188D-03, -.6218D-03, & + & -.4239D-03, -.3586D-03, -.2263D-03, -.1602D-03, -.1607D-03, & + & -.9433D-04/ + + data (calcpts(j,20), j = 1,neta) /0.2649D-03, 0.3628D-03, & + & 0.4389D-03, 0.5311D-03, 0.6156D-03, 0.7351D-03, 0.9273D-03, & + & 0.1098D-02, 0.1360D-02, 0.1614D-02, 0.1975D-02, 0.2366D-02, & + & 0.2840D-02, 0.3463D-02, 0.4193D-02, 0.5110D-02, 0.6146D-02, & + & 0.7424D-02, 0.8974D-02, 0.1083D-01, 0.1308D-01, 0.1578D-01, & + & 0.1902D-01, 0.2290D-01, 0.2754D-01, 0.3302D-01, 0.3944D-01, & + & 0.4679D-01, 0.5495D-01, 0.6349D-01, 0.7155D-01, 0.7762D-01, & + & 0.7945D-01, 0.7436D-01, 0.5992D-01, 0.3533D-01, 0.2460D-02, & + & -.3427D-01, -.6935D-01, -.9831D-01, -.1185D+00, -.1292D+00, & + & -.1312D+00, -.1263D+00, -.1166D+00, -.1040D+00, -.9026D-01, & + & -.7664D-01, -.6388D-01, -.5242D-01, -.4250D-01, -.3404D-01, & + & -.2704D-01, -.2125D-01, -.1666D-01, -.1292D-01, -.9981D-02, & + & -.7669D-02, -.5863D-02, -.4437D-02, -.3399D-02, -.2551D-02, & + & -.1897D-02, -.1440D-02, -.1046D-02, -.7831D-03, -.5859D-03, & + & -.4545D-03, -.3224D-03, -.2566D-03, -.1906D-03, -.1243D-03, & + & -.1246D-03/ + + data (calcpts(j,21), j = 1,neta) /0.2746D-03, 0.2937D-03, & + & 0.3818D-03, 0.4467D-03, 0.5340D-03, 0.6221D-03, 0.7518D-03, & + & 0.9649D-03, 0.1110D-02, 0.1358D-02, 0.1692D-02, 0.2035D-02, & + & 0.2442D-02, 0.2911D-02, 0.3557D-02, 0.4292D-02, 0.5185D-02, & + & 0.6263D-02, 0.7562D-02, 0.9125D-02, 0.1101D-01, 0.1327D-01, & + & 0.1598D-01, 0.1921D-01, 0.2306D-01, 0.2759D-01, 0.3285D-01, & + & 0.3881D-01, 0.4535D-01, 0.5204D-01, 0.5812D-01, 0.6231D-01, & + & 0.6271D-01, 0.5712D-01, 0.4360D-01, 0.2153D-01, -.7528D-02, & + & -.3993D-01, -.7107D-01, -.9708D-01, -.1155D+00, -.1254D+00, & + & -.1274D+00, -.1229D+00, -.1137D+00, -.1016D+00, -.8842D-01, & + & -.7514D-01, -.6277D-01, -.5157D-01, -.4185D-01, -.3357D-01, & + & -.2671D-01, -.2101D-01, -.1646D-01, -.1276D-01, -.9880D-02, & + & -.7626D-02, -.5813D-02, -.4450D-02, -.3342D-02, -.2559D-02, & + & -.1904D-02, -.1445D-02, -.1051D-02, -.7878D-03, -.5903D-03, & + & -.4587D-03, -.3265D-03, -.2606D-03, -.1945D-03, -.1282D-03, & + & -.1284D-03/ + + data (calcpts(j,22), j = 1,neta) /0.2248D-03, 0.2547D-03, & + & 0.3143D-03, 0.3815D-03, 0.4381D-03, 0.5321D-03, 0.6410D-03, & + & 0.7432D-03, 0.8898D-03, 0.1121D-02, 0.1291D-02, 0.1588D-02, & + & 0.1936D-02, 0.2333D-02, 0.2822D-02, 0.3406D-02, 0.4113D-02, & + & 0.4971D-02, 0.5996D-02, 0.7237D-02, 0.8724D-02, 0.1050D-01, & + & 0.1263D-01, 0.1517D-01, 0.1817D-01, 0.2168D-01, 0.2572D-01, & + & 0.3025D-01, 0.3511D-01, 0.3993D-01, 0.4403D-01, 0.4633D-01, & + & 0.4529D-01, 0.3915D-01, 0.2645D-01, 0.6839D-02, -.1830D-01, & + & -.4602D-01, -.7264D-01, -.9510D-01, -.1113D+00, -.1203D+00, & + & -.1222D+00, -.1182D+00, -.1097D+00, -.9839D-01, -.8586D-01, & + & -.7318D-01, -.6123D-01, -.5042D-01, -.4101D-01, -.3296D-01, & + & -.2623D-01, -.2068D-01, -.1623D-01, -.1258D-01, -.9749D-02, & + & -.7485D-02, -.5732D-02, -.4364D-02, -.3319D-02, -.2534D-02, & + & -.1877D-02, -.1418D-02, -.1089D-02, -.8255D-03, -.6277D-03, & + & -.4292D-03, -.2969D-03, -.2309D-03, -.1647D-03, -.1650D-03, & + & -.9859D-04/ + + data (calcpts(j,23), j = 1,neta) /0.1575D-03, 0.1414D-03, & + & 0.1837D-03, 0.2659D-03, 0.3061D-03, 0.3553D-03, 0.4615D-03, & + & 0.5397D-03, 0.6435D-03, 0.7975D-03, 0.9631D-03, 0.1172D-02, & + & 0.1414D-02, 0.1714D-02, 0.2071D-02, 0.2500D-02, 0.3019D-02, & + & 0.3651D-02, 0.4404D-02, 0.5304D-02, 0.6396D-02, 0.7693D-02, & + & 0.9237D-02, 0.1107D-01, 0.1323D-01, 0.1573D-01, 0.1859D-01, & + & 0.2172D-01, 0.2499D-01, 0.2807D-01, 0.3035D-01, 0.3096D-01, & + & 0.2865D-01, 0.2205D-01, 0.1012D-01, -.7229D-02, -.2869D-01, & + & -.5179D-01, -.7370D-01, -.9219D-01, -.1057D+00, -.1135D+00, & + & -.1154D+00, -.1120D+00, -.1044D+00, -.9415D-01, -.8249D-01, & + & -.7063D-01, -.5927D-01, -.4896D-01, -.3987D-01, -.3211D-01, & + & -.2564D-01, -.2024D-01, -.1589D-01, -.1234D-01, -.9563D-02, & + & -.7355D-02, -.5661D-02, -.4288D-02, -.3306D-02, -.2452D-02, & + & -.1861D-02, -.1400D-02, -.1070D-02, -.8064D-03, -.6082D-03, & + & -.4095D-03, -.3437D-03, -.2109D-03, -.1447D-03, -.1449D-03, & + & -.7844D-04/ + + data (calcpts(j,24), j = 1,neta) /0.9565D-04, 0.1144D-03, & + & 0.1394D-03, 0.1691D-03, 0.2046D-03, 0.2465D-03, 0.2996D-03, & + & 0.3624D-03, 0.4374D-03, 0.5335D-03, 0.6405D-03, 0.7778D-03, & + & 0.9370D-03, 0.1136D-02, 0.1376D-02, 0.1657D-02, 0.2002D-02, & + & 0.2416D-02, 0.2906D-02, 0.3499D-02, 0.4216D-02, 0.5063D-02, & + & 0.6065D-02, 0.7252D-02, 0.8636D-02, 0.1023D-01, 0.1200D-01, & + & 0.1390D-01, 0.1578D-01, 0.1735D-01, 0.1812D-01, 0.1736D-01, & + & 0.1409D-01, 0.7257D-02, -.3859D-02, -.1916D-01, -.3737D-01, & + & -.5634D-01, -.7382D-01, -.8828D-01, -.9890D-01, -.1052D+00, & + & -.1070D+00, -.1043D+00, -.9787D-01, -.8882D-01, -.7832D-01, & + & -.6740D-01, -.5686D-01, -.4712D-01, -.3854D-01, -.3114D-01, & + & -.2486D-01, -.1968D-01, -.1550D-01, -.1206D-01, -.9400D-02, & + & -.7247D-02, -.5546D-02, -.4235D-02, -.3250D-02, -.2460D-02, & + & -.1867D-02, -.1405D-02, -.1008D-02, -.8105D-03, -.6120D-03, & + & -.4130D-03, -.3470D-03, -.2141D-03, -.1478D-03, -.1480D-03, & + & -.8150D-04/ + + data (calcpts(j,25), j = 1,neta) /0.4989D-04, 0.6372D-04, & + & 0.7586D-04, 0.9470D-04, 0.1172D-03, 0.1402D-03, 0.1717D-03, & + & 0.2067D-03, 0.2498D-03, 0.3003D-03, 0.3632D-03, 0.4391D-03, & + & 0.5342D-03, 0.6391D-03, 0.7736D-03, 0.9330D-03, 0.1122D-02, & + & 0.1355D-02, 0.1626D-02, 0.1957D-02, 0.2347D-02, 0.2812D-02, & + & 0.3356D-02, 0.3994D-02, 0.4725D-02, 0.5546D-02, 0.6430D-02, & + & 0.7312D-02, 0.8061D-02, 0.8431D-02, 0.8039D-02, 0.6292D-02, & + & 0.2426D-02, -.4343D-02, -.1454D-01, -.2794D-01, -.4336D-01, & + & -.5888D-01, -.7259D-01, -.8343D-01, -.9112D-01, -.9571D-01, & + & -.9709D-01, -.9512D-01, -.9001D-01, -.8241D-01, -.7327D-01, & + & -.6351D-01, -.5389D-01, -.4489D-01, -.3690D-01, -.2994D-01, & + & -.2399D-01, -.1903D-01, -.1502D-01, -.1176D-01, -.9151D-02, & + & -.7055D-02, -.5414D-02, -.4165D-02, -.3177D-02, -.2385D-02, & + & -.1790D-02, -.1394D-02, -.9966D-03, -.7984D-03, -.5996D-03, & + & -.4004D-03, -.3342D-03, -.2013D-03, -.2015D-03, -.1350D-03, & + & -.6850D-04/ + + data (calcpts(j,26), j = 1,neta) /0.1907D-04, 0.1918D-04, & + & 0.2593D-04, 0.3718D-04, 0.4555D-04, 0.5013D-04, 0.6176D-04, & + & 0.7818D-04, 0.9929D-04, 0.1208D-03, 0.1428D-03, 0.1736D-03, & + & 0.2073D-03, 0.2545D-03, 0.3059D-03, 0.3685D-03, 0.4413D-03, & + & 0.5237D-03, 0.6323D-03, 0.7488D-03, 0.8974D-03, 0.1060D-02, & + & 0.1249D-02, 0.1461D-02, 0.1691D-02, 0.1922D-02, 0.2125D-02, & + & 0.2235D-02, 0.2139D-02, 0.1643D-02, 0.4357D-03, -.1939D-02, & + & -.6063D-02, -.1252D-01, -.2168D-01, -.3329D-01, -.4632D-01, & + & -.5906D-01, -.6983D-01, -.7774D-01, -.8286D-01, -.8565D-01, & + & -.8639D-01, -.8491D-01, -.8106D-01, -.7502D-01, -.6742D-01, & + & -.5900D-01, -.5047D-01, -.4236D-01, -.3498D-01, -.2847D-01, & + & -.2293D-01, -.1833D-01, -.1449D-01, -.1135D-01, -.8859D-02, & + & -.6821D-02, -.5307D-02, -.4054D-02, -.3063D-02, -.2336D-02, & + & -.1740D-02, -.1343D-02, -.1012D-02, -.7464D-03, -.5473D-03, & + & -.4146D-03, -.2817D-03, -.2153D-03, -.1489D-03, -.1490D-03, & + & -.8244D-04/ + + data (calcpts(j,27), j = 1,neta) /0.2006D-05, 0.2856D-05, & + & 0.1167D-05, 0.3743D-05, 0.5087D-05, -.4811D-06, 0.1882D-06, & + & 0.3604D-06, 0.1543D-05, -.4601D-05, -.3152D-05, -.4930D-05, & + & -.8063D-05, -.1520D-04, -.1737D-04, -.2860D-04, -.4090D-04, & + & -.5485D-04, -.6813D-04, -.9724D-04, -.1257D-03, -.1702D-03, & + & -.2322D-03, -.3168D-03, -.4380D-03, -.6165D-03, -.8839D-03, & + & -.1301D-02, -.1962D-02, -.3024D-02, -.4730D-02, -.7424D-02, & + & -.1154D-01, -.1752D-01, -.2560D-01, -.3554D-01, -.4649D-01, & + & -.5701D-01, -.6561D-01, -.7144D-01, -.7456D-01, -.7573D-01, & + & -.7560D-01, -.7426D-01, -.7142D-01, -.6691D-01, -.6092D-01, & + & -.5396D-01, -.4665D-01, -.3949D-01, -.3285D-01, -.2693D-01, & + & -.2181D-01, -.1747D-01, -.1388D-01, -.1092D-01, -.8556D-02, & + & -.6645D-02, -.5126D-02, -.3936D-02, -.3010D-02, -.2281D-02, & + & -.1751D-02, -.1286D-02, -.1021D-02, -.7556D-03, -.5563D-03, & + & -.4235D-03, -.2904D-03, -.2240D-03, -.1575D-03, -.1576D-03, & + & -.9097D-04/ + + data (calcpts(j,28), j = 1,neta) /-.1237D-04, -.1446D-04, & + & -.1884D-04, -.2362D-04, -.3282D-04, -.3729D-04, -.4875D-04, & + & -.5886D-04, -.7149D-04, -.8621D-04, -.1070D-03, -.1237D-03, & + & -.1536D-03, -.1859D-03, -.2326D-03, -.2819D-03, -.3422D-03, & + & -.4187D-03, -.5150D-03, -.6270D-03, -.7669D-03, -.9413D-03, & + & -.1158D-02, -.1426D-02, -.1763D-02, -.2192D-02, -.2745D-02, & + & -.3476D-02, -.4466D-02, -.5839D-02, -.7781D-02, -.1055D-01, & + & -.1448D-01, -.1986D-01, -.2687D-01, -.3531D-01, -.4447D-01, & + & -.5320D-01, -.6021D-01, -.6468D-01, -.6654D-01, -.6648D-01, & + & -.6542D-01, -.6384D-01, -.6161D-01, -.5836D-01, -.5391D-01, & + & -.4846D-01, -.4244D-01, -.3633D-01, -.3050D-01, -.2519D-01, & + & -.2053D-01, -.1653D-01, -.1318D-01, -.1042D-01, -.8179D-02, & + & -.6375D-02, -.4933D-02, -.3800D-02, -.2919D-02, -.2222D-02, & + & -.1691D-02, -.1279D-02, -.9605D-03, -.7213D-03, -.5418D-03, & + & -.4088D-03, -.3024D-03, -.2292D-03, -.1693D-03, -.1227D-03, & + & -.9611D-04/ + + data (calcpts(j,29), j = 1,neta) /-.2297D-04, -.2752D-04, & + & -.3754D-04, -.4311D-04, -.5382D-04, -.5937D-04, -.7678D-04, & + & -.8971D-04, -.1077D-03, -.1287D-03, -.1558D-03, -.1915D-03, & + & -.2322D-03, -.2801D-03, -.3415D-03, -.4181D-03, -.5071D-03, & + & -.6130D-03, -.7460D-03, -.9078D-03, -.1104D-02, -.1346D-02, & + & -.1642D-02, -.2004D-02, -.2451D-02, -.3006D-02, -.3698D-02, & + & -.4577D-02, -.5709D-02, -.7193D-02, -.9172D-02, -.1184D-01, & + & -.1544D-01, -.2018D-01, -.2618D-01, -.3327D-01, -.4091D-01, & + & -.4818D-01, -.5404D-01, -.5768D-01, -.5890D-01, -.5817D-01, & + & -.5640D-01, -.5434D-01, -.5225D-01, -.4982D-01, -.4667D-01, & + & -.4265D-01, -.3795D-01, -.3293D-01, -.2797D-01, -.2331D-01, & + & -.1914D-01, -.1551D-01, -.1244D-01, -.9882D-02, -.7787D-02, & + & -.6085D-02, -.4727D-02, -.3652D-02, -.2803D-02, -.2145D-02, & + & -.1627D-02, -.1235D-02, -.9289D-03, -.6028D-03, -.5232D-03, & + & -.3901D-03, -.2903D-03, -.2171D-03, -.1572D-03, -.1172D-03, & + & -.8393D-04/ + + data (calcpts(j,30), j = 1,neta) /-.2720D-04, -.2861D-04, & + & -.3471D-04, -.4794D-04, -.5707D-04, -.6429D-04, -.7893D-04, & + & -.9699D-04, -.1206D-03, -.1465D-03, -.1769D-03, -.2139D-03, & + & -.2600D-03, -.3148D-03, -.3814D-03, -.4633D-03, -.5624D-03, & + & -.6828D-03, -.8292D-03, -.1008D-02, -.1224D-02, -.1489D-02, & + & -.1811D-02, -.2204D-02, -.2684D-02, -.3275D-02, -.4004D-02, & + & -.4911D-02, -.6053D-02, -.7509D-02, -.9389D-02, -.1184D-01, & + & -.1503D-01, -.1911D-01, -.2418D-01, -.3008D-01, -.3642D-01, & + & -.4249D-01, -.4745D-01, -.5062D-01, -.5165D-01, -.5077D-01, & + & -.4867D-01, -.4620D-01, -.4390D-01, -.4181D-01, -.3953D-01, & + & -.3672D-01, -.3327D-01, -.2936D-01, -.2529D-01, -.2133D-01, & + & -.1768D-01, -.1444D-01, -.1165D-01, -.9313D-02, -.7372D-02, & + & -.5788D-02, -.4514D-02, -.3498D-02, -.2694D-02, -.2069D-02, & + & -.1577D-02, -.1198D-02, -.9051D-03, -.6122D-03, -.5125D-03, & + & -.3860D-03, -.2861D-03, -.2129D-03, -.1596D-03, -.1197D-03, & + & -.8635D-04/ + + data (calcpts(j,31), j = 1,neta) /-.2258D-04, -.3019D-04, & + & -.3714D-04, -.4516D-04, -.5510D-04, -.6652D-04, -.8066D-04, & + & -.9812D-04, -.1185D-03, -.1435D-03, -.1744D-03, -.2112D-03, & + & -.2566D-03, -.3107D-03, -.3767D-03, -.4573D-03, -.5548D-03, & + & -.6731D-03, -.8174D-03, -.9925D-03, -.1204D-02, -.1462D-02, & + & -.1777D-02, -.2159D-02, -.2625D-02, -.3194D-02, -.3891D-02, & + & -.4753D-02, -.5822D-02, -.7163D-02, -.8859D-02, -.1102D-01, & + & -.1377D-01, -.1723D-01, -.2144D-01, -.2631D-01, -.3153D-01, & + & -.3657D-01, -.4081D-01, -.4365D-01, -.4473D-01, -.4408D-01, & + & -.4210D-01, -.3948D-01, -.3692D-01, -.3476D-01, -.3289D-01, & + & -.3091D-01, -.2852D-01, -.2566D-01, -.2249D-01, -.1924D-01, & + & -.1614D-01, -.1332D-01, -.1083D-01, -.8710D-02, -.6933D-02, & + & -.5472D-02, -.4283D-02, -.3333D-02, -.2582D-02, -.1983D-02, & + & -.1517D-02, -.1158D-02, -.8784D-03, -.6120D-03, -.4989D-03, & + & -.3724D-03, -.2791D-03, -.2059D-03, -.1526D-03, -.1126D-03, & + & -.8596D-04/ + + data (calcpts(j,32), j = 1,neta) /-.2433D-04, -.2931D-04, & + & -.3516D-04, -.4244D-04, -.5156D-04, -.6163D-04, -.7470D-04, & + & -.9082D-04, -.1098D-03, -.1328D-03, -.1611D-03, -.1946D-03, & + & -.2361D-03, -.2861D-03, -.3465D-03, -.4206D-03, -.5098D-03, & + & -.6182D-03, -.7499D-03, -.9101D-03, -.1103D-02, -.1340D-02, & + & -.1626D-02, -.1974D-02, -.2397D-02, -.2912D-02, -.3542D-02, & + & -.4314D-02, -.5266D-02, -.6446D-02, -.7921D-02, -.9772D-02, & + & -.1209D-01, -.1496D-01, -.1841D-01, -.2238D-01, -.2663D-01, & + & -.3079D-01, -.3438D-01, -.3695D-01, -.3815D-01, -.3789D-01, & + & -.3633D-01, -.3394D-01, -.3131D-01, -.2897D-01, -.2711D-01, & + & -.2553D-01, -.2389D-01, -.2192D-01, -.1961D-01, -.1709D-01, & + & -.1455D-01, -.1214D-01, -.9967D-02, -.8077D-02, -.6471D-02, & + & -.5135D-02, -.4045D-02, -.3161D-02, -.2449D-02, -.1896D-02, & + & -.1457D-02, -.1111D-02, -.8444D-03, -.6046D-03, -.4781D-03, & + & -.3582D-03, -.2716D-03, -.1983D-03, -.1450D-03, -.1117D-03, & + & -.7837D-04/ + + data (calcpts(j,33), j = 1,neta) /-.1992D-04, -.2417D-04, & + & -.2929D-04, -.3614D-04, -.4347D-04, -.5343D-04, -.6432D-04, & + & -.7849D-04, -.9477D-04, -.1151D-03, -.1399D-03, -.1700D-03, & + & -.2059D-03, -.2498D-03, -.3031D-03, -.3675D-03, -.4459D-03, & + & -.5409D-03, -.6558D-03, -.7954D-03, -.9646D-03, -.1171D-02, & + & -.1420D-02, -.1723D-02, -.2091D-02, -.2539D-02, -.3083D-02, & + & -.3749D-02, -.4566D-02, -.5572D-02, -.6817D-02, -.8362D-02, & + & -.1027D-01, -.1262D-01, -.1541D-01, -.1860D-01, -.2204D-01, & + & -.2544D-01, -.2845D-01, -.3073D-01, -.3201D-01, -.3213D-01, & + & -.3112D-01, -.2920D-01, -.2681D-01, -.2443D-01, -.2244D-01, & + & -.2090D-01, -.1963D-01, -.1830D-01, -.1671D-01, -.1488D-01, & + & -.1290D-01, -.1093D-01, -.9078D-02, -.7432D-02, -.6003D-02, & + & -.4793D-02, -.3795D-02, -.2984D-02, -.2325D-02, -.1805D-02, & + & -.1393D-02, -.1066D-02, -.8131D-03, -.5933D-03, -.4667D-03, & + & -.3535D-03, -.2668D-03, -.2002D-03, -.1469D-03, -.1136D-03, & + & -.8026D-04/ + + data (calcpts(j,34), j = 1,neta) /-.1712D-04, -.2071D-04, & + & -.2527D-04, -.3077D-04, -.3773D-04, -.4540D-04, -.5514D-04, & + & -.6700D-04, -.8094D-04, -.9790D-04, -.1186D-03, -.1438D-03, & + & -.1749D-03, -.2115D-03, -.2566D-03, -.3113D-03, -.3772D-03, & + & -.4571D-03, -.5546D-03, -.6724D-03, -.8150D-03, -.9890D-03, & + & -.1199D-02, -.1454D-02, -.1765D-02, -.2141D-02, -.2598D-02, & + & -.3156D-02, -.3838D-02, -.4672D-02, -.5699D-02, -.6963D-02, & + & -.8515D-02, -.1040D-01, -.1263D-01, -.1518D-01, -.1792D-01, & + & -.2066D-01, -.2314D-01, -.2513D-01, -.2639D-01, -.2679D-01, & + & -.2629D-01, -.2496D-01, -.2303D-01, -.2086D-01, -.1882D-01, & + & -.1719D-01, -.1597D-01, -.1496D-01, -.1390D-01, -.1265D-01, & + & -.1121D-01, -.9674D-02, -.8164D-02, -.6756D-02, -.5513D-02, & + & -.4435D-02, -.3537D-02, -.2791D-02, -.2192D-02, -.1706D-02, & + & -.1319D-02, -.1013D-02, -.7732D-03, -.5733D-03, -.4467D-03, & + & -.3401D-03, -.2535D-03, -.1935D-03, -.1402D-03, -.1068D-03, & + & -.8018D-04/ + + data (calcpts(j,35), j = 1,neta) /-.1442D-04, -.1761D-04, & + & -.2114D-04, -.2543D-04, -.3088D-04, -.3788D-04, -.4561D-04, & + & -.5524D-04, -.6656D-04, -.8093D-04, -.9821D-04, -.1189D-03, & + & -.1444D-03, -.1747D-03, -.2120D-03, -.2566D-03, -.3108D-03, & + & -.3768D-03, -.4572D-03, -.5540D-03, -.6717D-03, -.8145D-03, & + & -.9876D-03, -.1197D-02, -.1452D-02, -.1761D-02, -.2136D-02, & + & -.2592D-02, -.3149D-02, -.3828D-02, -.4659D-02, -.5676D-02, & + & -.6916D-02, -.8412D-02, -.1018D-01, -.1218D-01, -.1435D-01, & + & -.1653D-01, -.1855D-01, -.2023D-01, -.2142D-01, -.2198D-01, & + & -.2186D-01, -.2106D-01, -.1968D-01, -.1791D-01, -.1604D-01, & + & -.1436D-01, -.1306D-01, -.1210D-01, -.1132D-01, -.1049D-01, & + & -.9515D-02, -.8398D-02, -.7220D-02, -.6068D-02, -.5007D-02, & + & -.4069D-02, -.3270D-02, -.2598D-02, -.2052D-02, -.1605D-02, & + & -.1246D-02, -.9591D-03, -.7326D-03, -.5526D-03, -.4260D-03, & + & -.3261D-03, -.2461D-03, -.1861D-03, -.1395D-03, -.1061D-03, & + & -.7946D-04/ + + data (calcpts(j,36), j = 1,neta) /-.1137D-04, -.1382D-04, & + & -.1702D-04, -.2062D-04, -.2489D-04, -.3011D-04, -.3664D-04, & + & -.4486D-04, -.5375D-04, -.6514D-04, -.7944D-04, -.9638D-04, & + & -.1165D-03, -.1415D-03, -.1711D-03, -.2073D-03, -.2513D-03, & + & -.3046D-03, -.3692D-03, -.4476D-03, -.5425D-03, -.6577D-03, & + & -.7973D-03, -.9666D-03, -.1172D-02, -.1421D-02, -.1723D-02, & + & -.2090D-02, -.2536D-02, -.3079D-02, -.3741D-02, -.4548D-02, & + & -.5527D-02, -.6701D-02, -.8081D-02, -.9647D-02, -.1134D-01, & + & -.1306D-01, -.1468D-01, -.1608D-01, -.1713D-01, -.1775D-01, & + & -.1788D-01, -.1748D-01, -.1660D-01, -.1530D-01, -.1377D-01, & + & -.1222D-01, -.1087D-01, -.9851D-02, -.9116D-02, -.8513D-02, & + & -.7875D-02, -.7120D-02, -.6263D-02, -.5366D-02, -.4494D-02, & + & -.3697D-02, -.2997D-02, -.2401D-02, -.1913D-02, -.1499D-02, & + & -.1166D-02, -.9065D-03, -.6999D-03, -.5266D-03, -.4067D-03, & + & -.3067D-03, -.2334D-03, -.1734D-03, -.1334D-03, -.1001D-03, & + & -.7340D-04/ + + data (calcpts(j,37), j = 1,neta) /-.9350D-05, -.1113D-04, & + & -.1370D-04, -.1661D-04, -.2005D-04, -.2421D-04, -.2924D-04, & + & -.3544D-04, -.4294D-04, -.5203D-04, -.6306D-04, -.7640D-04, & + & -.9263D-04, -.1122D-03, -.1360D-03, -.1649D-03, -.1998D-03, & + & -.2422D-03, -.2935D-03, -.3558D-03, -.4312D-03, -.5227D-03, & + & -.6336D-03, -.7680D-03, -.9309D-03, -.1128D-02, -.1368D-02, & + & -.1658D-02, -.2011D-02, -.2439D-02, -.2961D-02, -.3593D-02, & + & -.4358D-02, -.5271D-02, -.6341D-02, -.7553D-02, -.8865D-02, & + & -.1021D-01, -.1149D-01, -.1263D-01, -.1353D-01, -.1413D-01, & + & -.1439D-01, -.1427D-01, -.1377D-01, -.1291D-01, -.1178D-01, & + & -.1050D-01, -.9244D-02, -.8180D-02, -.7389D-02, -.6829D-02, & + & -.6369D-02, -.5881D-02, -.5303D-02, -.4651D-02, -.3971D-02, & + & -.3316D-02, -.2720D-02, -.2199D-02, -.1758D-02, -.1392D-02, & + & -.1095D-02, -.8512D-03, -.6606D-03, -.5066D-03, -.3886D-03, & + & -.2953D-03, -.2240D-03, -.1693D-03, -.1273D-03, -.9535D-04, & + & -.7135D-04/ + + data (calcpts(j,38), j = 1,neta) /-.7323D-05, -.8879D-05, & + & -.1071D-04, -.1298D-04, -.1574D-04, -.1902D-04, -.2306D-04, & + & -.2791D-04, -.3375D-04, -.4091D-04, -.4954D-04, -.6005D-04, & + & -.7274D-04, -.8814D-04, -.1067D-03, -.1294D-03, -.1568D-03, & + & -.1900D-03, -.2303D-03, -.2792D-03, -.3383D-03, -.4100D-03, & + & -.4970D-03, -.6023D-03, -.7300D-03, -.8847D-03, -.1072D-02, & + & -.1299D-02, -.1575D-02, -.1909D-02, -.2315D-02, -.2806D-02, & + & -.3397D-02, -.4101D-02, -.4924D-02, -.5855D-02, -.6865D-02, & + & -.7905D-02, -.8912D-02, -.9819D-02, -.1057D-01, -.1111D-01, & + & -.1141D-01, -.1146D-01, -.1122D-01, -.1071D-01, -.9941D-02, & + & -.8985D-02, -.7943D-02, -.6946D-02, -.6119D-02, -.5514D-02, & + & -.5091D-02, -.4743D-02, -.4372D-02, -.3933D-02, -.3439D-02, & + & -.2928D-02, -.2438D-02, -.1994D-02, -.1609D-02, -.1283D-02, & + & -.1016D-02, -.7942D-03, -.6176D-03, -.4770D-03, -.3677D-03, & + & -.2804D-03, -.2130D-03, -.1610D-03, -.1217D-03, -.9104D-04, & + & -.6771D-04/ + + data (calcpts(j,39), j = 1,neta) /-.5564D-05, -.6759D-05, & + & -.8192D-05, -.9970D-05, -.1212D-04, -.1469D-04, -.1779D-04, & + & -.2157D-04, -.2609D-04, -.3166D-04, -.3838D-04, -.4656D-04, & + & -.5639D-04, -.6835D-04, -.8283D-04, -.1004D-03, -.1217D-03, & + & -.1475D-03, -.1787D-03, -.2167D-03, -.2625D-03, -.3182D-03, & + & -.3856D-03, -.4674D-03, -.5663D-03, -.6863D-03, -.8314D-03, & + & -.1007D-02, -.1221D-02, -.1479D-02, -.1792D-02, -.2170D-02, & + & -.2623D-02, -.3162D-02, -.3790D-02, -.4501D-02, -.5273D-02, & + & -.6072D-02, -.6852D-02, -.7568D-02, -.8177D-02, -.8646D-02, & + & -.8952D-02, -.9074D-02, -.9000D-02, -.8723D-02, -.8246D-02, & + & -.7592D-02, -.6807D-02, -.5974D-02, -.5194D-02, -.4557D-02, & + & -.4098D-02, -.3780D-02, -.3519D-02, -.3239D-02, -.2907D-02, & + & -.2535D-02, -.2153D-02, -.1788D-02, -.1457D-02, -.1175D-02, & + & -.9354D-03, -.7381D-03, -.5775D-03, -.4488D-03, -.3468D-03, & + & -.2662D-03, -.2035D-03, -.1549D-03, -.1169D-03, -.8820D-04, & + & -.6620D-04/ + + data (calcpts(j,40), j = 1,neta) /-.4321D-05, -.5241D-05, & + & -.6319D-05, -.7696D-05, -.9306D-05, -.1129D-04, -.1367D-04, & + & -.1662D-04, -.2009D-04, -.2435D-04, -.2952D-04, -.3579D-04, & + & -.4337D-04, -.5257D-04, -.6371D-04, -.7722D-04, -.9360D-04, & + & -.1134D-03, -.1374D-03, -.1666D-03, -.2019D-03, -.2446D-03, & + & -.2965D-03, -.3593D-03, -.4353D-03, -.5274D-03, -.6389D-03, & + & -.7739D-03, -.9375D-03, -.1135D-02, -.1374D-02, -.1663D-02, & + & -.2009D-02, -.2418D-02, -.2895D-02, -.3434D-02, -.4020D-02, & + & -.4630D-02, -.5230D-02, -.5788D-02, -.6274D-02, -.6666D-02, & + & -.6944D-02, -.7097D-02, -.7115D-02, -.6989D-02, -.6715D-02, & + & -.6298D-02, -.5755D-02, -.5125D-02, -.4469D-02, -.3865D-02, & + & -.3379D-02, -.3033D-02, -.2795D-02, -.2600D-02, -.2389D-02, & + & -.2140D-02, -.1862D-02, -.1578D-02, -.1307D-02, -.1065D-02, & + & -.8552D-03, -.6799D-03, -.5353D-03, -.4180D-03, -.3246D-03, & + & -.2506D-03, -.1920D-03, -.1466D-03, -.1113D-03, -.8399D-04, & + & -.6332D-04/ + + data (calcpts(j,41), j = 1,neta) /-.3334D-05, -.4055D-05, & + & -.4852D-05, -.5910D-05, -.7143D-05, -.8672D-05, -.1049D-04, & + & -.1268D-04, -.1537D-04, -.1864D-04, -.2260D-04, -.2733D-04, & + & -.3314D-04, -.4016D-04, -.4862D-04, -.5896D-04, -.7144D-04, & + & -.8655D-04, -.1049D-03, -.1271D-03, -.1540D-03, -.1866D-03, & + & -.2261D-03, -.2740D-03, -.3319D-03, -.4022D-03, -.4871D-03, & + & -.5900D-03, -.7145D-03, -.8649D-03, -.1047D-02, -.1265D-02, & + & -.1527D-02, -.1837D-02, -.2196D-02, -.2603D-02, -.3046D-02, & + & -.3508D-02, -.3966D-02, -.4397D-02, -.4780D-02, -.5098D-02, & + & -.5339D-02, -.5494D-02, -.5555D-02, -.5518D-02, -.5376D-02, & + & -.5128D-02, -.4777D-02, -.4337D-02, -.3838D-02, -.3328D-02, & + & -.2864D-02, -.2496D-02, -.2236D-02, -.2060D-02, -.1915D-02, & + & -.1757D-02, -.1571D-02, -.1364D-02, -.1157D-02, -.9529D-03, & + & -.7742D-03, -.6209D-03, -.4923D-03, -.3869D-03, -.3023D-03, & + & -.2343D-03, -.1803D-03, -.1383D-03, -.1050D-03, -.7963D-04, & + & -.6029D-04/ + + data (calcpts(j,42), j = 1,neta) /-.2479D-05, -.3065D-05, & + & -.3689D-05, -.4454D-05, -.5396D-05, -.6551D-05, -.7966D-05, & + & -.9624D-05, -.1164D-04, -.1409D-04, -.1709D-04, -.2071D-04, & + & -.2511D-04, -.3044D-04, -.3685D-04, -.4467D-04, -.5412D-04, & + & -.6560D-04, -.7945D-04, -.9630D-04, -.1166D-03, -.1413D-03, & + & -.1713D-03, -.2076D-03, -.2514D-03, -.3046D-03, -.3689D-03, & + & -.4468D-03, -.5409D-03, -.6546D-03, -.7917D-03, -.9566D-03, & + & -.1154D-02, -.1386D-02, -.1657D-02, -.1962D-02, -.2295D-02, & + & -.2644D-02, -.2991D-02, -.3321D-02, -.3618D-02, -.3872D-02, & + & -.4073D-02, -.4215D-02, -.4293D-02, -.4303D-02, -.4241D-02, & + & -.4104D-02, -.3890D-02, -.3602D-02, -.3251D-02, -.2861D-02, & + & -.2468D-02, -.2115D-02, -.1837D-02, -.1644D-02, -.1513D-02, & + & -.1406D-02, -.1289D-02, -.1150D-02, -.9963D-03, -.8400D-03, & + & -.6934D-03, -.5621D-03, -.4501D-03, -.3568D-03, -.2801D-03, & + & -.2181D-03, -.1688D-03, -.1301D-03, -.9944D-04, -.7544D-04, & + & -.5744D-04/ + + data (calcpts(j,43), j = 1,neta) /-.1859D-05, -.2269D-05, & + & -.2779D-05, -.3347D-05, -.4064D-05, -.4958D-05, -.5995D-05, & + & -.7236D-05, -.8771D-05, -.1062D-04, -.1288D-04, -.1560D-04, & + & -.1890D-04, -.2290D-04, -.2775D-04, -.3363D-04, -.4075D-04, & + & -.4937D-04, -.5983D-04, -.7250D-04, -.8785D-04, -.1064D-03, & + & -.1290D-03, -.1563D-03, -.1893D-03, -.2293D-03, -.2777D-03, & + & -.3363D-03, -.4070D-03, -.4925D-03, -.5955D-03, -.7191D-03, & + & -.8667D-03, -.1041D-02, -.1243D-02, -.1471D-02, -.1720D-02, & + & -.1982D-02, -.2244D-02, -.2495D-02, -.2724D-02, -.2923D-02, & + & -.3086D-02, -.3209D-02, -.3288D-02, -.3321D-02, -.3304D-02, & + & -.3235D-02, -.3111D-02, -.2932D-02, -.2702D-02, -.2426D-02, & + & -.2125D-02, -.1824D-02, -.1557D-02, -.1349D-02, -.1205D-02, & + & -.1109D-02, -.1029D-02, -.9423D-03, -.8397D-03, -.7260D-03, & + & -.6111D-03, -.5032D-03, -.4074D-03, -.3254D-03, -.2574D-03, & + & -.2021D-03, -.1574D-03, -.1214D-03, -.9342D-04, -.7142D-04, & + & -.5409D-04/ + + data (calcpts(j,44), j = 1,neta) /-.1425D-05, -.1723D-05, & + & -.2083D-05, -.2524D-05, -.3056D-05, -.3699D-05, -.4481D-05, & + & -.5430D-05, -.6576D-05, -.7963D-05, -.9650D-05, -.1169D-04, & + & -.1416D-04, -.1716D-04, -.2079D-04, -.2519D-04, -.3052D-04, & + & -.3698D-04, -.4482D-04, -.5431D-04, -.6579D-04, -.7972D-04, & + & -.9660D-04, -.1170D-03, -.1417D-03, -.1717D-03, -.2079D-03, & + & -.2518D-03, -.3047D-03, -.3686D-03, -.4455D-03, -.5378D-03, & + & -.6479D-03, -.7776D-03, -.9280D-03, -.1098D-02, -.1284D-02, & + & -.1479D-02, -.1676D-02, -.1865D-02, -.2041D-02, -.2195D-02, & + & -.2325D-02, -.2428D-02, -.2499D-02, -.2539D-02, -.2546D-02, & + & -.2517D-02, -.2450D-02, -.2345D-02, -.2200D-02, -.2016D-02, & + & -.1803D-02, -.1571D-02, -.1344D-02, -.1143D-02, -.9871D-03, & + & -.8809D-03, -.8099D-03, -.7514D-03, -.6872D-03, -.6114D-03, & + & -.5277D-03, -.4433D-03, -.3645D-03, -.2946D-03, -.2351D-03, & + & -.1856D-03, -.1456D-03, -.1129D-03, -.8693D-04, -.6693D-04, & + & -.5093D-04/ + + data (calcpts(j,45), j = 1,neta) /-.1047D-05, -.1275D-05, & + & -.1544D-05, -.1873D-05, -.2268D-05, -.2748D-05, -.3332D-05, & + & -.4036D-05, -.4893D-05, -.5928D-05, -.7185D-05, -.8710D-05, & + & -.1055D-04, -.1279D-04, -.1549D-04, -.1877D-04, -.2276D-04, & + & -.2757D-04, -.3341D-04, -.4049D-04, -.4905D-04, -.5944D-04, & + & -.7201D-04, -.8724D-04, -.1057D-03, -.1280D-03, -.1550D-03, & + & -.1876D-03, -.2271D-03, -.2746D-03, -.3319D-03, -.4005D-03, & + & -.4822D-03, -.5785D-03, -.6900D-03, -.8160D-03, -.9539D-03, & + & -.1099D-02, -.1246D-02, -.1389D-02, -.1522D-02, -.1641D-02, & + & -.1743D-02, -.1826D-02, -.1887D-02, -.1928D-02, -.1945D-02, & + & -.1938D-02, -.1906D-02, -.1846D-02, -.1758D-02, -.1642D-02, & + & -.1499D-02, -.1335D-02, -.1159D-02, -.9869D-03, -.8364D-03, & + & -.7209D-03, -.6425D-03, -.5904D-03, -.5475D-03, -.5002D-03, & + & -.4444D-03, -.3830D-03, -.3212D-03, -.2637D-03, -.2128D-03, & + & -.1696D-03, -.1338D-03, -.1049D-03, -.8132D-04, -.6279D-04, & + & -.4812D-04/ + + data (calcpts(j,46), j = 1,neta) /-.7797D-06, -.9460D-06, & + & -.1149D-05, -.1390D-05, -.1685D-05, -.2043D-05, -.2478D-05, & + & -.3000D-05, -.3631D-05, -.4402D-05, -.5337D-05, -.6469D-05, & + & -.7835D-05, -.9494D-05, -.1150D-04, -.1394D-04, -.1689D-04, & + & -.2047D-04, -.2480D-04, -.3005D-04, -.3641D-04, -.4411D-04, & + & -.5345D-04, -.6475D-04, -.7843D-04, -.9499D-04, -.1150D-03, & + & -.1392D-03, -.1685D-03, -.2037D-03, -.2461D-03, -.2970D-03, & + & -.3574D-03, -.4286D-03, -.5110D-03, -.6042D-03, -.7062D-03, & + & -.8140D-03, -.9235D-03, -.1030D-02, -.1131D-02, -.1222D-02, & + & -.1300D-02, -.1366D-02, -.1417D-02, -.1454D-02, -.1474D-02, & + & -.1479D-02, -.1466D-02, -.1434D-02, -.1383D-02, -.1313D-02, & + & -.1221D-02, -.1110D-02, -.9850D-03, -.8519D-03, -.7227D-03, & + & -.6105D-03, -.5250D-03, -.4674D-03, -.4293D-03, -.3978D-03, & + & -.3632D-03, -.3223D-03, -.2773D-03, -.2321D-03, -.1902D-03, & + & -.1533D-03, -.1220D-03, -.9633D-04, -.7513D-04, -.5833D-04, & + & -.4486D-04/ + + data (calcpts(j,47), j = 1,neta) /-.5812D-06, -.7041D-06, & + & -.8530D-06, -.1034D-05, -.1247D-05, -.1512D-05, -.1830D-05, & + & -.2218D-05, -.2692D-05, -.3258D-05, -.3949D-05, -.4785D-05, & + & -.5798D-05, -.7020D-05, -.8509D-05, -.1031D-04, -.1249D-04, & + & -.1514D-04, -.1834D-04, -.2222D-04, -.2692D-04, -.3261D-04, & + & -.3952D-04, -.4787D-04, -.5798D-04, -.7023D-04, -.8502D-04, & + & -.1029D-03, -.1245D-03, -.1505D-03, -.1819D-03, -.2193D-03, & + & -.2639D-03, -.3164D-03, -.3771D-03, -.4458D-03, -.5210D-03, & + & -.6007D-03, -.6818D-03, -.7614D-03, -.8367D-03, -.9054D-03, & + & -.9658D-03, -.1018D-02, -.1059D-02, -.1090D-02, -.1111D-02, & + & -.1120D-02, -.1118D-02, -.1102D-02, -.1074D-02, -.1032D-02, & + & -.9757D-03, -.9045D-03, -.8198D-03, -.7246D-03, -.6244D-03, & + & -.5279D-03, -.4446D-03, -.3815D-03, -.3393D-03, -.3115D-03, & + & -.2885D-03, -.2631D-03, -.2332D-03, -.2003D-03, -.1675D-03, & + & -.1370D-03, -.1103D-03, -.8765D-04, -.6899D-04, -.5385D-04, & + & -.4165D-04/ + + data (calcpts(j,48), j = 1,neta) /-.4289D-06, -.5178D-06, & + & -.6274D-06, -.7621D-06, -.9198D-06, -.1112D-05, -.1351D-05, & + & -.1637D-05, -.1984D-05, -.2400D-05, -.2909D-05, -.3527D-05, & + & -.4273D-05, -.5175D-05, -.6268D-05, -.7597D-05, -.9203D-05, & + & -.1115D-04, -.1351D-04, -.1637D-04, -.1983D-04, -.2403D-04, & + & -.2912D-04, -.3527D-04, -.4272D-04, -.5174D-04, -.6264D-04, & + & -.7582D-04, -.9172D-04, -.1109D-03, -.1339D-03, -.1615D-03, & + & -.1943D-03, -.2329D-03, -.2775D-03, -.3278D-03, -.3832D-03, & + & -.4419D-03, -.5019D-03, -.5609D-03, -.6172D-03, -.6690D-03, & + & -.7152D-03, -.7550D-03, -.7880D-03, -.8138D-03, -.8322D-03, & + & -.8427D-03, -.8453D-03, -.8395D-03, -.8249D-03, -.8008D-03, & + & -.7669D-03, -.7226D-03, -.6678D-03, -.6033D-03, -.5315D-03, & + & -.4565D-03, -.3860D-03, -.3231D-03, -.2767D-03, -.2458D-03, & + & -.2256D-03, -.2088D-03, -.1903D-03, -.1684D-03, -.1445D-03, & + & -.1206D-03, -.9858D-04, -.7925D-04, -.6292D-04, -.4952D-04, & + & -.3852D-04/ + + data (calcpts(j,49), j = 1,neta) /-.3130D-06, -.3793D-06, & + & -.4580D-06, -.5590D-06, -.6787D-06, -.8204D-06, -.9885D-06, & + & -.1201D-05, -.1456D-05, -.1761D-05, -.2137D-05, -.2588D-05, & + & -.3137D-05, -.3800D-05, -.4604D-05, -.5579D-05, -.6762D-05, & + & -.8190D-05, -.9926D-05, -.1203D-04, -.1457D-04, -.1765D-04, & + & -.2138D-04, -.2590D-04, -.3137D-04, -.3800D-04, -.4600D-04, & + & -.5567D-04, -.6735D-04, -.8141D-04, -.9832D-04, -.1185D-03, & + & -.1426D-03, -.1708D-03, -.2035D-03, -.2405D-03, -.2811D-03, & + & -.3241D-03, -.3683D-03, -.4121D-03, -.4539D-03, -.4927D-03, & + & -.5276D-03, -.5582D-03, -.5840D-03, -.6048D-03, -.6204D-03, & + & -.6307D-03, -.6355D-03, -.6346D-03, -.6277D-03, -.6146D-03, & + & -.5947D-03, -.5677D-03, -.5333D-03, -.4915D-03, -.4427D-03, & + & -.3888D-03, -.3330D-03, -.2798D-03, -.2343D-03, -.2003D-03, & + & -.1778D-03, -.1630D-03, -.1509D-03, -.1374D-03, -.1215D-03, & + & -.1041D-03, -.8673D-04, -.7079D-04, -.5686D-04, -.4513D-04, & + & -.3539D-04/ + + data (dlaeta(j), j = 1,neta) / & + & -6d0, -5.83333333d0, -5.66666667d0, -5.5d0, -5.33333333d0, & + & -5.16666667d0, -5d0, -4.83333333d0, -4.66666667d0, -4.5d0, & + & -4.33333333d0, -4.16666667d0, -4d0, -3.83333333d0, & + & -3.66666667d0, -3.5d0, -3.33333333d0, -3.16666667d0, -3d0, & + & -2.83333333d0, -2.66666667d0, -2.5d0, -2.33333333d0, & + & -2.16666667d0, -2d0, -1.83333333d0, -1.66666667d0, -1.5d0, & + & -1.33333333d0, -1.16666667d0, -1d0, -0.83333333d0, -0.66666667d0,& + & -0.5d0, -0.33333333d0, -0.16666667d0, 0d0, 0.16666667d0, & + & 0.33333333d0, 0.5d0, 0.66666667d0, 0.83333333d0, 1d0, & + & 1.16666667d0, 1.33333333d0, 1.5d0, 1.66666667d0, 1.83333333d0, & + & 2d0, 2.16666667d0, 2.33333333d0, 2.5d0, 2.66666667d0, & + & 2.83333333d0, 3d0, 3.16666667d0, 3.33333333d0, 3.5d0, & + & 3.66666667d0, 3.83333333d0, 4d0, 4.16666667d0, 4.33333333d0, & + & 4.5d0, 4.66666667d0, 4.83333333d0, 5d0, 5.16666667d0, & + & 5.33333333d0, 5.5d0, 5.66666667d0, 5.83333333d0, 6d0/ + + data (dlaxi(j), j = 1,nxi) / & + & -3d0, -2.83333333d0, -2.66666667d0, -2.5d0, -2.33333333d0, & + & -2.16666667d0, -2d0, -1.83333333d0, -1.66666667d0, -1.5d0, & + & -1.33333333d0, -1.16666667d0, -1d0, -0.83333333d0, -0.66666667d0,& + & -0.5d0, -0.33333333d0, -0.16666667d0, 0d0, 0.16666667d0, & + & 0.33333333d0, 0.5d0, 0.66666667d0, 0.83333333d0, 1d0, & + & 1.16666667d0, 1.33333333d0, 1.5d0, 1.66666667d0, 1.83333333d0, & + & 2d0, 2.16666667d0, 2.33333333d0, 2.5d0, 2.66666667d0, & + & 2.83333333d0, 3d0, 3.16666667d0, 3.33333333d0, 3.5d0, & + & 3.66666667d0, 3.83333333d0, 4d0, 4.16666667d0, 4.33333333d0, & + & 4.5d0, 4.66666667d0, 4.83333333d0, 5d0/ + + dleta = dlog10(eta) + dlxi = dlog10(xi) + if (dlxi .le. dlaxi(1)) dlxi = dlaxi(1) + if (dlxi .ge. dlaxi(nxi)) dlxi = dlaxi(nxi) + if (dleta .ge. dlaeta(neta)) dleta = dlaeta(neta) + if (dleta .le. dlaeta(1)) dleta = dlaeta(1) + call locate(dlaeta,neta, dleta, ieta) + call locate(dlaxi, nxi, dlxi, ixi) +! interpolating between the appropriate points + delxi = 1d0/6d0 + deleta = 1d0/6d0 +! lagrange 3-pt. + if (ixi .le. 2) ixi = 2 + if (ixi .ge. 48) ixi = 48 + if (ieta .le. 2) ieta = 2 + if (ieta .ge. 72) ieta = 72 + pxi = (dlxi - dlaxi(ixi))/delxi + f(-1) = pxi*(pxi-1d0)/2d0*calcpts(ieta-1,ixi-1) + & + & (1d0 - pxi**2)*calcpts(ieta-1,ixi) + & + & pxi*(pxi+1d0)/2d0*calcpts(ieta-1,ixi+1) + f(0) = pxi*(pxi-1d0)/2d0*calcpts(ieta,ixi-1) + & + & (1d0 - pxi**2)*calcpts(ieta,ixi) + & + & pxi*(pxi+1d0)/2d0*calcpts(ieta,ixi+1) + f(1) = pxi*(pxi-1d0)/2d0*calcpts(ieta+1,ixi-1) + & + & (1d0 - pxi**2)*calcpts(ieta+1,ixi) + & + & pxi*(pxi+1d0)/2d0*calcpts(ieta+1,ixi+1) + peta = (dleta - dlaeta(ieta))/deleta + h1_ATg = peta*(peta-1d0)/2d0*f(-1) + & + & (1d0 - peta**2)*f(0) + & + & peta*(peta+1d0)/2d0*f(1) +!MB + + peta*(peta+1d0)/2d0*f(1) + return + END + +! ======================================== + double precision function h1_FTg(eta,xi) +! ======================================== + +! eq (10) in PLB347 (1995) 143 - 151 for the transverse piece +! MSbar scheme +! This routine is called subctcf in the original code. +! Called sctcf in updated code (03/06/96). + + implicit none + integer neta, nxi + parameter (neta = 73, nxi = 49) + double precision calcpts(neta, nxi), dlaeta(neta), dlaxi(nxi) + double precision eta, xi, dleta, dlxi + double precision pxi, peta, f(-1:1), delxi, deleta + integer j, ieta, ixi + data (calcpts(j, 1), j = 1,neta) /-.2005D-03, -.2004D-03, & + & -.3501D-03, -.3497D-03, -.4991D-03, -.4983D-03, -.6470D-03, & + & -.7952D-03, -.9425D-03, -.1089D-02, -.1383D-02, -.1524D-02, & + & -.1962D-02, -.2243D-02, -.2666D-02, -.3227D-02, -.3769D-02, & + & -.4434D-02, -.5209D-02, -.6075D-02, -.7007D-02, -.7963D-02, & + & -.8887D-02, -.9694D-02, -.1011D-01, -.1027D-01, -.9623D-02, & + & -.7967D-02, -.4835D-02, -.5091D-03, 0.5340D-02, 0.1151D-01, & + & 0.1643D-01, 0.1747D-01, 0.1237D-01, 0.7897D-03, -.1390D-01, & + & -.2616D-01, -.3083D-01, -.2674D-01, -.1655D-01, -.4410D-02, & + & 0.6429D-02, 0.1431D-01, 0.1894D-01, 0.2087D-01, 0.2082D-01, & + & 0.1952D-01, 0.1755D-01, 0.1527D-01, 0.1299D-01, 0.1083D-01, & + & 0.8899D-02, 0.7217D-02, 0.5789D-02, 0.4600D-02, 0.3625D-02, & + & 0.2837D-02, 0.2204D-02, 0.1703D-02, 0.1309D-02, 0.1001D-02, & + & 0.7622D-03, 0.5780D-03, 0.4364D-03, 0.3286D-03, 0.2464D-03, & + & 0.1844D-03, 0.1375D-03, 0.1022D-03, 0.7583D-04, 0.5611D-04, & + & 0.4143D-04/ + + data (calcpts(j, 2), j = 1,neta) /-.1546D-03, -.3044D-03, & + & -.3042D-03, -.3038D-03, -.4532D-03, -.4523D-03, -.6011D-03, & + & -.7493D-03, -.8966D-03, -.1043D-02, -.1337D-02, -.1628D-02, & + & -.1916D-02, -.2347D-02, -.2770D-02, -.3181D-02, -.3873D-02, & + & -.4538D-02, -.5313D-02, -.6180D-02, -.6961D-02, -.7918D-02, & + & -.8841D-02, -.9649D-02, -.1022D-01, -.1023D-01, -.9578D-02, & + & -.7923D-02, -.4941D-02, -.4661D-03, 0.5382D-02, 0.1155D-01, & + & 0.1647D-01, 0.1750D-01, 0.1240D-01, 0.8170D-03, -.1388D-01, & + & -.2616D-01, -.3083D-01, -.2673D-01, -.1655D-01, -.4404D-02, & + & 0.6433D-02, 0.1429D-01, 0.1894D-01, 0.2086D-01, 0.2082D-01, & + & 0.1952D-01, 0.1755D-01, 0.1527D-01, 0.1298D-01, 0.1083D-01, & + & 0.8899D-02, 0.7217D-02, 0.5789D-02, 0.4600D-02, 0.3625D-02, & + & 0.2837D-02, 0.2204D-02, 0.1703D-02, 0.1309D-02, 0.1001D-02, & + & 0.7622D-03, 0.5780D-03, 0.4364D-03, 0.3286D-03, 0.2464D-03, & + & 0.1844D-03, 0.1375D-03, 0.1022D-03, 0.7583D-04, 0.5611D-04, & + & 0.4143D-04/ + + data (calcpts(j, 3), j = 1,neta) /-.2373D-03, -.2372D-03, & + & -.2369D-03, -.3865D-03, -.3859D-03, -.5351D-03, -.6838D-03, & + & -.6820D-03, -.9793D-03, -.1125D-02, -.1270D-02, -.1561D-02, & + & -.1848D-02, -.2280D-02, -.2703D-02, -.3264D-02, -.3806D-02, & + & -.4471D-02, -.5246D-02, -.6112D-02, -.7044D-02, -.8001D-02, & + & -.8924D-02, -.9582D-02, -.1015D-01, -.1016D-01, -.9512D-02, & + & -.7858D-02, -.4877D-02, -.4031D-03, 0.5293D-02, 0.1145D-01, & + & 0.1637D-01, 0.1755D-01, 0.1244D-01, 0.8570D-03, -.1399D-01, & + & -.2615D-01, -.3083D-01, -.2673D-01, -.1656D-01, -.4395D-02, & + & 0.6424D-02, 0.1430D-01, 0.1893D-01, 0.2086D-01, 0.2082D-01, & + & 0.1952D-01, 0.1755D-01, 0.1527D-01, 0.1299D-01, 0.1083D-01, & + & 0.8899D-02, 0.7217D-02, 0.5789D-02, 0.4600D-02, 0.3625D-02, & + & 0.2837D-02, 0.2204D-02, 0.1703D-02, 0.1309D-02, 0.1001D-02, & + & 0.7622D-03, 0.5778D-03, 0.4364D-03, 0.3286D-03, 0.2464D-03, & + & 0.1844D-03, 0.1375D-03, 0.1022D-03, 0.7583D-04, 0.5611D-04, & + & 0.4143D-04/ + + data (calcpts(j, 4), j = 1,neta) /-.1385D-03, -.2883D-03, & + & -.2881D-03, -.2877D-03, -.4371D-03, -.5862D-03, -.5850D-03, & + & -.7331D-03, -.8804D-03, -.1026D-02, -.1321D-02, -.1612D-02, & + & -.1900D-02, -.2331D-02, -.2754D-02, -.3165D-02, -.3857D-02, & + & -.4522D-02, -.5297D-02, -.6164D-02, -.6946D-02, -.7902D-02, & + & -.8826D-02, -.9634D-02, -.1020D-01, -.1021D-01, -.9565D-02, & + & -.7912D-02, -.4932D-02, -.4606D-03, 0.5233D-02, 0.1154D-01, & + & 0.1645D-01, 0.1748D-01, 0.1236D-01, 0.7658D-03, -.1394D-01, & + & -.2615D-01, -.3082D-01, -.2673D-01, -.1655D-01, -.4398D-02, & + & 0.6433D-02, 0.1429D-01, 0.1894D-01, 0.2087D-01, 0.2083D-01, & + & 0.1952D-01, 0.1753D-01, 0.1527D-01, 0.1298D-01, 0.1083D-01, & + & 0.8899D-02, 0.7216D-02, 0.5790D-02, 0.4600D-02, 0.3625D-02, & + & 0.2837D-02, 0.2204D-02, 0.1703D-02, 0.1309D-02, 0.1001D-02, & + & 0.7622D-03, 0.5778D-03, 0.4364D-03, 0.3286D-03, 0.2464D-03, & + & 0.1844D-03, 0.1375D-03, 0.1022D-03, 0.7582D-04, 0.5611D-04, & + & 0.4143D-04/ + + data (calcpts(j, 5), j = 1,neta) /-.1435D-03, -.2933D-03, & + & -.2930D-03, -.2926D-03, -.4421D-03, -.5912D-03, -.5900D-03, & + & -.7381D-03, -.8854D-03, -.1031D-02, -.1326D-02, -.1617D-02, & + & -.1905D-02, -.2336D-02, -.2759D-02, -.3170D-02, -.3862D-02, & + & -.4527D-02, -.5302D-02, -.6169D-02, -.6951D-02, -.7908D-02, & + & -.8831D-02, -.9640D-02, -.1021D-01, -.1022D-01, -.9573D-02, & + & -.7921D-02, -.4944D-02, -.4749D-03, 0.5215D-02, 0.1152D-01, & + & 0.1642D-01, 0.1744D-01, 0.1231D-01, 0.8520D-03, -.1402D-01, & + & -.2614D-01, -.3081D-01, -.2671D-01, -.1654D-01, -.4394D-02, & + & 0.6431D-02, 0.1430D-01, 0.1893D-01, 0.2087D-01, 0.2083D-01, & + & 0.1953D-01, 0.1754D-01, 0.1527D-01, 0.1298D-01, 0.1083D-01, & + & 0.8898D-02, 0.7216D-02, 0.5788D-02, 0.4600D-02, 0.3625D-02, & + & 0.2835D-02, 0.2205D-02, 0.1703D-02, 0.1309D-02, 0.1001D-02, & + & 0.7621D-03, 0.5778D-03, 0.4365D-03, 0.3286D-03, 0.2464D-03, & + & 0.1844D-03, 0.1374D-03, 0.1022D-03, 0.7582D-04, 0.5611D-04, & + & 0.4143D-04/ + + data (calcpts(j, 6), j = 1,neta) /-.2310D-03, -.2308D-03, & + & -.2305D-03, -.3801D-03, -.3795D-03, -.5287D-03, -.6774D-03, & + & -.8256D-03, -.9729D-03, -.1119D-02, -.1263D-02, -.1555D-02, & + & -.1842D-02, -.2274D-02, -.2697D-02, -.3257D-02, -.3799D-02, & + & -.4464D-02, -.5240D-02, -.6107D-02, -.7039D-02, -.7996D-02, & + & -.8920D-02, -.9579D-02, -.1015D-01, -.1016D-01, -.9515D-02, & + & -.7865D-02, -.4891D-02, -.5759D-03, 0.5258D-02, 0.1140D-01, & + & 0.1630D-01, 0.1745D-01, 0.1231D-01, 0.8284D-03, -.1392D-01, & + & -.2614D-01, -.3080D-01, -.2671D-01, -.1653D-01, -.4397D-02, & + & 0.6421D-02, 0.1430D-01, 0.1894D-01, 0.2086D-01, 0.2082D-01, & + & 0.1953D-01, 0.1754D-01, 0.1527D-01, 0.1298D-01, 0.1083D-01, & + & 0.8897D-02, 0.7216D-02, 0.5788D-02, 0.4599D-02, 0.3625D-02, & + & 0.2836D-02, 0.2205D-02, 0.1703D-02, 0.1309D-02, 0.1001D-02, & + & 0.7621D-03, 0.5779D-03, 0.4365D-03, 0.3284D-03, 0.2464D-03, & + & 0.1844D-03, 0.1374D-03, 0.1022D-03, 0.7582D-04, 0.5611D-04, & + & 0.4143D-04/ + + data (calcpts(j, 7), j = 1,neta) /-.2194D-03, -.2192D-03, & + & -.2189D-03, -.3685D-03, -.3680D-03, -.5171D-03, -.6659D-03, & + & -.8140D-03, -.9613D-03, -.1107D-02, -.1252D-02, -.1543D-02, & + & -.1831D-02, -.2262D-02, -.2685D-02, -.3246D-02, -.3788D-02, & + & -.4453D-02, -.5228D-02, -.6096D-02, -.7028D-02, -.7985D-02, & + & -.8910D-02, -.9569D-02, -.1014D-01, -.1030D-01, -.9660D-02, & + & -.7863D-02, -.5043D-02, -.5842D-03, 0.5241D-02, 0.1137D-01, & + & 0.1625D-01, 0.1739D-01, 0.1222D-01, 0.7137D-03, -.1391D-01, & + & -.2612D-01, -.3079D-01, -.2669D-01, -.1652D-01, -.4402D-02, & + & 0.6419D-02, 0.1429D-01, 0.1892D-01, 0.2086D-01, 0.2081D-01, & + & 0.1952D-01, 0.1754D-01, 0.1527D-01, 0.1298D-01, 0.1083D-01, & + & 0.8896D-02, 0.7215D-02, 0.5787D-02, 0.4599D-02, 0.3625D-02, & + & 0.2836D-02, 0.2205D-02, 0.1704D-02, 0.1309D-02, 0.1001D-02, & + & 0.7621D-03, 0.5779D-03, 0.4365D-03, 0.3285D-03, 0.2464D-03, & + & 0.1842D-03, 0.1374D-03, 0.1022D-03, 0.7582D-04, 0.5611D-04, & + & 0.4143D-04/ + + data (calcpts(j, 8), j = 1,neta) /-.2128D-03, -.2126D-03, & + & -.3623D-03, -.3619D-03, -.3613D-03, -.5105D-03, -.6592D-03, & + & -.8074D-03, -.9547D-03, -.1101D-02, -.1245D-02, -.1536D-02, & + & -.1824D-02, -.2256D-02, -.2679D-02, -.3239D-02, -.3782D-02, & + & -.4447D-02, -.5222D-02, -.6090D-02, -.7022D-02, -.7980D-02, & + & -.8905D-02, -.9566D-02, -.1014D-01, -.1030D-01, -.9663D-02, & + & -.8021D-02, -.5056D-02, -.6067D-03, 0.5056D-02, 0.1132D-01, & + & 0.1618D-01, 0.1713D-01, 0.1223D-01, 0.6853D-03, -.1398D-01, & + & -.2611D-01, -.3077D-01, -.2667D-01, -.1652D-01, -.4388D-02, & + & 0.6431D-02, 0.1429D-01, 0.1893D-01, 0.2086D-01, 0.2082D-01, & + & 0.1951D-01, 0.1753D-01, 0.1526D-01, 0.1298D-01, 0.1083D-01, & + & 0.8895D-02, 0.7215D-02, 0.5788D-02, 0.4598D-02, 0.3624D-02, & + & 0.2836D-02, 0.2203D-02, 0.1704D-02, 0.1309D-02, 0.1001D-02, & + & 0.7620D-03, 0.5779D-03, 0.4365D-03, 0.3285D-03, 0.2464D-03, & + & 0.1842D-03, 0.1374D-03, 0.1022D-03, 0.7582D-04, 0.5611D-04, & + & 0.4143D-04/ + + data (calcpts(j, 9), j = 1,neta) /-.1453D-03, -.2952D-03, & + & -.2949D-03, -.2945D-03, -.4439D-03, -.4431D-03, -.5918D-03, & + & -.7400D-03, -.8873D-03, -.1033D-02, -.1328D-02, -.1619D-02, & + & -.1907D-02, -.2188D-02, -.2762D-02, -.3172D-02, -.3864D-02, & + & -.4530D-02, -.5306D-02, -.6023D-02, -.6956D-02, -.7915D-02, & + & -.8841D-02, -.9653D-02, -.1023D-01, -.1024D-01, -.9610D-02, & + & -.7974D-02, -.5019D-02, -.7318D-03, 0.4913D-02, 0.1115D-01, & + & 0.1598D-01, 0.1704D-01, 0.1209D-01, 0.6323D-03, -.1395D-01, & + & -.2608D-01, -.3072D-01, -.2665D-01, -.1649D-01, -.4378D-02, & + & 0.6416D-02, 0.1428D-01, 0.1891D-01, 0.2085D-01, 0.2080D-01, & + & 0.1950D-01, 0.1752D-01, 0.1527D-01, 0.1298D-01, 0.1083D-01, & + & 0.8894D-02, 0.7213D-02, 0.5787D-02, 0.4599D-02, 0.3624D-02, & + & 0.2835D-02, 0.2203D-02, 0.1702D-02, 0.1309D-02, 0.1001D-02, & + & 0.7620D-03, 0.5777D-03, 0.4363D-03, 0.3285D-03, 0.2464D-03, & + & 0.1842D-03, 0.1374D-03, 0.1022D-03, 0.7581D-04, 0.5611D-04, & + & 0.4143D-04/ + + data (calcpts(j,10), j = 1,neta) /-.2188D-03, -.2186D-03, & + & -.2183D-03, -.3679D-03, -.3673D-03, -.5165D-03, -.6652D-03, & + & -.8134D-03, -.9608D-03, -.1107D-02, -.1251D-02, -.1543D-02, & + & -.1830D-02, -.2262D-02, -.2685D-02, -.3246D-02, -.3788D-02, & + & -.4454D-02, -.5230D-02, -.6098D-02, -.7032D-02, -.7841D-02, & + & -.8769D-02, -.9583D-02, -.1016D-01, -.1018D-01, -.9704D-02, & + & -.8077D-02, -.5135D-02, -.8675D-03, 0.4751D-02, 0.1096D-01, & + & 0.1573D-01, 0.1673D-01, 0.1185D-01, 0.4632D-03, -.1406D-01, & + & -.2606D-01, -.3067D-01, -.2659D-01, -.1647D-01, -.4373D-02, & + & 0.6415D-02, 0.1427D-01, 0.1891D-01, 0.2083D-01, 0.2079D-01, & + & 0.1950D-01, 0.1752D-01, 0.1526D-01, 0.1297D-01, 0.1082D-01, & + & 0.8891D-02, 0.7211D-02, 0.5785D-02, 0.4598D-02, 0.3623D-02, & + & 0.2835D-02, 0.2204D-02, 0.1702D-02, 0.1308D-02, 0.1001D-02, & + & 0.7619D-03, 0.5776D-03, 0.4364D-03, 0.3285D-03, 0.2463D-03, & + & 0.1842D-03, 0.1374D-03, 0.1022D-03, 0.7581D-04, 0.5610D-04, & + & 0.4142D-04/ + + data (calcpts(j,11), j = 1,neta) /-.1437D-03, -.2935D-03, & + & -.2933D-03, -.2929D-03, -.4423D-03, -.4414D-03, -.5902D-03, & + & -.7384D-03, -.8857D-03, -.1032D-02, -.1326D-02, -.1618D-02, & + & -.1905D-02, -.2187D-02, -.2610D-02, -.3171D-02, -.3714D-02, & + & -.4380D-02, -.5156D-02, -.6025D-02, -.6960D-02, -.7920D-02, & + & -.8850D-02, -.9667D-02, -.1010D-01, -.1028D-01, -.9659D-02, & + & -.8046D-02, -.5273D-02, -.1033D-02, 0.4546D-02, 0.1055D-01, & + & 0.1540D-01, 0.1646D-01, 0.1163D-01, 0.4108D-03, -.1410D-01, & + & -.2601D-01, -.3059D-01, -.2652D-01, -.1642D-01, -.4356D-02, & + & 0.6410D-02, 0.1426D-01, 0.1888D-01, 0.2081D-01, 0.2078D-01, & + & 0.1949D-01, 0.1752D-01, 0.1525D-01, 0.1297D-01, 0.1082D-01, & + & 0.8887D-02, 0.7209D-02, 0.5783D-02, 0.4596D-02, 0.3622D-02, & + & 0.2834D-02, 0.2202D-02, 0.1703D-02, 0.1308D-02, 0.1000D-02, & + & 0.7617D-03, 0.5775D-03, 0.4362D-03, 0.3284D-03, 0.2463D-03, & + & 0.1843D-03, 0.1374D-03, 0.1022D-03, 0.7580D-04, 0.5609D-04, & + & 0.4142D-04/ + + data (calcpts(j,12), j = 1,neta) /-.1721D-03, -.1719D-03, & + & -.3216D-03, -.3212D-03, -.4707D-03, -.4698D-03, -.6186D-03, & + & -.7668D-03, -.9141D-03, -.1060D-02, -.1355D-02, -.1496D-02, & + & -.1934D-02, -.2216D-02, -.2639D-02, -.3200D-02, -.3743D-02, & + & -.4410D-02, -.5187D-02, -.6056D-02, -.6993D-02, -.7805D-02, & + & -.8738D-02, -.9560D-02, -.1015D-01, -.1019D-01, -.9731D-02, & + & -.8137D-02, -.5394D-02, -.1194D-02, 0.4180D-02, 0.1010D-01, & + & 0.1486D-01, 0.1594D-01, 0.1109D-01, 0.1429D-03, -.1411D-01, & + & -.2595D-01, -.3047D-01, -.2643D-01, -.1637D-01, -.4346D-02, & + & 0.6403D-02, 0.1424D-01, 0.1885D-01, 0.2079D-01, 0.2076D-01, & + & 0.1946D-01, 0.1749D-01, 0.1524D-01, 0.1296D-01, 0.1081D-01, & + & 0.8882D-02, 0.7204D-02, 0.5779D-02, 0.4593D-02, 0.3620D-02, & + & 0.2833D-02, 0.2201D-02, 0.1701D-02, 0.1308D-02, 0.1000D-02, & + & 0.7615D-03, 0.5774D-03, 0.4361D-03, 0.3282D-03, 0.2463D-03, & + & 0.1841D-03, 0.1373D-03, 0.1021D-03, 0.7577D-04, 0.5607D-04, & + & 0.4140D-04/ + + data (calcpts(j,13), j = 1,neta) /-.1707D-03, -.1705D-03, & + & -.3202D-03, -.3198D-03, -.4693D-03, -.4684D-03, -.6172D-03, & + & -.7654D-03, -.9128D-03, -.1059D-02, -.1353D-02, -.1495D-02, & + & -.1783D-02, -.2215D-02, -.2639D-02, -.3200D-02, -.3743D-02, & + & -.4410D-02, -.5188D-02, -.5909D-02, -.6848D-02, -.7813D-02, & + & -.8751D-02, -.9579D-02, -.1018D-01, -.1023D-01, -.9793D-02, & + & -.8378D-02, -.5676D-02, -.1534D-02, 0.3758D-02, 0.9572D-02, & + & 0.1418D-01, 0.1522D-01, 0.1059D-01, -.1719D-03, -.1426D-01, & + & -.2585D-01, -.3032D-01, -.2629D-01, -.1629D-01, -.4321D-02, & + & 0.6391D-02, 0.1421D-01, 0.1882D-01, 0.2075D-01, 0.2072D-01, & + & 0.1943D-01, 0.1748D-01, 0.1521D-01, 0.1294D-01, 0.1080D-01, & + & 0.8874D-02, 0.7198D-02, 0.5775D-02, 0.4590D-02, 0.3617D-02, & + & 0.2831D-02, 0.2200D-02, 0.1700D-02, 0.1307D-02, 0.9996D-03, & + & 0.7612D-03, 0.5771D-03, 0.4359D-03, 0.3281D-03, 0.2462D-03, & + & 0.1841D-03, 0.1373D-03, 0.1021D-03, 0.7575D-04, 0.5606D-04, & + & 0.4139D-04/ + + data (calcpts(j,14), j = 1,neta) /-.1968D-03, -.1967D-03, & + & -.3464D-03, -.3460D-03, -.3455D-03, -.4946D-03, -.6434D-03, & + & -.7917D-03, -.9391D-03, -.1085D-02, -.1230D-02, -.1521D-02, & + & -.1809D-02, -.2242D-02, -.2666D-02, -.3077D-02, -.3621D-02, & + & -.4289D-02, -.5069D-02, -.5942D-02, -.6883D-02, -.7703D-02, & + & -.8647D-02, -.9484D-02, -.1010D-01, -.1032D-01, -.9760D-02, & + & -.8537D-02, -.5893D-02, -.1986D-02, 0.3039D-02, 0.8692D-02, & + & 0.1309D-01, 0.1430D-01, 0.9794D-02, -.7502D-03, -.1435D-01, & + & -.2570D-01, -.3009D-01, -.2609D-01, -.1617D-01, -.4278D-02, & + & 0.6379D-02, 0.1415D-01, 0.1876D-01, 0.2070D-01, 0.2068D-01, & + & 0.1941D-01, 0.1744D-01, 0.1520D-01, 0.1292D-01, 0.1078D-01, & + & 0.8862D-02, 0.7189D-02, 0.5769D-02, 0.4586D-02, 0.3615D-02, & + & 0.2828D-02, 0.2198D-02, 0.1699D-02, 0.1306D-02, 0.9988D-03, & + & 0.7606D-03, 0.5768D-03, 0.4357D-03, 0.3279D-03, 0.2461D-03, & + & 0.1840D-03, 0.1372D-03, 0.1021D-03, 0.7573D-04, 0.5604D-04, & + & 0.4138D-04/ + + data (calcpts(j,15), j = 1,neta) /-.1824D-03, -.1823D-03, & + & -.3320D-03, -.3316D-03, -.4811D-03, -.4803D-03, -.6291D-03, & + & -.7773D-03, -.9248D-03, -.1071D-02, -.1216D-02, -.1507D-02, & + & -.1796D-02, -.2228D-02, -.2503D-02, -.3065D-02, -.3610D-02, & + & -.4279D-02, -.5061D-02, -.5787D-02, -.6732D-02, -.7708D-02, & + & -.8511D-02, -.9361D-02, -.9993D-02, -.1024D-01, -.9876D-02, & + & -.8711D-02, -.6303D-02, -.2665D-02, 0.2193D-02, 0.7467D-02, & + & 0.1186D-01, 0.1284D-01, 0.8604D-02, -.1434D-02, -.1442D-01, & + & -.2550D-01, -.2975D-01, -.2580D-01, -.1602D-01, -.4239D-02, & + & 0.6339D-02, 0.1408D-01, 0.1867D-01, 0.2062D-01, 0.2060D-01, & + & 0.1933D-01, 0.1739D-01, 0.1515D-01, 0.1289D-01, 0.1076D-01, & + & 0.8844D-02, 0.7176D-02, 0.5758D-02, 0.4578D-02, 0.3609D-02, & + & 0.2824D-02, 0.2195D-02, 0.1697D-02, 0.1304D-02, 0.9978D-03, & + & 0.7599D-03, 0.5762D-03, 0.4354D-03, 0.3277D-03, 0.2459D-03, & + & 0.1839D-03, 0.1371D-03, 0.1020D-03, 0.7567D-04, 0.5600D-04, & + & 0.4136D-04/ + + data (calcpts(j,16), j = 1,neta) /-.1800D-03, -.1799D-03, & + & -.3296D-03, -.3292D-03, -.3287D-03, -.4779D-03, -.6267D-03, & + & -.6250D-03, -.7725D-03, -.1069D-02, -.1213D-02, -.1506D-02, & + & -.1794D-02, -.2077D-02, -.2502D-02, -.2915D-02, -.3612D-02, & + & -.4133D-02, -.4917D-02, -.5647D-02, -.6598D-02, -.7583D-02, & + & -.8399D-02, -.9268D-02, -.9927D-02, -.1022D-01, -.1006D-01, & + & -.8976D-02, -.6836D-02, -.3517D-02, 0.9542D-03, 0.5906D-02, & + & 0.1002D-01, 0.1105D-01, 0.7198D-02, -.2258D-02, -.1472D-01, & + & -.2521D-01, -.2927D-01, -.2542D-01, -.1580D-01, -.4190D-02, & + & 0.6275D-02, 0.1396D-01, 0.1855D-01, 0.2048D-01, 0.2050D-01, & + & 0.1925D-01, 0.1732D-01, 0.1510D-01, 0.1285D-01, 0.1073D-01, & + & 0.8819D-02, 0.7157D-02, 0.5744D-02, 0.4567D-02, 0.3601D-02, & + & 0.2819D-02, 0.2191D-02, 0.1694D-02, 0.1302D-02, 0.9963D-03, & + & 0.7588D-03, 0.5754D-03, 0.4348D-03, 0.3272D-03, 0.2455D-03, & + & 0.1837D-03, 0.1370D-03, 0.1019D-03, 0.7560D-04, 0.5596D-04, & + & 0.4132D-04/ + + data (calcpts(j,17), j = 1,neta) /-.1148D-03, -.2646D-03, & + & -.2644D-03, -.2640D-03, -.4135D-03, -.4127D-03, -.5616D-03, & + & -.7100D-03, -.8576D-03, -.1004D-02, -.1149D-02, -.1441D-02, & + & -.1730D-02, -.2013D-02, -.2439D-02, -.2854D-02, -.3402D-02, & + & -.4076D-02, -.4714D-02, -.5599D-02, -.6409D-02, -.7256D-02, & + & -.8239D-02, -.9134D-02, -.9831D-02, -.1017D-01, -.1010D-01, & + & -.9280D-02, -.7456D-02, -.4522D-02, -.5274D-03, 0.3977D-02, & + & 0.7644D-02, 0.8816D-02, 0.5388D-02, -.3332D-02, -.1483D-01, & + & -.2478D-01, -.2863D-01, -.2489D-01, -.1552D-01, -.4146D-02, & + & 0.6172D-02, 0.1378D-01, 0.1835D-01, 0.2029D-01, 0.2033D-01, & + & 0.1912D-01, 0.1722D-01, 0.1502D-01, 0.1278D-01, 0.1068D-01, & + & 0.8782D-02, 0.7130D-02, 0.5725D-02, 0.4553D-02, 0.3590D-02, & + & 0.2811D-02, 0.2186D-02, 0.1690D-02, 0.1299D-02, 0.9941D-03, & + & 0.7572D-03, 0.5743D-03, 0.4340D-03, 0.3268D-03, 0.2452D-03, & + & 0.1835D-03, 0.1368D-03, 0.1018D-03, 0.7550D-04, 0.5588D-04, & + & 0.4127D-04/ + + data (calcpts(j,18), j = 1,neta) /-.1467D-03, -.1465D-03, & + & -.2963D-03, -.2960D-03, -.2955D-03, -.4447D-03, -.5937D-03, & + & -.5921D-03, -.7398D-03, -.8864D-03, -.1181D-02, -.1324D-02, & + & -.1613D-02, -.1898D-02, -.2325D-02, -.2741D-02, -.3291D-02, & + & -.3819D-02, -.4462D-02, -.5205D-02, -.6176D-02, -.7039D-02, & + & -.7897D-02, -.8826D-02, -.9575D-02, -.9992D-02, -.1002D-01, & + & -.9512D-02, -.8062D-02, -.5594D-02, -.2193D-02, 0.1706D-02, & + & 0.5020D-02, 0.6064D-02, 0.3033D-02, -.4576D-02, -.1507D-01, & + & -.2416D-01, -.2776D-01, -.2419D-01, -.1519D-01, -.4142D-02, & + & 0.5976D-02, 0.1351D-01, 0.1805D-01, 0.2003D-01, 0.2009D-01, & + & 0.1892D-01, 0.1705D-01, 0.1489D-01, 0.1269D-01, 0.1061D-01, & + & 0.8730D-02, 0.7091D-02, 0.5696D-02, 0.4531D-02, 0.3575D-02, & + & 0.2799D-02, 0.2178D-02, 0.1683D-02, 0.1295D-02, 0.9910D-03, & + & 0.7550D-03, 0.5727D-03, 0.4329D-03, 0.3260D-03, 0.2446D-03, & + & 0.1830D-03, 0.1365D-03, 0.1016D-03, 0.7536D-04, 0.5579D-04, & + & 0.4120D-04/ + + data (calcpts(j,19), j = 1,neta) /-.2090D-03, -.2088D-03, & + & -.2086D-03, -.2083D-03, -.3578D-03, -.3571D-03, -.5061D-03, & + & -.6547D-03, -.6525D-03, -.7993D-03, -.1095D-02, -.1238D-02, & + & -.1528D-02, -.1813D-02, -.2092D-02, -.2510D-02, -.3064D-02, & + & -.3595D-02, -.4245D-02, -.4999D-02, -.5684D-02, -.6569D-02, & + & -.7458D-02, -.8283D-02, -.9099D-02, -.9764D-02, -.9935D-02, & + & -.9630D-02, -.8473D-02, -.6571D-02, -.3899D-02, -.6442D-03, & + & 0.2218D-02, 0.3113D-02, 0.6896D-03, -.5955D-02, -.1509D-01, & + & -.2328D-01, -.2662D-01, -.2333D-01, -.1482D-01, -.4195D-02, & + & 0.5655D-02, 0.1305D-01, 0.1759D-01, 0.1960D-01, 0.1974D-01, & + & 0.1863D-01, 0.1682D-01, 0.1472D-01, 0.1256D-01, 0.1051D-01, & + & 0.8655D-02, 0.7035D-02, 0.5655D-02, 0.4501D-02, 0.3553D-02, & + & 0.2784D-02, 0.2166D-02, 0.1676D-02, 0.1289D-02, 0.9868D-03, & + & 0.7519D-03, 0.5706D-03, 0.4312D-03, 0.3248D-03, 0.2438D-03, & + & 0.1824D-03, 0.1361D-03, 0.1013D-03, 0.7515D-04, 0.5564D-04, & + & 0.4110D-04/ + + data (calcpts(j,20), j = 1,neta) /-.1704D-03, -.1703D-03, & + & -.1701D-03, -.1698D-03, -.3194D-03, -.3188D-03, -.4679D-03, & + & -.4665D-03, -.6145D-03, -.7616D-03, -.9074D-03, -.1051D-02, & + & -.1342D-02, -.1629D-02, -.1909D-02, -.2330D-02, -.2737D-02, & + & -.3275D-02, -.3784D-02, -.4550D-02, -.5253D-02, -.6015D-02, & + & -.6793D-02, -.7677D-02, -.8426D-02, -.9065D-02, -.9413D-02, & + & -.9366D-02, -.8727D-02, -.7347D-02, -.5105D-02, -.2548D-02, & + & -.2590D-03, 0.4423D-03, -.1496D-02, -.6912D-02, -.1477D-01, & + & -.2202D-01, -.2513D-01, -.2227D-01, -.1444D-01, -.4398D-02, & + & 0.5099D-02, 0.1237D-01, 0.1690D-01, 0.1899D-01, 0.1922D-01, & + & 0.1822D-01, 0.1651D-01, 0.1447D-01, 0.1237D-01, 0.1037D-01, & + & 0.8549D-02, 0.6956D-02, 0.5596D-02, 0.4459D-02, 0.3522D-02, & + & 0.2761D-02, 0.2149D-02, 0.1663D-02, 0.1280D-02, 0.9806D-03, & + & 0.7475D-03, 0.5674D-03, 0.4290D-03, 0.3232D-03, 0.2427D-03, & + & 0.1816D-03, 0.1355D-03, 0.1009D-03, 0.7488D-04, 0.5544D-04, & + & 0.4096D-04/ + + data (calcpts(j,21), j = 1,neta) /-.9777D-04, -.9765D-04, & + & -.2475D-03, -.2472D-03, -.2468D-03, -.3963D-03, -.3955D-03, & + & -.5443D-03, -.5425D-03, -.6900D-03, -.8362D-03, -.9806D-03, & + & -.1272D-02, -.1411D-02, -.1693D-02, -.2117D-02, -.2380D-02, & + & -.2924D-02, -.3443D-02, -.3924D-02, -.4649D-02, -.5293D-02, & + & -.6119D-02, -.6921D-02, -.7621D-02, -.8255D-02, -.8666D-02, & + & -.8774D-02, -.8275D-02, -.7367D-02, -.5844D-02, -.3874D-02, & + & -.1962D-02, -.1328D-02, -.2876D-02, -.7216D-02, -.1382D-01, & + & -.2019D-01, -.2324D-01, -.2102D-01, -.1410D-01, -.4830D-02, & + & 0.4201D-02, 0.1132D-01, 0.1589D-01, 0.1810D-01, 0.1848D-01, & + & 0.1764D-01, 0.1604D-01, 0.1411D-01, 0.1210D-01, 0.1017D-01, & + & 0.8402D-02, 0.6848D-02, 0.5517D-02, 0.4401D-02, 0.3480D-02, & + & 0.2730D-02, 0.2128D-02, 0.1649D-02, 0.1269D-02, 0.9725D-03, & + & 0.7418D-03, 0.5633D-03, 0.4261D-03, 0.3212D-03, 0.2412D-03, & + & 0.1805D-03, 0.1348D-03, 0.1003D-03, 0.7450D-04, 0.5519D-04, & + & 0.4077D-04/ + + data (calcpts(j,22), j = 1,neta) /-.1735D-03, -.1734D-03, & + & -.1732D-03, -.1730D-03, -.1727D-03, -.3222D-03, -.3215D-03, & + & -.4705D-03, -.4690D-03, -.6168D-03, -.7635D-03, -.9088D-03, & + & -.1052D-02, -.1192D-02, -.1476D-02, -.1754D-02, -.2022D-02, & + & -.2424D-02, -.2805D-02, -.3302D-02, -.3902D-02, -.4582D-02, & + & -.5160D-02, -.5890D-02, -.6402D-02, -.7051D-02, -.7399D-02, & + & -.7551D-02, -.7244D-02, -.6584D-02, -.5435D-02, -.3748D-02, & + & -.2404D-02, -.1634D-02, -.2806D-02, -.6324D-02, -.1186D-01, & + & -.1759D-01, -.2080D-01, -.1952D-01, -.1382D-01, -.5557D-02, & + & 0.2891D-02, 0.9818D-02, 0.1445D-01, 0.1684D-01, 0.1745D-01, & + & 0.1682D-01, 0.1542D-01, 0.1364D-01, 0.1175D-01, 0.9902D-02, & + & 0.8205D-02, 0.6703D-02, 0.5412D-02, 0.4324D-02, 0.3423D-02, & + & 0.2689D-02, 0.2099D-02, 0.1627D-02, 0.1254D-02, 0.9617D-03, & + & 0.7340D-03, 0.5578D-03, 0.4222D-03, 0.3184D-03, 0.2392D-03, & + & 0.1791D-03, 0.1338D-03, 0.9964D-04, 0.7402D-04, 0.5483D-04, & + & 0.4054D-04/ + + data (calcpts(j,23), j = 1,neta) /-.1129D-03, -.1128D-03, & + & -.1127D-03, -.1125D-03, -.1122D-03, -.2618D-03, -.2612D-03, & + & -.2604D-03, -.4091D-03, -.4073D-03, -.5546D-03, -.7007D-03, & + & -.8449D-03, -.9864D-03, -.1124D-02, -.1406D-02, -.1679D-02, & + & -.1939D-02, -.2331D-02, -.2697D-02, -.3172D-02, -.3590D-02, & + & -.4073D-02, -.4583D-02, -.5063D-02, -.5583D-02, -.5880D-02, & + & -.5942D-02, -.5700D-02, -.5019D-02, -.3989D-02, -.2646D-02, & + & -.1380D-02, -.6668D-03, -.1348D-02, -.4099D-02, -.8787D-02, & + & -.1408D-01, -.1771D-01, -.1766D-01, -.1350D-01, -.6539D-02, & + & 0.1131D-02, 0.7788D-02, 0.1250D-01, 0.1516D-01, 0.1607D-01, & + & 0.1573D-01, 0.1458D-01, 0.1301D-01, 0.1127D-01, 0.9550D-02, & + & 0.7946D-02, 0.6514D-02, 0.5274D-02, 0.4223D-02, 0.3352D-02, & + & 0.2638D-02, 0.2061D-02, 0.1599D-02, 0.1235D-02, 0.9479D-03, & + & 0.7242D-03, 0.5508D-03, 0.4171D-03, 0.3147D-03, 0.2367D-03, & + & 0.1774D-03, 0.1326D-03, 0.9877D-04, 0.7339D-04, 0.5439D-04, & + & 0.4023D-04/ + + data (calcpts(j,24), j = 1,neta) /-.6910D-04, -.6903D-04, & + & -.9893D-04, -.1138D-03, -.1286D-03, -.1583D-03, -.2028D-03, & + & -.2471D-03, -.2911D-03, -.3496D-03, -.4225D-03, -.5093D-03, & + & -.6097D-03, -.7229D-03, -.8780D-03, -.1043D-02, -.1247D-02, & + & -.1470D-02, -.1739D-02, -.2031D-02, -.2367D-02, -.2716D-02, & + & -.3103D-02, -.3481D-02, -.3821D-02, -.4103D-02, -.4266D-02, & + & -.4227D-02, -.3915D-02, -.3268D-02, -.2253D-02, -.9436D-03, & + & 0.4012D-03, 0.1290D-02, 0.1046D-02, -.9929D-03, -.4925D-02, & + & -.9856D-02, -.1397D-01, -.1528D-01, -.1294D-01, -.7601D-02, & + & -.9618D-03, 0.5278D-02, 0.1004D-01, 0.1299D-01, 0.1429D-01, & + & 0.1432D-01, 0.1350D-01, 0.1220D-01, 0.1067D-01, 0.9105D-02, & + & 0.7620D-02, 0.6276D-02, 0.5100D-02, 0.4098D-02, 0.3261D-02, & + & 0.2573D-02, 0.2015D-02, 0.1566D-02, 0.1211D-02, 0.9308D-03, & + & 0.7119D-03, 0.5422D-03, 0.4110D-03, 0.3105D-03, 0.2336D-03, & + & 0.1753D-03, 0.1310D-03, 0.9769D-04, 0.7262D-04, 0.5386D-04, & + & 0.3984D-04/ + + data (calcpts(j,25), j = 1,neta) /-.4463D-04, -.5957D-04, & + & -.7450D-04, -.8938D-04, -.1042D-03, -.1190D-03, -.1486D-03, & + & -.1781D-03, -.2073D-03, -.2512D-03, -.3095D-03, -.3671D-03, & + & -.4385D-03, -.5383D-03, -.6356D-03, -.7593D-03, -.8927D-03, & + & -.1063D-02, -.1253D-02, -.1455D-02, -.1694D-02, -.1941D-02, & + & -.2196D-02, -.2435D-02, -.2639D-02, -.2786D-02, -.2809D-02, & + & -.2651D-02, -.2252D-02, -.1543D-02, -.5098D-03, 0.8178D-03, & + & 0.2215D-02, 0.3330D-02, 0.3531D-02, 0.2191D-02, -.9599D-03, & + & -.5427D-02, -.9834D-02, -.1238D-01, -.1187D-01, -.8389D-02, & + & -.3088D-02, 0.2501D-02, 0.7192D-02, 0.1042D-01, 0.1214D-01, & + & 0.1261D-01, 0.1219D-01, 0.1120D-01, 0.9929D-02, 0.8561D-02, & + & 0.7221D-02, 0.5986D-02, 0.4890D-02, 0.3947D-02, 0.3152D-02, & + & 0.2494D-02, 0.1957D-02, 0.1526D-02, 0.1182D-02, 0.9102D-03, & + & 0.6974D-03, 0.5317D-03, 0.4036D-03, 0.3053D-03, 0.2299D-03, & + & 0.1726D-03, 0.1292D-03, 0.9638D-04, 0.7171D-04, 0.5322D-04, & + & 0.3940D-04/ + + data (calcpts(j,26), j = 1,neta) /-.2966D-04, -.2962D-04, & + & -.4456D-04, -.4447D-04, -.5935D-04, -.7417D-04, -.8890D-04, & + & -.1185D-03, -.1329D-03, -.1621D-03, -.2058D-03, -.2490D-03, & + & -.3063D-03, -.3624D-03, -.4316D-03, -.5132D-03, -.6057D-03, & + & -.7225D-03, -.8457D-03, -.9865D-03, -.1139D-02, -.1295D-02, & + & -.1441D-02, -.1591D-02, -.1687D-02, -.1708D-02, -.1632D-02, & + & -.1397D-02, -.9495D-03, -.2161D-03, 0.8048D-03, 0.2109D-02, & + & 0.3533D-02, 0.4767D-02, 0.5314D-02, 0.4615D-02, 0.2265D-02, & + & -.1537D-02, -.5856D-02, -.9181D-02, -.1023D-01, -.8583D-02, & + & -.4844D-02, -.1984D-03, 0.4188D-02, 0.7570D-02, 0.9685D-02, & + & 0.1062D-01, 0.1064D-01, 0.1003D-01, 0.9054D-02, 0.7917D-02, & + & 0.6752D-02, 0.5644D-02, 0.4644D-02, 0.3768D-02, 0.3024D-02, & + & 0.2402D-02, 0.1891D-02, 0.1479D-02, 0.1148D-02, 0.8863D-03, & + & 0.6802D-03, 0.5196D-03, 0.3951D-03, 0.2992D-03, 0.2257D-03, & + & 0.1695D-03, 0.1270D-03, 0.9488D-04, 0.7065D-04, 0.5247D-04, & + & 0.3887D-04/ + + data (calcpts(j,27), j = 1,neta) /-.3332D-04, -.3329D-04, & + & -.4825D-04, -.4819D-04, -.6309D-04, -.6296D-04, -.7777D-04, & + & -.9248D-04, -.1071D-03, -.1364D-03, -.1505D-03, -.1792D-03, & + & -.2222D-03, -.2494D-03, -.3051D-03, -.3589D-03, -.4248D-03, & + & -.4865D-03, -.5719D-03, -.6482D-03, -.7412D-03, -.8295D-03, & + & -.9192D-03, -.9822D-03, -.9994D-03, -.9586D-03, -.8365D-03, & + & -.5633D-03, -.9504D-04, 0.5896D-03, 0.1553D-02, 0.2755D-02, & + & 0.4087D-02, 0.5337D-02, 0.6085D-02, 0.5854D-02, 0.4228D-02, & + & 0.1195D-02, -.2655D-02, -.6188D-02, -.8228D-02, -.8095D-02, & + & -.5908D-02, -.2429D-02, 0.1368D-02, 0.4683D-02, 0.7072D-02, & + & 0.8434D-02, 0.8900D-02, 0.8695D-02, 0.8056D-02, 0.7179D-02, & + & 0.6213D-02, 0.5253D-02, 0.4361D-02, 0.3564D-02, 0.2877D-02, & + & 0.2297D-02, 0.1817D-02, 0.1425D-02, 0.1110D-02, 0.8591D-03, & + & 0.6609D-03, 0.5058D-03, 0.3854D-03, 0.2922D-03, 0.2208D-03, & + & 0.1661D-03, 0.1246D-03, 0.9317D-04, 0.6945D-04, 0.5163D-04, & + & 0.3828D-04/ + + data (calcpts(j,28), j = 1,neta) /-.1367D-04, -.1365D-04, & + & -.2862D-04, -.2858D-04, -.2851D-04, -.4342D-04, -.4328D-04, & + & -.5807D-04, -.7277D-04, -.7232D-04, -.1017D-03, -.1157D-03, & + & -.1293D-03, -.1572D-03, -.1842D-03, -.2248D-03, -.2633D-03, & + & -.2987D-03, -.3447D-03, -.3991D-03, -.4439D-03, -.4897D-03, & + & -.5300D-03, -.5403D-03, -.5221D-03, -.4407D-03, -.2989D-03, & + & -.2706D-04, 0.3975D-03, 0.1014D-02, 0.1850D-02, 0.2886D-02, & + & 0.4067D-02, 0.5210D-02, 0.6002D-02, 0.6036D-02, 0.4981D-02, & + & 0.2682D-02, -.5298D-03, -.3840D-02, -.6280D-02, -.7128D-02, & + & -.6212D-02, -.3917D-02, -.9303D-03, 0.2049D-02, 0.4500D-02, & + & 0.6172D-02, 0.7042D-02, 0.7241D-02, 0.6951D-02, 0.6357D-02, & + & 0.5610D-02, 0.4815D-02, 0.4043D-02, 0.3336D-02, 0.2713D-02, & + & 0.2179D-02, 0.1734D-02, 0.1365D-02, 0.1067D-02, 0.8287D-03, & + & 0.6394D-03, 0.4906D-03, 0.3745D-03, 0.2845D-03, 0.2153D-03, & + & 0.1623D-03, 0.1219D-03, 0.9126D-04, 0.6811D-04, 0.5068D-04, & + & 0.3761D-04/ + + data (calcpts(j,29), j = 1,neta) /0.8002D-06, -.1419D-04, & + & -.1416D-04, -.1413D-04, -.1409D-04, -.1402D-04, -.2892D-04, & + & -.2877D-04, -.2856D-04, -.4325D-04, -.5778D-04, -.5711D-04, & + & -.7112D-04, -.8466D-04, -.1125D-03, -.1244D-03, -.1498D-03, & + & -.1730D-03, -.1931D-03, -.2236D-03, -.2473D-03, -.2610D-03, & + & -.2753D-03, -.2534D-03, -.2158D-03, -.1335D-03, 0.2768D-04, & + & 0.2657D-03, 0.6328D-03, 0.1148D-02, 0.1843D-02, 0.2699D-02, & + & 0.3677D-02, 0.4635D-02, 0.5363D-02, 0.5530D-02, 0.4838D-02, & + & 0.3127D-02, 0.5668D-03, -.2303D-02, -.4731D-02, -.6054D-02, & + & -.5981D-02, -.4655D-02, -.2514D-02, -.7367D-04, 0.2202D-02, & + & 0.3995D-02, 0.5164D-02, 0.5717D-02, 0.5769D-02, 0.5467D-02, & + & 0.4952D-02, 0.4334D-02, 0.3695D-02, 0.3085D-02, 0.2533D-02, & + & 0.2051D-02, 0.1640D-02, 0.1300D-02, 0.1021D-02, 0.7954D-03, & + & 0.6157D-03, 0.4738D-03, 0.3626D-03, 0.2761D-03, 0.2094D-03, & + & 0.1580D-03, 0.1189D-03, 0.8917D-04, 0.6664D-04, 0.4965D-04, & + & 0.3688D-04/ + + data (calcpts(j,30), j = 1,neta) /0.2726D-05, -.1226D-04, & + & -.1225D-04, -.1223D-04, -.1219D-04, -.1215D-04, -.1208D-04, & + & -.1198D-04, -.2683D-04, -.2661D-04, -.2628D-04, -.4081D-04, & + & -.4012D-04, -.5410D-04, -.6761D-04, -.6541D-04, -.7719D-04, & + & -.1025D-03, -.1105D-03, -.1154D-03, -.1305D-03, -.1237D-03, & + & -.1217D-03, -.8993D-04, -.5168D-04, 0.3277D-04, 0.1769D-03, & + & 0.3852D-03, 0.6838D-03, 0.1107D-02, 0.1652D-02, 0.2325D-02, & + & 0.3112D-02, 0.3884D-02, 0.4477D-02, 0.4672D-02, 0.4216D-02, & + & 0.2951D-02, 0.9433D-03, -.1449D-02, -.3665D-02, -.5139D-02, & + & -.5535D-02, -.4866D-02, -.3416D-02, -.1555D-02, 0.3704D-03, & + & 0.2080D-02, 0.3384D-02, 0.4200D-02, 0.4549D-02, 0.4527D-02, & + & 0.4248D-02, 0.3816D-02, 0.3319D-02, 0.2814D-02, 0.2337D-02, & + & 0.1910D-02, 0.1540D-02, 0.1228D-02, 0.9698D-03, 0.7593D-03, & + & 0.5900D-03, 0.4556D-03, 0.3496D-03, 0.2670D-03, 0.2029D-03, & + & 0.1536D-03, 0.1157D-03, 0.8690D-04, 0.6504D-04, 0.4852D-04, & + & 0.3610D-04/ + + data (calcpts(j,31), j = 1,neta) /0.1204D-05, 0.1211D-05, & + & 0.1222D-05, 0.1237D-05, 0.1259D-05, -.1371D-04, -.1366D-04, & + & -.1359D-04, -.1349D-04, -.1333D-04, -.1311D-04, -.1278D-04, & + & -.2730D-04, -.2659D-04, -.2556D-04, -.3904D-04, -.3680D-04, & + & -.4853D-04, -.4372D-04, -.5167D-04, -.5635D-04, -.4120D-04, & + & -.3402D-04, -.1605D-05, 0.4573D-04, 0.1297D-03, 0.2447D-03, & + & 0.4041D-03, 0.6562D-03, 0.9796D-03, 0.1404D-02, 0.1920D-02, & + & 0.2519D-02, 0.3115D-02, 0.3590D-02, 0.3764D-02, 0.3443D-02, & + & 0.2495D-02, 0.9307D-03, -.1023D-02, -.2965D-02, -.4429D-02, & + & -.5075D-02, -.4820D-02, -.3847D-02, -.2457D-02, -.9175D-03, & + & 0.5657D-03, 0.1835D-02, 0.2778D-02, 0.3347D-02, 0.3567D-02, & + & 0.3512D-02, 0.3267D-02, 0.2916D-02, 0.2522D-02, 0.2127D-02, & + & 0.1761D-02, 0.1433D-02, 0.1152D-02, 0.9153D-03, 0.7205D-03, & + & 0.5625D-03, 0.4360D-03, 0.3358D-03, 0.2572D-03, 0.1960D-03, & + & 0.1486D-03, 0.1123D-03, 0.8446D-04, 0.6331D-04, 0.4732D-04, & + & 0.3525D-04/ + + data (calcpts(j,32), j = 1,neta) /-.4108D-06, -.4060D-06, & + & -.3988D-06, -.3883D-06, -.1873D-05, -.1850D-05, -.3317D-05, & + & -.3268D-05, -.4697D-05, -.6092D-05, -.7438D-05, -.8712D-05, & + & -.9880D-05, -.1089D-04, -.1318D-04, -.1513D-04, -.1659D-04, & + & -.1733D-04, -.1702D-04, -.1515D-04, -.9533D-05, 0.9116D-06, & + & 0.1771D-04, 0.4607D-04, 0.8921D-04, 0.1533D-03, 0.2492D-03, & + & 0.3834D-03, 0.5712D-03, 0.8215D-03, 0.1145D-02, 0.1540D-02, & + & 0.1985D-02, 0.2433D-02, 0.2792D-02, 0.2929D-02, 0.2695D-02, & + & 0.1979D-02, 0.7654D-03, -.8107D-03, -.2468D-02, -.3849D-02, & + & -.4632D-02, -.4666D-02, -.4031D-02, -.2965D-02, -.1732D-02, & + & -.5033D-03, 0.6184D-03, 0.1553D-02, 0.2232D-02, 0.2630D-02, & + & 0.2766D-02, 0.2698D-02, 0.2493D-02, 0.2213D-02, 0.1905D-02, & + & 0.1600D-02, 0.1319D-02, 0.1070D-02, 0.8571D-03, 0.6791D-03, & + & 0.5331D-03, 0.4152D-03, 0.3211D-03, 0.2467D-03, 0.1886D-03, & + & 0.1434D-03, 0.1086D-03, 0.8187D-04, 0.6149D-04, 0.4602D-04, & + & 0.3434D-04/ + + data (calcpts(j,33), j = 1,neta) /-.1502D-05, -.1499D-05, & + & -.1494D-05, -.2987D-05, -.2976D-05, -.2960D-05, -.2938D-05, & + & -.2904D-05, -.2855D-05, -.4283D-05, -.4177D-05, -.4021D-05, & + & -.5293D-05, -.4958D-05, -.5967D-05, -.5246D-05, -.5687D-05, & + & -.4135D-05, -.1857D-05, 0.2986D-05, 0.9379D-05, 0.1956D-04, & + & 0.3607D-04, 0.6194D-04, 0.9788D-04, 0.1516D-03, 0.2260D-03, & + & 0.3319D-03, 0.4751D-03, 0.6637D-03, 0.9059D-03, 0.1200D-02, & + & 0.1530D-02, 0.1861D-02, 0.2124D-02, 0.2225D-02, 0.2050D-02, & + & 0.1508D-02, 0.5710D-03, -.6807D-03, -.2063D-02, -.3315D-02, & + & -.4162D-02, -.4421D-02, -.4069D-02, -.3260D-02, -.2236D-02, & + & -.1198D-02, -.2422D-03, 0.5943D-03, 0.1277D-02, 0.1765D-02, & + & 0.2043D-02, 0.2126D-02, 0.2058D-02, 0.1891D-02, 0.1669D-02, & + & 0.1431D-02, 0.1198D-02, 0.9835D-03, 0.7955D-03, 0.6352D-03, & + & 0.5020D-03, 0.3931D-03, 0.3054D-03, 0.2357D-03, 0.1807D-03, & + & 0.1379D-03, 0.1047D-03, 0.7910D-04, 0.5955D-04, 0.4466D-04, & + & 0.3338D-04/ + + data (calcpts(j,34), j = 1,neta) /-.6676D-06, -.6653D-06, & + & -.6619D-06, -.6570D-06, -.6497D-06, -.6391D-06, -.6234D-06, & + & -.6005D-06, -.5668D-06, -.5174D-06, -.4448D-06, -.3383D-06, & + & -.1820D-06, 0.4757D-07, 0.3840D-06, 0.8782D-06, 0.3104D-05, & + & 0.5667D-05, 0.8728D-05, 0.1252D-04, 0.2037D-04, 0.2979D-04, & + & 0.4449D-04, 0.6552D-04, 0.9590D-04, 0.1378D-03, 0.1958D-03, & + & 0.2772D-03, 0.3849D-03, 0.5267D-03, 0.7048D-03, 0.9213D-03, & + & 0.1163D-02, 0.1404D-02, 0.1595D-02, 0.1666D-02, 0.1531D-02, & + & 0.1122D-02, 0.4051D-03, -.5752D-03, -.1702D-02, -.2792D-02, & + & -.3638D-02, -.4057D-02, -.3963D-02, -.3408D-02, -.2568D-02, & + & -.1655D-02, -.8125D-03, -.8359D-04, 0.5332D-03, 0.1029D-02, & + & 0.1379D-02, 0.1572D-02, 0.1621D-02, 0.1560D-02, 0.1425D-02, & + & 0.1253D-02, 0.1070D-02, 0.8921D-03, 0.7305D-03, 0.5890D-03, & + & 0.4691D-03, 0.3697D-03, 0.2889D-03, 0.2240D-03, 0.1725D-03, & + & 0.1320D-03, 0.1005D-03, 0.7618D-04, 0.5748D-04, 0.4321D-04, & + & 0.3237D-04/ + + data (calcpts(j,35), j = 1,neta) /0.5347D-06, 0.5363D-06, & + & 0.5386D-06, 0.5419D-06, 0.5469D-06, 0.5542D-06, 0.5649D-06, & + & 0.5806D-06, 0.6036D-06, 0.6374D-06, 0.2187D-05, 0.2260D-05, & + & 0.2367D-05, 0.2524D-05, 0.4254D-05, 0.4592D-05, 0.6588D-05, & + & 0.8816D-05, 0.1288D-04, 0.1745D-04, 0.2274D-04, 0.3211D-04, & + & 0.4453D-04, 0.6073D-04, 0.8475D-04, 0.1181D-03, 0.1628D-03, & + & 0.2234D-03, 0.3054D-03, 0.4095D-03, 0.5410D-03, 0.6985D-03, & + & 0.8741D-03, 0.1048D-02, 0.1186D-02, 0.1233D-02, 0.1131D-02, & + & 0.8216D-03, 0.2791D-03, -.4777D-03, -.1375D-02, -.2291D-02, & + & -.3077D-02, -.3580D-02, -.3695D-02, -.3395D-02, -.2766D-02, & + & -.1979D-02, -.1205D-02, -.5397D-03, 0.7416D-05, 0.4582D-03, & + & 0.8161D-03, 0.1067D-02, 0.1201D-02, 0.1229D-02, 0.1175D-02, & + & 0.1069D-02, 0.9362D-03, 0.7963D-03, 0.6621D-03, 0.5404D-03, & + & 0.4347D-03, 0.3453D-03, 0.2716D-03, 0.2118D-03, 0.1638D-03, & + & 0.1259D-03, 0.9621D-04, 0.7313D-04, 0.5534D-04, 0.4170D-04, & + & 0.3129D-04/ + + data (calcpts(j,36), j = 1,neta) /-.1272D-06, -.1261D-06, & + & -.1245D-06, -.1222D-06, -.1188D-06, -.1139D-06, 0.1393D-05, & + & 0.1404D-05, 0.1420D-05, 0.1443D-05, 0.1477D-05, 0.1527D-05, & + & 0.3100D-05, 0.3207D-05, 0.4864D-05, 0.5095D-05, 0.6934D-05, & + & 0.8931D-05, 0.1266D-04, 0.1673D-04, 0.2130D-04, 0.2960D-04, & + & 0.3896D-04, 0.5288D-04, 0.7206D-04, 0.9603D-04, 0.1307D-03, & + & 0.1766D-03, 0.2366D-03, 0.3126D-03, 0.4092D-03, 0.5243D-03, & + & 0.6506D-03, 0.7755D-03, 0.8721D-03, 0.9047D-03, 0.8264D-03, & + & 0.5968D-03, 0.1887D-03, -.3877D-03, -.1088D-02, -.1834D-02, & + & -.2521D-02, -.3038D-02, -.3286D-02, -.3207D-02, -.2811D-02, & + & -.2193D-02, -.1499D-02, -.8651D-03, -.3506D-03, 0.5516D-04, & + & 0.3822D-03, 0.6395D-03, 0.8182D-03, 0.9113D-03, 0.9262D-03, & + & 0.8813D-03, 0.7983D-03, 0.6966D-03, 0.5905D-03, 0.4894D-03, & + & 0.3984D-03, 0.3197D-03, 0.2535D-03, 0.1989D-03, 0.1548D-03, & + & 0.1195D-03, 0.9167D-04, 0.6994D-04, 0.5308D-04, 0.4011D-04, & + & 0.3018D-04/ + + data (calcpts(j,37), j = 1,neta) /-.3661D-07, -.3588D-07, & + & -.3480D-07, -.3323D-07, -.3091D-07, -.2751D-07, 0.1477D-05, & + & 0.1485D-05, 0.1496D-05, 0.1511D-05, 0.1534D-05, 0.1568D-05, & + & 0.3118D-05, 0.3191D-05, 0.4799D-05, 0.4956D-05, 0.6688D-05, & + & 0.8527D-05, 0.1202D-04, 0.1426D-04, 0.1982D-04, 0.2589D-04, & + & 0.3269D-04, 0.4355D-04, 0.5745D-04, 0.7660D-04, 0.1035D-03, & + & 0.1364D-03, 0.1804D-03, 0.2378D-03, 0.3072D-03, 0.3892D-03, & + & 0.4797D-03, 0.5693D-03, 0.6385D-03, 0.6609D-03, 0.6013D-03, & + & 0.4300D-03, 0.1266D-03, -.3072D-03, -.8445D-03, -.1435D-02, & + & -.2010D-02, -.2491D-02, -.2801D-02, -.2875D-02, -.2689D-02, & + & -.2270D-02, -.1706D-02, -.1120D-02, -.6135D-03, -.2218D-03, & + & 0.7605D-04, 0.3118D-03, 0.4963D-03, 0.6232D-03, 0.6876D-03, & + & 0.6946D-03, 0.6579D-03, 0.5936D-03, 0.5163D-03, 0.4364D-03, & + & 0.3607D-03, 0.2929D-03, 0.2344D-03, 0.1855D-03, 0.1452D-03, & + & 0.1128D-03, 0.8695D-04, 0.6660D-04, 0.5073D-04, 0.3844D-04, & + & 0.2901D-04/ + + data (calcpts(j,38), j = 1,neta) /0.4340D-06, 0.4345D-06, & + & 0.4352D-06, 0.5863D-06, 0.5879D-06, 0.7402D-06, 0.8936D-06, & + & 0.1049D-05, 0.1206D-05, 0.1517D-05, 0.1832D-05, 0.2156D-05, & + & 0.2640D-05, 0.3290D-05, 0.4113D-05, 0.5120D-05, 0.6328D-05, & + & 0.7909D-05, 0.1005D-04, 0.1265D-04, 0.1623D-04, 0.2090D-04, & + & 0.2711D-04, 0.3525D-04, 0.4610D-04, 0.6057D-04, 0.7963D-04, & + & 0.1045D-03, 0.1369D-03, 0.1778D-03, 0.2282D-03, 0.2876D-03, & + & 0.3529D-03, 0.4165D-03, 0.4653D-03, 0.4797D-03, 0.4353D-03, & + & 0.3089D-03, 0.8466D-04, -.2385D-03, -.6450D-03, -.1103D-02, & + & -.1567D-02, -.1985D-02, -.2300D-02, -.2460D-02, -.2429D-02, & + & -.2195D-02, -.1796D-02, -.1306D-02, -.8268D-03, -.4301D-03, & + & -.1358D-03, 0.8103D-04, 0.2500D-03, 0.3818D-03, 0.4719D-03, & + & 0.5163D-03, 0.5186D-03, 0.4891D-03, 0.4398D-03, 0.3814D-03, & + & 0.3214D-03, 0.2650D-03, 0.2148D-03, 0.1714D-03, 0.1354D-03, & + & 0.1058D-03, 0.8203D-04, 0.6313D-04, 0.4828D-04, 0.3672D-04, & + & 0.2779D-04/ + + data (calcpts(j,39), j = 1,neta) /0.5623D-07, 0.5657D-07, & + & 0.2071D-06, 0.2078D-06, 0.3589D-06, 0.3605D-06, 0.5128D-06, & + & 0.6662D-06, 0.8212D-06, 0.9785D-06, 0.1289D-05, 0.1605D-05, & + & 0.2078D-05, 0.2562D-05, 0.3212D-05, 0.4036D-05, 0.5043D-05, & + & 0.6251D-05, 0.7983D-05, 0.1012D-04, 0.1287D-04, 0.1645D-04, & + & 0.2127D-04, 0.2748D-04, 0.3561D-04, 0.4644D-04, 0.6040D-04, & + & 0.7877D-04, 0.1022D-03, 0.1320D-03, 0.1684D-03, 0.2110D-03, & + & 0.2576D-03, 0.3029D-03, 0.3373D-03, 0.3468D-03, 0.3138D-03, & + & 0.2211D-03, 0.5647D-04, -.1822D-03, -.4860D-03, -.8348D-03, & + & -.1199D-02, -.1545D-02, -.1832D-02, -.2025D-02, -.2087D-02, & + & -.1997D-02, -.1755D-02, -.1398D-02, -.9886D-03, -.6044D-03, & + & -.2986D-03, -.7958D-04, 0.7717D-04, 0.1978D-03, 0.2916D-03, & + & 0.3554D-03, 0.3859D-03, 0.3857D-03, 0.3623D-03, 0.3247D-03, & + & 0.2808D-03, 0.2361D-03, 0.1942D-03, 0.1570D-03, 0.1251D-03, & + & 0.9858D-04, 0.7692D-04, 0.5953D-04, 0.4575D-04, 0.3493D-04, & + & 0.2653D-04/ + + data (calcpts(j,40), j = 1,neta) /0.5510D-07, 0.2053D-06, & + & 0.2057D-06, 0.2062D-06, 0.3569D-06, 0.3580D-06, 0.5096D-06, & + & 0.6619D-06, 0.8153D-06, 0.9703D-06, 0.1128D-05, 0.1438D-05, & + & 0.1754D-05, 0.2227D-05, 0.2711D-05, 0.3361D-05, 0.4185D-05, & + & 0.5192D-05, 0.6400D-05, 0.8132D-05, 0.1027D-04, 0.1302D-04, & + & 0.1660D-04, 0.2126D-04, 0.2732D-04, 0.3528D-04, 0.4562D-04, & + & 0.5906D-04, 0.7606D-04, 0.9755D-04, 0.1236D-03, 0.1542D-03, & + & 0.1874D-03, 0.2196D-03, 0.2437D-03, 0.2500D-03, 0.2255D-03, & + & 0.1579D-03, 0.3784D-04, -.1373D-03, -.3623D-03, -.6244D-03, & + & -.9049D-03, -.1181D-02, -.1427D-02, -.1616D-02, -.1722D-02, & + & -.1723D-02, -.1607D-02, -.1381D-02, -.1074D-02, -.7406D-03, & + & -.4383D-03, -.2052D-03, -.4368D-04, 0.6896D-04, 0.1547D-03, & + & 0.2212D-03, 0.2663D-03, 0.2872D-03, 0.2859D-03, 0.2676D-03, & + & 0.2391D-03, 0.2061D-03, 0.1729D-03, 0.1419D-03, 0.1145D-03, & + & 0.9106D-04, 0.7162D-04, 0.5580D-04, 0.4311D-04, 0.3307D-04, & + & 0.2523D-04/ + + data (calcpts(j,41), j = 1,neta) /0.1538D-06, 0.1540D-06, & + & 0.1542D-06, 0.3046D-06, 0.3051D-06, 0.4558D-06, 0.4569D-06, & + & 0.6085D-06, 0.6108D-06, 0.7642D-06, 0.9192D-06, 0.1227D-05, & + & 0.1387D-05, 0.1853D-05, 0.2176D-05, 0.2660D-05, 0.3310D-05, & + & 0.4134D-05, 0.5141D-05, 0.6349D-05, 0.8080D-05, 0.1007D-04, & + & 0.1282D-04, 0.1624D-04, 0.2075D-04, 0.2664D-04, 0.3413D-04, & + & 0.4397D-04, 0.5625D-04, 0.7167D-04, 0.9044D-04, 0.1121D-03, & + & 0.1358D-03, 0.1586D-03, 0.1756D-03, 0.1796D-03, 0.1617D-03, & + & 0.1126D-03, 0.2545D-04, -.1023D-03, -.2677D-03, -.4625D-03, & + & -.6750D-03, -.8898D-03, -.1090D-02, -.1259D-02, -.1376D-02, & + & -.1426D-02, -.1393D-02, -.1273D-02, -.1072D-02, -.8171D-03, & + & -.5502D-03, -.3156D-03, -.1398D-03, -.2141D-04, 0.5911D-04, & + & 0.1198D-03, 0.1670D-03, 0.1987D-03, 0.2130D-03, 0.2110D-03, & + & 0.1969D-03, 0.1755D-03, 0.1509D-03, 0.1263D-03, 0.1034D-03, & + & 0.8329D-04, 0.6615D-04, 0.5193D-04, 0.4039D-04, 0.3117D-04, & + & 0.2388D-04/ + + data (calcpts(j,42), j = 1,neta) /0.1268D-06, 0.1269D-06, & + & 0.1271D-06, 0.1273D-06, 0.2777D-06, 0.2782D-06, 0.2789D-06, & + & 0.4300D-06, 0.5816D-06, 0.5839D-06, 0.7373D-06, 0.8923D-06, & + & 0.1050D-05, 0.1360D-05, 0.1676D-05, 0.1999D-05, 0.2484D-05, & + & 0.3133D-05, 0.3957D-05, 0.4814D-05, 0.6172D-05, 0.7603D-05, & + & 0.9741D-05, 0.1219D-04, 0.1561D-04, 0.1981D-04, 0.2539D-04, & + & 0.3239D-04, 0.4125D-04, 0.5232D-04, 0.6577D-04, 0.8122D-04, & + & 0.9796D-04, 0.1141D-03, 0.1261D-03, 0.1287D-03, 0.1156D-03, & + & 0.8019D-04, 0.1712D-04, -.7555D-04, -.1962D-03, -.3400D-03, & + & -.4988D-03, -.6630D-03, -.8216D-03, -.9624D-03, -.1073D-02, & + & -.1142D-02, -.1157D-02, -.1108D-02, -.9944D-03, -.8232D-03, & + & -.6161D-03, -.4059D-03, -.2258D-03, -.9430D-04, -.8106D-05, & + & 0.4920D-04, 0.9207D-04, 0.1254D-03, 0.1477D-03, 0.1575D-03, & + & 0.1554D-03, 0.1445D-03, 0.1285D-03, 0.1102D-03, 0.9204D-04, & + & 0.7524D-04, 0.6046D-04, 0.4794D-04, 0.3757D-04, 0.2919D-04, & + & 0.2248D-04/ + + data (calcpts(j,43), j = 1,neta) /0.3333D-07, 0.3340D-07, & + & 0.1835D-06, 0.1837D-06, 0.1839D-06, 0.1842D-06, 0.3347D-06, & + & 0.3355D-06, 0.3366D-06, 0.4881D-06, 0.6405D-06, 0.6439D-06, & + & 0.7989D-06, 0.1106D-05, 0.1267D-05, 0.1583D-05, 0.1906D-05, & + & 0.2390D-05, 0.3040D-05, 0.3713D-05, 0.4571D-05, 0.5778D-05, & + & 0.7209D-05, 0.9196D-05, 0.1164D-04, 0.1475D-04, 0.1864D-04, & + & 0.2375D-04, 0.3010D-04, 0.3810D-04, 0.4761D-04, 0.5868D-04, & + & 0.7061D-04, 0.8200D-04, 0.9031D-04, 0.9201D-04, 0.8259D-04, & + & 0.5698D-04, 0.1157D-04, -.5540D-04, -.1431D-03, -.2484D-03, & + & -.3660D-03, -.4896D-03, -.6121D-03, -.7254D-03, -.8216D-03, & + & -.8921D-03, -.9283D-03, -.9227D-03, -.8695D-03, -.7683D-03, & + & -.6264D-03, -.4612D-03, -.2978D-03, -.1608D-03, -.6301D-04, & + & -.5616D-06, 0.4006D-04, 0.7022D-04, 0.9372D-04, 0.1094D-03, & + & 0.1160D-03, 0.1141D-03, 0.1058D-03, 0.9379D-04, 0.8031D-04, & + & 0.6693D-04, 0.5461D-04, 0.4381D-04, 0.3468D-04, 0.2715D-04, & + & 0.2104D-04/ + + data (calcpts(j,44), j = 1,neta) /0.8178D-07, 0.9683D-07, & + & 0.1119D-06, 0.1270D-06, 0.1572D-06, 0.1724D-06, 0.2177D-06, & + & 0.2632D-06, 0.3090D-06, 0.3701D-06, 0.4466D-06, 0.5540D-06, & + & 0.6624D-06, 0.8174D-06, 0.9897D-06, 0.1210D-05, 0.1481D-05, & + & 0.1835D-05, 0.2259D-05, 0.2788D-05, 0.3462D-05, 0.4319D-05, & + & 0.5406D-05, 0.6791D-05, 0.8566D-05, 0.1082D-04, 0.1369D-04, & + & 0.1736D-04, 0.2194D-04, 0.2760D-04, 0.3441D-04, 0.4223D-04, & + & 0.5065D-04, 0.5868D-04, 0.6457D-04, 0.6569D-04, 0.5879D-04, & + & 0.4045D-04, 0.7843D-05, -.4037D-04, -.1038D-03, -.1805D-03, & + & -.2670D-03, -.3590D-03, -.4519D-03, -.5404D-03, -.6195D-03, & + & -.6833D-03, -.7262D-03, -.7420D-03, -.7260D-03, -.6746D-03, & + & -.5881D-03, -.4730D-03, -.3430D-03, -.2173D-03, -.1139D-03, & + & -.4169D-04, 0.3367D-05, 0.3205D-04, 0.5322D-04, 0.6976D-04, & + & 0.8076D-04, 0.8520D-04, 0.8352D-04, 0.7725D-04, 0.6834D-04, & + & 0.5838D-04, 0.4857D-04, 0.3955D-04, 0.3168D-04, 0.2505D-04, & + & 0.1957D-04/ + + data (calcpts(j,45), j = 1,neta) /0.3399D-07, 0.4903D-07, & + & 0.4908D-07, 0.6415D-07, 0.9426D-07, 0.1094D-06, 0.1396D-06, & + & 0.1700D-06, 0.2155D-06, 0.2612D-06, 0.3223D-06, 0.3839D-06, & + & 0.4762D-06, 0.5846D-06, 0.7246D-06, 0.8820D-06, 0.1088D-05, & + & 0.1344D-05, 0.1652D-05, 0.2046D-05, 0.2546D-05, 0.3174D-05, & + & 0.3971D-05, 0.4982D-05, 0.6261D-05, 0.7899D-05, 0.9971D-05, & + & 0.1259D-04, 0.1587D-04, 0.1989D-04, 0.2474D-04, 0.3029D-04, & + & 0.3624D-04, 0.4189D-04, 0.4602D-04, 0.4677D-04, 0.4180D-04, & + & 0.2866D-04, 0.5308D-05, -.2928D-04, -.7499D-04, -.1305D-03, & + & -.1937D-03, -.2616D-03, -.3313D-03, -.3991D-03, -.4619D-03, & + & -.5157D-03, -.5569D-03, -.5813D-03, -.5850D-03, -.5648D-03, & + & -.5184D-03, -.4467D-03, -.3548D-03, -.2537D-03, -.1578D-03, & + & -.8039D-04, -.2727D-04, 0.5103D-05, 0.2530D-04, 0.4012D-04, & + & 0.5173D-04, 0.5943D-04, 0.6243D-04, 0.6099D-04, 0.5628D-04, & + & 0.4968D-04, 0.4236D-04, 0.3517D-04, 0.2860D-04, 0.2287D-04, & + & 0.1806D-04/ + + data (calcpts(j,46), j = 1,neta) /0.2403D-07, 0.3905D-07, & + & 0.5409D-07, 0.5414D-07, 0.6921D-07, 0.8432D-07, 0.1145D-06, & + & 0.1297D-06, 0.1601D-06, 0.1906D-06, 0.2363D-06, 0.2974D-06, & + & 0.3589D-06, 0.4363D-06, 0.5447D-06, 0.6547D-06, 0.8120D-06, & + & 0.1003D-05, 0.1229D-05, 0.1522D-05, 0.1886D-05, 0.2341D-05, & + & 0.2923D-05, 0.3645D-05, 0.4581D-05, 0.5753D-05, 0.7236D-05, & + & 0.9121D-05, 0.1145D-04, 0.1432D-04, 0.1775D-04, 0.2168D-04, & + & 0.2590D-04, 0.2987D-04, 0.3277D-04, 0.3325D-04, 0.2967D-04, & + & 0.2028D-04, 0.3616D-05, -.2114D-04, -.5397D-04, -.9405D-04, & + & -.1399D-03, -.1898D-03, -.2413D-03, -.2927D-03, -.3412D-03, & + & -.3847D-03, -.4206D-03, -.4463D-03, -.4591D-03, -.4560D-03, & + & -.4351D-03, -.3952D-03, -.3368D-03, -.2646D-03, -.1869D-03, & + & -.1142D-03, -.5652D-04, -.1763D-04, 0.5553D-05, 0.1974D-04, & + & 0.3009D-04, 0.3822D-04, 0.4360D-04, 0.4561D-04, 0.4443D-04, & + & 0.4090D-04, 0.3603D-04, 0.3067D-04, 0.2542D-04, 0.2064D-04, & + & 0.1816D-04/ + + data (calcpts(j,47), j = 1,neta) /0.3417D-07, 0.3418D-07, & + & 0.3421D-07, 0.4924D-07, 0.6429D-07, 0.6436D-07, 0.7947D-07, & + & 0.1096D-06, 0.1249D-06, 0.1552D-06, 0.1857D-06, 0.2314D-06, & + & 0.2775D-06, 0.3391D-06, 0.4014D-06, 0.4948D-06, 0.6048D-06, & + & 0.7472D-06, 0.9079D-06, 0.1119D-05, 0.1382D-05, 0.1716D-05, & + & 0.2140D-05, 0.2663D-05, 0.3339D-05, 0.4184D-05, 0.5248D-05, & + & 0.6591D-05, 0.8255D-05, 0.1029D-04, 0.1273D-04, 0.1550D-04, & + & 0.1847D-04, 0.2126D-04, 0.2327D-04, 0.2360D-04, 0.2103D-04, & + & 0.1434D-04, 0.2465D-05, -.1521D-04, -.3871D-04, -.6754D-04, & + & -.1007D-03, -.1370D-03, -.1751D-03, -.2133D-03, -.2503D-03, & + & -.2844D-03, -.3140D-03, -.3374D-03, -.3528D-03, -.3583D-03, & + & -.3521D-03, -.3326D-03, -.2990D-03, -.2525D-03, -.1964D-03, & + & -.1370D-03, -.8239D-04, -.3957D-04, -.1122D-04, 0.5333D-05, & + & 0.1525D-04, 0.2350D-04, 0.2827D-04, 0.3192D-04, 0.3325D-04, & + & 0.3231D-04, 0.3967D-04, 0.2610D-04, 0.2217D-04, 0.2139D-04, & + & 0.1488D-04/ + + data (calcpts(j,48), j = 1,neta) /0.1551D-07, 0.3052D-07, & + & 0.3053D-07, 0.3056D-07, 0.4559D-07, 0.4564D-07, 0.6072D-07, & + & 0.7582D-07, 0.9098D-07, 0.1062D-06, 0.1366D-06, 0.1671D-06, & + & 0.1978D-06, 0.2439D-06, 0.2904D-06, 0.3678D-06, 0.4462D-06, & + & 0.5412D-06, 0.6685D-06, 0.8143D-06, 0.1010D-05, 0.1258D-05, & + & 0.1547D-05, 0.1926D-05, 0.2419D-05, 0.3019D-05, 0.3787D-05, & + & 0.4727D-05, 0.5913D-05, 0.7366D-05, 0.9086D-05, 0.1104D-04, & + & 0.1313D-04, 0.1509D-04, 0.1650D-04, 0.1671D-04, 0.1489D-04, & + & 0.1013D-04, 0.1680D-05, -.1091D-04, -.2770D-04, -.4837D-04, & + & -.7228D-04, -.9860D-04, -.1264D-03, -.1548D-03, -.1824D-03, & + & -.2087D-03, -.2323D-03, -.2522D-03, -.2670D-03, -.2758D-03, & + & -.2771D-03, -.2696D-03, -.2523D-03, -.2250D-03, -.1884D-03, & + & -.1451D-03, -.1001D-03, -.5924D-04, -.2765D-04, -.7038D-05, & + & 0.4754D-05, 0.1169D-04, 0.1671D-04, 0.2068D-04, 0.2329D-04, & + & 0.2419D-04, 0.2344D-04, 0.2149D-04, 0.1885D-04, 0.1600D-04, & + & 0.1322D-04/ + + data (calcpts(j,49), j = 1,neta) /0.1268D-07, 0.1269D-07, & + & 0.2770D-07, 0.2771D-07, 0.2774D-07, 0.4277D-07, 0.4282D-07, & + & 0.5790D-07, 0.7300D-07, 0.7316D-07, 0.1034D-06, 0.1187D-06, & + & 0.1492D-06, 0.1800D-06, 0.2110D-06, 0.2576D-06, 0.3200D-06, & + & 0.3984D-06, 0.4784D-06, 0.5907D-06, 0.7364D-06, 0.9022D-06, & + & 0.1120D-05, 0.1394D-05, 0.1743D-05, 0.2175D-05, 0.2714D-05, & + & 0.3389D-05, 0.4234D-05, 0.5260D-05, 0.6466D-05, 0.7858D-05, & + & 0.9321D-05, 0.1070D-04, 0.1170D-04, 0.1182D-04, 0.1052D-04, & + & 0.7142D-05, 0.1146D-05, -.7803D-05, -.1976D-04, -.3455D-04, & + & -.5172D-04, -.7074D-04, -.9095D-04, -.1117D-03, -.1324D-03, & + & -.1522D-03, -.1706D-03, -.1866D-03, -.1996D-03, -.2088D-03, & + & -.2135D-03, -.2124D-03, -.2049D-03, -.1902D-03, -.1683D-03, & + & -.1398D-03, -.1068D-03, -.7290D-04, -.4251D-04, -.1928D-04, & + & -.4354D-05, 0.4011D-05, 0.8844D-05, 0.1234D-04, 0.1510D-04, & + & 0.1693D-04, 0.1753D-04, 0.1695D-04, 0.1551D-04, 0.1360D-04, & + & 0.1152D-04/ + + data (dlaeta(j), j = 1,neta) / & + & -6d0, -5.83333333d0, -5.66666667d0, -5.5d0, -5.33333333d0, & + & -5.16666667d0, -5d0, -4.83333333d0, -4.66666667d0, -4.5d0, & + & -4.33333333d0, -4.16666667d0, -4d0, -3.83333333d0, & + & -3.66666667d0, -3.5d0, -3.33333333d0, -3.16666667d0, -3d0, & + & -2.83333333d0, -2.66666667d0, -2.5d0, -2.33333333d0, & + & -2.16666667d0, -2d0, -1.83333333d0, -1.66666667d0, -1.5d0, & + & -1.33333333d0, -1.16666667d0, -1d0, -0.83333333d0, -0.66666667d0,& + & -0.5d0, -0.33333333d0, -0.16666667d0, 0d0, 0.16666667d0, & + & 0.33333333d0, 0.5d0, 0.66666667d0, 0.83333333d0, 1d0, & + & 1.16666667d0, 1.33333333d0, 1.5d0, 1.66666667d0, 1.83333333d0, & + & 2d0, 2.16666667d0, 2.33333333d0, 2.5d0, 2.66666667d0, & + & 2.83333333d0, 3d0, 3.16666667d0, 3.33333333d0, 3.5d0, & + & 3.66666667d0, 3.83333333d0, 4d0, 4.16666667d0, 4.33333333d0, & + & 4.5d0, 4.66666667d0, 4.83333333d0, 5d0, 5.16666667d0, & + & 5.33333333d0, 5.5d0, 5.66666667d0, 5.83333333d0, 6d0/ + + data (dlaxi(j), j = 1,nxi) / & + & -3d0, -2.83333333d0, -2.66666667d0, -2.5d0, -2.33333333d0, & + & -2.16666667d0, -2d0, -1.83333333d0, -1.66666667d0, -1.5d0, & + & -1.33333333d0, -1.16666667d0, -1d0, -0.83333333d0, -0.66666667d0,& + & -0.5d0, -0.33333333d0, -0.16666667d0, 0d0, 0.16666667d0, & + & 0.33333333d0, 0.5d0, 0.66666667d0, 0.83333333d0, 1d0, & + & 1.16666667d0, 1.33333333d0, 1.5d0, 1.66666667d0, 1.83333333d0, & + & 2d0, 2.16666667d0, 2.33333333d0, 2.5d0, 2.66666667d0, & + & 2.83333333d0, 3d0, 3.16666667d0, 3.33333333d0, 3.5d0, & + & 3.66666667d0, 3.83333333d0, 4d0, 4.16666667d0, 4.33333333d0, & + & 4.5d0, 4.66666667d0, 4.83333333d0, 5d0/ + + dleta = dlog10(eta) + dlxi = dlog10(xi) + if (dlxi .le. dlaxi(1)) dlxi = dlaxi(1) + if (dlxi .ge. dlaxi(nxi)) dlxi = dlaxi(nxi) + if (dleta .ge. dlaeta(neta)) dleta = dlaeta(neta) + if (dleta .le. dlaeta(1)) dleta = dlaeta(1) + call locate(dlaeta,neta, dleta, ieta) + call locate(dlaxi, nxi, dlxi, ixi) +! interpolating between the appropriate points + delxi = 1d0/6d0 + deleta = 1d0/6d0 +! lagrange 3-pt. + if (ixi .le. 2) ixi = 2 + if (ixi .ge. 48) ixi = 48 + if (ieta .le. 2) ieta = 2 + if (ieta .ge. 72) ieta = 72 + pxi = (dlxi - dlaxi(ixi))/delxi + f(-1) = pxi*(pxi-1d0)/2d0*calcpts(ieta-1,ixi-1) + & + & (1d0 - pxi**2)*calcpts(ieta-1,ixi) + & + & pxi*(pxi+1d0)/2d0*calcpts(ieta-1,ixi+1) + f(0) = pxi*(pxi-1d0)/2d0*calcpts(ieta,ixi-1) + & + & (1d0 - pxi**2)*calcpts(ieta,ixi) + & + & pxi*(pxi+1d0)/2d0*calcpts(ieta,ixi+1) + f(1) = pxi*(pxi-1d0)/2d0*calcpts(ieta+1,ixi-1) + & + & (1d0 - pxi**2)*calcpts(ieta+1,ixi) + & + & pxi*(pxi+1d0)/2d0*calcpts(ieta+1,ixi+1) + peta = (dleta - dlaeta(ieta))/deleta + h1_FTg = peta*(peta-1d0)/2d0*f(-1) + & + & (1d0 - peta**2)*f(0) + & + & peta*(peta+1d0)/2d0*f(1) +!MB + + peta*(peta+1d0)/2d0*f(1) + return + END + +! ========================================== + double precision function h1bar_Tg(eta,xi) +! ========================================== + +! eq (12) in PLB347 (1995) 143 - 151 for the transverse piece +! MSbar scheme +! This routine is called subctbar in the original code. +! Called sctbar in updated code (03/06/96). + + implicit none + integer neta, nxi + parameter (neta = 73, nxi = 49) + double precision calcpts(neta, nxi), dlaeta(neta), dlaxi(nxi) + double precision eta, xi, dleta, dlxi + double precision pxi, peta, f(-1:1), delxi, deleta + integer j, ieta, ixi + + data (calcpts(j, 1), j = 1,neta) /0.2829D-03, 0.3429D-03, & + & 0.4153D-03, 0.5032D-03, 0.6093D-03, 0.7385D-03, 0.8944D-03, & + & 0.1084D-02, 0.1313D-02, 0.1591D-02, 0.1928D-02, 0.2339D-02, & + & 0.2827D-02, 0.3429D-02, 0.4159D-02, 0.5038D-02, 0.6106D-02, & + & 0.7404D-02, 0.8979D-02, 0.1089D-01, 0.1322D-01, 0.1605D-01, & + & 0.1950D-01, 0.2372D-01, 0.2888D-01, 0.3520D-01, 0.4295D-01, & + & 0.5243D-01, 0.6398D-01, 0.7789D-01, 0.9419D-01, 0.1127D+00, & + & 0.1321D+00, 0.1504D+00, 0.1646D+00, 0.1713D+00, 0.1691D+00, & + & 0.1584D+00, 0.1416D+00, 0.1221D+00, 0.1025D+00, 0.8429D-01, & + & 0.6827D-01, 0.5456D-01, 0.4314D-01, 0.3383D-01, 0.2625D-01, & + & 0.2023D-01, 0.1549D-01, 0.1175D-01, 0.8913D-02, 0.6710D-02, & + & 0.4996D-02, 0.3763D-02, 0.2807D-02, 0.2058D-02, 0.1515D-02, & + & 0.1108D-02, 0.8360D-03, 0.6327D-03, 0.4304D-03, 0.2955D-03, & + & 0.2278D-03, 0.1604D-03, 0.9327D-04, 0.9293D-04, 0.9271D-04, & + & 0.2589D-04, 0.2578D-04, 0.2571D-04, 0.2566D-04, 0.2563D-04, & + & 0.2561D-04/ + + data (calcpts(j, 2), j = 1,neta) /0.2830D-03, 0.3423D-03, & + & 0.4154D-03, 0.5027D-03, 0.6095D-03, 0.7380D-03, 0.8946D-03, & + & 0.1083D-02, 0.1313D-02, 0.1591D-02, 0.1928D-02, 0.2333D-02, & + & 0.2828D-02, 0.3430D-02, 0.4153D-02, 0.5039D-02, 0.6107D-02, & + & 0.7399D-02, 0.8973D-02, 0.1089D-01, 0.1321D-01, 0.1604D-01, & + & 0.1950D-01, 0.2371D-01, 0.2888D-01, 0.3519D-01, 0.4294D-01, & + & 0.5242D-01, 0.6398D-01, 0.7789D-01, 0.9419D-01, 0.1127D+00, & + & 0.1321D+00, 0.1504D+00, 0.1645D+00, 0.1713D+00, 0.1691D+00, & + & 0.1584D+00, 0.1416D+00, 0.1221D+00, 0.1025D+00, 0.8429D-01, & + & 0.6827D-01, 0.5462D-01, 0.4320D-01, 0.3382D-01, 0.2623D-01, & + & 0.2021D-01, 0.1548D-01, 0.1173D-01, 0.8899D-02, 0.6697D-02, & + & 0.5049D-02, 0.3750D-02, 0.2794D-02, 0.2045D-02, 0.1501D-02, & + & 0.1094D-02, 0.8227D-03, 0.6194D-03, 0.4172D-03, 0.3490D-03, & + & 0.2146D-03, 0.1472D-03, 0.1467D-03, 0.7970D-04, 0.7948D-04, & + & 0.7932D-04, 0.1255D-04, 0.1248D-04, 0.1243D-04, 0.1240D-04, & + & 0.1237D-04/ + + data (calcpts(j, 3), j = 1,neta) /0.2825D-03, 0.3425D-03, & + & 0.4150D-03, 0.5030D-03, 0.6091D-03, 0.7384D-03, 0.8943D-03, & + & 0.1084D-02, 0.1313D-02, 0.1591D-02, 0.1927D-02, 0.2333D-02, & + & 0.2829D-02, 0.3431D-02, 0.4154D-02, 0.5033D-02, 0.6102D-02, & + & 0.7400D-02, 0.8975D-02, 0.1088D-01, 0.1322D-01, 0.1605D-01, & + & 0.1950D-01, 0.2372D-01, 0.2887D-01, 0.3519D-01, 0.4294D-01, & + & 0.5242D-01, 0.6397D-01, 0.7783D-01, 0.9418D-01, 0.1127D+00, & + & 0.1321D+00, 0.1503D+00, 0.1645D+00, 0.1713D+00, 0.1691D+00, & + & 0.1583D+00, 0.1416D+00, 0.1221D+00, 0.1025D+00, 0.8428D-01, & + & 0.6826D-01, 0.5460D-01, 0.4318D-01, 0.3380D-01, 0.2621D-01, & + & 0.2019D-01, 0.1546D-01, 0.1178D-01, 0.8880D-02, 0.6677D-02, & + & 0.5030D-02, 0.3730D-02, 0.2774D-02, 0.2092D-02, 0.1549D-02, & + & 0.1142D-02, 0.8033D-03, 0.6000D-03, 0.4644D-03, 0.3296D-03, & + & 0.2618D-03, 0.1945D-03, 0.1273D-03, 0.6031D-04, 0.6008D-04, & + & 0.5993D-04, 0.5982D-04, -.6914D-05, -.6963D-05, -.6996D-05, & + & -.7019D-05/ + + data (calcpts(j, 4), j = 1,neta) /0.2827D-03, 0.3428D-03, & + & 0.4153D-03, 0.5027D-03, 0.6089D-03, 0.7382D-03, 0.8942D-03, & + & 0.1083D-02, 0.1313D-02, 0.1591D-02, 0.1927D-02, 0.2335D-02, & + & 0.2830D-02, 0.3426D-02, 0.4156D-02, 0.5035D-02, 0.6104D-02, & + & 0.7403D-02, 0.8971D-02, 0.1089D-01, 0.1321D-01, 0.1604D-01, & + & 0.1949D-01, 0.2371D-01, 0.2887D-01, 0.3519D-01, 0.4293D-01, & + & 0.5241D-01, 0.6395D-01, 0.7783D-01, 0.9418D-01, 0.1126D+00, & + & 0.1320D+00, 0.1503D+00, 0.1644D+00, 0.1713D+00, 0.1691D+00, & + & 0.1583D+00, 0.1416D+00, 0.1221D+00, 0.1024D+00, 0.8428D-01, & + & 0.6826D-01, 0.5457D-01, 0.4315D-01, 0.3377D-01, 0.2625D-01, & + & 0.2023D-01, 0.1550D-01, 0.1175D-01, 0.8918D-02, 0.6715D-02, & + & 0.5001D-02, 0.3768D-02, 0.2813D-02, 0.2064D-02, 0.1520D-02, & + & 0.1113D-02, 0.8415D-03, 0.6382D-03, 0.4360D-03, 0.3011D-03, & + & 0.2334D-03, 0.1660D-03, 0.9883D-04, 0.9849D-04, 0.3160D-04, & + & 0.3145D-04, 0.3134D-04, 0.3127D-04, 0.3122D-04, 0.3119D-04, & + & 0.3117D-04/ + + data (calcpts(j, 5), j = 1,neta) /0.2824D-03, 0.3425D-03, & + & 0.4151D-03, 0.5025D-03, 0.6088D-03, 0.7382D-03, 0.8944D-03, & + & 0.1083D-02, 0.1313D-02, 0.1591D-02, 0.1927D-02, 0.2336D-02, & + & 0.2832D-02, 0.3428D-02, 0.4152D-02, 0.5031D-02, 0.6100D-02, & + & 0.7399D-02, 0.8968D-02, 0.1088D-01, 0.1321D-01, 0.1604D-01, & + & 0.1949D-01, 0.2370D-01, 0.2886D-01, 0.3518D-01, 0.4292D-01, & + & 0.5239D-01, 0.6393D-01, 0.7782D-01, 0.9411D-01, 0.1126D+00, & + & 0.1320D+00, 0.1503D+00, 0.1644D+00, 0.1713D+00, 0.1690D+00, & + & 0.1583D+00, 0.1415D+00, 0.1221D+00, 0.1024D+00, 0.8427D-01, & + & 0.6825D-01, 0.5459D-01, 0.4317D-01, 0.3380D-01, 0.2621D-01, & + & 0.2019D-01, 0.1545D-01, 0.1178D-01, 0.8876D-02, 0.6674D-02, & + & 0.5026D-02, 0.3727D-02, 0.2771D-02, 0.2089D-02, 0.1545D-02, & + & 0.1138D-02, 0.7997D-03, 0.5964D-03, 0.4608D-03, 0.3260D-03, & + & 0.2582D-03, 0.1909D-03, 0.1237D-03, 0.5670D-04, 0.5648D-04, & + & 0.5632D-04, 0.5622D-04, 0.5615D-04, -.1057D-04, -.1060D-04, & + & -.1062D-04/ + + data (calcpts(j, 6), j = 1,neta) /0.2829D-03, 0.3424D-03, & + & 0.4150D-03, 0.5026D-03, 0.6090D-03, 0.7379D-03, 0.8935D-03, & + & 0.1083D-02, 0.1312D-02, 0.1590D-02, 0.1925D-02, 0.2332D-02, & + & 0.2828D-02, 0.3424D-02, 0.4155D-02, 0.5035D-02, 0.6098D-02, & + & 0.7398D-02, 0.8967D-02, 0.1088D-01, 0.1320D-01, 0.1603D-01, & + & 0.1948D-01, 0.2369D-01, 0.2885D-01, 0.3516D-01, 0.4290D-01, & + & 0.5237D-01, 0.6390D-01, 0.7776D-01, 0.9410D-01, 0.1125D+00, & + & 0.1319D+00, 0.1502D+00, 0.1643D+00, 0.1711D+00, 0.1690D+00, & + & 0.1582D+00, 0.1415D+00, 0.1220D+00, 0.1024D+00, 0.8425D-01, & + & 0.6824D-01, 0.5459D-01, 0.4318D-01, 0.3380D-01, 0.2621D-01, & + & 0.2020D-01, 0.1546D-01, 0.1178D-01, 0.8882D-02, 0.6679D-02, & + & 0.5031D-02, 0.3732D-02, 0.2776D-02, 0.2094D-02, 0.1550D-02, & + & 0.1143D-02, 0.8052D-03, 0.6018D-03, 0.4662D-03, 0.3314D-03, & + & 0.2637D-03, 0.1963D-03, 0.1291D-03, 0.6213D-04, 0.6190D-04, & + & 0.6175D-04, 0.6164D-04, -.5098D-05, -.5147D-05, -.5180D-05, & + & -.5203D-05/ + + data (calcpts(j, 7), j = 1,neta) /0.2822D-03, 0.3418D-03, & + & 0.4146D-03, 0.5024D-03, 0.6083D-03, 0.7374D-03, 0.8933D-03, & + & 0.1082D-02, 0.1311D-02, 0.1589D-02, 0.1925D-02, 0.2335D-02, & + & 0.2825D-02, 0.3422D-02, 0.4147D-02, 0.5028D-02, 0.6098D-02, & + & 0.7392D-02, 0.8962D-02, 0.1087D-01, 0.1319D-01, 0.1602D-01, & + & 0.1947D-01, 0.2368D-01, 0.2883D-01, 0.3514D-01, 0.4287D-01, & + & 0.5234D-01, 0.6386D-01, 0.7775D-01, 0.9403D-01, 0.1124D+00, & + & 0.1318D+00, 0.1501D+00, 0.1642D+00, 0.1711D+00, 0.1689D+00, & + & 0.1581D+00, 0.1414D+00, 0.1220D+00, 0.1024D+00, 0.8422D-01, & + & 0.6822D-01, 0.5457D-01, 0.4315D-01, 0.3378D-01, 0.2626D-01, & + & 0.2024D-01, 0.1544D-01, 0.1176D-01, 0.8925D-02, 0.6722D-02, & + & 0.5008D-02, 0.3775D-02, 0.2820D-02, 0.2071D-02, 0.1527D-02, & + & 0.1120D-02, 0.8487D-03, 0.5787D-03, 0.4431D-03, 0.3083D-03, & + & 0.2405D-03, 0.1732D-03, 0.1060D-03, 0.1057D-03, 0.3878D-04, & + & 0.3863D-04, 0.3852D-04, 0.3845D-04, 0.3840D-04, 0.3837D-04, & + & 0.3835D-04/ + + data (calcpts(j, 8), j = 1,neta) /0.2819D-03, 0.3417D-03, & + & 0.4140D-03, 0.5020D-03, 0.6082D-03, 0.7369D-03, 0.8925D-03, & + & 0.1081D-02, 0.1311D-02, 0.1588D-02, 0.1923D-02, 0.2327D-02, & + & 0.2824D-02, 0.3422D-02, 0.4148D-02, 0.5023D-02, 0.6094D-02, & + & 0.7383D-02, 0.8954D-02, 0.1087D-01, 0.1319D-01, 0.1601D-01, & + & 0.1946D-01, 0.2366D-01, 0.2880D-01, 0.3511D-01, 0.4283D-01, & + & 0.5229D-01, 0.6380D-01, 0.7762D-01, 0.9395D-01, 0.1123D+00, & + & 0.1317D+00, 0.1500D+00, 0.1640D+00, 0.1709D+00, 0.1687D+00, & + & 0.1580D+00, 0.1414D+00, 0.1219D+00, 0.1023D+00, 0.8419D-01, & + & 0.6819D-01, 0.5450D-01, 0.4315D-01, 0.3378D-01, 0.2626D-01, & + & 0.2017D-01, 0.1544D-01, 0.1176D-01, 0.8926D-02, 0.6724D-02, & + & 0.5010D-02, 0.3777D-02, 0.2755D-02, 0.2073D-02, 0.1529D-02, & + & 0.1122D-02, 0.8504D-03, 0.5805D-03, 0.4449D-03, 0.3100D-03, & + & 0.2423D-03, 0.1749D-03, 0.1078D-03, 0.1074D-03, 0.4054D-04, & + & 0.4039D-04, 0.4028D-04, 0.4021D-04, 0.4016D-04, 0.4013D-04, & + & 0.4011D-04/ + + data (calcpts(j, 9), j = 1,neta) /0.2821D-03, 0.3414D-03, & + & 0.4141D-03, 0.5010D-03, 0.6076D-03, 0.7361D-03, 0.8916D-03, & + & 0.1080D-02, 0.1309D-02, 0.1585D-02, 0.1921D-02, 0.2328D-02, & + & 0.2820D-02, 0.3419D-02, 0.4139D-02, 0.5022D-02, 0.6082D-02, & + & 0.7378D-02, 0.8945D-02, 0.1085D-01, 0.1317D-01, 0.1599D-01, & + & 0.1943D-01, 0.2363D-01, 0.2877D-01, 0.3506D-01, 0.4277D-01, & + & 0.5221D-01, 0.6370D-01, 0.7755D-01, 0.9379D-01, 0.1121D+00, & + & 0.1315D+00, 0.1497D+00, 0.1638D+00, 0.1707D+00, 0.1685D+00, & + & 0.1579D+00, 0.1412D+00, 0.1218D+00, 0.1023D+00, 0.8414D-01, & + & 0.6816D-01, 0.5450D-01, 0.4309D-01, 0.3378D-01, 0.2620D-01, & + & 0.2018D-01, 0.1544D-01, 0.1177D-01, 0.8867D-02, 0.6665D-02, & + & 0.5017D-02, 0.3718D-02, 0.2762D-02, 0.2080D-02, 0.1537D-02, & + & 0.1130D-02, 0.7915D-03, 0.5882D-03, 0.4526D-03, 0.3177D-03, & + & 0.2500D-03, 0.1826D-03, 0.1155D-03, 0.1151D-03, 0.4825D-04, & + & 0.4810D-04, 0.4800D-04, 0.4793D-04, 0.4788D-04, -.1882D-04, & + & -.1885D-04/ + + data (calcpts(j,10), j = 1,neta) /0.2816D-03, 0.3406D-03, & + & 0.4130D-03, 0.5005D-03, 0.6063D-03, 0.7348D-03, 0.8897D-03, & + & 0.1078D-02, 0.1307D-02, 0.1583D-02, 0.1917D-02, 0.2324D-02, & + & 0.2812D-02, 0.3413D-02, 0.4136D-02, 0.5014D-02, 0.6076D-02, & + & 0.7362D-02, 0.8930D-02, 0.1083D-01, 0.1315D-01, 0.1596D-01, & + & 0.1939D-01, 0.2359D-01, 0.2871D-01, 0.3500D-01, 0.4269D-01, & + & 0.5211D-01, 0.6357D-01, 0.7734D-01, 0.9356D-01, 0.1119D+00, & + & 0.1311D+00, 0.1493D+00, 0.1634D+00, 0.1703D+00, 0.1682D+00, & + & 0.1576D+00, 0.1410D+00, 0.1217D+00, 0.1022D+00, 0.8406D-01, & + & 0.6810D-01, 0.5448D-01, 0.4307D-01, 0.3376D-01, 0.2618D-01, & + & 0.2016D-01, 0.1543D-01, 0.1175D-01, 0.8918D-02, 0.6716D-02, & + & 0.5002D-02, 0.3770D-02, 0.2814D-02, 0.2066D-02, 0.1522D-02, & + & 0.1115D-02, 0.8435D-03, 0.5735D-03, 0.4379D-03, 0.3031D-03, & + & 0.2354D-03, 0.1680D-03, 0.1008D-03, 0.1005D-03, 0.3361D-04, & + & 0.3346D-04, 0.3335D-04, 0.3328D-04, 0.3324D-04, 0.3320D-04, & + & 0.3318D-04/ + + data (calcpts(j,11), j = 1,neta) /0.2808D-03, 0.3397D-03, & + & 0.4121D-03, 0.4989D-03, 0.6049D-03, 0.7330D-03, 0.8876D-03, & + & 0.1076D-02, 0.1304D-02, 0.1579D-02, 0.1913D-02, 0.2318D-02, & + & 0.2811D-02, 0.3401D-02, 0.4126D-02, 0.5001D-02, 0.6060D-02, & + & 0.7342D-02, 0.8908D-02, 0.1080D-01, 0.1311D-01, 0.1592D-01, & + & 0.1934D-01, 0.2352D-01, 0.2864D-01, 0.3490D-01, 0.4257D-01, & + & 0.5195D-01, 0.6338D-01, 0.7713D-01, 0.9325D-01, 0.1115D+00, & + & 0.1307D+00, 0.1489D+00, 0.1630D+00, 0.1698D+00, 0.1678D+00, & + & 0.1573D+00, 0.1408D+00, 0.1215D+00, 0.1020D+00, 0.8395D-01, & + & 0.6802D-01, 0.5440D-01, 0.4305D-01, 0.3368D-01, 0.2616D-01, & + & 0.2015D-01, 0.1541D-01, 0.1174D-01, 0.8907D-02, 0.6705D-02, & + & 0.4991D-02, 0.3759D-02, 0.2804D-02, 0.2055D-02, 0.1512D-02, & + & 0.1105D-02, 0.8330D-03, 0.6298D-03, 0.4275D-03, 0.2927D-03, & + & 0.2250D-03, 0.1576D-03, 0.9045D-04, 0.9012D-04, 0.8989D-04, & + & 0.2308D-04, 0.2297D-04, 0.2290D-04, 0.2285D-04, 0.2282D-04, & + & 0.2280D-04/ + + data (calcpts(j,12), j = 1,neta) /0.2794D-03, 0.3384D-03, & + & 0.4104D-03, 0.4976D-03, 0.6028D-03, 0.7303D-03, 0.8845D-03, & + & 0.1072D-02, 0.1298D-02, 0.1573D-02, 0.1906D-02, 0.2310D-02, & + & 0.2798D-02, 0.3391D-02, 0.4107D-02, 0.4980D-02, 0.6037D-02, & + & 0.7318D-02, 0.8875D-02, 0.1076D-01, 0.1306D-01, 0.1586D-01, & + & 0.1927D-01, 0.2343D-01, 0.2853D-01, 0.3476D-01, 0.4239D-01, & + & 0.5173D-01, 0.6310D-01, 0.7678D-01, 0.9279D-01, 0.1109D+00, & + & 0.1301D+00, 0.1481D+00, 0.1622D+00, 0.1691D+00, 0.1672D+00, & + & 0.1568D+00, 0.1404D+00, 0.1212D+00, 0.1018D+00, 0.8379D-01, & + & 0.6790D-01, 0.5432D-01, 0.4298D-01, 0.3368D-01, 0.2616D-01, & + & 0.2015D-01, 0.1542D-01, 0.1174D-01, 0.8843D-02, 0.6708D-02, & + & 0.4995D-02, 0.3762D-02, 0.2807D-02, 0.2059D-02, 0.1515D-02, & + & 0.1108D-02, 0.8366D-03, 0.6334D-03, 0.4312D-03, 0.2963D-03, & + & 0.2286D-03, 0.1613D-03, 0.9411D-04, 0.9378D-04, 0.9356D-04, & + & 0.2674D-04, 0.2664D-04, 0.2657D-04, 0.2652D-04, 0.2649D-04, & + & 0.2647D-04/ + + data (calcpts(j,13), j = 1,neta) /0.2781D-03, 0.3369D-03, & + & 0.4082D-03, 0.4949D-03, 0.5992D-03, 0.7261D-03, 0.8799D-03, & + & 0.1066D-02, 0.1291D-02, 0.1565D-02, 0.1896D-02, 0.2297D-02, & + & 0.2783D-02, 0.3376D-02, 0.4084D-02, 0.4957D-02, 0.6001D-02, & + & 0.7282D-02, 0.8828D-02, 0.1071D-01, 0.1300D-01, 0.1577D-01, & + & 0.1916D-01, 0.2330D-01, 0.2836D-01, 0.3455D-01, 0.4214D-01, & + & 0.5141D-01, 0.6268D-01, 0.7623D-01, 0.9216D-01, 0.1102D+00, & + & 0.1291D+00, 0.1471D+00, 0.1611D+00, 0.1681D+00, 0.1663D+00, & + & 0.1560D+00, 0.1398D+00, 0.1208D+00, 0.1015D+00, 0.8356D-01, & + & 0.6773D-01, 0.5417D-01, 0.4290D-01, 0.3360D-01, 0.2609D-01, & + & 0.2015D-01, 0.1542D-01, 0.1174D-01, 0.8844D-02, 0.6643D-02, & + & 0.4997D-02, 0.3765D-02, 0.2810D-02, 0.2062D-02, 0.1518D-02, & + & 0.1111D-02, 0.8399D-03, 0.6366D-03, 0.4344D-03, 0.2996D-03, & + & 0.2319D-03, 0.1645D-03, 0.9741D-04, 0.9708D-04, 0.9686D-04, & + & 0.3005D-04, 0.2994D-04, 0.2987D-04, 0.2983D-04, 0.2979D-04, & + & 0.2977D-04/ + + data (calcpts(j,14), j = 1,neta) /0.2757D-03, 0.3342D-03, & + & 0.4053D-03, 0.4909D-03, 0.5944D-03, 0.7208D-03, 0.8734D-03, & + & 0.1058D-02, 0.1282D-02, 0.1553D-02, 0.1881D-02, 0.2279D-02, & + & 0.2760D-02, 0.3346D-02, 0.4057D-02, 0.4912D-02, 0.5959D-02, & + & 0.7225D-02, 0.8761D-02, 0.1063D-01, 0.1289D-01, 0.1565D-01, & + & 0.1901D-01, 0.2312D-01, 0.2813D-01, 0.3426D-01, 0.4177D-01, & + & 0.5094D-01, 0.6209D-01, 0.7546D-01, 0.9123D-01, 0.1090D+00, & + & 0.1277D+00, 0.1456D+00, 0.1595D+00, 0.1666D+00, 0.1649D+00, & + & 0.1550D+00, 0.1390D+00, 0.1201D+00, 0.1010D+00, 0.8322D-01, & + & 0.6748D-01, 0.5402D-01, 0.4276D-01, 0.3354D-01, 0.2604D-01, & + & 0.2009D-01, 0.1537D-01, 0.1169D-01, 0.8864D-02, 0.6664D-02, & + & 0.5018D-02, 0.3720D-02, 0.2765D-02, 0.2084D-02, 0.1540D-02, & + & 0.1134D-02, 0.7956D-03, 0.5924D-03, 0.4569D-03, 0.3221D-03, & + & 0.2544D-03, 0.1870D-03, 0.1199D-03, 0.1196D-03, 0.5270D-04, & + & 0.5255D-04, 0.5245D-04, 0.5238D-04, -.1433D-04, -.1436D-04, & + & -.1438D-04/ + + data (calcpts(j,15), j = 1,neta) /0.2728D-03, 0.3303D-03, & + & 0.4008D-03, 0.4855D-03, 0.5879D-03, 0.7125D-03, 0.8631D-03, & + & 0.1045D-02, 0.1267D-02, 0.1535D-02, 0.1860D-02, 0.2254D-02, & + & 0.2733D-02, 0.3311D-02, 0.4014D-02, 0.4862D-02, 0.5890D-02, & + & 0.7144D-02, 0.8656D-02, 0.1050D-01, 0.1274D-01, 0.1547D-01, & + & 0.1879D-01, 0.2284D-01, 0.2779D-01, 0.3384D-01, 0.4124D-01, & + & 0.5028D-01, 0.6126D-01, 0.7442D-01, 0.8991D-01, 0.1074D+00, & + & 0.1259D+00, 0.1435D+00, 0.1573D+00, 0.1644D+00, 0.1630D+00, & + & 0.1534D+00, 0.1378D+00, 0.1192D+00, 0.1004D+00, 0.8273D-01, & + & 0.6712D-01, 0.5375D-01, 0.4256D-01, 0.3335D-01, 0.2591D-01, & + & 0.1998D-01, 0.1532D-01, 0.1165D-01, 0.8822D-02, 0.6623D-02, & + & 0.4978D-02, 0.3748D-02, 0.2793D-02, 0.2045D-02, 0.1502D-02, & + & 0.1095D-02, 0.8240D-03, 0.6209D-03, 0.4188D-03, 0.3507D-03, & + & 0.2163D-03, 0.1490D-03, 0.1485D-03, 0.8154D-04, 0.8133D-04, & + & 0.1452D-04, 0.1442D-04, 0.1435D-04, 0.1431D-04, 0.1427D-04, & + & 0.1425D-04/ + + data (calcpts(j,16), j = 1,neta) /0.2682D-03, 0.3250D-03, & + & 0.3946D-03, 0.4778D-03, 0.5786D-03, 0.7010D-03, 0.8497D-03, & + & 0.1029D-02, 0.1247D-02, 0.1511D-02, 0.1830D-02, 0.2218D-02, & + & 0.2686D-02, 0.3253D-02, 0.3946D-02, 0.4780D-02, 0.5795D-02, & + & 0.7024D-02, 0.8518D-02, 0.1033D-01, 0.1254D-01, 0.1521D-01, & + & 0.1848D-01, 0.2246D-01, 0.2732D-01, 0.3325D-01, 0.4050D-01, & + & 0.4935D-01, 0.6008D-01, 0.7296D-01, 0.8805D-01, 0.1051D+00, & + & 0.1232D+00, 0.1404D+00, 0.1541D+00, 0.1614D+00, 0.1603D+00, & + & 0.1512D+00, 0.1361D+00, 0.1180D+00, 0.9940D-01, 0.8202D-01, & + & 0.6661D-01, 0.5338D-01, 0.4228D-01, 0.3315D-01, 0.2579D-01, & + & 0.1993D-01, 0.1528D-01, 0.1161D-01, 0.8786D-02, 0.6655D-02, & + & 0.4945D-02, 0.3715D-02, 0.2761D-02, 0.2080D-02, 0.1537D-02, & + & 0.1131D-02, 0.7928D-03, 0.5897D-03, 0.4543D-03, 0.3196D-03, & + & 0.2519D-03, 0.1846D-03, 0.1175D-03, 0.1172D-03, 0.5032D-04, & + & 0.5017D-04, 0.5008D-04, 0.5001D-04, 0.4997D-04, -.1673D-04, & + & -.1675D-04/ + + data (calcpts(j,17), j = 1,neta) /0.2625D-03, 0.3178D-03, & + & 0.3854D-03, 0.4667D-03, 0.5652D-03, 0.6851D-03, 0.8304D-03, & + & 0.1006D-02, 0.1219D-02, 0.1476D-02, 0.1789D-02, 0.2167D-02, & + & 0.2629D-02, 0.3185D-02, 0.3855D-02, 0.4675D-02, 0.5665D-02, & + & 0.6864D-02, 0.8322D-02, 0.1010D-01, 0.1225D-01, 0.1486D-01, & + & 0.1804D-01, 0.2192D-01, 0.2666D-01, 0.3243D-01, 0.3947D-01, & + & 0.4806D-01, 0.5845D-01, 0.7091D-01, 0.8548D-01, 0.1020D+00, & + & 0.1195D+00, 0.1363D+00, 0.1497D+00, 0.1571D+00, 0.1566D+00, & + & 0.1481D+00, 0.1336D+00, 0.1161D+00, 0.9804D-01, 0.8102D-01, & + & 0.6588D-01, 0.5284D-01, 0.4189D-01, 0.3291D-01, 0.2564D-01, & + & 0.1978D-01, 0.1514D-01, 0.1154D-01, 0.8721D-02, 0.6593D-02, & + & 0.4951D-02, 0.3722D-02, 0.2768D-02, 0.2022D-02, 0.1479D-02, & + & 0.1139D-02, 0.8017D-03, 0.5988D-03, 0.4634D-03, 0.3287D-03, & + & 0.2611D-03, 0.1938D-03, 0.1267D-03, 0.5977D-04, 0.5957D-04, & + & 0.5944D-04, 0.5934D-04, -.7387D-05, -.7430D-05, -.7460D-05, & + & -.7480D-05/ + + data (calcpts(j,18), j = 1,neta) /0.2543D-03, 0.3078D-03, & + & 0.3732D-03, 0.4520D-03, 0.5474D-03, 0.6629D-03, 0.8035D-03, & + & 0.9733D-03, 0.1180D-02, 0.1429D-02, 0.1731D-02, 0.2098D-02, & + & 0.2541D-02, 0.3079D-02, 0.3729D-02, 0.4525D-02, 0.5479D-02, & + & 0.6644D-02, 0.8051D-02, 0.9766D-02, 0.1184D-01, 0.1437D-01, & + & 0.1745D-01, 0.2119D-01, 0.2575D-01, 0.3131D-01, 0.3808D-01, & + & 0.4632D-01, 0.5627D-01, 0.6816D-01, 0.8206D-01, 0.9782D-01, & + & 0.1145D+00, 0.1306D+00, 0.1438D+00, 0.1513D+00, 0.1513D+00, & + & 0.1437D+00, 0.1302D+00, 0.1135D+00, 0.9614D-01, 0.7963D-01, & + & 0.6486D-01, 0.5210D-01, 0.4140D-01, 0.3251D-01, 0.2532D-01, & + & 0.1955D-01, 0.1505D-01, 0.1146D-01, 0.8710D-02, 0.6519D-02, & + & 0.4945D-02, 0.3651D-02, 0.2766D-02, 0.2020D-02, 0.1478D-02, & + & 0.1138D-02, 0.8008D-03, 0.5980D-03, 0.4628D-03, 0.3282D-03, & + & 0.2606D-03, 0.1934D-03, 0.1263D-03, 0.5934D-04, 0.5915D-04, & + & 0.5902D-04, 0.5893D-04, -.7793D-05, -.7834D-05, -.7862D-05, & + & -.7881D-05/ + + data (calcpts(j,19), j = 1,neta) /0.2427D-03, 0.2943D-03, & + & 0.3564D-03, 0.4321D-03, 0.5233D-03, 0.6339D-03, 0.7677D-03, & + & 0.9304D-03, 0.1128D-02, 0.1366D-02, 0.1654D-02, 0.2005D-02, & + & 0.2429D-02, 0.2943D-02, 0.3568D-02, 0.4323D-02, 0.5235D-02, & + & 0.6346D-02, 0.7694D-02, 0.9331D-02, 0.1131D-01, 0.1372D-01, & + & 0.1665D-01, 0.2022D-01, 0.2455D-01, 0.2983D-01, 0.3625D-01, & + & 0.4403D-01, 0.5342D-01, 0.6460D-01, 0.7767D-01, 0.9241D-01, & + & 0.1081D+00, 0.1234D+00, 0.1360D+00, 0.1437D+00, 0.1443D+00, & + & 0.1378D+00, 0.1256D+00, 0.1100D+00, 0.9352D-01, 0.7771D-01, & + & 0.6346D-01, 0.5109D-01, 0.4065D-01, 0.3199D-01, 0.2496D-01, & + & 0.1934D-01, 0.1485D-01, 0.1134D-01, 0.8593D-02, 0.6472D-02, & + & 0.4902D-02, 0.3676D-02, 0.2725D-02, 0.2047D-02, 0.1505D-02, & + & 0.1100D-02, 0.8295D-03, 0.6269D-03, 0.4251D-03, 0.2906D-03, & + & 0.2231D-03, 0.1559D-03, 0.8884D-04, 0.8859D-04, 0.8841D-04, & + & 0.2162D-04, 0.2154D-04, 0.2149D-04, 0.2145D-04, 0.2142D-04, & + & 0.2140D-04/ + + data (calcpts(j,20), j = 1,neta) /0.2281D-03, 0.2765D-03, & + & 0.3351D-03, 0.4057D-03, 0.4920D-03, 0.5961D-03, 0.7219D-03, & + & 0.8744D-03, 0.1060D-02, 0.1284D-02, 0.1555D-02, 0.1885D-02, & + & 0.2284D-02, 0.2768D-02, 0.3353D-02, 0.4060D-02, 0.4921D-02, & + & 0.5965D-02, 0.7228D-02, 0.8768D-02, 0.1063D-01, 0.1289D-01, & + & 0.1564D-01, 0.1897D-01, 0.2303D-01, 0.2795D-01, 0.3393D-01, & + & 0.4116D-01, 0.4985D-01, 0.6017D-01, 0.7220D-01, 0.8575D-01, & + & 0.1002D+00, 0.1144D+00, 0.1263D+00, 0.1338D+00, 0.1352D+00, & + & 0.1300D+00, 0.1193D+00, 0.1053D+00, 0.8999D-01, 0.7513D-01, & + & 0.6159D-01, 0.4974D-01, 0.3967D-01, 0.3130D-01, 0.2449D-01, & + & 0.1896D-01, 0.1462D-01, 0.1112D-01, 0.8449D-02, 0.6401D-02, & + & 0.4834D-02, 0.3611D-02, 0.2662D-02, 0.1985D-02, 0.1511D-02, & + & 0.1106D-02, 0.7688D-03, 0.5665D-03, 0.4316D-03, 0.2972D-03, & + & 0.2298D-03, 0.1626D-03, 0.9560D-04, 0.9537D-04, 0.2855D-04, & + & 0.2844D-04, 0.2836D-04, 0.2831D-04, 0.2828D-04, 0.2826D-04, & + & 0.2824D-04/ + + data (calcpts(j,21), j = 1,neta) /0.2103D-03, 0.2549D-03, & + & 0.3087D-03, 0.3736D-03, 0.4527D-03, 0.5489D-03, 0.6649D-03, & + & 0.8050D-03, 0.9762D-03, 0.1182D-02, 0.1432D-02, 0.1735D-02, & + & 0.2103D-02, 0.2547D-02, 0.3085D-02, 0.3741D-02, 0.4530D-02, & + & 0.5493D-02, 0.6658D-02, 0.8067D-02, 0.9784D-02, 0.1186D-01, & + & 0.1438D-01, 0.1744D-01, 0.2116D-01, 0.2566D-01, 0.3112D-01, & + & 0.3769D-01, 0.4558D-01, 0.5491D-01, 0.6575D-01, 0.7794D-01, & + & 0.9094D-01, 0.1037D+00, 0.1147D+00, 0.1220D+00, 0.1241D+00, & + & 0.1202D+00, 0.1113D+00, 0.9908D-01, 0.8539D-01, 0.7177D-01, & + & 0.5916D-01, 0.4799D-01, 0.3842D-01, 0.3041D-01, 0.2384D-01, & + & 0.1852D-01, 0.1426D-01, 0.1091D-01, 0.8312D-02, 0.6336D-02, & + & 0.4774D-02, 0.3554D-02, 0.2674D-02, 0.1998D-02, 0.1458D-02, & + & 0.1120D-02, 0.7841D-03, 0.5821D-03, 0.4474D-03, 0.3131D-03, & + & 0.2458D-03, 0.1787D-03, 0.1117D-03, 0.1115D-03, 0.4471D-04, & + & 0.4462D-04, 0.4455D-04, 0.4451D-04, 0.4448D-04, 0.4446D-04, & + & 0.4445D-04/ + + data (calcpts(j,22), j = 1,neta) /0.1892D-03, 0.2287D-03, & + & 0.2776D-03, 0.3361D-03, 0.4075D-03, 0.4932D-03, 0.5976D-03, & + & 0.7242D-03, 0.8775D-03, 0.1063D-02, 0.1288D-02, 0.1560D-02, & + & 0.1890D-02, 0.2291D-02, 0.2775D-02, 0.3362D-02, 0.4075D-02, & + & 0.4940D-02, 0.5984D-02, 0.7251D-02, 0.8790D-02, 0.1066D-01, & + & 0.1292D-01, 0.1566D-01, 0.1898D-01, 0.2301D-01, 0.2788D-01, & + & 0.3373D-01, 0.4073D-01, 0.4899D-01, 0.5855D-01, 0.6927D-01, & + & 0.8071D-01, 0.9201D-01, 0.1019D+00, 0.1087D+00, 0.1111D+00, & + & 0.1086D+00, 0.1016D+00, 0.9138D-01, 0.7959D-01, 0.6752D-01, & + & 0.5609D-01, 0.4579D-01, 0.3685D-01, 0.2929D-01, 0.2304D-01, & + & 0.1796D-01, 0.1389D-01, 0.1066D-01, 0.8130D-02, 0.6135D-02, & + & 0.4644D-02, 0.3495D-02, 0.2617D-02, 0.1942D-02, 0.1470D-02, & + & 0.1067D-02, 0.7975D-03, 0.5958D-03, 0.3947D-03, 0.3272D-03, & + & 0.2600D-03, 0.1930D-03, 0.1261D-03, 0.5924D-04, 0.5913D-04, & + & 0.5905D-04, 0.5900D-04, 0.5896D-04, -.7732D-05, -.7749D-05, & + & -.7760D-05/ + + data (calcpts(j,23), j = 1,neta) /0.1655D-03, 0.2005D-03, & + & 0.2427D-03, 0.2942D-03, 0.3569D-03, 0.4318D-03, 0.5232D-03, & + & 0.6342D-03, 0.7686D-03, 0.9306D-03, 0.1128D-02, 0.1366D-02, & + & 0.1655D-02, 0.2006D-02, 0.2430D-02, 0.2944D-02, 0.3566D-02, & + & 0.4324D-02, 0.5236D-02, 0.6346D-02, 0.7697D-02, 0.9327D-02, & + & 0.1130D-01, 0.1370D-01, 0.1660D-01, 0.2012D-01, 0.2435D-01, & + & 0.2944D-01, 0.3551D-01, 0.4267D-01, 0.5093D-01, 0.6019D-01, & + & 0.7004D-01, 0.7982D-01, 0.8841D-01, 0.9454D-01, 0.9712D-01, & + & 0.9561D-01, 0.9035D-01, 0.8227D-01, 0.7258D-01, 0.6234D-01, & + & 0.5234D-01, 0.4311D-01, 0.3494D-01, 0.2794D-01, 0.2208D-01, & + & 0.1727D-01, 0.1340D-01, 0.1032D-01, 0.7891D-02, 0.6003D-02, & + & 0.4538D-02, 0.3418D-02, 0.2556D-02, 0.1909D-02, 0.1419D-02, & + & 0.1049D-02, 0.7738D-03, 0.5724D-03, 0.4115D-03, 0.3043D-03, & + & 0.2172D-03, 0.1635D-03, 0.1167D-03, 0.8322D-04, 0.5646D-04, & + & 0.4307D-04, 0.2969D-04, 0.2300D-04, 0.1631D-04, 0.9633D-05, & + & 0.2957D-05/ + + data (calcpts(j,24), j = 1,neta) /0.1409D-03, 0.1707D-03, & + & 0.2069D-03, 0.2508D-03, 0.3035D-03, 0.3675D-03, 0.4456D-03, & + & 0.5401D-03, 0.6543D-03, 0.7925D-03, 0.9600D-03, 0.1164D-02, & + & 0.1410D-02, 0.1708D-02, 0.2069D-02, 0.2507D-02, 0.3038D-02, & + & 0.3684D-02, 0.4462D-02, 0.5404D-02, 0.6550D-02, 0.7939D-02, & + & 0.9619D-02, 0.1166D-01, 0.1413D-01, 0.1711D-01, 0.2072D-01, & + & 0.2504D-01, 0.3019D-01, 0.3626D-01, 0.4327D-01, 0.5112D-01, & + & 0.5950D-01, 0.6782D-01, 0.7521D-01, 0.8060D-01, 0.8310D-01, & + & 0.8228D-01, 0.7840D-01, 0.7221D-01, 0.6458D-01, 0.5629D-01, & + & 0.4793D-01, 0.3996D-01, 0.3271D-01, 0.2636D-01, 0.2096D-01, & + & 0.1649D-01, 0.1285D-01, 0.9932D-02, 0.7623D-02, 0.5816D-02, & + & 0.4408D-02, 0.3325D-02, 0.2498D-02, 0.1867D-02, 0.1391D-02, & + & 0.1029D-02, 0.7605D-03, 0.5595D-03, 0.4122D-03, 0.3051D-03, & + & 0.2181D-03, 0.1579D-03, 0.1177D-03, 0.8429D-04, 0.6423D-04, & + & 0.4418D-04, 0.3082D-04, 0.2413D-04, 0.1745D-04, 0.1077D-04, & + & 0.1076D-04/ + + data (calcpts(j,25), j = 1,neta) /0.1168D-03, 0.1415D-03, & + & 0.1715D-03, 0.2077D-03, 0.2514D-03, 0.3048D-03, 0.3695D-03, & + & 0.4475D-03, 0.5420D-03, 0.6569D-03, 0.7959D-03, 0.9642D-03, & + & 0.1169D-02, 0.1415D-02, 0.1715D-02, 0.2078D-02, 0.2518D-02, & + & 0.3051D-02, 0.3697D-02, 0.4481D-02, 0.5431D-02, 0.6581D-02, & + & 0.7974D-02, 0.9667D-02, 0.1171D-01, 0.1419D-01, 0.1717D-01, & + & 0.2076D-01, 0.2503D-01, 0.3008D-01, 0.3591D-01, 0.4247D-01, & + & 0.4949D-01, 0.5653D-01, 0.6285D-01, 0.6757D-01, 0.6993D-01, & + & 0.6954D-01, 0.6664D-01, 0.6189D-01, 0.5601D-01, 0.4956D-01, & + & 0.4291D-01, 0.3634D-01, 0.3015D-01, 0.2456D-01, 0.1970D-01, & + & 0.1560D-01, 0.1222D-01, 0.9487D-02, 0.7313D-02, 0.5599D-02, & + & 0.4256D-02, 0.3222D-02, 0.2424D-02, 0.1814D-02, 0.1359D-02, & + & 0.1011D-02, 0.7496D-03, 0.5489D-03, 0.4018D-03, 0.2948D-03, & + & 0.2146D-03, 0.1611D-03, 0.1143D-03, 0.8092D-04, 0.6087D-04, & + & 0.4084D-04, 0.3415D-04, 0.2080D-04, 0.1413D-04, 0.1412D-04, & + & 0.7449D-05/ + + data (calcpts(j,26), j = 1,neta) /0.9441D-04, 0.1144D-03, & + & 0.1386D-03, 0.1679D-03, 0.2035D-03, 0.2465D-03, 0.2988D-03, & + & 0.3618D-03, 0.4387D-03, 0.5310D-03, 0.6434D-03, 0.7796D-03, & + & 0.9444D-03, 0.1144D-02, 0.1386D-02, 0.1680D-02, 0.2035D-02, & + & 0.2466D-02, 0.2989D-02, 0.3622D-02, 0.4389D-02, 0.5322D-02, & + & 0.6448D-02, 0.7811D-02, 0.9470D-02, 0.1148D-01, 0.1389D-01, & + & 0.1680D-01, 0.2027D-01, 0.2438D-01, 0.2914D-01, 0.3452D-01, & + & 0.4033D-01, 0.4624D-01, 0.5164D-01, 0.5581D-01, 0.5808D-01, & + & 0.5806D-01, 0.5589D-01, 0.5214D-01, 0.4753D-01, 0.4257D-01, & + & 0.3746D-01, 0.3231D-01, 0.2728D-01, 0.2255D-01, 0.1829D-01, & + & 0.1461D-01, 0.1153D-01, 0.8999D-02, 0.6966D-02, 0.5350D-02, & + & 0.4084D-02, 0.3099D-02, 0.2343D-02, 0.1761D-02, 0.1313D-02, & + & 0.9785D-03, 0.7245D-03, 0.5374D-03, 0.3904D-03, 0.2902D-03, & + & 0.2101D-03, 0.1567D-03, 0.1099D-03, 0.7655D-04, 0.5652D-04, & + & 0.4316D-04, 0.2982D-04, 0.1647D-04, 0.1647D-04, 0.9795D-05, & + & 0.3125D-05/ + + data (calcpts(j,27), j = 1,neta) /0.7459D-04, 0.9038D-04, & + & 0.1096D-03, 0.1328D-03, 0.1608D-03, 0.1948D-03, 0.2361D-03, & + & 0.2860D-03, 0.3463D-03, 0.4201D-03, 0.5086D-03, 0.6162D-03, & + & 0.7467D-03, 0.9047D-03, 0.1096D-02, 0.1328D-02, 0.1609D-02, & + & 0.1950D-02, 0.2363D-02, 0.2863D-02, 0.3470D-02, 0.4206D-02, & + & 0.5098D-02, 0.6182D-02, 0.7492D-02, 0.9074D-02, 0.1099D-01, & + & 0.1330D-01, 0.1607D-01, 0.1933D-01, 0.2315D-01, 0.2749D-01, & + & 0.3223D-01, 0.3712D-01, 0.4171D-01, 0.4543D-01, 0.4767D-01, & + & 0.4805D-01, 0.4654D-01, 0.4356D-01, 0.3980D-01, 0.3583D-01, & + & 0.3191D-01, 0.2802D-01, 0.2413D-01, 0.2032D-01, 0.1674D-01, & + & 0.1353D-01, 0.1078D-01, 0.8474D-02, 0.6599D-02, 0.5100D-02, & + & 0.3910D-02, 0.2980D-02, 0.2259D-02, 0.1704D-02, 0.1277D-02, & + & 0.9560D-03, 0.7089D-03, 0.5286D-03, 0.3884D-03, 0.2883D-03, & + & 0.2149D-03, 0.1548D-03, 0.1148D-03, 0.8145D-04, 0.6143D-04, & + & 0.4808D-04, 0.3474D-04, 0.2807D-04, 0.2140D-04, 0.1473D-04, & + & 0.1472D-04/ + + data (calcpts(j,28), j = 1,neta) /0.5791D-04, 0.7018D-04, & + & 0.8503D-04, 0.1030D-03, 0.1248D-03, 0.1512D-03, 0.1832D-03, & + & 0.2219D-03, 0.2689D-03, 0.3258D-03, 0.3947D-03, 0.4780D-03, & + & 0.5794D-03, 0.7018D-03, 0.8505D-03, 0.1030D-02, 0.1249D-02, & + & 0.1513D-02, 0.1834D-02, 0.2222D-02, 0.2693D-02, 0.3264D-02, & + & 0.3956D-02, 0.4796D-02, 0.5814D-02, 0.7043D-02, 0.8538D-02, & + & 0.1034D-01, 0.1248D-01, 0.1505D-01, 0.1805D-01, 0.2148D-01, & + & 0.2527D-01, 0.2925D-01, 0.3310D-01, 0.3637D-01, 0.3858D-01, & + & 0.3935D-01, 0.3852D-01, 0.3628D-01, 0.3320D-01, 0.2986D-01, & + & 0.2667D-01, 0.2369D-01, 0.2079D-01, 0.1789D-01, 0.1503D-01, & + & 0.1235D-01, 0.9957D-02, 0.7905D-02, 0.6194D-02, 0.4811D-02, & + & 0.3709D-02, 0.2841D-02, 0.2160D-02, 0.1633D-02, 0.1232D-02, & + & 0.9185D-03, 0.6850D-03, 0.5115D-03, 0.3781D-03, 0.2780D-03, & + & 0.2046D-03, 0.1512D-03, 0.1112D-03, 0.7787D-04, 0.5786D-04, & + & 0.4452D-04, 0.3119D-04, 0.2452D-04, 0.1785D-04, 0.1118D-04, & + & 0.1118D-04/ + + data (calcpts(j,29), j = 1,neta) /0.4422D-04, 0.5359D-04, & + & 0.6494D-04, 0.7870D-04, 0.9534D-04, 0.1155D-03, 0.1400D-03, & + & 0.1695D-03, 0.2054D-03, 0.2489D-03, 0.3015D-03, 0.3653D-03, & + & 0.4423D-03, 0.5363D-03, 0.6496D-03, 0.7869D-03, 0.9536D-03, & + & 0.1156D-02, 0.1400D-02, 0.1697D-02, 0.2057D-02, 0.2493D-02, & + & 0.3022D-02, 0.3664D-02, 0.4441D-02, 0.5384D-02, 0.6524D-02, & + & 0.7899D-02, 0.9553D-02, 0.1153D-01, 0.1384D-01, 0.1651D-01, & + & 0.1948D-01, 0.2266D-01, 0.2581D-01, 0.2862D-01, 0.3073D-01, & + & 0.3179D-01, 0.3158D-01, 0.3012D-01, 0.2772D-01, 0.2490D-01, & + & 0.2214D-01, 0.1968D-01, 0.1747D-01, 0.1533D-01, 0.1318D-01, & + & 0.1106D-01, 0.9063D-02, 0.7286D-02, 0.5765D-02, 0.4510D-02, & + & 0.3496D-02, 0.2688D-02, 0.2055D-02, 0.1561D-02, 0.1174D-02, & + & 0.8874D-03, 0.6607D-03, 0.4939D-03, 0.3672D-03, 0.2672D-03, & + & 0.2005D-03, 0.1472D-03, 0.1071D-03, 0.7381D-04, 0.5380D-04, & + & 0.4047D-04, 0.2713D-04, 0.2046D-04, 0.1379D-04, 0.7127D-05, & + & 0.7127D-05/ + + data (calcpts(j,30), j = 1,neta) /0.3339D-04, 0.4040D-04, & + & 0.4896D-04, 0.5931D-04, 0.7186D-04, 0.8708D-04, 0.1055D-03, & + & 0.1279D-03, 0.1549D-03, 0.1876D-03, 0.2273D-03, 0.2755D-03, & + & 0.3337D-03, 0.4043D-03, 0.4899D-03, 0.5933D-03, 0.7195D-03, & + & 0.8717D-03, 0.1056D-02, 0.1280D-02, 0.1551D-02, 0.1880D-02, & + & 0.2279D-02, 0.2763D-02, 0.3350D-02, 0.4061D-02, 0.4922D-02, & + & 0.5962D-02, 0.7212D-02, 0.8703D-02, 0.1047D-01, 0.1251D-01, & + & 0.1481D-01, 0.1729D-01, 0.1981D-01, 0.2216D-01, 0.2408D-01, & + & 0.2527D-01, 0.2553D-01, 0.2477D-01, 0.2311D-01, 0.2086D-01, & + & 0.1846D-01, 0.1628D-01, 0.1443D-01, 0.1281D-01, 0.1125D-01, & + & 0.9669D-02, 0.8097D-02, 0.6622D-02, 0.5310D-02, 0.4192D-02, & + & 0.3272D-02, 0.2532D-02, 0.1945D-02, 0.1485D-02, 0.1125D-02, & + & 0.8448D-03, 0.6381D-03, 0.4781D-03, 0.3514D-03, 0.2648D-03, & + & 0.1914D-03, 0.1448D-03, 0.1048D-03, 0.7809D-04, 0.5809D-04, & + & 0.3809D-04, 0.3142D-04, 0.1809D-04, 0.1809D-04, 0.1142D-04, & + & 0.4756D-05/ + + data (calcpts(j,31), j = 1,neta) /0.2490D-04, 0.3016D-04, & + & 0.3654D-04, 0.4428D-04, 0.5367D-04, 0.6502D-04, 0.7877D-04, & + & 0.9543D-04, 0.1156D-03, 0.1401D-03, 0.1697D-03, 0.2056D-03, & + & 0.2490D-03, 0.3017D-03, 0.3656D-03, 0.4430D-03, 0.5366D-03, & + & 0.6505D-03, 0.7880D-03, 0.9552D-03, 0.1158D-02, 0.1403D-02, & + & 0.1701D-02, 0.2062D-02, 0.2499D-02, 0.3031D-02, 0.3673D-02, & + & 0.4450D-02, 0.5386D-02, 0.6504D-02, 0.7828D-02, 0.9372D-02, & + & 0.1112D-01, 0.1302D-01, 0.1501D-01, 0.1691D-01, 0.1855D-01, & + & 0.1974D-01, 0.2028D-01, 0.2007D-01, 0.1909D-01, 0.1747D-01, & + & 0.1552D-01, 0.1357D-01, 0.1189D-01, 0.1053D-01, 0.9356D-02, & + & 0.8220D-02, 0.7059D-02, 0.5903D-02, 0.4817D-02, 0.3855D-02, & + & 0.3039D-02, 0.2368D-02, 0.1827D-02, 0.1400D-02, 0.1067D-02, & + & 0.8068D-03, 0.6068D-03, 0.4535D-03, 0.3402D-03, 0.2535D-03, & + & 0.1869D-03, 0.1402D-03, 0.1002D-03, 0.7354D-04, 0.5354D-04, & + & 0.4021D-04, 0.2687D-04, 0.2021D-04, 0.1354D-04, 0.1354D-04, & + & 0.6874D-05/ + + data (calcpts(j,32), j = 1,neta) /0.1842D-04, 0.2232D-04, & + & 0.2705D-04, 0.3277D-04, 0.3967D-04, 0.4809D-04, 0.5828D-04, & + & 0.7059D-04, 0.8552D-04, 0.1036D-03, 0.1255D-03, 0.1521D-03, & + & 0.1842D-03, 0.2232D-03, 0.2705D-03, 0.3277D-03, 0.3971D-03, & + & 0.4812D-03, 0.5832D-03, 0.7063D-03, 0.8566D-03, 0.1038D-02, & + & 0.1258D-02, 0.1525D-02, 0.1849D-02, 0.2242D-02, 0.2717D-02, & + & 0.3293D-02, 0.3986D-02, 0.4815D-02, 0.5799D-02, 0.6949D-02, & + & 0.8259D-02, 0.9705D-02, 0.1123D-01, 0.1273D-01, 0.1409D-01, & + & 0.1517D-01, 0.1583D-01, 0.1597D-01, 0.1551D-01, 0.1450D-01, & + & 0.1306D-01, 0.1144D-01, 0.9914D-02, 0.8646D-02, 0.7648D-02, & + & 0.6802D-02, 0.5979D-02, 0.5131D-02, 0.4284D-02, 0.3490D-02, & + & 0.2787D-02, 0.2193D-02, 0.1706D-02, 0.1315D-02, 0.1007D-02, & + & 0.7654D-03, 0.5787D-03, 0.4354D-03, 0.3261D-03, 0.2428D-03, & + & 0.1801D-03, 0.1328D-03, 0.9812D-04, 0.7146D-04, 0.5213D-04, & + & 0.3813D-04, 0.2746D-04, 0.1946D-04, 0.1413D-04, 0.1013D-04, & + & 0.6796D-05/ + + data (calcpts(j,33), j = 1,neta) /0.1353D-04, 0.1639D-04, & + & 0.1986D-04, 0.2406D-04, 0.2915D-04, 0.3532D-04, 0.4280D-04, & + & 0.5186D-04, 0.6284D-04, 0.7611D-04, 0.9222D-04, 0.1117D-03, & + & 0.1353D-03, 0.1640D-03, 0.1987D-03, 0.2407D-03, 0.2917D-03, & + & 0.3535D-03, 0.4283D-03, 0.5190D-03, 0.6291D-03, 0.7624D-03, & + & 0.9242D-03, 0.1120D-02, 0.1359D-02, 0.1647D-02, 0.1996D-02, & + & 0.2419D-02, 0.2929D-02, 0.3539D-02, 0.4264D-02, 0.5114D-02, & + & 0.6087D-02, 0.7170D-02, 0.8324D-02, 0.9486D-02, 0.1058D-01, & + & 0.1150D-01, 0.1216D-01, 0.1247D-01, 0.1237D-01, 0.1182D-01, & + & 0.1089D-01, 0.9674D-02, 0.8381D-02, 0.7203D-02, 0.6260D-02, & + & 0.5537D-02, 0.4928D-02, 0.4334D-02, 0.3718D-02, 0.3101D-02, & + & 0.2522D-02, 0.2011D-02, 0.1580D-02, 0.1228D-02, 0.9457D-03, & + & 0.7231D-03, 0.5498D-03, 0.4151D-03, 0.3125D-03, 0.2338D-03, & + & 0.1745D-03, 0.1299D-03, 0.9586D-04, 0.7119D-04, 0.5253D-04, & + & 0.3853D-04, 0.2853D-04, 0.2053D-04, 0.1520D-04, 0.1120D-04, & + & 0.8532D-05/ + + data (calcpts(j,34), j = 1,neta) /0.9884D-05, 0.1197D-04, & + & 0.1451D-04, 0.1758D-04, 0.2129D-04, 0.2579D-04, 0.3125D-04, & + & 0.3787D-04, 0.4585D-04, 0.5560D-04, 0.6733D-04, 0.8161D-04, & + & 0.9883D-04, 0.1198D-03, 0.1451D-03, 0.1758D-03, 0.2130D-03, & + & 0.2581D-03, 0.3128D-03, 0.3790D-03, 0.4594D-03, 0.5567D-03, & + & 0.6748D-03, 0.8180D-03, 0.9920D-03, 0.1203D-02, 0.1457D-02, & + & 0.1766D-02, 0.2138D-02, 0.2585D-02, 0.3116D-02, 0.3739D-02, & + & 0.4456D-02, 0.5258D-02, 0.6121D-02, 0.7005D-02, 0.7857D-02, & + & 0.8612D-02, 0.9205D-02, 0.9575D-02, 0.9668D-02, 0.9447D-02, & + & 0.8908D-02, 0.8095D-02, 0.7109D-02, 0.6099D-02, 0.5209D-02, & + & 0.4514D-02, 0.3993D-02, 0.3557D-02, 0.3130D-02, 0.2683D-02, & + & 0.2236D-02, 0.1816D-02, 0.1445D-02, 0.1134D-02, 0.8796D-03, & + & 0.6770D-03, 0.5170D-03, 0.3924D-03, 0.2930D-03, 0.2224D-03, & + & 0.1664D-03, 0.1237D-03, 0.9174D-04, 0.6774D-04, 0.4974D-04, & + & 0.3641D-04, 0.2708D-04, 0.1974D-04, 0.1441D-04, 0.1041D-04, & + & 0.7744D-05/ + + data (calcpts(j,35), j = 1,neta) /0.7181D-05, 0.8703D-05, & + & 0.1054D-04, 0.1277D-04, 0.1548D-04, 0.1875D-04, 0.2272D-04, & + & 0.2752D-04, 0.3334D-04, 0.4039D-04, 0.4895D-04, 0.5928D-04, & + & 0.7186D-04, 0.8704D-04, 0.1055D-03, 0.1278D-03, 0.1548D-03, & + & 0.1876D-03, 0.2273D-03, 0.2754D-03, 0.3338D-03, 0.4046D-03, & + & 0.4904D-03, 0.5944D-03, 0.7209D-03, 0.8739D-03, 0.1059D-02, & + & 0.1283D-02, 0.1554D-02, 0.1878D-02, 0.2265D-02, 0.2719D-02, & + & 0.3243D-02, 0.3833D-02, 0.4472D-02, 0.5136D-02, 0.5787D-02, & + & 0.6385D-02, 0.6885D-02, 0.7246D-02, 0.7428D-02, 0.7396D-02, & + & 0.7134D-02, 0.6646D-02, 0.5971D-02, 0.5191D-02, 0.4417D-02, & + & 0.3752D-02, 0.3245D-02, 0.2871D-02, 0.2560D-02, 0.2253D-02, & + & 0.1931D-02, 0.1607D-02, 0.1303D-02, 0.1036D-02, 0.8116D-03, & + & 0.6290D-03, 0.4830D-03, 0.3684D-03, 0.2791D-03, 0.2104D-03, & + & 0.1578D-03, 0.1178D-03, 0.8778D-04, 0.6511D-04, 0.4778D-04, & + & 0.3512D-04, 0.2578D-04, 0.1845D-04, 0.1378D-04, 0.9784D-05, & + & 0.7117D-05/ + + data (calcpts(j,36), j = 1,neta) /0.5199D-05, 0.6298D-05, & + & 0.7628D-05, 0.9240D-05, 0.1120D-04, 0.1356D-04, 0.1644D-04, & + & 0.1991D-04, 0.2413D-04, 0.2923D-04, 0.3541D-04, 0.4290D-04, & + & 0.5199D-04, 0.6297D-04, 0.7629D-04, 0.9246D-04, 0.1120D-03, & + & 0.1357D-03, 0.1645D-03, 0.1993D-03, 0.2415D-03, 0.2927D-03, & + & 0.3548D-03, 0.4301D-03, 0.5213D-03, 0.6320D-03, 0.7660D-03, & + & 0.9282D-03, 0.1124D-02, 0.1359D-02, 0.1639D-02, 0.1969D-02, & + & 0.2350D-02, 0.2780D-02, 0.3250D-02, 0.3743D-02, 0.4234D-02, & + & 0.4697D-02, 0.5101D-02, 0.5419D-02, 0.5623D-02, 0.5688D-02, & + & 0.5595D-02, 0.5336D-02, 0.4918D-02, 0.4375D-02, 0.3771D-02, & + & 0.3185D-02, 0.2694D-02, 0.2326D-02, 0.2059D-02, 0.1837D-02, & + & 0.1617D-02, 0.1386D-02, 0.1152D-02, 0.9331D-03, 0.7411D-03, & + & 0.5799D-03, 0.4492D-03, 0.3446D-03, 0.2626D-03, 0.1993D-03, & + & 0.1499D-03, 0.1126D-03, 0.8394D-04, 0.6261D-04, 0.4595D-04, & + & 0.3395D-04, 0.2528D-04, 0.1795D-04, 0.1328D-04, 0.9951D-05, & + & 0.7284D-05/ + + data (calcpts(j,37), j = 1,neta) /0.3747D-05, 0.4542D-05, & + & 0.5498D-05, 0.6662D-05, 0.8071D-05, 0.9782D-05, 0.1185D-04, & + & 0.1435D-04, 0.1739D-04, 0.2107D-04, 0.2553D-04, 0.3093D-04, & + & 0.3748D-04, 0.4540D-04, 0.5502D-04, 0.6667D-04, 0.8072D-04, & + & 0.9783D-04, 0.1185D-03, 0.1437D-03, 0.1741D-03, 0.2110D-03, & + & 0.2558D-03, 0.3100D-03, 0.3758D-03, 0.4556D-03, 0.5522D-03, & + & 0.6690D-03, 0.8100D-03, 0.9794D-03, 0.1181D-02, 0.1419D-02, & + & 0.1695D-02, 0.2008D-02, 0.2351D-02, 0.2714D-02, 0.3080D-02, & + & 0.3432D-02, 0.3749D-02, 0.4013D-02, 0.4205D-02, 0.4308D-02, & + & 0.4308D-02, 0.4192D-02, 0.3958D-02, 0.3614D-02, 0.3188D-02, & + & 0.2726D-02, 0.2289D-02, 0.1928D-02, 0.1663D-02, 0.1473D-02, & + & 0.1315D-02, 0.1158D-02, 0.9917D-03, 0.8239D-03, 0.6665D-03, & + & 0.5292D-03, 0.4132D-03, 0.3199D-03, 0.2452D-03, 0.1865D-03, & + & 0.1412D-03, 0.1066D-03, 0.7989D-04, 0.5923D-04, 0.4389D-04, & + & 0.3256D-04, 0.2389D-04, 0.1723D-04, 0.1323D-04, 0.9229D-05, & + & 0.6563D-05/ + + data (calcpts(j,38), j = 1,neta) /0.2693D-05, 0.3262D-05, & + & 0.3953D-05, 0.4790D-05, 0.5801D-05, 0.7032D-05, 0.8515D-05, & + & 0.1032D-04, 0.1250D-04, 0.1514D-04, 0.1835D-04, 0.2223D-04, & + & 0.2693D-04, 0.3263D-04, 0.3954D-04, 0.4790D-04, 0.5803D-04, & + & 0.7034D-04, 0.8521D-04, 0.1033D-03, 0.1251D-03, 0.1516D-03, & + & 0.1838D-03, 0.2228D-03, 0.2700D-03, 0.3273D-03, 0.3967D-03, & + & 0.4807D-03, 0.5819D-03, 0.7036D-03, 0.8488D-03, 0.1020D-02, & + & 0.1219D-02, 0.1445D-02, 0.1694D-02, 0.1960D-02, 0.2230D-02, & + & 0.2494D-02, 0.2738D-02, 0.2949D-02, 0.3115D-02, 0.3224D-02, & + & 0.3266D-02, 0.3231D-02, 0.3114D-02, 0.2915D-02, 0.2640D-02, & + & 0.2311D-02, 0.1963D-02, 0.1640D-02, 0.1377D-02, 0.1186D-02, & + & 0.1051D-02, 0.9394D-03, 0.8273D-03, 0.7081D-03, 0.5877D-03, & + & 0.4752D-03, 0.3766D-03, 0.2938D-03, 0.2271D-03, 0.1738D-03, & + & 0.1325D-03, 0.9981D-04, 0.7515D-04, 0.5648D-04, 0.4182D-04, & + & 0.3115D-04, 0.2315D-04, 0.1648D-04, 0.1248D-04, 0.9150D-05, & + & 0.6484D-05/ + + data (calcpts(j,39), j = 1,neta) /0.1929D-05, 0.2338D-05, & + & 0.2832D-05, 0.3431D-05, 0.4157D-05, 0.5039D-05, 0.6100D-05, & + & 0.7390D-05, 0.8955D-05, 0.1085D-04, 0.1314D-04, 0.1593D-04, & + & 0.1930D-04, 0.2338D-04, 0.2833D-04, 0.3433D-04, 0.4159D-04, & + & 0.5039D-04, 0.6106D-04, 0.7396D-04, 0.8967D-04, 0.1087D-03, & + & 0.1317D-03, 0.1596D-03, 0.1935D-03, 0.2345D-03, 0.2842D-03, & + & 0.3443D-03, 0.4170D-03, 0.5041D-03, 0.6082D-03, 0.7312D-03, & + & 0.8742D-03, 0.1037D-02, 0.1217D-02, 0.1410D-02, 0.1608D-02, & + & 0.1804D-02, 0.1989D-02, 0.2153D-02, 0.2288D-02, 0.2388D-02, & + & 0.2445D-02, 0.2452D-02, 0.2404D-02, 0.2298D-02, 0.2134D-02, & + & 0.1919D-02, 0.1669D-02, 0.1410D-02, 0.1172D-02, 0.9811D-03, & + & 0.8447D-03, 0.7488D-03, 0.6697D-03, 0.5899D-03, 0.5048D-03, & + & 0.4188D-03, 0.3383D-03, 0.2679D-03, 0.2091D-03, 0.1614D-03, & + & 0.1236D-03, 0.9402D-04, 0.7108D-04, 0.5349D-04, 0.3989D-04, & + & 0.2989D-04, 0.2189D-04, 0.1655D-04, 0.1189D-04, 0.9221D-05, & + & 0.6554D-05/ + + data (calcpts(j,40), j = 1,neta) /0.1379D-05, 0.1671D-05, & + & 0.2025D-05, 0.2453D-05, 0.2972D-05, 0.3600D-05, 0.4362D-05, & + & 0.5285D-05, 0.6401D-05, 0.7759D-05, 0.9399D-05, 0.1138D-04, & + & 0.1380D-04, 0.1671D-04, 0.2025D-04, 0.2454D-04, 0.2973D-04, & + & 0.3602D-04, 0.4364D-04, 0.5288D-04, 0.6408D-04, 0.7768D-04, & + & 0.9415D-04, 0.1141D-03, 0.1382D-03, 0.1676D-03, 0.2031D-03, & + & 0.2461D-03, 0.2980D-03, 0.3602D-03, 0.4347D-03, 0.5226D-03, & + & 0.6251D-03, 0.7419D-03, 0.8716D-03, 0.1011D-02, 0.1155D-02, & + & 0.1300D-02, 0.1438D-02, 0.1563D-02, 0.1670D-02, 0.1755D-02, & + & 0.1812D-02, 0.1837D-02, 0.1825D-02, 0.1775D-02, 0.1685D-02, & + & 0.1554D-02, 0.1389D-02, 0.1201D-02, 0.1009D-02, 0.8352D-03, & + & 0.6976D-03, 0.6001D-03, 0.5322D-03, 0.4763D-03, 0.4197D-03, & + & 0.3590D-03, 0.2976D-03, 0.2402D-03, 0.1901D-03, 0.1482D-03, & + & 0.1143D-03, 0.8746D-04, 0.6646D-04, 0.5026D-04, 0.3773D-04, & + & 0.2826D-04, 0.2106D-04, 0.1546D-04, 0.1153D-04, 0.8464D-05, & + & 0.6264D-05/ + + data (calcpts(j,41), j = 1,neta) /0.9836D-06, 0.1192D-05, & + & 0.1444D-05, 0.1750D-05, 0.2120D-05, 0.2568D-05, 0.3111D-05, & + & 0.3769D-05, 0.4567D-05, 0.5531D-05, 0.6704D-05, 0.8123D-05, & + & 0.9839D-05, 0.1192D-04, 0.1444D-04, 0.1750D-04, 0.2120D-04, & + & 0.2569D-04, 0.3113D-04, 0.3772D-04, 0.4570D-04, 0.5539D-04, & + & 0.6713D-04, 0.8134D-04, 0.9861D-04, 0.1195D-03, 0.1449D-03, & + & 0.1754D-03, 0.2125D-03, 0.2569D-03, 0.3099D-03, 0.3727D-03, & + & 0.4459D-03, 0.5295D-03, 0.6227D-03, 0.7233D-03, 0.8281D-03, & + & 0.9335D-03, 0.1036D-02, 0.1130D-02, 0.1213D-02, 0.1281D-02, & + & 0.1331D-02, 0.1362D-02, 0.1368D-02, 0.1349D-02, 0.1303D-02, & + & 0.1229D-02, 0.1126D-02, 0.1001D-02, 0.8613D-03, 0.7202D-03, & + & 0.5940D-03, 0.4950D-03, 0.4256D-03, 0.3776D-03, 0.3382D-03, & + & 0.2980D-03, 0.2548D-03, 0.2111D-03, 0.1702D-03, 0.1346D-03, & + & 0.1049D-03, 0.8085D-04, 0.6179D-04, 0.4692D-04, 0.3539D-04, & + & 0.2659D-04, 0.1985D-04, 0.1466D-04, 0.1092D-04, 0.8055D-05, & + & 0.5922D-05/ + + data (calcpts(j,42), j = 1,neta) /0.7004D-06, 0.8482D-06, & + & 0.1028D-05, 0.1246D-05, 0.1509D-05, 0.1827D-05, 0.2214D-05, & + & 0.2683D-05, 0.3250D-05, 0.3938D-05, 0.4771D-05, 0.5778D-05, & + & 0.7001D-05, 0.8488D-05, 0.1028D-04, 0.1245D-04, 0.1509D-04, & + & 0.1828D-04, 0.2216D-04, 0.2684D-04, 0.3252D-04, 0.3942D-04, & + & 0.4777D-04, 0.5790D-04, 0.7017D-04, 0.8503D-04, 0.1031D-03, & + & 0.1248D-03, 0.1512D-03, 0.1828D-03, 0.2205D-03, 0.2653D-03, & + & 0.3174D-03, 0.3772D-03, 0.4439D-03, 0.5161D-03, 0.5919D-03, & + & 0.6686D-03, 0.7434D-03, 0.8136D-03, 0.8767D-03, 0.9305D-03, & + & 0.9725D-03, 0.1001D-02, 0.1015D-02, 0.1012D-02, 0.9913D-03, & + & 0.9518D-03, 0.8919D-03, 0.8136D-03, 0.7195D-03, 0.6161D-03, & + & 0.5131D-03, 0.4218D-03, 0.3507D-03, 0.3014D-03, 0.2676D-03, & + & 0.2398D-03, 0.2113D-03, 0.1806D-03, 0.1496D-03, 0.1206D-03, & + & 0.9525D-04, 0.7412D-04, 0.5712D-04, 0.4366D-04, 0.3312D-04, & + & 0.2499D-04, 0.1879D-04, 0.1392D-04, 0.1039D-04, 0.7724D-05, & + & 0.5658D-05/ + + data (calcpts(j,43), j = 1,neta) /0.4974D-06, 0.6029D-06, & + & 0.7301D-06, 0.8846D-06, 0.1071D-05, 0.1298D-05, 0.1573D-05, & + & 0.1906D-05, 0.2309D-05, 0.2798D-05, 0.3389D-05, 0.4106D-05, & + & 0.4975D-05, 0.6027D-05, 0.7305D-05, 0.8846D-05, 0.1072D-04, & + & 0.1299D-04, 0.1574D-04, 0.1907D-04, 0.2311D-04, 0.2800D-04, & + & 0.3393D-04, 0.4113D-04, 0.4985D-04, 0.6041D-04, 0.7320D-04, & + & 0.8870D-04, 0.1073D-03, 0.1298D-03, 0.1566D-03, 0.1884D-03, & + & 0.2256D-03, 0.2681D-03, 0.3157D-03, 0.3675D-03, 0.4220D-03, & + & 0.4776D-03, 0.5321D-03, 0.5840D-03, 0.6313D-03, 0.6725D-03, & + & 0.7062D-03, 0.7312D-03, 0.7465D-03, 0.7510D-03, 0.7440D-03, & + & 0.7243D-03, 0.6914D-03, 0.6450D-03, 0.5856D-03, 0.5156D-03, & + & 0.4396D-03, 0.3647D-03, 0.2989D-03, 0.2481D-03, 0.2132D-03, & + & 0.1893D-03, 0.1697D-03, 0.1496D-03, 0.1278D-03, 0.1058D-03, & + & 0.8526D-04, 0.6726D-04, 0.5232D-04, 0.4032D-04, 0.3079D-04, & + & 0.2333D-04, 0.1759D-04, 0.1319D-04, 0.9859D-05, 0.7325D-05, & + & 0.5459D-05/ + + data (calcpts(j,44), j = 1,neta) /0.3528D-06, 0.4274D-06, & + & 0.5179D-06, 0.6277D-06, 0.7598D-06, 0.9211D-06, 0.1116D-05, & + & 0.1352D-05, 0.1638D-05, 0.1984D-05, 0.2404D-05, 0.2912D-05, & + & 0.3528D-05, 0.4275D-05, 0.5179D-05, 0.6275D-05, 0.7603D-05, & + & 0.9212D-05, 0.1116D-04, 0.1352D-04, 0.1639D-04, 0.1986D-04, & + & 0.2406D-04, 0.2916D-04, 0.3535D-04, 0.4284D-04, 0.5190D-04, & + & 0.6288D-04, 0.7611D-04, 0.9204D-04, 0.1111D-03, 0.1336D-03, & + & 0.1600D-03, 0.1903D-03, 0.2242D-03, 0.2612D-03, 0.3003D-03, & + & 0.3403D-03, 0.3800D-03, 0.4180D-03, 0.4531D-03, 0.4843D-03, & + & 0.5106D-03, 0.5312D-03, 0.5454D-03, 0.5527D-03, 0.5524D-03, & + & 0.5439D-03, 0.5268D-03, 0.5004D-03, 0.4648D-03, 0.4202D-03, & + & 0.3685D-03, 0.3130D-03, 0.2588D-03, 0.2115D-03, 0.1753D-03, & + & 0.1505D-03, 0.1337D-03, 0.1199D-03, 0.1057D-03, 0.9034D-04, & + & 0.7472D-04, 0.6014D-04, 0.4747D-04, 0.3687D-04, 0.2840D-04, & + & 0.2167D-04, 0.1640D-04, 0.1240D-04, 0.9271D-05, 0.6938D-05, & + & 0.5138D-05/ + + data (calcpts(j,45), j = 1,neta) /0.2498D-06, 0.3026D-06, & + & 0.3666D-06, 0.4442D-06, 0.5384D-06, 0.6517D-06, 0.7901D-06, & + & 0.9569D-06, 0.1160D-05, 0.1405D-05, 0.1702D-05, 0.2062D-05, & + & 0.2499D-05, 0.3027D-05, 0.3667D-05, 0.4443D-05, 0.5383D-05, & + & 0.6523D-05, 0.7902D-05, 0.9579D-05, 0.1160D-04, 0.1406D-04, & + & 0.1704D-04, 0.2065D-04, 0.2502D-04, 0.3033D-04, 0.3675D-04, & + & 0.4452D-04, 0.5389D-04, 0.6516D-04, 0.7864D-04, 0.9462D-04, & + & 0.1133D-03, 0.1348D-03, 0.1589D-03, 0.1853D-03, 0.2133D-03, & + & 0.2421D-03, 0.2708D-03, 0.2985D-03, 0.3243D-03, 0.3477D-03, & + & 0.3678D-03, 0.3841D-03, 0.3963D-03, 0.4039D-03, 0.4067D-03, & + & 0.4041D-03, 0.3958D-03, 0.3816D-03, 0.3610D-03, 0.3339D-03, & + & 0.3007D-03, 0.2628D-03, 0.2225D-03, 0.1834D-03, 0.1495D-03, & + & 0.1237D-03, 0.1062D-03, 0.9438D-04, 0.8469D-04, 0.7467D-04, & + & 0.6379D-04, 0.5275D-04, 0.4245D-04, 0.3348D-04, 0.2604D-04, & + & 0.2004D-04, 0.1524D-04, 0.1158D-04, 0.8709D-05, 0.6576D-05, & + & 0.4909D-05/ + + data (calcpts(j,46), j = 1,neta) /0.1766D-06, 0.2140D-06, & + & 0.2593D-06, 0.3141D-06, 0.3805D-06, 0.4610D-06, 0.5583D-06, & + & 0.6765D-06, 0.8200D-06, 0.9935D-06, 0.1204D-05, 0.1458D-05, & + & 0.1766D-05, 0.2140D-05, 0.2593D-05, 0.3142D-05, 0.3807D-05, & + & 0.4612D-05, 0.5588D-05, 0.6771D-05, 0.8207D-05, 0.9939D-05, & + & 0.1205D-04, 0.1460D-04, 0.1770D-04, 0.2144D-04, 0.2598D-04, & + & 0.3147D-04, 0.3810D-04, 0.4606D-04, 0.5559D-04, 0.6689D-04, & + & 0.8012D-04, 0.9534D-04, 0.1125D-03, 0.1312D-03, 0.1512D-03, & + & 0.1719D-03, 0.1925D-03, 0.2126D-03, 0.2316D-03, 0.2488D-03, & + & 0.2640D-03, 0.2767D-03, 0.2866D-03, 0.2936D-03, 0.2972D-03, & + & 0.2976D-03, 0.2942D-03, 0.2869D-03, 0.2754D-03, 0.2595D-03, & + & 0.2392D-03, 0.2147D-03, 0.1870D-03, 0.1578D-03, 0.1297D-03, & + & 0.1055D-03, 0.8715D-04, 0.7480D-04, 0.6651D-04, 0.5970D-04, & + & 0.5264D-04, 0.4496D-04, 0.3716D-04, 0.2989D-04, 0.2356D-04, & + & 0.1830D-04, 0.1407D-04, 0.1073D-04, 0.8131D-05, 0.6124D-05, & + & 0.4591D-05/ + + data (calcpts(j,47), j = 1,neta) /0.1247D-06, 0.1511D-06, & + & 0.1831D-06, 0.2218D-06, 0.2687D-06, 0.3256D-06, 0.3945D-06, & + & 0.4779D-06, 0.5790D-06, 0.7013D-06, 0.8498D-06, 0.1029D-05, & + & 0.1247D-05, 0.1511D-05, 0.1831D-05, 0.2218D-05, 0.2688D-05, & + & 0.3257D-05, 0.3946D-05, 0.4781D-05, 0.5793D-05, 0.7020D-05, & + & 0.8506D-05, 0.1031D-04, 0.1249D-04, 0.1514D-04, 0.1834D-04, & + & 0.2222D-04, 0.2689D-04, 0.3252D-04, 0.3925D-04, 0.4723D-04, & + & 0.5657D-04, 0.6735D-04, 0.7949D-04, 0.9282D-04, 0.1071D-03, & + & 0.1218D-03, 0.1366D-03, 0.1512D-03, 0.1650D-03, 0.1777D-03, & + & 0.1890D-03, 0.1986D-03, 0.2065D-03, 0.2123D-03, 0.2161D-03, & + & 0.2176D-03, 0.2167D-03, 0.2133D-03, 0.2071D-03, 0.1981D-03, & + & 0.1860D-03, 0.1709D-03, 0.1530D-03, 0.1328D-03, 0.1118D-03, & + & 0.9159D-04, 0.7433D-04, 0.6134D-04, 0.5263D-04, 0.4681D-04, & + & 0.4204D-04, 0.3707D-04, 0.3166D-04, 0.2615D-04, 0.2102D-04, & + & 0.1656D-04, 0.1286D-04, 0.9878D-05, 0.7524D-05, 0.5698D-05, & + & 0.4291D-05/ + + data (calcpts(j,48), j = 1,neta) /0.8797D-07, 0.1066D-06, & + & 0.1291D-06, 0.1564D-06, 0.1895D-06, 0.2296D-06, 0.2782D-06, & + & 0.3371D-06, 0.4083D-06, 0.4947D-06, 0.5994D-06, 0.7261D-06, & + & 0.8796D-06, 0.1066D-05, 0.1291D-05, 0.1565D-05, 0.1896D-05, & + & 0.2296D-05, 0.2783D-05, 0.3372D-05, 0.4086D-05, 0.4951D-05, & + & 0.6000D-05, 0.7270D-05, 0.8808D-05, 0.1068D-04, 0.1293D-04, & + & 0.1567D-04, 0.1897D-04, 0.2293D-04, 0.2767D-04, 0.3331D-04, & + & 0.3991D-04, 0.4752D-04, 0.5611D-04, 0.6556D-04, 0.7568D-04, & + & 0.8621D-04, 0.9686D-04, 0.1073D-03, 0.1173D-03, 0.1265D-03, & + & 0.1350D-03, 0.1422D-03, 0.1482D-03, 0.1530D-03, 0.1564D-03, & + & 0.1582D-03, 0.1585D-03, 0.1572D-03, 0.1541D-03, 0.1491D-03, & + & 0.1421D-03, 0.1330D-03, 0.1219D-03, 0.1088D-03, 0.9418D-04, & + & 0.7904D-04, 0.6462D-04, 0.5233D-04, 0.4313D-04, 0.3700D-04, & + & 0.3292D-04, 0.2958D-04, 0.2609D-04, 0.2227D-04, 0.1839D-04, & + & 0.1478D-04, 0.1163D-04, 0.9027D-05, 0.6934D-05, 0.5281D-05, & + & 0.4001D-05/ + + data (calcpts(j,49), j = 1,neta) /0.6194D-07, 0.7506D-07, & + & 0.9095D-07, 0.1102D-06, 0.1335D-06, 0.1617D-06, 0.1960D-06, & + & 0.2374D-06, 0.2876D-06, 0.3485D-06, 0.4222D-06, 0.5115D-06, & + & 0.6198D-06, 0.7509D-06, 0.9094D-06, 0.1102D-05, 0.1335D-05, & + & 0.1618D-05, 0.1960D-05, 0.2375D-05, 0.2878D-05, 0.3488D-05, & + & 0.4226D-05, 0.5121D-05, 0.6206D-05, 0.7520D-05, 0.9108D-05, & + & 0.1104D-04, 0.1335D-04, 0.1615D-04, 0.1949D-04, 0.2346D-04, & + & 0.2811D-04, 0.3348D-04, 0.3956D-04, 0.4625D-04, 0.5343D-04, & + & 0.6092D-04, 0.6852D-04, 0.7603D-04, 0.8325D-04, 0.8997D-04, & + & 0.9617D-04, 0.1015D-03, 0.1062D-03, 0.1099D-03, 0.1127D-03, & + & 0.1145D-03, 0.1153D-03, 0.1150D-03, 0.1135D-03, 0.1109D-03, & + & 0.1070D-03, 0.1017D-03, 0.9490D-04, 0.8672D-04, 0.7719D-04, & + & 0.6667D-04, 0.5582D-04, 0.4553D-04, 0.3680D-04, 0.3030D-04, & + & 0.2599D-04, 0.2313D-04, 0.2079D-04, 0.1833D-04, 0.1565D-04, & + & 0.1292D-04, 0.1038D-04, 0.8170D-05, 0.6337D-05, 0.4864D-05, & + & 0.3704D-05/ + + data (dlaeta(j), j = 1,neta) / & + & -6d0, -5.83333333d0, -5.66666667d0, -5.5d0, -5.33333333d0, & + & -5.16666667d0, -5d0, -4.83333333d0, -4.66666667d0, -4.5d0, & + & -4.33333333d0, -4.16666667d0, -4d0, -3.83333333d0, & + & -3.66666667d0, -3.5d0, -3.33333333d0, -3.16666667d0, -3d0, & + & -2.83333333d0, -2.66666667d0, -2.5d0, -2.33333333d0, & + & -2.16666667d0, -2d0, -1.83333333d0, -1.66666667d0, -1.5d0, & + & -1.33333333d0, -1.16666667d0, -1d0, -0.83333333d0, -0.66666667d0,& + & -0.5d0, -0.33333333d0, -0.16666667d0, 0d0, 0.16666667d0, & + & 0.33333333d0, 0.5d0, 0.66666667d0, 0.83333333d0, 1d0, & + & 1.16666667d0, 1.33333333d0, 1.5d0, 1.66666667d0, 1.83333333d0, & + & 2d0, 2.16666667d0, 2.33333333d0, 2.5d0, 2.66666667d0, & + & 2.83333333d0, 3d0, 3.16666667d0, 3.33333333d0, 3.5d0, & + & 3.66666667d0, 3.83333333d0, 4d0, 4.16666667d0, 4.33333333d0, & + & 4.5d0, 4.66666667d0, 4.83333333d0, 5d0, 5.16666667d0, & + & 5.33333333d0, 5.5d0, 5.66666667d0, 5.83333333d0, 6d0/ + + data (dlaxi(j), j = 1,nxi) / & + & -3d0, -2.83333333d0, -2.66666667d0, -2.5d0, -2.33333333d0, & + & -2.16666667d0, -2d0, -1.83333333d0, -1.66666667d0, -1.5d0, & + & -1.33333333d0, -1.16666667d0, -1d0, -0.83333333d0, -0.66666667d0,& + & -0.5d0, -0.33333333d0, -0.16666667d0, 0d0, 0.16666667d0, & + & 0.33333333d0, 0.5d0, 0.66666667d0, 0.83333333d0, 1d0, & + & 1.16666667d0, 1.33333333d0, 1.5d0, 1.66666667d0, 1.83333333d0, & + & 2d0, 2.16666667d0, 2.33333333d0, 2.5d0, 2.66666667d0, & + & 2.83333333d0, 3d0, 3.16666667d0, 3.33333333d0, 3.5d0, & + & 3.66666667d0, 3.83333333d0, 4d0, 4.16666667d0, 4.33333333d0, & + & 4.5d0, 4.66666667d0, 4.83333333d0, 5d0/ + + dleta = dlog10(eta) + dlxi = dlog10(xi) + if (dlxi .le. dlaxi(1)) dlxi = dlaxi(1) + if (dlxi .ge. dlaxi(nxi)) dlxi = dlaxi(nxi) + if (dleta .ge. dlaeta(neta)) dleta = dlaeta(neta) + if (dleta .le. dlaeta(1)) dleta = dlaeta(1) + call locate(dlaeta,neta, dleta, ieta) + call locate(dlaxi, nxi, dlxi, ixi) +! interpolating between the appropriate points + delxi = 1d0/6d0 + deleta = 1d0/6d0 +! lagrange 3-pt. + if (ixi .le. 2) ixi = 2 + if (ixi .ge. 48) ixi = 48 + if (ieta .le. 2) ieta = 2 + if (ixi .ge. 72) ieta = 72 + pxi = (dlxi - dlaxi(ixi))/delxi + f(-1) = pxi*(pxi-1d0)/2d0*calcpts(ieta-1,ixi-1) + & + & (1d0 - pxi**2)*calcpts(ieta-1,ixi) + & + & pxi*(pxi+1d0)/2d0*calcpts(ieta-1,ixi+1) + f(0) = pxi*(pxi-1d0)/2d0*calcpts(ieta,ixi-1) + & + & (1d0 - pxi**2)*calcpts(ieta,ixi) + & + & pxi*(pxi+1d0)/2d0*calcpts(ieta,ixi+1) + f(1) = pxi*(pxi-1d0)/2d0*calcpts(ieta+1,ixi-1) + & + & (1d0 - pxi**2)*calcpts(ieta+1,ixi) + & + & pxi*(pxi+1d0)/2d0*calcpts(ieta+1,ixi+1) + peta = (dleta - dlaeta(ieta))/deleta + h1bar_Tg = peta*(peta-1d0)/2d0*f(-1) + & + & (1d0 - peta**2)*f(0) + & + & peta*(peta+1d0)/2d0*f(1) +!MB + + peta*(peta+1d0)/2d0*f(1) + return + END + +!DECK ID>, GCORRL. + +! ======================================== + double precision function h1_ALg(eta,xi) +! ======================================== + +! eq (9) in PLB347 (1995) 143 - 151 for the longitudinal piece +! MSbar scheme +! This routine is called subclca in the original code. +! Called sclca in updated code (03/06/96). + + implicit none + integer neta, nxi + parameter (neta = 73, nxi = 49) + double precision calcpts(neta, nxi), dlaeta(neta), dlaxi(nxi) + double precision eta, xi, dleta, dlxi + double precision pxi, peta, f(-1:1), delxi, deleta + integer j, ieta, ixi + + data (calcpts(j, 1), j = 1,neta) /-.1179D-07, -.1428D-07, & + & -.1730D-07, -.2095D-07, -.2538D-07, -.3074D-07, -.3723D-07, & + & -.4509D-07, -.5457D-07, -.6604D-07, -.7989D-07, -.9657D-07, & + & -.1166D-06, -.1406D-06, -.1691D-06, -.2029D-06, -.2423D-06, & + & -.2875D-06, -.3377D-06, -.3910D-06, -.4424D-06, -.4824D-06, & + & -.4929D-06, -.4417D-06, -.2734D-06, 0.1048D-06, 0.8410D-06, & + & 0.2167D-05, 0.4413D-05, 0.8018D-05, 0.1347D-04, 0.2118D-04, & + & 0.3115D-04, 0.4274D-04, 0.5440D-04, 0.6402D-04, 0.6968D-04, & + & 0.7031D-04, 0.6605D-04, 0.5802D-04, 0.4795D-04, 0.3757D-04, & + & 0.2814D-04, 0.2032D-04, 0.1427D-04, 0.9805D-05, 0.6626D-05, & + & 0.4430D-05, 0.2942D-05, 0.1939D-05, 0.1271D-05, 0.8315D-06, & + & 0.5416D-06, 0.3496D-06, 0.2296D-06, 0.1507D-06, 0.9812D-07, & + & 0.6371D-07, 0.3752D-07, 0.2606D-07, 0.1129D-07, 0.1001D-07, & + & 0.6726D-08, -.6033D-10, 0.1982D-08, -.1166D-08, -.3311D-08, & + & -.4773D-08, 0.8985D-09, 0.2197D-09, -.2427D-09, -.5576D-09, & + & -.7721D-09/ + + data (calcpts(j, 2), j = 1,neta) /-.1730D-07, -.2096D-07, & + & -.2538D-07, -.3075D-07, -.3725D-07, -.4512D-07, -.5464D-07, & + & -.6617D-07, -.8009D-07, -.9693D-07, -.1173D-06, -.1417D-06, & + & -.1711D-06, -.2063D-06, -.2482D-06, -.2978D-06, -.3556D-06, & + & -.4219D-06, -.4957D-06, -.5739D-06, -.6493D-06, -.7080D-06, & + & -.7235D-06, -.6485D-06, -.4017D-06, 0.1531D-06, 0.1234D-05, & + & 0.3179D-05, 0.6475D-05, 0.1177D-04, 0.1977D-04, 0.3108D-04, & + & 0.4572D-04, 0.6272D-04, 0.7983D-04, 0.9395D-04, 0.1023D-03, & + & 0.1032D-03, 0.9692D-04, 0.8514D-04, 0.7037D-04, 0.5514D-04, & + & 0.4130D-04, 0.2982D-04, 0.2094D-04, 0.1439D-04, 0.9726D-05, & + & 0.6501D-05, 0.4316D-05, 0.2843D-05, 0.1869D-05, 0.1219D-05, & + & 0.7955D-06, 0.5175D-06, 0.3379D-06, 0.2175D-06, 0.1385D-06, & + & 0.8579D-07, 0.5801D-07, 0.3185D-07, 0.2039D-07, 0.1227D-07, & + & 0.4342D-08, 0.1049D-08, 0.9303D-09, -.3690D-08, -.1711D-09, & + & -.2317D-08, -.3777D-08, -.4773D-08, -.5452D-08, -.5914D-08, & + & -.6228D-08/ + + data (calcpts(j, 3), j = 1,neta) /-.2537D-07, -.3074D-07, & + & -.3724D-07, -.4511D-07, -.5465D-07, -.6619D-07, -.8016D-07, & + & -.9707D-07, -.1175D-06, -.1422D-06, -.1720D-06, -.2079D-06, & + & -.2510D-06, -.3027D-06, -.3642D-06, -.4368D-06, -.5217D-06, & + & -.6189D-06, -.7272D-06, -.8419D-06, -.9525D-06, -.1039D-05, & + & -.1061D-05, -.9512D-06, -.5895D-06, 0.2244D-06, 0.1810D-05, & + & 0.4663D-05, 0.9499D-05, 0.1726D-04, 0.2900D-04, 0.4559D-04, & + & 0.6706D-04, 0.9199D-04, 0.1171D-03, 0.1378D-03, 0.1500D-03, & + & 0.1513D-03, 0.1421D-03, 0.1249D-03, 0.1032D-03, 0.8086D-04, & + & 0.6056D-04, 0.4373D-04, 0.3071D-04, 0.2110D-04, 0.1427D-04, & + & 0.9545D-05, 0.6330D-05, 0.4175D-05, 0.2746D-05, 0.1799D-05, & + & 0.1177D-05, 0.7653D-06, 0.4997D-06, 0.3263D-06, 0.2127D-06, & + & 0.1402D-06, 0.9418D-07, 0.5982D-07, 0.4034D-07, 0.2889D-07, & + & 0.2081D-07, 0.1287D-07, 0.9587D-08, 0.9478D-08, 0.4861D-08, & + & 0.8381D-08, 0.6240D-08, 0.4779D-08, 0.3784D-08, 0.3106D-08, & + & 0.2644D-08/ + + data (calcpts(j, 4), j = 1,neta) /-.3724D-07, -.4511D-07, & + & -.5464D-07, -.6620D-07, -.8019D-07, -.9713D-07, -.1176D-06, & + & -.1424D-06, -.1724D-06, -.2087D-06, -.2524D-06, -.3051D-06, & + & -.3684D-06, -.4442D-06, -.5344D-06, -.6411D-06, -.7656D-06, & + & -.9083D-06, -.1067D-05, -.1236D-05, -.1398D-05, -.1524D-05, & + & -.1558D-05, -.1397D-05, -.8658D-06, 0.3268D-06, 0.2652D-05, & + & 0.6837D-05, 0.1393D-04, 0.2531D-04, 0.4253D-04, 0.6687D-04, & + & 0.9836D-04, 0.1349D-03, 0.1717D-03, 0.2021D-03, 0.2200D-03, & + & 0.2219D-03, 0.2085D-03, 0.1831D-03, 0.1514D-03, 0.1186D-03, & + & 0.8883D-04, 0.6414D-04, 0.4504D-04, 0.3095D-04, 0.2093D-04, & + & 0.1400D-04, 0.9283D-05, 0.6119D-05, 0.4024D-05, 0.2635D-05, & + & 0.1720D-05, 0.1122D-05, 0.7284D-06, 0.4753D-06, 0.3088D-06, & + & 0.2015D-06, 0.1291D-06, 0.8310D-07, 0.5541D-07, 0.3594D-07, & + & 0.2453D-07, 0.1644D-07, 0.8512D-08, 0.5240D-08, 0.5134D-08, & + & 0.7185D-08, 0.4044D-08, 0.1901D-08, 0.4413D-09, 0.6114D-08, & + & 0.5437D-08/ + + data (calcpts(j, 5), j = 1,neta) /-.5464D-07, -.6620D-07, & + & -.8018D-07, -.9714D-07, -.1177D-06, -.1425D-06, -.1726D-06, & + & -.2090D-06, -.2530D-06, -.3062D-06, -.3704D-06, -.4477D-06, & + & -.5406D-06, -.6519D-06, -.7842D-06, -.9407D-06, -.1123D-05, & + & -.1333D-05, -.1566D-05, -.1813D-05, -.2052D-05, -.2229D-05, & + & -.2287D-05, -.2051D-05, -.1274D-05, 0.4740D-06, 0.3881D-05, & + & 0.1002D-04, 0.2042D-04, 0.3710D-04, 0.6236D-04, 0.9805D-04, & + & 0.1442D-03, 0.1979D-03, 0.2518D-03, 0.2964D-03, 0.3225D-03, & + & 0.3254D-03, 0.3056D-03, 0.2685D-03, 0.2219D-03, 0.1739D-03, & + & 0.1302D-03, 0.9403D-04, 0.6603D-04, 0.4537D-04, 0.3067D-04, & + & 0.2051D-04, 0.1360D-04, 0.8964D-05, 0.5884D-05, 0.3854D-05, & + & 0.2514D-05, 0.1636D-05, 0.1062D-05, 0.6875D-06, 0.4415D-06, & + & 0.2878D-06, 0.1807D-06, 0.1151D-06, 0.6913D-07, 0.4147D-07, & + & 0.2875D-07, 0.1733D-07, 0.9258D-08, 0.1351D-08, -.1914D-08, & + & -.2016D-08, 0.4406D-10, -.3098D-08, -.5239D-08, -.6697D-08, & + & -.7690D-08/ + + data (calcpts(j, 6), j = 1,neta) /-.8015D-07, -.9710D-07, & + & -.1176D-06, -.1425D-06, -.1726D-06, -.2090D-06, -.2532D-06, & + & -.3066D-06, -.3711D-06, -.4491D-06, -.5433D-06, -.6566D-06, & + & -.7929D-06, -.9561D-06, -.1150D-05, -.1380D-05, -.1648D-05, & + & -.1955D-05, -.2297D-05, -.2660D-05, -.3010D-05, -.3283D-05, & + & -.3357D-05, -.3012D-05, -.1874D-05, 0.6859D-06, 0.5677D-05, & + & 0.1467D-04, 0.2990D-04, 0.5435D-04, 0.9137D-04, 0.1437D-03, & + & 0.2113D-03, 0.2900D-03, 0.3690D-03, 0.4343D-03, 0.4726D-03, & + & 0.4768D-03, 0.4478D-03, 0.3933D-03, 0.3251D-03, 0.2547D-03, & + & 0.1908D-03, 0.1377D-03, 0.9673D-04, 0.6645D-04, 0.4493D-04, & + & 0.3004D-04, 0.1995D-04, 0.1316D-04, 0.8593D-05, 0.5674D-05, & + & 0.3711D-05, 0.2394D-05, 0.1547D-05, 0.1026D-05, 0.6864D-06, & + & 0.4268D-06, 0.2468D-06, 0.1668D-06, 0.8797D-07, 0.5549D-07, & + & 0.5467D-07, 0.8638D-08, 0.4394D-07, 0.2258D-07, 0.8028D-08, & + & -.1890D-08, -.8640D-08, -.1324D-07, -.1638D-07, -.1852D-07, & + & -.1997D-07/ + + data (calcpts(j, 7), j = 1,neta) /-.1175D-06, -.1424D-06, & + & -.1725D-06, -.2089D-06, -.2531D-06, -.3065D-06, -.3712D-06, & + & -.4496D-06, -.5441D-06, -.6585D-06, -.7966D-06, -.9629D-06, & + & -.1163D-05, -.1402D-05, -.1687D-05, -.2023D-05, -.2417D-05, & + & -.2867D-05, -.3369D-05, -.3901D-05, -.4415D-05, -.4817D-05, & + & -.4927D-05, -.4425D-05, -.2761D-05, 0.9843D-06, 0.8293D-05, & + & 0.2145D-04, 0.4376D-04, 0.7956D-04, 0.1338D-03, 0.2103D-03, & + & 0.3094D-03, 0.4245D-03, 0.5403D-03, 0.6358D-03, 0.6919D-03, & + & 0.6980D-03, 0.6555D-03, 0.5757D-03, 0.4758D-03, 0.3728D-03, & + & 0.2792D-03, 0.2016D-03, 0.1416D-03, 0.9723D-04, 0.6578D-04, & + & 0.4393D-04, 0.2913D-04, 0.1919D-04, 0.1264D-04, 0.8225D-05, & + & 0.5357D-05, 0.3523D-05, 0.2272D-05, 0.1492D-05, 0.9729D-06, & + & 0.6333D-06, 0.3745D-06, 0.2620D-06, 0.1824D-06, 0.1038D-06, & + & 0.7170D-07, 0.7095D-07, 0.2502D-07, -.6248D-08, 0.3911D-07, & + & 0.2459D-07, 0.1470D-07, 0.7959D-08, 0.3366D-08, 0.2383D-09, & + & -.1893D-08/ + + data (calcpts(j, 8), j = 1,neta) /-.1723D-06, -.2087D-06, & + & -.2528D-06, -.3063D-06, -.3710D-06, -.4494D-06, -.5442D-06, & + & -.6590D-06, -.7977D-06, -.9654D-06, -.1168D-05, -.1412D-05, & + & -.1705D-05, -.2055D-05, -.2473D-05, -.2966D-05, -.3543D-05, & + & -.4204D-05, -.4940D-05, -.5721D-05, -.6476D-05, -.7067D-05, & + & -.7232D-05, -.6503D-05, -.4077D-05, 0.1394D-05, 0.1208D-04, & + & 0.3131D-04, 0.6393D-04, 0.1163D-03, 0.1956D-03, 0.3076D-03, & + & 0.4526D-03, 0.6210D-03, 0.7904D-03, 0.9301D-03, 0.1012D-02, & + & 0.1021D-02, 0.9584D-03, 0.8418D-03, 0.6956D-03, 0.5450D-03, & + & 0.4082D-03, 0.2947D-03, 0.2069D-03, 0.1421D-03, 0.9608D-04, & + & 0.6424D-04, 0.4255D-04, 0.2802D-04, 0.1842D-04, 0.1201D-04, & + & 0.7843D-05, 0.5108D-05, 0.3342D-05, 0.2159D-05, 0.1384D-05, & + & 0.8661D-06, 0.5282D-06, 0.3378D-06, 0.2262D-06, 0.1472D-06, & + & 0.6927D-07, 0.3732D-07, 0.3679D-07, -.8953D-08, -.4013D-07, & + & 0.5292D-08, -.9167D-08, -.1903D-07, -.2575D-07, -.3033D-07, & + & -.3344D-07/ + + data (calcpts(j, 9), j = 1,neta) /-.2523D-06, -.3056D-06, & + & -.3702D-06, -.4485D-06, -.5433D-06, -.6580D-06, -.7969D-06, & + & -.9650D-06, -.1168D-05, -.1414D-05, -.1710D-05, -.2067D-05, & + & -.2496D-05, -.3010D-05, -.3621D-05, -.4344D-05, -.5189D-05, & + & -.6157D-05, -.7236D-05, -.8381D-05, -.9489D-05, -.1036D-04, & + & -.1061D-04, -.9553D-05, -.6026D-05, 0.1952D-05, 0.1753D-04, & + & 0.4560D-04, 0.9323D-04, 0.1697D-03, 0.2854D-03, 0.4491D-03, & + & 0.6608D-03, 0.9066D-03, 0.1154D-02, 0.1358D-02, 0.1477D-02, & + & 0.1489D-02, 0.1398D-02, 0.1228D-02, 0.1015D-02, 0.7949D-03, & + & 0.5953D-03, 0.4298D-03, 0.3017D-03, 0.2073D-03, 0.1401D-03, & + & 0.9366D-04, 0.6213D-04, 0.4095D-04, 0.2689D-04, 0.1763D-04, & + & 0.1148D-04, 0.7522D-05, 0.4865D-05, 0.3176D-05, 0.2071D-05, & + & 0.1367D-05, 0.9203D-06, 0.5863D-06, 0.3981D-06, 0.2880D-06, & + & 0.2103D-06, 0.1330D-06, 0.1016D-06, 0.1015D-06, 0.5597D-07, & + & 0.9162D-07, 0.7051D-07, 0.5611D-07, 0.4630D-07, 0.3963D-07, & + & 0.3507D-07/ + + data (calcpts(j,10), j = 1,neta) /-.3692D-06, -.4473D-06, & + & -.5418D-06, -.6564D-06, -.7951D-06, -.9630D-06, -.1166D-05, & + & -.1412D-05, -.1710D-05, -.2069D-05, -.2503D-05, -.3025D-05, & + & -.3653D-05, -.4405D-05, -.5300D-05, -.6359D-05, -.7596D-05, & + & -.9014D-05, -.1059D-04, -.1228D-04, -.1390D-04, -.1519D-04, & + & -.1557D-04, -.1406D-04, -.8939D-05, 0.2642D-05, 0.2530D-04, & + & 0.6612D-04, 0.1355D-03, 0.2468D-03, 0.4155D-03, 0.6540D-03, & + & 0.9626D-03, 0.1321D-02, 0.1681D-02, 0.1977D-02, 0.2151D-02, & + & 0.2168D-02, 0.2035D-02, 0.1787D-02, 0.1476D-02, 0.1157D-02, & + & 0.8661D-03, 0.6252D-03, 0.4389D-03, 0.3014D-03, 0.2036D-03, & + & 0.1361D-03, 0.9018D-04, 0.5939D-04, 0.3901D-04, 0.2549D-04, & + & 0.1665D-04, 0.1087D-04, 0.7076D-05, 0.4575D-05, 0.2974D-05, & + & 0.1947D-05, 0.1253D-05, 0.8136D-06, 0.5508D-06, 0.3657D-06, & + & 0.2582D-06, 0.1818D-06, 0.1055D-06, 0.7487D-07, 0.7522D-07, & + & 0.3003D-07, 0.6594D-07, 0.4496D-07, 0.3066D-07, 0.2093D-07, & + & 0.1430D-07/ + + data (calcpts(j,11), j = 1,neta) /-.5396D-06, -.6538D-06, & + & -.7919D-06, -.9593D-06, -.1162D-05, -.1408D-05, -.1705D-05, & + & -.2064D-05, -.2499D-05, -.3024D-05, -.3658D-05, -.4422D-05, & + & -.5340D-05, -.6440D-05, -.7748D-05, -.9296D-05, -.1111D-04, & + & -.1318D-04, -.1550D-04, -.1796D-04, -.2035D-04, -.2225D-04, & + & -.2285D-04, -.2070D-04, -.1334D-04, 0.3407D-05, 0.3622D-04, & + & 0.9542D-04, 0.1961D-03, 0.3577D-03, 0.6026D-03, 0.9490D-03, & + & 0.1397D-02, 0.1918D-02, 0.2441D-02, 0.2870D-02, 0.3121D-02, & + & 0.3145D-02, 0.2951D-02, 0.2590D-02, 0.2140D-02, 0.1676D-02, & + & 0.1255D-02, 0.9058D-03, 0.6357D-03, 0.4364D-03, 0.2948D-03, & + & 0.1969D-03, 0.1304D-03, 0.8575D-04, 0.5625D-04, 0.3676D-04, & + & 0.2393D-04, 0.1552D-04, 0.1008D-04, 0.6481D-05, 0.4160D-05, & + & 0.2653D-05, 0.1713D-05, 0.1101D-05, 0.6720D-06, 0.4159D-06, & + & 0.2361D-06, 0.1315D-06, 0.5727D-07, 0.4929D-07, 0.1966D-07, & + & -.4596D-07, -.2396D-07, -.5443D-07, -.8516D-08, -.2265D-07, & + & -.3228D-07/ + + data (calcpts(j,12), j = 1,neta) /-.7869D-06, -.9534D-06, & + & -.1155D-05, -.1399D-05, -.1695D-05, -.2053D-05, -.2486D-05, & + & -.3010D-05, -.3644D-05, -.4410D-05, -.5335D-05, -.6449D-05, & + & -.7788D-05, -.9392D-05, -.1130D-04, -.1356D-04, -.1620D-04, & + & -.1923D-04, -.2262D-04, -.2623D-04, -.2974D-04, -.3256D-04, & + & -.3352D-04, -.3053D-04, -.2001D-04, 0.4009D-05, 0.5124D-04, & + & 0.1366D-03, 0.2818D-03, 0.5152D-03, 0.8691D-03, 0.1370D-02, & + & 0.2017D-02, 0.2770D-02, 0.3525D-02, 0.4144D-02, 0.4503D-02, & + & 0.4535D-02, 0.4252D-02, 0.3731D-02, 0.3082D-02, 0.2414D-02, & + & 0.1807D-02, 0.1304D-02, 0.9149D-03, 0.6277D-03, 0.4238D-03, & + & 0.2828D-03, 0.1872D-03, 0.1229D-03, 0.8080D-04, 0.5295D-04, & + & 0.3401D-04, 0.2244D-04, 0.1462D-04, 0.9176D-05, 0.6076D-05, & + & 0.3683D-05, 0.2688D-05, 0.1315D-05, 0.1259D-05, 0.3109D-06, & + & 0.3326D-06, 0.5592D-06, 0.2594D-06, 0.5532D-07, -.8377D-07, & + & -.1786D-06, -.2431D-06, -.2871D-06, -.3171D-06, -.3375D-06, & + & 0.3153D-06/ + + data (calcpts(j,13), j = 1,neta) /-.1144D-05, -.1386D-05, & + & -.1679D-05, -.2034D-05, -.2464D-05, -.2985D-05, -.3615D-05, & + & -.4377D-05, -.5298D-05, -.6413D-05, -.7758D-05, -.9378D-05, & + & -.1133D-04, -.1366D-04, -.1644D-04, -.1973D-04, -.2357D-04, & + & -.2799D-04, -.3293D-04, -.3821D-04, -.4338D-04, -.4758D-04, & + & -.4914D-04, -.4507D-04, -.3027D-04, 0.3885D-05, 0.7130D-04, & + & 0.1933D-03, 0.4011D-03, 0.7355D-03, 0.1243D-02, 0.1961D-02, & + & 0.2891D-02, 0.3971D-02, 0.5053D-02, 0.5938D-02, 0.6447D-02, & + & 0.6486D-02, 0.6077D-02, 0.5330D-02, 0.4401D-02, 0.3446D-02, & + & 0.2579D-02, 0.1861D-02, 0.1304D-02, 0.8946D-03, 0.6032D-03, & + & 0.4024D-03, 0.2659D-03, 0.1747D-03, 0.1141D-03, 0.7479D-04, & + & 0.4834D-04, 0.3132D-04, 0.2016D-04, 0.1329D-04, 0.8727D-05, & + & 0.5761D-05, 0.3467D-05, 0.2542D-05, 0.1215D-05, 0.1189D-05, & + & 0.2640D-06, 0.2996D-06, 0.5363D-06, 0.2436D-06, 0.4415D-07, & + & -.9180D-07, -.1843D-06, -.2474D-06, -.2904D-06, -.3197D-06, & + & 0.3270D-06/ + + data (calcpts(j,14), j = 1,neta) /-.1657D-05, -.2007D-05, & + & -.2431D-05, -.2945D-05, -.3568D-05, -.4322D-05, -.5234D-05, & + & -.6338D-05, -.7672D-05, -.9286D-05, -.1123D-04, -.1358D-04, & + & -.1640D-04, -.1978D-04, -.2381D-04, -.2858D-04, -.3416D-04, & + & -.4059D-04, -.4778D-04, -.5550D-04, -.6310D-04, -.6938D-04, & + & -.7199D-04, -.6670D-04, -.4629D-04, 0.1539D-05, 0.9639D-04, & + & 0.2687D-03, 0.5627D-03, 0.1037D-02, 0.1757D-02, 0.2777D-02, & + & 0.4099D-02, 0.5632D-02, 0.7167D-02, 0.8417D-02, 0.9127D-02, & + & 0.9171D-02, 0.8582D-02, 0.7520D-02, 0.6206D-02, 0.4858D-02, & + & 0.3635D-02, 0.2621D-02, 0.1836D-02, 0.1258D-02, 0.8476D-03, & + & 0.5644D-03, 0.3724D-03, 0.2439D-03, 0.1595D-03, 0.1036D-03, & + & 0.6734D-04, 0.4349D-04, 0.2802D-04, 0.1813D-04, 0.1171D-04, & + & 0.7432D-05, 0.4671D-05, 0.2520D-05, 0.1690D-05, 0.1095D-05, & + & 0.4487D-06, 0.2198D-06, 0.2762D-06, -.1392D-06, -.4223D-06, & + & 0.5138D-07, -.7992D-07, -.1695D-06, -.2305D-06, -.2721D-06, & + & -.3004D-06/ + + data (calcpts(j,15), j = 1,neta) /-.2383D-05, -.2887D-05, & + & -.3497D-05, -.4237D-05, -.5132D-05, -.6216D-05, -.7528D-05, & + & -.9117D-05, -.1104D-04, -.1336D-04, -.1616D-04, -.1954D-04, & + & -.2360D-04, -.2847D-04, -.3427D-04, -.4115D-04, -.4920D-04, & + & -.5849D-04, -.6892D-04, -.8016D-04, -.9134D-04, -.1008D-03, & + & -.1052D-03, -.9882D-04, -.7144D-04, -.5986D-05, 0.1249D-03, & + & 0.3641D-03, 0.7735D-03, 0.1435D-02, 0.2441D-02, 0.3868D-02, & + & 0.5719D-02, 0.7864D-02, 0.1001D-01, 0.1174D-01, 0.1271D-01, & + & 0.1274D-01, 0.1190D-01, 0.1042D-01, 0.8590D-02, 0.6721D-02, & + & 0.5026D-02, 0.3621D-02, 0.2535D-02, 0.1734D-02, 0.1166D-02, & + & 0.7749D-03, 0.5102D-03, 0.3340D-03, 0.2176D-03, 0.1414D-03, & + & 0.9123D-04, 0.5901D-04, 0.3835D-04, 0.2483D-04, 0.1587D-04, & + & 0.1004D-04, 0.6855D-05, 0.4387D-05, 0.3100D-05, 0.1738D-05, & + & 0.1237D-05, 0.1319D-05, 0.4663D-06, 0.5524D-06, 0.8235D-06, & + & 0.5539D-06, 0.3704D-06, 0.2452D-06, 0.1599D-06, 0.7685D-06, & + & 0.7290D-06/ + + data (calcpts(j,16), j = 1,neta) /-.3399D-05, -.4118D-05, & + & -.4987D-05, -.6042D-05, -.7320D-05, -.8866D-05, -.1074D-04, & + & -.1300D-04, -.1574D-04, -.1905D-04, -.2305D-04, -.2787D-04, & + & -.3367D-04, -.4062D-04, -.4892D-04, -.5875D-04, -.7030D-04, & + & -.8363D-04, -.9867D-04, -.1150D-03, -.1314D-03, -.1457D-03, & + & -.1534D-03, -.1467D-03, -.1116D-03, -.2496D-04, 0.1510D-03, & + & 0.4744D-03, 0.1031D-02, 0.1933D-02, 0.3310D-02, 0.5266D-02, & + & 0.7804D-02, 0.1074D-01, 0.1367D-01, 0.1602D-01, 0.1729D-01, & + & 0.1729D-01, 0.1611D-01, 0.1407D-01, 0.1159D-01, 0.9058D-02, & + & 0.6768D-02, 0.4871D-02, 0.3403D-02, 0.2322D-02, 0.1558D-02, & + & 0.1031D-02, 0.6766D-03, 0.4404D-03, 0.2855D-03, 0.1841D-03, & + & 0.1183D-03, 0.7551D-04, 0.4836D-04, 0.3095D-04, 0.1992D-04, & + & 0.1215D-04, 0.7833D-05, 0.5229D-05, 0.3152D-05, 0.2130D-05, & + & 0.1620D-05, 0.5744D-06, 0.7410D-06, 0.6133D-06, 0.7196D-07, & + & 0.3697D-06, 0.1186D-06, -.5265D-07, 0.4973D-06, 0.4179D-06, & + & 0.3637D-06/ + + data (calcpts(j,17), j = 1,neta) /-.4787D-05, -.5799D-05, & + & -.7024D-05, -.8510D-05, -.1031D-04, -.1249D-04, -.1512D-04, & + & -.1831D-04, -.2217D-04, -.2684D-04, -.3247D-04, -.3927D-04, & + & -.4744D-04, -.5726D-04, -.6897D-04, -.8288D-04, -.9925D-04, & + & -.1182D-03, -.1397D-03, -.1632D-03, -.1872D-03, -.2089D-03, & + & -.2225D-03, -.2175D-03, -.1756D-03, -.6628D-04, 0.1608D-03, & + & 0.5829D-03, 0.1315D-02, 0.2507D-02, 0.4333D-02, 0.6934D-02, & + & 0.1031D-01, 0.1423D-01, 0.1811D-01, 0.2118D-01, 0.2278D-01, & + & 0.2267D-01, 0.2103D-01, 0.1831D-01, 0.1505D-01, 0.1175D-01, & + & 0.8769D-02, 0.6299D-02, 0.4389D-02, 0.2984D-02, 0.1991D-02, & + & 0.1311D-02, 0.8538D-03, 0.5514D-03, 0.3545D-03, 0.2259D-03, & + & 0.1436D-03, 0.9038D-04, 0.5691D-04, 0.3544D-04, 0.2219D-04, & + & 0.1349D-04, 0.8014D-05, 0.4806D-05, 0.2954D-05, 0.1390D-05, & + & 0.7233D-06, 0.4491D-06, -.4337D-06, -.1554D-06, -.2076D-06, & + & -.6975D-06, -.3643D-06, -.5918D-06, -.8006D-07, -.1856D-06, & + & -.2575D-06/ + + data (calcpts(j,18), j = 1,neta) /-.6622D-05, -.8023D-05, & + & -.9718D-05, -.1177D-04, -.1426D-04, -.1728D-04, -.2092D-04, & + & -.2534D-04, -.3068D-04, -.3714D-04, -.4494D-04, -.5435D-04, & + & -.6568D-04, -.7930D-04, -.9556D-04, -.1149D-03, -.1377D-03, & + & -.1643D-03, -.1945D-03, -.2280D-03, -.2629D-03, -.2957D-03, & + & -.3192D-03, -.3204D-03, -.2763D-03, -.1477D-03, 0.1293D-03, & + & 0.6528D-03, 0.1571D-02, 0.3078D-02, 0.5398D-02, 0.8718D-02, & + & 0.1304D-01, 0.1805D-01, 0.2298D-01, 0.2680D-01, 0.2868D-01, & + & 0.2835D-01, 0.2612D-01, 0.2263D-01, 0.1854D-01, 0.1444D-01, & + & 0.1075D-01, 0.7700D-02, 0.5341D-02, 0.3610D-02, 0.2390D-02, & + & 0.1559D-02, 0.1004D-02, 0.6399D-03, 0.4053D-03, 0.2541D-03, & + & 0.1585D-03, 0.9786D-04, 0.6010D-04, 0.3658D-04, 0.2153D-04, & + & 0.1259D-04, 0.7535D-05, 0.4100D-05, 0.2275D-05, 0.6996D-06, & + & 0.4511D-06, 0.2193D-06, -.4223D-06, -.4336D-06, -.1650D-07, & + & 0.2570D-07, -.3993D-06, -.2249D-07, -.2200D-06, -.3545D-06, & + & -.4461D-06/ + + data (calcpts(j,19), j = 1,neta) /-.8944D-05, -.1084D-04, & + & -.1313D-04, -.1590D-04, -.1926D-04, -.2333D-04, -.2826D-04, & + & -.3423D-04, -.4144D-04, -.5018D-04, -.6073D-04, -.7346D-04, & + & -.8880D-04, -.1072D-03, -.1293D-03, -.1556D-03, -.1868D-03, & + & -.2231D-03, -.2649D-03, -.3117D-03, -.3616D-03, -.4106D-03, & + & -.4504D-03, -.4657D-03, -.4291D-03, -.2940D-03, 0.1615D-04, & + & 0.6224D-03, 0.1702D-02, 0.3494D-02, 0.6278D-02, 0.1028D-01, & + & 0.1552D-01, 0.2159D-01, 0.2751D-01, 0.3198D-01, 0.3397D-01, & + & 0.3323D-01, 0.3029D-01, 0.2600D-01, 0.2118D-01, 0.1643D-01, & + & 0.1219D-01, 0.8681D-02, 0.5976D-02, 0.3995D-02, 0.2606D-02, & + & 0.1672D-02, 0.1050D-02, 0.6528D-03, 0.4005D-03, 0.2438D-03, & + & 0.1417D-03, 0.8085D-04, 0.5090D-04, 0.2916D-04, 0.1133D-04, & + & 0.9738D-05, -.7403D-06, 0.3042D-05, -.1345D-05, -.2214D-05, & + & -.6755D-06, -.4174D-05, 0.1085D-06, -.1515D-05, -.2621D-05, & + & -.3374D-05, 0.2779D-05, 0.2429D-05, 0.2191D-05, 0.2029D-05, & + & 0.1918D-05/ + + data (calcpts(j,20), j = 1,neta) /-.1170D-04, -.1418D-04, & + & -.1718D-04, -.2081D-04, -.2521D-04, -.3054D-04, -.3699D-04, & + & -.4480D-04, -.5424D-04, -.6568D-04, -.7950D-04, -.9619D-04, & + & -.1163D-03, -.1405D-03, -.1696D-03, -.2043D-03, -.2455D-03, & + & -.2939D-03, -.3500D-03, -.4137D-03, -.4831D-03, -.5545D-03, & + & -.6190D-03, -.6600D-03, -.6477D-03, -.5303D-03, -.2221D-03, & + & 0.4126D-03, 0.1576D-02, 0.3543D-02, 0.6635D-02, 0.1113D-01, & + & 0.1703D-01, 0.2388D-01, 0.3049D-01, 0.3532D-01, 0.3712D-01, & + & 0.3572D-01, 0.3197D-01, 0.2701D-01, 0.2174D-01, 0.1674D-01, & + & 0.1232D-01, 0.8686D-02, 0.5892D-02, 0.3851D-02, 0.2443D-02, & + & 0.1508D-02, 0.9013D-03, 0.5197D-03, 0.2912D-03, 0.1579D-03, & + & 0.7953D-04, 0.3170D-04, 0.7900D-05, -.3297D-05, -.7561D-05, & + & -.6888D-05, -.7032D-05, -.1196D-04, -.4404D-05, -.6222D-05, & + & -.5329D-05, -.2602D-05, -.5286D-05, -.4467D-06, -.1692D-05, & + & -.2541D-05, -.3118D-05, -.3512D-05, -.3781D-05, -.3963D-05, & + & -.4088D-05/ + + data (calcpts(j,21), j = 1,neta) /-.1470D-04, -.1781D-04, & + & -.2158D-04, -.2614D-04, -.3167D-04, -.3836D-04, -.4647D-04, & + & -.5628D-04, -.6815D-04, -.8253D-04, -.9992D-04, -.1209D-03, & + & -.1463D-03, -.1768D-03, -.2135D-03, -.2575D-03, -.3099D-03, & + & -.3718D-03, -.4443D-03, -.5276D-03, -.6206D-03, -.7201D-03, & + & -.8181D-03, -.8986D-03, -.9318D-03, -.8660D-03, -.6136D-03, & + & -.3460D-04, 0.1080D-02, 0.3021D-02, 0.6132D-02, 0.1071D-01, & + & 0.1680D-01, 0.2386D-01, 0.3062D-01, 0.3531D-01, 0.3655D-01, & + & 0.3428D-01, 0.2968D-01, 0.2428D-01, 0.1905D-01, 0.1439D-01, & + & 0.1041D-01, 0.7176D-02, 0.4703D-02, 0.2916D-02, 0.1706D-02, & + & 0.9332D-03, 0.4593D-03, 0.1896D-03, 0.4181D-04, -.3145D-04, & + & -.5890D-04, -.6627D-04, -.6098D-04, -.5508D-04, -.4132D-04, & + & -.3532D-04, -.2972D-04, -.2194D-04, -.1481D-04, -.1025D-04, & + & -.9558D-05, -.6966D-05, -.3075D-05, -.4965D-05, 0.4133D-06, & + & -.4645D-06, -.1062D-05, -.1469D-05, -.1747D-05, -.1936D-05, & + & -.2065D-05/ + + data (calcpts(j,22), j = 1,neta) /-.1759D-04, -.2131D-04, & + & -.2581D-04, -.3127D-04, -.3788D-04, -.4589D-04, -.5559D-04, & + & -.6734D-04, -.8155D-04, -.9876D-04, -.1196D-03, -.1448D-03, & + & -.1752D-03, -.2119D-03, -.2560D-03, -.3091D-03, -.3725D-03, & + & -.4480D-03, -.5370D-03, -.6406D-03, -.7588D-03, -.8898D-03, & + & -.1027D-02, -.1158D-02, -.1257D-02, -.1277D-02, -.1139D-02, & + & -.7134D-03, 0.1963D-03, 0.1866D-02, 0.4629D-02, 0.8781D-02, & + & 0.1438D-01, 0.2091D-01, 0.2711D-01, 0.3112D-01, 0.3152D-01, & + & 0.2827D-01, 0.2292D-01, 0.1735D-01, 0.1266D-01, 0.9007D-02, & + & 0.6154D-02, 0.3926D-02, 0.2252D-02, 0.1077D-02, 0.3285D-03, & + & -.1048D-03, -.3108D-03, -.3821D-03, -.3808D-03, -.3361D-03, & + & -.2800D-03, -.2292D-03, -.1760D-03, -.1380D-03, -.1006D-03, & + & -.7878D-04, -.5814D-04, -.4252D-04, -.2794D-04, -.2284D-04, & + & -.1511D-04, -.1227D-04, -.8204D-05, -.3311D-05, -.4519D-05, & + & -.5343D-05, 0.7633D-06, 0.3809D-06, 0.1204D-06, -.5698D-07, & + & -.1778D-06/ + + data (calcpts(j,23), j = 1,neta) /-.1989D-04, -.2409D-04, & + & -.2918D-04, -.3536D-04, -.4284D-04, -.5190D-04, -.6287D-04, & + & -.7616D-04, -.9223D-04, -.1117D-03, -.1353D-03, -.1638D-03, & + & -.1983D-03, -.2399D-03, -.2901D-03, -.3506D-03, -.4231D-03, & + & -.5098D-03, -.6129D-03, -.7342D-03, -.8750D-03, -.1036D-02, & + & -.1212D-02, -.1397D-02, -.1569D-02, -.1695D-02, -.1710D-02, & + & -.1509D-02, -.9289D-03, 0.2640D-03, 0.2358D-02, 0.5620D-02, & + & 0.1011D-01, 0.1541D-01, 0.2038D-01, 0.2331D-01, 0.2276D-01, & + & 0.1873D-01, 0.1286D-01, 0.7356D-02, 0.3497D-02, 0.1266D-02, & + & 0.3697D-04, -.7100D-03, -.1187D-02, -.1463D-02, -.1552D-02, & + & -.1489D-02, -.1333D-02, -.1135D-02, -.9232D-03, -.7340D-03, & + & -.5716D-03, -.4336D-03, -.3286D-03, -.2446D-03, -.1785D-03, & + & -.1308D-03, -.9282D-04, -.6781D-04, -.5136D-04, -.3832D-04, & + & -.2306D-04, -.1963D-04, -.1516D-04, -.9997D-05, -.4353D-05, & + & -.5049D-05, -.5523D-05, -.5847D-05, 0.5996D-06, 0.4496D-06, & + & 0.3474D-06/ + + data (calcpts(j,24), j = 1,neta) /-.2117D-04, -.2564D-04, & + & -.3106D-04, -.3763D-04, -.4560D-04, -.5524D-04, -.6692D-04, & + & -.8107D-04, -.9819D-04, -.1189D-03, -.1441D-03, -.1745D-03, & + & -.2112D-03, -.2557D-03, -.3093D-03, -.3741D-03, -.4520D-03, & + & -.5456D-03, -.6574D-03, -.7902D-03, -.9465D-03, -.1128D-02, & + & -.1335D-02, -.1564D-02, -.1803D-02, -.2029D-02, -.2199D-02, & + & -.2238D-02, -.2028D-02, -.1394D-02, -.1156D-03, 0.2017D-02, & + & 0.5066D-02, 0.8726D-02, 0.1210D-01, 0.1376D-01, 0.1244D-01, & + & 0.8023D-02, 0.2015D-02, -.3294D-02, -.6393D-02, -.7245D-02, & + & -.6777D-02, -.5883D-02, -.5009D-02, -.4254D-02, -.3594D-02, & + & -.2993D-02, -.2443D-02, -.1947D-02, -.1520D-02, -.1169D-02, & + & -.8818D-03, -.6554D-03, -.4863D-03, -.3526D-03, -.2554D-03, & + & -.1867D-03, -.1368D-03, -.9494D-04, -.6941D-04, -.4806D-04, & + & -.3168D-04, -.2748D-04, -.1583D-04, -.1031D-04, -.1109D-04, & + & -.4956D-05, -.5318D-05, -.5565D-05, 0.9334D-06, 0.8188D-06, & + & 0.7408D-06/ + + data (calcpts(j,25), j = 1,neta) /-.2120D-04, -.2568D-04, & + & -.3111D-04, -.3769D-04, -.4567D-04, -.5532D-04, -.6702D-04, & + & -.8120D-04, -.9835D-04, -.1191D-03, -.1443D-03, -.1748D-03, & + & -.2117D-03, -.2563D-03, -.3102D-03, -.3754D-03, -.4540D-03, & + & -.5486D-03, -.6623D-03, -.7982D-03, -.9596D-03, -.1150D-02, & + & -.1372D-02, -.1626D-02, -.1907D-02, -.2205D-02, -.2495D-02, & + & -.2732D-02, -.2841D-02, -.2708D-02, -.2186D-02, -.1130D-02, & + & 0.5125D-03, 0.2538D-02, 0.4317D-02, 0.4811D-02, 0.2999D-02, & + & -.1337D-02, -.7059D-02, -.1210D-01, -.1476D-01, -.1475D-01, & + & -.1299D-01, -.1067D-01, -.8534D-02, -.6815D-02, -.5453D-02, & + & -.4354D-02, -.3441D-02, -.2691D-02, -.2071D-02, -.1573D-02, & + & -.1175D-02, -.8679D-03, -.6419D-03, -.4655D-03, -.3374D-03, & + & -.2412D-03, -.1729D-03, -.1209D-03, -.8633D-04, -.6337D-04, & + & -.4589D-04, -.3428D-04, -.2211D-04, -.1625D-04, -.1012D-04, & + & -.1049D-04, -.4079D-05, -.4251D-05, -.4369D-05, -.4448D-05, & + & -.4503D-05/ + + data (calcpts(j,26), j = 1,neta) /-.2004D-04, -.2428D-04, & + & -.2941D-04, -.3563D-04, -.4317D-04, -.5230D-04, -.6336D-04, & + & -.7677D-04, -.9298D-04, -.1126D-03, -.1365D-03, -.1653D-03, & + & -.2002D-03, -.2425D-03, -.2936D-03, -.3554D-03, -.4301D-03, & + & -.5202D-03, -.6287D-03, -.7591D-03, -.9150D-03, -.1101D-02, & + & -.1321D-02, -.1577D-02, -.1872D-02, -.2202D-02, -.2558D-02, & + & -.2917D-02, -.3239D-02, -.3459D-02, -.3493D-02, -.3253D-02, & + & -.2705D-02, -.1976D-02, -.1463D-02, -.1853D-02, -.3876D-02, & + & -.7789D-02, -.1288D-01, -.1756D-01, -.2015D-01, -.1998D-01, & + & -.1766D-01, -.1444D-01, -.1135D-01, -.8830D-02, -.6891D-02, & + & -.5395D-02, -.4216D-02, -.3267D-02, -.2506D-02, -.1896D-02, & + & -.1418D-02, -.1049D-02, -.7705D-03, -.5611D-03, -.4041D-03, & + & -.2886D-03, -.2095D-03, -.1480D-03, -.1048D-03, -.7391D-04, & + & -.5554D-04, -.3665D-04, -.2408D-04, -.1793D-04, -.1162D-04, & + & -.1186D-04, -.5353D-05, -.5465D-05, -.5541D-05, 0.1074D-05, & + & 0.1039D-05/ + + data (calcpts(j,27), j = 1,neta) /-.1799D-04, -.2179D-04, & + & -.2640D-04, -.3199D-04, -.3875D-04, -.4695D-04, -.5688D-04, & + & -.6891D-04, -.8347D-04, -.1011D-03, -.1225D-03, -.1484D-03, & + & -.1798D-03, -.2178D-03, -.2637D-03, -.3193D-03, -.3866D-03, & + & -.4678D-03, -.5659D-03, -.6842D-03, -.8261D-03, -.9964D-03, & + & -.1200D-02, -.1440D-02, -.1722D-02, -.2048D-02, -.2416D-02, & + & -.2821D-02, -.3243D-02, -.3654D-02, -.4010D-02, -.4266D-02, & + & -.4407D-02, -.4507D-02, -.4803D-02, -.5710D-02, -.7709D-02, & + & -.1103D-01, -.1532D-01, -.1951D-01, -.2220D-01, -.2245D-01, & + & -.2037D-01, -.1695D-01, -.1334D-01, -.1025D-01, -.7864D-02, & + & -.6080D-02, -.4713D-02, -.3649D-02, -.2801D-02, -.2129D-02, & + & -.1595D-02, -.1187D-02, -.8684D-03, -.6365D-03, -.4599D-03, & + & -.3334D-03, -.2381D-03, -.1680D-03, -.1235D-03, -.8495D-04, & + & -.5929D-04, -.4665D-04, -.3378D-04, -.2077D-04, -.1432D-04, & + & -.1447D-04, -.7903D-05, -.7972D-05, -.8019D-05, -.1384D-05, & + & -.1406D-05/ + + data (calcpts(j,28), j = 1,neta) /-.1544D-04, -.1871D-04, & + & -.2266D-04, -.2745D-04, -.3326D-04, -.4030D-04, -.4882D-04, & + & -.5915D-04, -.7165D-04, -.8681D-04, -.1052D-03, -.1274D-03, & + & -.1543D-03, -.1870D-03, -.2264D-03, -.2742D-03, -.3321D-03, & + & -.4021D-03, -.4866D-03, -.5888D-03, -.7117D-03, -.8598D-03, & + & -.1037D-02, -.1249D-02, -.1501D-02, -.1797D-02, -.2141D-02, & + & -.2533D-02, -.2970D-02, -.3441D-02, -.3929D-02, -.4414D-02, & + & -.4893D-02, -.5410D-02, -.6097D-02, -.7195D-02, -.8996D-02, & + & -.1169D-01, -.1512D-01, -.1871D-01, -.2144D-01, -.2235D-01, & + & -.2108D-01, -.1813D-01, -.1453D-01, -.1116D-01, -.8466D-02, & + & -.6453D-02, -.4965D-02, -.3831D-02, -.2950D-02, -.2251D-02, & + & -.1699D-02, -.1272D-02, -.9380D-03, -.6869D-03, -.4997D-03, & + & -.3571D-03, -.2600D-03, -.1819D-03, -.1299D-03, -.9075D-04, & + & -.6469D-04, -.4510D-04, -.3205D-04, -.2558D-04, -.1904D-04, & + & -.1246D-04, -.5857D-05, -.5898D-05, -.5926D-05, -.5946D-05, & + & 0.7080D-06/ + + data (calcpts(j,29), j = 1,neta) /-.1277D-04, -.1547D-04, & + & -.1874D-04, -.2270D-04, -.2750D-04, -.3332D-04, -.4037D-04, & + & -.4891D-04, -.5924D-04, -.7178D-04, -.8697D-04, -.1054D-03, & + & -.1276D-03, -.1546D-03, -.1873D-03, -.2268D-03, -.2748D-03, & + & -.3327D-03, -.4028D-03, -.4876D-03, -.5898D-03, -.7133D-03, & + & -.8618D-03, -.1040D-02, -.1253D-02, -.1506D-02, -.1804D-02, & + & -.2152D-02, -.2552D-02, -.3002D-02, -.3499D-02, -.4038D-02, & + & -.4618D-02, -.5268D-02, -.6058D-02, -.7120D-02, -.8624D-02, & + & -.1070D-01, -.1334D-01, -.1624D-01, -.1880D-01, -.2025D-01, & + & -.1999D-01, -.1802D-01, -.1495D-01, -.1167D-01, -.8823D-02, & + & -.6636D-02, -.5040D-02, -.3866D-02, -.2982D-02, -.2286D-02, & + & -.1743D-02, -.1308D-02, -.9757D-03, -.7144D-03, -.5247D-03, & + & -.3806D-03, -.2689D-03, -.1968D-03, -.1376D-03, -.9809D-04, & + & -.7179D-04, -.5204D-04, -.3221D-04, -.2566D-04, -.1907D-04, & + & -.1246D-04, -.5827D-05, -.5852D-05, -.5869D-05, 0.7861D-06, & + & 0.7782D-06/ + + data (calcpts(j,30), j = 1,neta) /-.1024D-04, -.1241D-04, & + & -.1503D-04, -.1821D-04, -.2206D-04, -.2673D-04, -.3238D-04, & + & -.3923D-04, -.4753D-04, -.5758D-04, -.6977D-04, -.8452D-04, & + & -.1024D-03, -.1240D-03, -.1502D-03, -.1820D-03, -.2205D-03, & + & -.2670D-03, -.3233D-03, -.3915D-03, -.4738D-03, -.5733D-03, & + & -.6933D-03, -.8376D-03, -.1011D-02, -.1218D-02, -.1464D-02, & + & -.1754D-02, -.2094D-02, -.2485D-02, -.2929D-02, -.3427D-02, & + & -.3981D-02, -.4606D-02, -.5340D-02, -.6249D-02, -.7431D-02, & + & -.8975D-02, -.1091D-01, -.1312D-01, -.1531D-01, -.1698D-01, & + & -.1754D-01, -.1668D-01, -.1456D-01, -.1177D-01, -.9012D-02, & + & -.6734D-02, -.5036D-02, -.3817D-02, -.2926D-02, -.2254D-02, & + & -.1725D-02, -.1312D-02, -.9835D-03, -.7334D-03, -.5357D-03, & + & -.3905D-03, -.2849D-03, -.2056D-03, -.1461D-03, -.9979D-04, & + & -.7335D-04, -.5350D-04, -.3361D-04, -.2701D-04, -.2039D-04, & + & -.1376D-04, -.7115D-05, -.7130D-05, -.7141D-05, -.4813D-06, & + & -.4861D-06/ + + data (calcpts(j,31), j = 1,neta) /-.8016D-05, -.9712D-05, & + & -.1176D-04, -.1425D-04, -.1727D-04, -.2092D-04, -.2535D-04, & + & -.3071D-04, -.3720D-04, -.4507D-04, -.5461D-04, -.6616D-04, & + & -.8015D-04, -.9711D-04, -.1176D-03, -.1425D-03, -.1726D-03, & + & -.2091D-03, -.2532D-03, -.3066D-03, -.3712D-03, -.4493D-03, & + & -.5436D-03, -.6573D-03, -.7940D-03, -.9580D-03, -.1154D-02, & + & -.1386D-02, -.1661D-02, -.1980D-02, -.2349D-02, -.2769D-02, & + & -.3242D-02, -.3776D-02, -.4389D-02, -.5113D-02, -.6000D-02, & + & -.7105D-02, -.8465D-02, -.1006D-01, -.1178D-01, -.1334D-01, & + & -.1435D-01, -.1440D-01, -.1333D-01, -.1135D-01, -.8994D-02, & + & -.6786D-02, -.5024D-02, -.3742D-02, -.2832D-02, -.2172D-02, & + & -.1671D-02, -.1280D-02, -.9694D-03, -.7248D-03, -.5396D-03, & + & -.3939D-03, -.2879D-03, -.2083D-03, -.1486D-03, -.1088D-03, & + & -.7564D-04, -.5574D-04, -.3580D-04, -.2918D-04, -.1588D-04, & + & -.1590D-04, -.9249D-05, -.9259D-05, -.2599D-05, -.2604D-05, & + & -.2607D-05/ + + data (calcpts(j,32), j = 1,neta) /-.6153D-05, -.7455D-05, & + & -.9030D-05, -.1094D-04, -.1326D-04, -.1606D-04, -.1946D-04, & + & -.2357D-04, -.2856D-04, -.3460D-04, -.4192D-04, -.5078D-04, & + & -.6152D-04, -.7454D-04, -.9028D-04, -.1094D-03, -.1325D-03, & + & -.1605D-03, -.1944D-03, -.2355D-03, -.2851D-03, -.3451D-03, & + & -.4177D-03, -.5052D-03, -.6106D-03, -.7374D-03, -.8890D-03, & + & -.1070D-02, -.1284D-02, -.1536D-02, -.1828D-02, -.2163D-02, & + & -.2543D-02, -.2970D-02, -.3452D-02, -.4003D-02, -.4647D-02, & + & -.5416D-02, -.6342D-02, -.7441D-02, -.8684D-02, -.9956D-02, & + & -.1104D-01, -.1161D-01, -.1141D-01, -.1034D-01, -.8643D-02, & + & -.6739D-02, -.5023D-02, -.3691D-02, -.2739D-02, -.2071D-02, & + & -.1588D-02, -.1222D-02, -.9344D-03, -.7078D-03, -.5294D-03, & + & -.3914D-03, -.2865D-03, -.2075D-03, -.1497D-03, -.1065D-03, & + & -.7590D-04, -.5396D-04, -.3800D-04, -.2670D-04, -.1872D-04, & + & -.1273D-04, -.8742D-05, -.6082D-05, -.4086D-05, -.2756D-05, & + & -.1425D-05/ + + data (calcpts(j,33), j = 1,neta) /-.4652D-05, -.5636D-05, & + & -.6827D-05, -.8271D-05, -.1002D-04, -.1214D-04, -.1471D-04, & + & -.1782D-04, -.2159D-04, -.2616D-04, -.3169D-04, -.3839D-04, & + & -.4651D-04, -.5635D-04, -.6826D-04, -.8269D-04, -.1002D-03, & + & -.1214D-03, -.1470D-03, -.1780D-03, -.2156D-03, -.2610D-03, & + & -.3160D-03, -.3822D-03, -.4622D-03, -.5584D-03, -.6736D-03, & + & -.8114D-03, -.9751D-03, -.1168D-02, -.1392D-02, -.1651D-02, & + & -.1944D-02, -.2273D-02, -.2639D-02, -.3046D-02, -.3505D-02, & + & -.4031D-02, -.4646D-02, -.5373D-02, -.6219D-02, -.7152D-02, & + & -.8076D-02, -.8811D-02, -.9122D-02, -.8814D-02, -.7864D-02, & + & -.6474D-02, -.4981D-02, -.3676D-02, -.2685D-02, -.1986D-02, & + & -.1501D-02, -.1151D-02, -.8859D-03, -.6775D-03, -.5128D-03, & + & -.3839D-03, -.2835D-03, -.2077D-03, -.1505D-03, -.1086D-03, & + & -.7804D-04, -.5541D-04, -.3944D-04, -.2813D-04, -.2014D-04, & + & -.1415D-04, -.1016D-04, -.7497D-05, -.5500D-05, -.4169D-05, & + & -.2837D-05/ + + data (calcpts(j,34), j = 1,neta) /-.3472D-05, -.4207D-05, & + & -.5096D-05, -.6174D-05, -.7481D-05, -.9063D-05, -.1098D-04, & + & -.1330D-04, -.1611D-04, -.1952D-04, -.2366D-04, -.2866D-04, & + & -.3472D-04, -.4207D-04, -.5095D-04, -.6173D-04, -.7479D-04, & + & -.9059D-04, -.1097D-03, -.1329D-03, -.1609D-03, -.1949D-03, & + & -.2359D-03, -.2855D-03, -.3452D-03, -.4172D-03, -.5035D-03, & + & -.6068D-03, -.7296D-03, -.8745D-03, -.1044D-02, -.1239D-02, & + & -.1460D-02, -.1707D-02, -.1978D-02, -.2274D-02, -.2596D-02, & + & -.2953D-02, -.3356D-02, -.3824D-02, -.4374D-02, -.5007D-02, & + & -.5697D-02, -.6361D-02, -.6858D-02, -.7012D-02, -.6688D-02, & + & -.5890D-02, -.4790D-02, -.3645D-02, -.2667D-02, -.1936D-02, & + & -.1429D-02, -.1079D-02, -.8275D-03, -.6368D-03, -.4866D-03, & + & -.3682D-03, -.2751D-03, -.2032D-03, -.1480D-03, -.1074D-03, & + & -.7742D-04, -.5545D-04, -.3947D-04, -.2815D-04, -.1949D-04, & + & -.1416D-04, -.1017D-04, -.6839D-05, -.4841D-05, -.3509D-05, & + & -.2843D-05/ + + data (calcpts(j,35), j = 1,neta) /-.2566D-05, -.3109D-05, & + & -.3766D-05, -.4563D-05, -.5529D-05, -.6698D-05, -.8115D-05, & + & -.9832D-05, -.1191D-04, -.1443D-04, -.1748D-04, -.2118D-04, & + & -.2566D-04, -.3109D-04, -.3766D-04, -.4562D-04, -.5527D-04, & + & -.6696D-04, -.8110D-04, -.9824D-04, -.1190D-03, -.1441D-03, & + & -.1744D-03, -.2110D-03, -.2552D-03, -.3085D-03, -.3724D-03, & + & -.4489D-03, -.5400D-03, -.6474D-03, -.7730D-03, -.9178D-03, & + & -.1082D-02, -.1264D-02, -.1463D-02, -.1676D-02, -.1901D-02, & + & -.2142D-02, -.2405D-02, -.2702D-02, -.3048D-02, -.3455D-02, & + & -.3924D-02, -.4429D-02, -.4904D-02, -.5239D-02, -.5304D-02, & + & -.5007D-02, -.4363D-02, -.3511D-02, -.2647D-02, -.1922D-02, & + & -.1388D-02, -.1022D-02, -.7714D-03, -.5912D-03, -.4549D-03, & + & -.3477D-03, -.2625D-03, -.1960D-03, -.1440D-03, -.1054D-03, & + & -.7611D-04, -.5480D-04, -.3881D-04, -.2749D-04, -.1949D-04, & + & -.1350D-04, -.9501D-05, -.6836D-05, -.4838D-05, -.3505D-05, & + & -.2173D-05/ + + data (calcpts(j,36), j = 1,neta) /-.1882D-05, -.2280D-05, & + & -.2762D-05, -.3346D-05, -.4055D-05, -.4912D-05, -.5951D-05, & + & -.7210D-05, -.8734D-05, -.1058D-04, -.1282D-04, -.1553D-04, & + & -.1882D-04, -.2280D-04, -.2762D-04, -.3346D-04, -.4054D-04, & + & -.4910D-04, -.5948D-04, -.7205D-04, -.8724D-04, -.1056D-03, & + & -.1279D-03, -.1548D-03, -.1872D-03, -.2263D-03, -.2732D-03, & + & -.3294D-03, -.3962D-03, -.4752D-03, -.5675D-03, -.6739D-03, & + & -.7942D-03, -.9276D-03, -.1072D-02, -.1224D-02, -.1382D-02, & + & -.1545D-02, -.1717D-02, -.1904D-02, -.2118D-02, -.2370D-02, & + & -.2669D-02, -.3013D-02, -.3381D-02, -.3720D-02, -.3946D-02, & + & -.3963D-02, -.3711D-02, -.3205D-02, -.2557D-02, -.1912D-02, & + & -.1379D-02, -.9917D-03, -.7282D-03, -.5492D-03, -.4207D-03, & + & -.3236D-03, -.2470D-03, -.1871D-03, -.1391D-03, -.1025D-03, & + & -.7449D-04, -.5384D-04, -.3852D-04, -.2786D-04, -.1986D-04, & + & -.1387D-04, -.9868D-05, -.6536D-05, -.4537D-05, -.3204D-05, & + & -.2538D-05/ + + data (calcpts(j,37), j = 1,neta) /-.1371D-05, -.1661D-05, & + & -.2012D-05, -.2438D-05, -.2954D-05, -.3579D-05, -.4336D-05, & + & -.5253D-05, -.6363D-05, -.7709D-05, -.9341D-05, -.1132D-04, & + & -.1371D-04, -.1661D-04, -.2012D-04, -.2438D-04, -.2953D-04, & + & -.3577D-04, -.4333D-04, -.5249D-04, -.6356D-04, -.7697D-04, & + & -.9319D-04, -.1128D-03, -.1364D-03, -.1649D-03, -.1991D-03, & + & -.2400D-03, -.2888D-03, -.3463D-03, -.4136D-03, -.4912D-03, & + & -.5787D-03, -.6755D-03, -.7795D-03, -.8880D-03, -.9986D-03, & + & -.1110D-02, -.1223D-02, -.1341D-02, -.1472D-02, -.1625D-02, & + & -.1808D-02, -.2026D-02, -.2278D-02, -.2546D-02, -.2787D-02, & + & -.2939D-02, -.2933D-02, -.2727D-02, -.2338D-02, -.1851D-02, & + & -.1374D-02, -.9852D-03, -.7055D-03, -.5172D-03, -.3894D-03, & + & -.2988D-03, -.2296D-03, -.1756D-03, -.1323D-03, -.9832D-04, & + & -.7234D-04, -.5302D-04, -.3836D-04, -.2703D-04, -.1970D-04, & + & -.1370D-04, -.9704D-05, -.7038D-05, -.5039D-05, -.3706D-05, & + & -.2373D-05/ + + data (calcpts(j,38), j = 1,neta) /-.9934D-06, -.1204D-05, & + & -.1458D-05, -.1767D-05, -.2140D-05, -.2593D-05, -.3141D-05, & + & -.3806D-05, -.4611D-05, -.5586D-05, -.6768D-05, -.8200D-05, & + & -.9934D-05, -.1204D-04, -.1458D-04, -.1766D-04, -.2140D-04, & + & -.2592D-04, -.3140D-04, -.3803D-04, -.4606D-04, -.5577D-04, & + & -.6753D-04, -.8172D-04, -.9885D-04, -.1195D-03, -.1443D-03, & + & -.1739D-03, -.2093D-03, -.2510D-03, -.2997D-03, -.3559D-03, & + & -.4192D-03, -.4891D-03, -.5638D-03, -.6411D-03, -.7187D-03, & + & -.7950D-03, -.8699D-03, -.9455D-03, -.1026D-02, -.1117D-02, & + & -.1226D-02, -.1358D-02, -.1518D-02, -.1702D-02, -.1895D-02, & + & -.2067D-02, -.2170D-02, -.2155D-02, -.1991D-02, -.1696D-02, & + & -.1334D-02, -.9843D-03, -.7016D-03, -.5005D-03, -.3659D-03, & + & -.2753D-03, -.2113D-03, -.1620D-03, -.1240D-03, -.9339D-04, & + & -.6940D-04, -.5141D-04, -.3741D-04, -.2675D-04, -.1942D-04, & + & -.1342D-04, -.9422D-05, -.6756D-05, -.4756D-05, -.3423D-05, & + & -.2090D-05/ + + data (calcpts(j,39), j = 1,neta) /-.7169D-06, -.8686D-06, & + & -.1052D-05, -.1275D-05, -.1545D-05, -.1871D-05, -.2267D-05, & + & -.2747D-05, -.3327D-05, -.4031D-05, -.4884D-05, -.5917D-05, & + & -.7169D-05, -.8685D-05, -.1052D-04, -.1275D-04, -.1544D-04, & + & -.1871D-04, -.2266D-04, -.2745D-04, -.3324D-04, -.4025D-04, & + & -.4873D-04, -.5897D-04, -.7134D-04, -.8623D-04, -.1041D-03, & + & -.1255D-03, -.1510D-03, -.1811D-03, -.2163D-03, -.2568D-03, & + & -.3024D-03, -.3527D-03, -.4062D-03, -.4612D-03, -.5158D-03, & + & -.5685D-03, -.6187D-03, -.6676D-03, -.7174D-03, -.7719D-03, & + & -.8355D-03, -.9132D-03, -.1009D-02, -.1126D-02, -.1259D-02, & + & -.1399D-02, -.1521D-02, -.1591D-02, -.1573D-02, -.1446D-02, & + & -.1226D-02, -.9584D-03, -.7031D-03, -.4988D-03, -.3545D-03, & + & -.2587D-03, -.1947D-03, -.1492D-03, -.1147D-03, -.8761D-04, & + & -.6616D-04, -.4956D-04, -.3623D-04, -.2623D-04, -.1890D-04, & + & -.1357D-04, -.9571D-05, -.6905D-05, -.4905D-05, -.3572D-05, & + & -.2239D-05/ + + data (calcpts(j,40), j = 1,neta) /-.5152D-06, -.6243D-06, & + & -.7562D-06, -.9162D-06, -.1110D-05, -.1345D-05, -.1629D-05, & + & -.1974D-05, -.2391D-05, -.2897D-05, -.3510D-05, -.4253D-05, & + & -.5152D-05, -.6242D-05, -.7561D-05, -.9160D-05, -.1110D-04, & + & -.1344D-04, -.1628D-04, -.1973D-04, -.2389D-04, -.2893D-04, & + & -.3502D-04, -.4238D-04, -.5127D-04, -.6197D-04, -.7482D-04, & + & -.9021D-04, -.1085D-03, -.1302D-03, -.1554D-03, -.1845D-03, & + & -.2173D-03, -.2533D-03, -.2915D-03, -.3306D-03, -.3691D-03, & + & -.4057D-03, -.4398D-03, -.4717D-03, -.5030D-03, -.5357D-03, & + & -.5727D-03, -.6176D-03, -.6733D-03, -.7430D-03, -.8276D-03, & + & -.9246D-03, -.1025D-02, -.1112D-02, -.1159D-02, -.1142D-02, & + & -.1046D-02, -.8819D-03, -.6861D-03, -.5007D-03, -.3536D-03, & + & -.2504D-03, -.1824D-03, -.1371D-03, -.1051D-03, -.8080D-04, & + & -.6168D-04, -.4655D-04, -.3462D-04, -.2542D-04, -.1848D-04, & + & -.1335D-04, -.9553D-05, -.6820D-05, -.4820D-05, -.3420D-05, & + & -.2420D-05/ + + data (calcpts(j,41), j = 1,neta) /-.3691D-06, -.4472D-06, & + & -.5416D-06, -.6563D-06, -.7952D-06, -.9633D-06, -.1167D-05, & + & -.1414D-05, -.1713D-05, -.2075D-05, -.2514D-05, -.3046D-05, & + & -.3691D-05, -.4471D-05, -.5416D-05, -.6562D-05, -.7950D-05, & + & -.9630D-05, -.1167D-04, -.1413D-04, -.1711D-04, -.2072D-04, & + & -.2509D-04, -.3036D-04, -.3672D-04, -.4439D-04, -.5360D-04, & + & -.6462D-04, -.7775D-04, -.9324D-04, -.1113D-03, -.1322D-03, & + & -.1556D-03, -.1813D-03, -.2086D-03, -.2364D-03, -.2635D-03, & + & -.2890D-03, -.3124D-03, -.3336D-03, -.3535D-03, -.3734D-03, & + & -.3951D-03, -.4206D-03, -.4523D-03, -.4925D-03, -.5429D-03, & + & -.6043D-03, -.6745D-03, -.7467D-03, -.8083D-03, -.8408D-03, & + & -.8255D-03, -.7532D-03, -.6325D-03, -.4898D-03, -.3558D-03, & + & -.2501D-03, -.1766D-03, -.1284D-03, -.9645D-04, -.7386D-04, & + & -.5680D-04, -.4333D-04, -.3267D-04, -.2427D-04, -.1780D-04, & + & -.1294D-04, -.9270D-05, -.6670D-05, -.4737D-05, -.3337D-05, & + & -.2337D-05/ + + data (calcpts(j,42), j = 1,neta) /-.2638D-06, -.3195D-06, & + & -.3871D-06, -.4689D-06, -.5682D-06, -.6883D-06, -.8339D-06, & + & -.1010D-05, -.1224D-05, -.1483D-05, -.1797D-05, -.2177D-05, & + & -.2637D-05, -.3195D-05, -.3870D-05, -.4688D-05, -.5680D-05, & + & -.6881D-05, -.8335D-05, -.1010D-04, -.1223D-04, -.1481D-04, & + & -.1793D-04, -.2169D-04, -.2624D-04, -.3172D-04, -.3830D-04, & + & -.4617D-04, -.5555D-04, -.6662D-04, -.7954D-04, -.9441D-04, & + & -.1111D-03, -.1295D-03, -.1489D-03, -.1686D-03, -.1878D-03, & + & -.2057D-03, -.2218D-03, -.2361D-03, -.2490D-03, -.2613D-03, & + & -.2741D-03, -.2886D-03, -.3064D-03, -.3289D-03, -.3579D-03, & + & -.3944D-03, -.4389D-03, -.4895D-03, -.5414D-03, -.5851D-03, & + & -.6073D-03, -.5946D-03, -.5408D-03, -.4524D-03, -.3489D-03, & + & -.2524D-03, -.1767D-03, -.1244D-03, -.9029D-04, -.6776D-04, & + & -.5190D-04, -.3990D-04, -.3044D-04, -.2297D-04, -.1704D-04, & + & -.1250D-04, -.9105D-05, -.6505D-05, -.4638D-05, -.3305D-05, & + & -.2372D-05/ + + data (calcpts(j,43), j = 1,neta) /-.1880D-06, -.2277D-06, & + & -.2758D-06, -.3342D-06, -.4049D-06, -.4906D-06, -.5944D-06, & + & -.7201D-06, -.8723D-06, -.1057D-05, -.1281D-05, -.1551D-05, & + & -.1879D-05, -.2277D-05, -.2758D-05, -.3342D-05, -.4049D-05, & + & -.4904D-05, -.5941D-05, -.7196D-05, -.8714D-05, -.1055D-04, & + & -.1278D-04, -.1546D-04, -.1870D-04, -.2261D-04, -.2729D-04, & + & -.3291D-04, -.3959D-04, -.4748D-04, -.5669D-04, -.6728D-04, & + & -.7919D-04, -.9224D-04, -.1060D-03, -.1200D-03, -.1336D-03, & + & -.1462D-03, -.1573D-03, -.1670D-03, -.1755D-03, -.1833D-03, & + & -.1910D-03, -.1993D-03, -.2093D-03, -.2217D-03, -.2379D-03, & + & -.2588D-03, -.2852D-03, -.3172D-03, -.3537D-03, -.3909D-03, & + & -.4218D-03, -.4371D-03, -.4269D-03, -.3872D-03, -.3228D-03, & + & -.2480D-03, -.1787D-03, -.1247D-03, -.8754D-04, -.6341D-04, & + & -.4755D-04, -.3642D-04, -.2802D-04, -.2135D-04, -.1609D-04, & + & -.1195D-04, -.8754D-05, -.6354D-05, -.4554D-05, -.3288D-05, & + & -.2288D-05/ + + data (calcpts(j,44), j = 1,neta) /-.1338D-06, -.1621D-06, & + & -.1963D-06, -.2378D-06, -.2880D-06, -.3489D-06, -.4227D-06, & + & -.5121D-06, -.6204D-06, -.7516D-06, -.9106D-06, -.1103D-05, & + & -.1337D-05, -.1619D-05, -.1961D-05, -.2376D-05, -.2879D-05, & + & -.3488D-05, -.4225D-05, -.5117D-05, -.6197D-05, -.7504D-05, & + & -.9086D-05, -.1100D-04, -.1330D-04, -.1608D-04, -.1941D-04, & + & -.2340D-04, -.2815D-04, -.3376D-04, -.4031D-04, -.4784D-04, & + & -.5630D-04, -.6557D-04, -.7537D-04, -.8529D-04, -.9487D-04, & + & -.1037D-03, -.1115D-03, -.1182D-03, -.1238D-03, -.1288D-03, & + & -.1335D-03, -.1384D-03, -.1439D-03, -.1508D-03, -.1596D-03, & + & -.1712D-03, -.1863D-03, -.2053D-03, -.2284D-03, -.2546D-03, & + & -.2812D-03, -.3031D-03, -.3135D-03, -.3057D-03, -.2764D-03, & + & -.2298D-03, -.1760D-03, -.1263D-03, -.8785D-04, -.6152D-04, & + & -.4446D-04, -.3332D-04, -.2552D-04, -.1959D-04, -.1499D-04, & + & -.1126D-04, -.8392D-05, -.6126D-05, -.4459D-05, -.3193D-05, & + & -.2259D-05/ + + data (calcpts(j,45), j = 1,neta) /-.9473D-07, -.1149D-06, & + & -.1392D-06, -.1688D-06, -.2045D-06, -.2477D-06, -.3001D-06, & + & -.3636D-06, -.4404D-06, -.5337D-06, -.6466D-06, -.7833D-06, & + & -.9490D-06, -.1150D-05, -.1393D-05, -.1687D-05, -.2044D-05, & + & -.2476D-05, -.3000D-05, -.3634D-05, -.4400D-05, -.5328D-05, & + & -.6451D-05, -.7807D-05, -.9444D-05, -.1142D-04, -.1378D-04, & + & -.1662D-04, -.1999D-04, -.2397D-04, -.2862D-04, -.3397D-04, & + & -.3997D-04, -.4655D-04, -.5350D-04, -.6052D-04, -.6730D-04, & + & -.7351D-04, -.7896D-04, -.8357D-04, -.8742D-04, -.9068D-04, & + & -.9360D-04, -.9648D-04, -.9962D-04, -.1034D-03, -.1082D-03, & + & -.1145D-03, -.1228D-03, -.1336D-03, -.1473D-03, -.1640D-03, & + & -.1827D-03, -.2017D-03, -.2172D-03, -.2243D-03, -.2184D-03, & + & -.1970D-03, -.1634D-03, -.1247D-03, -.8922D-04, -.6185D-04, & + & -.4319D-04, -.3121D-04, -.2337D-04, -.1791D-04, -.1377D-04, & + & -.1051D-04, -.7907D-05, -.5907D-05, -.4307D-05, -.3107D-05, & + & -.2241D-05/ + + data (calcpts(j,46), j = 1,neta) /-.6701D-07, -.8119D-07, & + & -.9870D-07, -.1195D-06, -.1447D-06, -.1754D-06, -.2127D-06, & + & -.2576D-06, -.3120D-06, -.3781D-06, -.4581D-06, -.5551D-06, & + & -.6724D-06, -.8147D-06, -.9868D-06, -.1196D-05, -.1449D-05, & + & -.1755D-05, -.2125D-05, -.2575D-05, -.3118D-05, -.3776D-05, & + & -.4571D-05, -.5532D-05, -.6691D-05, -.8089D-05, -.9765D-05, & + & -.1177D-04, -.1416D-04, -.1699D-04, -.2028D-04, -.2407D-04, & + & -.2832D-04, -.3298D-04, -.3790D-04, -.4286D-04, -.4765D-04, & + & -.5203D-04, -.5584D-04, -.5904D-04, -.6167D-04, -.6384D-04, & + & -.6570D-04, -.6744D-04, -.6924D-04, -.7133D-04, -.7392D-04, & + & -.7731D-04, -.8181D-04, -.8777D-04, -.9555D-04, -.1054D-03, & + & -.1173D-03, -.1308D-03, -.1443D-03, -.1552D-03, -.1602D-03, & + & -.1556D-03, -.1401D-03, -.1158D-03, -.8818D-04, -.6290D-04, & + & -.4347D-04, -.3029D-04, -.2185D-04, -.1636D-04, -.1252D-04, & + & -.9628D-05, -.7341D-05, -.5528D-05, -.4108D-05, -.3008D-05, & + & -.2181D-05/ + + data (calcpts(j,47), j = 1,neta) /-.4757D-07, -.5758D-07, & + & -.6968D-07, -.8450D-07, -.1024D-06, -.1242D-06, -.1503D-06, & + & -.1822D-06, -.2207D-06, -.2675D-06, -.3240D-06, -.3926D-06, & + & -.4757D-06, -.5763D-06, -.6981D-06, -.8458D-06, -.1025D-05, & + & -.1241D-05, -.1504D-05, -.1821D-05, -.2206D-05, -.2671D-05, & + & -.3234D-05, -.3913D-05, -.4734D-05, -.5722D-05, -.6908D-05, & + & -.8329D-05, -.1002D-04, -.1202D-04, -.1435D-04, -.1702D-04, & + & -.2003D-04, -.2333D-04, -.2680D-04, -.3031D-04, -.3369D-04, & + & -.3677D-04, -.3945D-04, -.4168D-04, -.4349D-04, -.4495D-04, & + & -.4616D-04, -.4724D-04, -.4829D-04, -.4945D-04, -.5086D-04, & + & -.5267D-04, -.5507D-04, -.5828D-04, -.6256D-04, -.6814D-04, & + & -.7521D-04, -.8374D-04, -.9332D-04, -.1029D-03, -.1107D-03, & + & -.1141D-03, -.1106D-03, -.9943D-04, -.8204D-04, -.6228D-04, & + & -.4429D-04, -.3052D-04, -.2122D-04, -.1528D-04, -.1143D-04, & + & -.8745D-05, -.6726D-05, -.5126D-05, -.3859D-05, -.2859D-05, & + & -.2092D-05/ + + data (calcpts(j,48), j = 1,neta) /-.3318D-07, -.4036D-07, & + & -.4933D-07, -.5977D-07, -.7242D-07, -.8763D-07, -.1062D-06, & + & -.1288D-06, -.1559D-06, -.1890D-06, -.2290D-06, -.2774D-06, & + & -.3361D-06, -.4072D-06, -.4933D-06, -.5976D-06, -.7240D-06, & + & -.8771D-06, -.1062D-05, -.1287D-05, -.1558D-05, -.1887D-05, & + & -.2285D-05, -.2765D-05, -.3345D-05, -.4043D-05, -.4881D-05, & + & -.5885D-05, -.7080D-05, -.8490D-05, -.1014D-04, -.1203D-04, & + & -.1415D-04, -.1648D-04, -.1893D-04, -.2141D-04, -.2379D-04, & + & -.2597D-04, -.2785D-04, -.2941D-04, -.3066D-04, -.3166D-04, & + & -.3246D-04, -.3313D-04, -.3376D-04, -.3442D-04, -.3519D-04, & + & -.3615D-04, -.3743D-04, -.3914D-04, -.4144D-04, -.4450D-04, & + & -.4849D-04, -.5354D-04, -.5964D-04, -.6647D-04, -.7329D-04, & + & -.7875D-04, -.8108D-04, -.7854D-04, -.7046D-04, -.5801D-04, & + & -.4393D-04, -.3116D-04, -.2142D-04, -.1486D-04, -.1069D-04, & + & -.7993D-05, -.6113D-05, -.4700D-05, -.3586D-05, -.2700D-05, & + & -.2000D-05/ + + data (calcpts(j,49), j = 1,neta) /-.2387D-07, -.2858D-07, & + & -.3511D-07, -.4218D-07, -.5120D-07, -.6191D-07, -.7500D-07, & + & -.9087D-07, -.1101D-06, -.1334D-06, -.1616D-06, -.1957D-06, & + & -.2372D-06, -.2873D-06, -.3480D-06, -.4217D-06, -.5109D-06, & + & -.6189D-06, -.7496D-06, -.9081D-06, -.1100D-05, -.1332D-05, & + & -.1612D-05, -.1951D-05, -.2360D-05, -.2853D-05, -.3444D-05, & + & -.4152D-05, -.4995D-05, -.5990D-05, -.7151D-05, -.8486D-05, & + & -.9986D-05, -.1163D-04, -.1336D-04, -.1510D-04, -.1678D-04, & + & -.1831D-04, -.1963D-04, -.2073D-04, -.2160D-04, -.2228D-04, & + & -.2282D-04, -.2326D-04, -.2364D-04, -.2402D-04, -.2445D-04, & + & -.2496D-04, -.2563D-04, -.2653D-04, -.2775D-04, -.2939D-04, & + & -.3159D-04, -.3444D-04, -.3805D-04, -.4239D-04, -.4725D-04, & + & -.5208D-04, -.5593D-04, -.5753D-04, -.5566D-04, -.4986D-04, & + & -.4097D-04, -.3095D-04, -.2190D-04, -.1502D-04, -.1040D-04, & + & -.7471D-05, -.5584D-05, -.4271D-05, -.3284D-05, -.2504D-05, & + & -.1884D-05/ + + data (dlaeta(j), j = 1,neta) / & + & -6d0, -5.83333333d0, -5.66666667d0, -5.5d0, -5.33333333d0, & + & -5.16666667d0, -5d0, -4.83333333d0, -4.66666667d0, -4.5d0, & + & -4.33333333d0, -4.16666667d0, -4d0, -3.83333333d0, & + & -3.66666667d0, -3.5d0, -3.33333333d0, -3.16666667d0, -3d0, & + & -2.83333333d0, -2.66666667d0, -2.5d0, -2.33333333d0, & + & -2.16666667d0, -2d0, -1.83333333d0, -1.66666667d0, -1.5d0, & + & -1.33333333d0, -1.16666667d0, -1d0, -0.83333333d0, -0.66666667d0,& + & -0.5d0, -0.33333333d0, -0.16666667d0, 0d0, 0.16666667d0, & + & 0.33333333d0, 0.5d0, 0.66666667d0, 0.83333333d0, 1d0, & + & 1.16666667d0, 1.33333333d0, 1.5d0, 1.66666667d0, 1.83333333d0, & + & 2d0, 2.16666667d0, 2.33333333d0, 2.5d0, 2.66666667d0, & + & 2.83333333d0, 3d0, 3.16666667d0, 3.33333333d0, 3.5d0, & + & 3.66666667d0, 3.83333333d0, 4d0, 4.16666667d0, 4.33333333d0, & + & 4.5d0, 4.66666667d0, 4.83333333d0, 5d0, 5.16666667d0, & + & 5.33333333d0, 5.5d0, 5.66666667d0, 5.83333333d0, 6d0/ + + data (dlaxi(j), j = 1,nxi) / & + & -3d0, -2.83333333d0, -2.66666667d0, -2.5d0, -2.33333333d0, & + & -2.16666667d0, -2d0, -1.83333333d0, -1.66666667d0, -1.5d0, & + & -1.33333333d0, -1.16666667d0, -1d0, -0.83333333d0, -0.66666667d0,& + & -0.5d0, -0.33333333d0, -0.16666667d0, 0d0, 0.16666667d0, & + & 0.33333333d0, 0.5d0, 0.66666667d0, 0.83333333d0, 1d0, & + & 1.16666667d0, 1.33333333d0, 1.5d0, 1.66666667d0, 1.83333333d0, & + & 2d0, 2.16666667d0, 2.33333333d0, 2.5d0, 2.66666667d0, & + & 2.83333333d0, 3d0, 3.16666667d0, 3.33333333d0, 3.5d0, & + & 3.66666667d0, 3.83333333d0, 4d0, 4.16666667d0, 4.33333333d0, & + & 4.5d0, 4.66666667d0, 4.83333333d0, 5d0/ + + dleta = dlog10(eta) + dlxi = dlog10(xi) + if (dlxi .le. dlaxi(1)) dlxi = dlaxi(1) + if (dlxi .ge. dlaxi(nxi)) dlxi = dlaxi(nxi) + if (dleta .ge. dlaeta(neta)) dleta = dlaeta(neta) + if (dleta .le. dlaeta(1)) dleta = dlaeta(1) + call locate(dlaeta,neta, dleta, ieta) + call locate(dlaxi, nxi, dlxi, ixi) +! interpolating between the appropriate points + delxi = 1d0/6d0 + deleta = 1d0/6d0 +! lagrange 3-pt. + if (ixi .le. 2) ixi = 2 + if (ixi .ge. 48) ixi = 48 + if (ieta .le. 2) ieta = 2 + if (ieta .ge. 72) ieta = 72 + pxi = (dlxi - dlaxi(ixi))/delxi + f(-1) = pxi*(pxi-1d0)/2d0*calcpts(ieta-1,ixi-1) + & + & (1d0 - pxi**2)*calcpts(ieta-1,ixi) + & + & pxi*(pxi+1d0)/2d0*calcpts(ieta-1,ixi+1) + f(0) = pxi*(pxi-1d0)/2d0*calcpts(ieta,ixi-1) + & + & (1d0 - pxi**2)*calcpts(ieta,ixi) + & + & pxi*(pxi+1d0)/2d0*calcpts(ieta,ixi+1) + f(1) = pxi*(pxi-1d0)/2d0*calcpts(ieta+1,ixi-1) + & + & (1d0 - pxi**2)*calcpts(ieta+1,ixi) + & + & pxi*(pxi+1d0)/2d0*calcpts(ieta+1,ixi+1) + peta = (dleta - dlaeta(ieta))/deleta + h1_ALg = peta*(peta-1d0)/2d0*f(-1) + & + & (1d0 - peta**2)*f(0) + & + & peta*(peta+1d0)/2d0*f(1) +!MB + + peta*(peta+1d0)/2d0*f(1) + return + END + +! ======================================== + double precision function h1_FLg(eta,xi) +! ======================================== + +! eq (10) in PLB347 (1995) 143 - 151 for the longitudinal piece +! MSbar scheme +! This routine is called subclcf in the original code. +! Called sclcf in updated code (03/06/96). + + implicit none + integer neta, nxi + parameter (neta = 73, nxi = 49) + double precision calcpts(neta, nxi), dlaeta(neta), dlaxi(nxi) + double precision eta, xi, dleta, dlxi + double precision pxi, peta, f(-1:1), delxi, deleta + integer j, ieta, ixi + + data (calcpts(j, 1), j = 1,neta) /-.1526D-12, -.3323D-12, & + & -.3907D-12, -.6839D-12, -.1600D-11, -.3278D-11, -.4479D-11, & + & -.9221D-11, -.1419D-10, -.2587D-10, -.4799D-10, -.7559D-10, & + & -.1451D-09, -.2621D-09, -.4500D-09, -.8116D-09, -.1474D-08, & + & -.2638D-08, -.4581D-08, -.8208D-08, -.1447D-07, -.2578D-07, & + & -.4622D-07, -.8126D-07, -.1450D-06, -.2590D-06, -.4588D-06, & + & -.8141D-06, -.1438D-05, -.2515D-05, -.4340D-05, -.7316D-05, & + & -.1190D-04, -.1839D-04, -.2652D-04, -.3509D-04, -.4205D-04, & + & -.4536D-04, -.4420D-04, -.3927D-04, -.3230D-04, -.2498D-04, & + & -.1844D-04, -.1315D-04, -.9162D-05, -.6272D-05, -.4243D-05, & + & -.2849D-05, -.1902D-05, -.1265D-05, -.8396D-06, -.5559D-06, & + & -.3675D-06, -.2427D-06, -.1601D-06, -.1055D-06, -.6950D-07, & + & -.4569D-07, -.3001D-07, -.1968D-07, -.1290D-07, -.8435D-08, & + & -.5514D-08, -.3594D-08, -.4557D-08, -.3116D-08, -.2128D-08, & + & -.1452D-08, -.9914D-09, -.6763D-09, -.4610D-09, -.3142D-09, & + & -.2142D-09/ + + data (calcpts(j, 2), j = 1,neta) /-.1979D-12, -.6116D-12, & + & -.5642D-12, -.1280D-11, -.3041D-11, -.3966D-11, -.7910D-11, & + & -.1347D-10, -.2032D-10, -.3911D-10, -.7392D-10, -.1265D-09, & + & -.2222D-09, -.4048D-09, -.6812D-09, -.1207D-08, -.2240D-08, & + & -.3794D-08, -.6782D-08, -.1216D-07, -.2132D-07, -.3805D-07, & + & -.6763D-07, -.1202D-06, -.2143D-06, -.3812D-06, -.6731D-06, & + & -.1196D-05, -.2112D-05, -.3695D-05, -.6377D-05, -.1074D-04, & + & -.1746D-04, -.2699D-04, -.3893D-04, -.5150D-04, -.6170D-04, & + & -.6657D-04, -.6486D-04, -.5763D-04, -.4739D-04, -.3665D-04, & + & -.2706D-04, -.1930D-04, -.1345D-04, -.9205D-05, -.6227D-05, & + & -.4180D-05, -.2791D-05, -.1856D-05, -.1232D-05, -.8156D-06, & + & -.5392D-06, -.3562D-06, -.2349D-06, -.1548D-06, -.1020D-06, & + & -.6705D-07, -.4403D-07, -.2888D-07, -.1893D-07, -.1238D-07, & + & -.8090D-08, -.5273D-08, -.3429D-08, -.4572D-08, -.3123D-08, & + & -.2131D-08, -.1455D-08, -.9921D-09, -.6764D-09, -.4611D-09, & + & -.3143D-09/ + + data (calcpts(j, 3), j = 1,neta) /-.2047D-12, -.4402D-12, & + & -.5594D-12, -.1213D-11, -.3449D-11, -.4707D-11, -.9446D-11, & + & -.1768D-10, -.2612D-10, -.5612D-10, -.9231D-10, -.1774D-09, & + & -.3093D-09, -.5600D-09, -.9492D-09, -.1660D-08, -.3105D-08, & + & -.5504D-08, -.9882D-08, -.1767D-07, -.3091D-07, -.5602D-07, & + & -.9938D-07, -.1750D-06, -.3126D-06, -.5560D-06, -.9846D-06, & + & -.1747D-05, -.3092D-05, -.5405D-05, -.9329D-05, -.1574D-04, & + & -.2559D-04, -.3955D-04, -.5706D-04, -.7550D-04, -.9047D-04, & + & -.9761D-04, -.9510D-04, -.8452D-04, -.6949D-04, -.5375D-04, & + & -.3968D-04, -.2830D-04, -.1972D-04, -.1350D-04, -.9131D-05, & + & -.6129D-05, -.4092D-05, -.2721D-05, -.1806D-05, -.1196D-05, & + & -.7903D-06, -.5220D-06, -.3444D-06, -.2268D-06, -.1495D-06, & + & -.9828D-07, -.6453D-07, -.4234D-07, -.2774D-07, -.1814D-07, & + & -.1186D-07, -.7726D-08, -.5024D-08, -.3262D-08, -.4580D-08, & + & -.3126D-08, -.2133D-08, -.1455D-08, -.9916D-09, -.6762D-09, & + & -.4608D-09/ + + data (calcpts(j, 4), j = 1,neta) /-.3980D-12, -.9437D-12, & + & -.1372D-11, -.2820D-11, -.4058D-11, -.7437D-11, -.1433D-10, & + & -.2712D-10, -.4303D-10, -.7171D-10, -.1424D-09, -.2625D-09, & + & -.4584D-09, -.8241D-09, -.1411D-08, -.2519D-08, -.4554D-08, & + & -.8235D-08, -.1450D-07, -.2605D-07, -.4624D-07, -.8090D-07, & + & -.1457D-06, -.2586D-06, -.4593D-06, -.8177D-06, -.1447D-05, & + & -.2562D-05, -.4530D-05, -.7931D-05, -.1368D-04, -.2309D-04, & + & -.3753D-04, -.5802D-04, -.8370D-04, -.1107D-03, -.1327D-03, & + & -.1432D-03, -.1395D-03, -.1240D-03, -.1019D-03, -.7884D-04, & + & -.5820D-04, -.4152D-04, -.2892D-04, -.1980D-04, -.1339D-04, & + & -.8990D-05, -.6002D-05, -.3991D-05, -.2649D-05, -.1754D-05, & + & -.1159D-05, -.7655D-06, -.5050D-06, -.3328D-06, -.2192D-06, & + & -.1441D-06, -.9463D-07, -.6208D-07, -.4067D-07, -.2659D-07, & + & -.1738D-07, -.1133D-07, -.7365D-08, -.4782D-08, -.3097D-08, & + & -.4585D-08, -.3129D-08, -.2134D-08, -.1454D-08, -.9915D-09, & + & -.6759D-09/ + + data (calcpts(j, 5), j = 1,neta) /-.8492D-12, -.1819D-11, & + & -.1594D-11, -.4321D-11, -.7149D-11, -.1278D-10, -.2327D-10, & + & -.4772D-10, -.5993D-10, -.1160D-09, -.2318D-09, -.3877D-09, & + & -.6909D-09, -.1180D-08, -.2148D-08, -.3792D-08, -.6799D-08, & + & -.1217D-07, -.2153D-07, -.3862D-07, -.6690D-07, -.1197D-06, & + & -.2149D-06, -.3801D-06, -.6744D-06, -.1203D-05, -.2123D-05, & + & -.3762D-05, -.6655D-05, -.1164D-04, -.2008D-04, -.3386D-04, & + & -.5505D-04, -.8509D-04, -.1227D-03, -.1624D-03, -.1945D-03, & + & -.2099D-03, -.2045D-03, -.1818D-03, -.1495D-03, -.1156D-03, & + & -.8534D-04, -.6087D-04, -.4240D-04, -.2902D-04, -.1963D-04, & + & -.1318D-04, -.8800D-05, -.5851D-05, -.3883D-05, -.2571D-05, & + & -.1699D-05, -.1122D-05, -.7403D-06, -.4877D-06, -.3213D-06, & + & -.2112D-06, -.1387D-06, -.9099D-07, -.5960D-07, -.3897D-07, & + & -.2547D-07, -.1659D-07, -.1079D-07, -.7007D-08, -.4537D-08, & + & -.2929D-08, -.4588D-08, -.3128D-08, -.2132D-08, -.1454D-08, & + & -.9910D-09/ + + data (calcpts(j, 6), j = 1,neta) /-.1553D-11, -.2541D-11, & + & -.1878D-11, -.5611D-11, -.1141D-10, -.1789D-10, -.3021D-10, & + & -.5472D-10, -.9229D-10, -.1729D-09, -.3173D-09, -.5690D-09, & + & -.1020D-08, -.1828D-08, -.3025D-08, -.5610D-08, -.9985D-08, & + & -.1771D-07, -.3101D-07, -.5642D-07, -.9798D-07, -.1758D-06, & + & -.3135D-06, -.5555D-06, -.9859D-06, -.1752D-05, -.3104D-05, & + & -.5519D-05, -.9739D-05, -.1703D-04, -.2940D-04, -.4958D-04, & + & -.8056D-04, -.1245D-03, -.1798D-03, -.2378D-03, -.2849D-03, & + & -.3075D-03, -.2996D-03, -.2663D-03, -.2190D-03, -.1694D-03, & + & -.1250D-03, -.8919D-04, -.6212D-04, -.4252D-04, -.2876D-04, & + & -.1931D-04, -.1289D-04, -.8570D-05, -.5687D-05, -.3765D-05, & + & -.2488D-05, -.1643D-05, -.1084D-05, -.7140D-06, -.4703D-06, & + & -.3092D-06, -.2030D-06, -.1332D-06, -.8723D-07, -.5703D-07, & + & -.3726D-07, -.2427D-07, -.1579D-07, -.1025D-07, -.6635D-08, & + & -.4282D-08, -.2759D-08, -.4583D-08, -.3124D-08, -.2130D-08, & + & -.1452D-08/ + + data (calcpts(j, 7), j = 1,neta) /-.1951D-11, -.3023D-11, & + & -.3552D-11, -.6768D-11, -.1542D-10, -.3304D-10, -.4905D-10, & + & -.8922D-10, -.1383D-09, -.2580D-09, -.4742D-09, -.7587D-09, & + & -.1494D-08, -.2591D-08, -.4467D-08, -.8113D-08, -.1468D-07, & + & -.2642D-07, -.4627D-07, -.8186D-07, -.1445D-06, -.2566D-06, & + & -.4593D-06, -.8145D-06, -.1443D-05, -.2580D-05, -.4555D-05, & + & -.8069D-05, -.1426D-04, -.2494D-04, -.4300D-04, -.7255D-04, & + & -.1179D-03, -.1822D-03, -.2629D-03, -.3479D-03, -.4170D-03, & + & -.4500D-03, -.4386D-03, -.3898D-03, -.3205D-03, -.2479D-03, & + & -.1830D-03, -.1305D-03, -.9092D-04, -.6223D-04, -.4210D-04, & + & -.2826D-04, -.1886D-04, -.1254D-04, -.8322D-05, -.5508D-05, & + & -.3640D-05, -.2404D-05, -.1585D-05, -.1044D-05, -.6877D-06, & + & -.4521D-06, -.2967D-06, -.1947D-06, -.1275D-06, -.8334D-07, & + & -.5444D-07, -.3546D-07, -.2305D-07, -.1496D-07, -.9679D-08, & + & -.6249D-08, -.4026D-08, -.2581D-08, -.4573D-08, -.3117D-08, & + & -.2125D-08/ + + data (calcpts(j, 8), j = 1,neta) /-.3202D-11, -.4660D-11, & + & -.6771D-11, -.1185D-10, -.2005D-10, -.3729D-10, -.7634D-10, & + & -.1351D-09, -.2145D-09, -.3817D-09, -.7858D-09, -.1241D-08, & + & -.2195D-08, -.3904D-08, -.6628D-08, -.1198D-07, -.2138D-07, & + & -.3774D-07, -.6762D-07, -.1203D-06, -.2116D-06, -.3773D-06, & + & -.6675D-06, -.1188D-05, -.2118D-05, -.3769D-05, -.6672D-05, & + & -.1182D-04, -.2086D-04, -.3649D-04, -.6290D-04, -.1060D-03, & + & -.1724D-03, -.2665D-03, -.3843D-03, -.5086D-03, -.6095D-03, & + & -.6578D-03, -.6413D-03, -.5699D-03, -.4687D-03, -.3625D-03, & + & -.2676D-03, -.1909D-03, -.1329D-03, -.9100D-04, -.6154D-04, & + & -.4130D-04, -.2757D-04, -.1833D-04, -.1216D-04, -.8049D-05, & + & -.5319D-05, -.3511D-05, -.2316D-05, -.1525D-05, -.1004D-05, & + & -.6600D-06, -.4332D-06, -.2840D-06, -.1861D-06, -.1216D-06, & + & -.7942D-07, -.5172D-07, -.3361D-07, -.2180D-07, -.1412D-07, & + & -.9108D-08, -.5862D-08, -.3756D-08, -.2397D-08, -.4558D-08, & + & -.3106D-08/ + + data (calcpts(j, 9), j = 1,neta) /-.2020D-11, -.5453D-11, & + & -.5060D-11, -.1092D-10, -.3336D-10, -.5003D-10, -.9420D-10, & + & -.1724D-09, -.2710D-09, -.5493D-09, -.9121D-09, -.1654D-08, & + & -.2942D-08, -.5559D-08, -.9296D-08, -.1649D-07, -.3097D-07, & + & -.5391D-07, -.9745D-07, -.1736D-06, -.3048D-06, -.5456D-06, & + & -.9811D-06, -.1731D-05, -.3082D-05, -.5485D-05, -.9689D-05, & + & -.1719D-04, -.3034D-04, -.5312D-04, -.9155D-04, -.1544D-03, & + & -.2510D-03, -.3881D-03, -.5599D-03, -.7412D-03, -.8885D-03, & + & -.9592D-03, -.9351D-03, -.8313D-03, -.6838D-03, -.5289D-03, & + & -.3904D-03, -.2785D-03, -.1939D-03, -.1327D-03, -.8974D-04, & + & -.6022D-04, -.4019D-04, -.2671D-04, -.1772D-04, -.1173D-04, & + & -.7748D-05, -.5113D-05, -.3372D-05, -.2221D-05, -.1462D-05, & + & -.9603D-06, -.6301D-06, -.4131D-06, -.2704D-06, -.1766D-06, & + & -.1153D-06, -.7510D-07, -.4878D-07, -.3163D-07, -.2046D-07, & + & -.1318D-07, -.8481D-08, -.5434D-08, -.3464D-08, -.2200D-08, & + & -.4531D-08/ + + data (calcpts(j,10), j = 1,neta) /-.4329D-11, -.8017D-11, & + & -.1468D-10, -.1912D-10, -.4450D-10, -.7630D-10, -.1318D-09, & + & -.2570D-09, -.4401D-09, -.7766D-09, -.1464D-08, -.2495D-08, & + & -.4473D-08, -.8107D-08, -.1423D-07, -.2431D-07, -.4600D-07, & + & -.7971D-07, -.1427D-06, -.2553D-06, -.4500D-06, -.8034D-06, & + & -.1424D-05, -.2529D-05, -.4495D-05, -.7996D-05, -.1418D-04, & + & -.2511D-04, -.4424D-04, -.7734D-04, -.1333D-03, -.2246D-03, & + & -.3650D-03, -.5643D-03, -.8141D-03, -.1078D-02, -.1292D-02, & + & -.1396D-02, -.1361D-02, -.1210D-02, -.9954D-03, -.7700D-03, & + & -.5684D-03, -.4053D-03, -.2823D-03, -.1931D-03, -.1306D-03, & + & -.8760D-04, -.5845D-04, -.3884D-04, -.2576D-04, -.1704D-04, & + & -.1125D-04, -.7428D-05, -.4896D-05, -.3223D-05, -.2121D-05, & + & -.1393D-05, -.9137D-06, -.5988D-06, -.3918D-06, -.2558D-06, & + & -.1670D-06, -.1086D-06, -.7052D-07, -.4570D-07, -.2953D-07, & + & -.1901D-07, -.1223D-07, -.7824D-08, -.4982D-08, -.3159D-08, & + & -.1992D-08/ + + data (calcpts(j,11), j = 1,neta) /-.7740D-11, -.1319D-10, & + & -.1127D-10, -.3932D-10, -.7316D-10, -.1185D-09, -.2253D-09, & + & -.4273D-09, -.7028D-09, -.1122D-08, -.2186D-08, -.3787D-08, & + & -.6692D-08, -.1282D-07, -.2105D-07, -.3761D-07, -.6681D-07, & + & -.1181D-06, -.2093D-06, -.3678D-06, -.6528D-06, -.1171D-05, & + & -.2076D-05, -.3676D-05, -.6540D-05, -.1168D-04, -.2046D-04, & + & -.3634D-04, -.6416D-04, -.1120D-03, -.1930D-03, -.3253D-03, & + & -.5284D-03, -.8167D-03, -.1178D-02, -.1560D-02, -.1872D-02, & + & -.2022D-02, -.1973D-02, -.1755D-02, -.1444D-02, -.1117D-02, & + & -.8243D-03, -.5878D-03, -.4092D-03, -.2799D-03, -.1892D-03, & + & -.1269D-03, -.8463D-04, -.5622D-04, -.3727D-04, -.2465D-04, & + & -.1627D-04, -.1073D-04, -.7072D-05, -.4653D-05, -.3060D-05, & + & -.2009D-05, -.1317D-05, -.8626D-06, -.5641D-06, -.3682D-06, & + & -.2400D-06, -.1560D-06, -.1012D-06, -.6552D-07, -.4230D-07, & + & -.2721D-07, -.1746D-07, -.1116D-07, -.7094D-08, -.4488D-08, & + & -.2823D-08/ + + data (calcpts(j,12), j = 1,neta) /-.5151D-11, -.2014D-10, & + & -.2631D-10, -.4695D-10, -.1052D-09, -.1791D-09, -.3485D-09, & + & -.6448D-09, -.8489D-09, -.1639D-08, -.3087D-08, -.5399D-08, & + & -.9179D-08, -.1779D-07, -.2957D-07, -.5384D-07, -.9629D-07, & + & -.1688D-06, -.3013D-06, -.5323D-06, -.9346D-06, -.1675D-05, & + & -.2995D-05, -.5313D-05, -.9461D-05, -.1675D-04, -.2958D-04, & + & -.5241D-04, -.9238D-04, -.1612D-03, -.2776D-03, -.4674D-03, & + & -.7593D-03, -.1173D-02, -.1694D-02, -.2243D-02, -.2692D-02, & + & -.2911D-02, -.2842D-02, -.2528D-02, -.2081D-02, -.1610D-02, & + & -.1188D-02, -.8472D-03, -.5896D-03, -.4031D-03, -.2724D-03, & + & -.1826D-03, -.1217D-03, -.8082D-04, -.5355D-04, -.3539D-04, & + & -.2335D-04, -.1540D-04, -.1014D-04, -.6664D-05, -.4380D-05, & + & -.2873D-05, -.1881D-05, -.1231D-05, -.8042D-06, -.5242D-06, & + & -.3414D-06, -.2216D-06, -.1435D-06, -.9286D-07, -.5979D-07, & + & -.3840D-07, -.2459D-07, -.1567D-07, -.9930D-08, -.6256D-08, & + & -.3925D-08/ + + data (calcpts(j,13), j = 1,neta) /-.1063D-10, -.3297D-10, & + & -.2997D-10, -.6987D-10, -.1541D-09, -.1764D-09, -.4019D-09, & + & -.7702D-09, -.1329D-08, -.2305D-08, -.4447D-08, -.7561D-08, & + & -.1408D-07, -.2476D-07, -.4276D-07, -.7568D-07, -.1385D-06, & + & -.2503D-06, -.4271D-06, -.7685D-06, -.1350D-05, -.2407D-05, & + & -.4305D-05, -.7545D-05, -.1347D-04, -.2398D-04, -.4235D-04, & + & -.7490D-04, -.1318D-03, -.2300D-03, -.3951D-03, -.6661D-03, & + & -.1080D-02, -.1670D-02, -.2411D-02, -.3195D-02, -.3840D-02, & + & -.4154D-02, -.4059D-02, -.3614D-02, -.2975D-02, -.2302D-02, & + & -.1699D-02, -.1211D-02, -.8425D-03, -.5757D-03, -.3887D-03, & + & -.2604D-03, -.1735D-03, -.1151D-03, -.7620D-04, -.5031D-04, & + & -.3317D-04, -.2184D-04, -.1437D-04, -.9435D-05, -.6194D-05, & + & -.4058D-05, -.2655D-05, -.1734D-05, -.1131D-05, -.7362D-06, & + & -.4786D-06, -.3101D-06, -.2004D-06, -.1293D-06, -.8305D-07, & + & -.5313D-07, -.3392D-07, -.2152D-07, -.1358D-07, -.8518D-08, & + & -.5306D-08/ + + data (calcpts(j,14), j = 1,neta) /-.2328D-10, -.4109D-10, & + & -.6336D-10, -.1073D-09, -.2166D-09, -.4000D-09, -.6766D-09, & + & -.1298D-08, -.1955D-08, -.3561D-08, -.6533D-08, -.1121D-07, & + & -.1965D-07, -.3564D-07, -.6167D-07, -.1104D-06, -.2020D-06, & + & -.3533D-06, -.6145D-06, -.1108D-05, -.1935D-05, -.3441D-05, & + & -.6092D-05, -.1088D-04, -.1924D-04, -.3402D-04, -.5993D-04, & + & -.1058D-03, -.1861D-03, -.3243D-03, -.5572D-03, -.9357D-03, & + & -.1517D-02, -.2345D-02, -.3386D-02, -.4491D-02, -.5401D-02, & + & -.5853D-02, -.5726D-02, -.5103D-02, -.4204D-02, -.3254D-02, & + & -.2401D-02, -.1710D-02, -.1189D-02, -.8120D-03, -.5478D-03, & + & -.3666D-03, -.2439D-03, -.1616D-03, -.1069D-03, -.7047D-04, & + & -.4639D-04, -.3050D-04, -.2003D-04, -.1314D-04, -.8608D-05, & + & -.5629D-05, -.3675D-05, -.2396D-05, -.1559D-05, -.1012D-05, & + & -.6559D-06, -.4238D-06, -.2728D-06, -.1752D-06, -.1121D-06, & + & -.7147D-07, -.4532D-07, -.2857D-07, -.1789D-07, -.1112D-07, & + & -.6848D-08/ + + data (calcpts(j,15), j = 1,neta) /-.1614D-10, -.4985D-10, & + & -.4193D-10, -.9810D-10, -.3052D-09, -.5043D-09, -.7527D-09, & + & -.1530D-08, -.2329D-08, -.3894D-08, -.8865D-08, -.1514D-07, & + & -.2616D-07, -.4793D-07, -.8227D-07, -.1503D-06, -.2650D-06, & + & -.4862D-06, -.8500D-06, -.1523D-05, -.2672D-05, -.4765D-05, & + & -.8445D-05, -.1498D-04, -.2667D-04, -.4723D-04, -.8297D-04, & + & -.1465D-03, -.2575D-03, -.4472D-03, -.7674D-03, -.1288D-02, & + & -.2085D-02, -.3222D-02, -.4654D-02, -.6183D-02, -.7451D-02, & + & -.8090D-02, -.7929D-02, -.7077D-02, -.5836D-02, -.4518D-02, & + & -.3333D-02, -.2373D-02, -.1648D-02, -.1124D-02, -.7570D-03, & + & -.5058D-03, -.3360D-03, -.2222D-03, -.1467D-03, -.9650D-04, & + & -.6339D-04, -.4159D-04, -.2725D-04, -.1782D-04, -.1165D-04, & + & -.7591D-05, -.4940D-05, -.3209D-05, -.2080D-05, -.1345D-05, & + & -.8676D-06, -.5575D-06, -.3569D-06, -.2278D-06, -.1446D-06, & + & -.9136D-07, -.5733D-07, -.3575D-07, -.2207D-07, -.1349D-07, & + & -.8146D-08/ + + data (calcpts(j,16), j = 1,neta) /-.3779D-10, -.7818D-10, & + & -.8196D-10, -.1363D-09, -.4489D-09, -.6883D-09, -.1116D-08, & + & -.2256D-08, -.3465D-08, -.5744D-08, -.1173D-07, -.2133D-07, & + & -.3697D-07, -.6801D-07, -.1161D-06, -.2106D-06, -.3768D-06, & + & -.6683D-06, -.1181D-05, -.2105D-05, -.3688D-05, -.6626D-05, & + & -.1173D-04, -.2059D-04, -.3645D-04, -.6435D-04, -.1129D-03, & + & -.1981D-03, -.3482D-03, -.6031D-03, -.1029D-02, -.1724D-02, & + & -.2789D-02, -.4304D-02, -.6223D-02, -.8281D-02, -.1000D-01, & + & -.1089D-01, -.1071D-01, -.9576D-02, -.7907D-02, -.6124D-02, & + & -.4516D-02, -.3212D-02, -.2228D-02, -.1516D-02, -.1019D-02, & + & -.6792D-03, -.4498D-03, -.2967D-03, -.1952D-03, -.1281D-03, & + & -.8383D-04, -.5480D-04, -.3576D-04, -.2330D-04, -.1516D-04, & + & -.9831D-05, -.6362D-05, -.4111D-05, -.2647D-05, -.1699D-05, & + & -.1088D-05, -.6925D-06, -.4388D-06, -.2768D-06, -.1733D-06, & + & -.1077D-06, -.6648D-07, -.4052D-07, -.2428D-07, -.1431D-07, & + & -.8243D-08/ + + data (calcpts(j,17), j = 1,neta) /-.6224D-10, -.1157D-09, & + & -.2071D-09, -.2779D-09, -.5111D-09, -.1001D-08, -.1657D-08, & + & -.3073D-08, -.4998D-08, -.8622D-08, -.1677D-07, -.2878D-07, & + & -.5099D-07, -.9334D-07, -.1627D-06, -.2805D-06, -.5088D-06, & + & -.9048D-06, -.1583D-05, -.2830D-05, -.4949D-05, -.8740D-05, & + & -.1552D-04, -.2748D-04, -.4835D-04, -.8505D-04, -.1485D-03, & + & -.2604D-03, -.4541D-03, -.7820D-03, -.1333D-02, -.2222D-02, & + & -.3583D-02, -.5523D-02, -.7988D-02, -.1065D-01, -.1292D-01, & + & -.1413D-01, -.1394D-01, -.1251D-01, -.1035D-01, -.8017D-02, & + & -.5909D-02, -.4197D-02, -.2903D-02, -.1970D-02, -.1319D-02, & + & -.8760D-03, -.5778D-03, -.3793D-03, -.2484D-03, -.1620D-03, & + & -.1055D-03, -.6854D-04, -.4444D-04, -.2874D-04, -.1856D-04, & + & -.1194D-04, -.7653D-05, -.4891D-05, -.3114D-05, -.1972D-05, & + & -.1244D-05, -.7786D-06, -.4830D-06, -.2973D-06, -.1809D-06, & + & -.1085D-06, -.6401D-07, -.3663D-07, -.2033D-07, -.1066D-07, & + & -.5102D-08/ + + data (calcpts(j,18), j = 1,neta) /-.6221D-10, -.1474D-09, & + & -.1298D-09, -.3912D-09, -.6718D-09, -.1189D-08, -.2102D-08, & + & -.4431D-08, -.5705D-08, -.1121D-07, -.2129D-07, -.3646D-07, & + & -.6552D-07, -.1150D-06, -.1978D-06, -.3621D-06, -.6497D-06, & + & -.1157D-05, -.2045D-05, -.3569D-05, -.6302D-05, -.1123D-04, & + & -.1991D-04, -.3492D-04, -.6120D-04, -.1076D-03, -.1863D-03, & + & -.3256D-03, -.5637D-03, -.9672D-03, -.1635D-02, -.2711D-02, & + & -.4353D-02, -.6694D-02, -.9686D-02, -.1295D-01, -.1579D-01, & + & -.1736D-01, -.1723D-01, -.1553D-01, -.1289D-01, -.9997D-02, & + & -.7362D-02, -.5214D-02, -.3594D-02, -.2427D-02, -.1616D-02, & + & -.1066D-02, -.6979D-03, -.4545D-03, -.2951D-03, -.1908D-03, & + & -.1230D-03, -.7906D-04, -.5065D-04, -.3233D-04, -.2058D-04, & + & -.1301D-04, -.8195D-05, -.5126D-05, -.3183D-05, -.1957D-05, & + & -.1192D-05, -.7138D-06, -.4200D-06, -.2413D-06, -.1338D-06, & + & -.7023D-07, -.3388D-07, -.1335D-07, -.2407D-08, 0.2877D-08, & + & 0.4963D-08/ + + data (calcpts(j,19), j = 1,neta) /-.7602D-10, -.1220D-09, & + & -.2737D-09, -.3859D-09, -.9139D-09, -.1511D-08, -.2536D-08, & + & -.4168D-08, -.7125D-08, -.1412D-07, -.2662D-07, -.4549D-07, & + & -.8145D-07, -.1415D-06, -.2551D-06, -.4471D-06, -.7992D-06, & + & -.1408D-05, -.2494D-05, -.4496D-05, -.7735D-05, -.1362D-04, & + & -.2398D-04, -.4201D-04, -.7350D-04, -.1277D-03, -.2213D-03, & + & -.3840D-03, -.6589D-03, -.1119D-02, -.1875D-02, -.3080D-02, & + & -.4910D-02, -.7516D-02, -.1087D-01, -.1458D-01, -.1788D-01, & + & -.1984D-01, -.1985D-01, -.1801D-01, -.1501D-01, -.1166D-01, & + & -.8571D-02, -.6046D-02, -.4139D-02, -.2772D-02, -.1828D-02, & + & -.1192D-02, -.7704D-03, -.4946D-03, -.3161D-03, -.2009D-03, & + & -.1269D-03, -.7981D-04, -.4988D-04, -.3093D-04, -.1903D-04, & + & -.1158D-04, -.6948D-05, -.4099D-05, -.2360D-05, -.1313D-05, & + & -.6978D-06, -.3404D-06, -.1395D-06, -.3238D-07, 0.2071D-07, & + & 0.4317D-07, 0.4897D-07, 0.4694D-07, 0.4109D-07, 0.3426D-07, & + & 0.2766D-07/ + + data (calcpts(j,20), j = 1,neta) /-.1486D-09, -.2084D-09, & + & -.2156D-09, -.5165D-09, -.1028D-08, -.1695D-08, -.2959D-08, & + & -.5026D-08, -.9531D-08, -.1689D-07, -.3069D-07, -.5319D-07, & + & -.9289D-07, -.1644D-06, -.2927D-06, -.5169D-06, -.9236D-06, & + & -.1621D-05, -.2863D-05, -.5112D-05, -.8725D-05, -.1553D-04, & + & -.2730D-04, -.4743D-04, -.8240D-04, -.1426D-03, -.2449D-03, & + & -.4185D-03, -.7110D-03, -.1193D-02, -.1971D-02, -.3194D-02, & + & -.5033D-02, -.7630D-02, -.1101D-01, -.1480D-01, -.1829D-01, & + & -.2051D-01, -.2077D-01, -.1904D-01, -.1596D-01, -.1242D-01, & + & -.9104D-02, -.6373D-02, -.4315D-02, -.2845D-02, -.1840D-02, & + & -.1173D-02, -.7391D-03, -.4604D-03, -.2842D-03, -.1733D-03, & + & -.1043D-03, -.6193D-04, -.3594D-04, -.2030D-04, -.1104D-04, & + & -.5610D-05, -.2531D-05, -.8511D-06, 0.3114D-08, 0.4043D-06, & + & 0.5460D-06, 0.5568D-06, 0.5061D-06, 0.4303D-06, 0.3510D-06, & + & 0.2788D-06, 0.2167D-06, 0.1660D-06, 0.1256D-06, 0.9417D-07, & + & 0.6990D-07/ + + data (calcpts(j,21), j = 1,neta) /-.5347D-10, -.2247D-09, & + & -.2536D-09, -.4946D-09, -.1075D-08, -.1854D-08, -.3507D-08, & + & -.6687D-08, -.9907D-08, -.1667D-07, -.3265D-07, -.5625D-07, & + & -.9228D-07, -.1809D-06, -.3111D-06, -.5438D-06, -.9714D-06, & + & -.1708D-05, -.3045D-05, -.5259D-05, -.9173D-05, -.1617D-04, & + & -.2835D-04, -.4914D-04, -.8478D-04, -.1455D-03, -.2474D-03, & + & -.4174D-03, -.6997D-03, -.1152D-02, -.1866D-02, -.2962D-02, & + & -.4565D-02, -.6829D-02, -.9739D-02, -.1308D-01, -.1630D-01, & + & -.1854D-01, -.1909D-01, -.1776D-01, -.1503D-01, -.1172D-01, & + & -.8532D-02, -.5885D-02, -.3892D-02, -.2485D-02, -.1542D-02, & + & -.9325D-03, -.5493D-03, -.3140D-03, -.1730D-03, -.9005D-04, & + & -.4266D-04, -.1663D-04, -.2895D-05, 0.3602D-05, 0.6205D-05, & + & 0.6783D-05, 0.6345D-05, 0.5478D-05, 0.4528D-05, 0.3614D-05, & + & 0.2823D-05, 0.2169D-05, 0.1646D-05, 0.1236D-05, 0.9190D-06, & + & 0.6792D-06, 0.4982D-06, 0.3639D-06, 0.2646D-06, 0.1917D-06, & + & 0.1382D-06/ + + data (calcpts(j,22), j = 1,neta) /-.1087D-09, -.2056D-09, & + & -.2857D-09, -.4519D-09, -.1035D-08, -.1817D-08, -.3161D-08, & + & -.6500D-08, -.8736D-08, -.1626D-07, -.3079D-07, -.5446D-07, & + & -.9652D-07, -.1794D-06, -.3003D-06, -.5267D-06, -.9420D-06, & + & -.1654D-05, -.2896D-05, -.5136D-05, -.8853D-05, -.1543D-04, & + & -.2682D-04, -.4618D-04, -.7917D-04, -.1347D-03, -.2258D-03, & + & -.3773D-03, -.6192D-03, -.9964D-03, -.1572D-02, -.2419D-02, & + & -.3614D-02, -.5217D-02, -.7271D-02, -.9648D-02, -.1207D-01, & + & -.1397D-01, -.1470D-01, -.1397D-01, -.1198D-01, -.9338D-02, & + & -.6697D-02, -.4463D-02, -.2789D-02, -.1633D-02, -.8906D-03, & + & -.4390D-03, -.1801D-03, -.4064D-04, 0.2741D-04, 0.5574D-04, & + & 0.6281D-04, 0.5925D-04, 0.5137D-04, 0.4233D-04, 0.3375D-04, & + & 0.2630D-04, 0.2016D-04, 0.1524D-04, 0.1141D-04, 0.8462D-05, & + & 0.6232D-05, 0.4565D-05, 0.3327D-05, 0.2415D-05, 0.1745D-05, & + & 0.1257D-05, 0.9025D-06, 0.6467D-06, 0.4621D-06, 0.3295D-06, & + & 0.2345D-06/ + + data (calcpts(j,23), j = 1,neta) /-.7139D-10, -.2032D-09, & + & -.2202D-09, -.4896D-09, -.9366D-09, -.1551D-08, -.2642D-08, & + & -.4985D-08, -.8101D-08, -.1518D-07, -.2690D-07, -.4750D-07, & + & -.8275D-07, -.1502D-06, -.2509D-06, -.4601D-06, -.8073D-06, & + & -.1424D-05, -.2501D-05, -.4335D-05, -.7507D-05, -.1324D-04, & + & -.2278D-04, -.3909D-04, -.6652D-04, -.1117D-03, -.1864D-03, & + & -.3059D-03, -.4916D-03, -.7702D-03, -.1172D-02, -.1726D-02, & + & -.2437D-02, -.3320D-02, -.4357D-02, -.5539D-02, -.6817D-02, & + & -.7998D-02, -.8679D-02, -.8506D-02, -.7418D-02, -.5731D-02, & + & -.3914D-02, -.2337D-02, -.1169D-02, -.4055D-03, 0.3533D-04, & + & 0.2515D-03, 0.3307D-03, 0.3336D-03, 0.2995D-03, 0.2522D-03, & + & 0.2037D-03, 0.1599D-03, 0.1229D-03, 0.9307D-04, 0.6966D-04, & + & 0.5164D-04, 0.3801D-04, 0.2780D-04, 0.2022D-04, 0.1464D-04, & + & 0.1056D-04, 0.7597D-05, 0.5449D-05, 0.3897D-05, 0.2780D-05, & + & 0.1980D-05, 0.1407D-05, 0.9980D-06, 0.7070D-06, 0.5001D-06, & + & 0.3532D-06/ + + data (calcpts(j,24), j = 1,neta) /-.6663D-10, -.1430D-09, & + & -.2377D-09, -.3509D-09, -.6307D-09, -.1200D-08, -.2150D-08, & + & -.3945D-08, -.6802D-08, -.1085D-07, -.2096D-07, -.3674D-07, & + & -.6488D-07, -.1169D-06, -.1955D-06, -.3622D-06, -.6396D-06, & + & -.1117D-05, -.1942D-05, -.3415D-05, -.5853D-05, -.1026D-04, & + & -.1762D-04, -.2996D-04, -.5068D-04, -.8471D-04, -.1387D-03, & + & -.2242D-03, -.3522D-03, -.5364D-03, -.7826D-03, -.1086D-02, & + & -.1409D-02, -.1705D-02, -.1925D-02, -.2067D-02, -.2263D-02, & + & -.2561D-02, -.2916D-02, -.3021D-02, -.2667D-02, -.1883D-02, & + & -.9116D-03, -.3166D-04, 0.5909D-03, 0.9319D-03, 0.1045D-02, & + & 0.1008D-02, 0.8924D-03, 0.7462D-03, 0.6003D-03, 0.4697D-03, & + & 0.3600D-03, 0.2715D-03, 0.2024D-03, 0.1493D-03, 0.1095D-03, & + & 0.7967D-04, 0.5773D-04, 0.4164D-04, 0.2993D-04, 0.2145D-04, & + & 0.1532D-04, 0.1093D-04, 0.7775D-05, 0.5521D-05, 0.3914D-05, & + & 0.2770D-05, 0.1958D-05, 0.1382D-05, 0.9741D-06, 0.6859D-06, & + & 0.4824D-06/ + + data (calcpts(j,25), j = 1,neta) /-.4096D-10, -.1024D-09, & + & -.1250D-09, -.3239D-09, -.5429D-09, -.8035D-09, -.1449D-08, & + & -.2800D-08, -.4499D-08, -.7629D-08, -.1569D-07, -.2552D-07, & + & -.4639D-07, -.8264D-07, -.1419D-06, -.2453D-06, -.4483D-06, & + & -.7893D-06, -.1374D-05, -.2390D-05, -.4106D-05, -.7060D-05, & + & -.1218D-04, -.2085D-04, -.3488D-04, -.5793D-04, -.9397D-04, & + & -.1492D-03, -.2306D-03, -.3418D-03, -.4774D-03, -.6178D-03, & + & -.7062D-03, -.6706D-03, -.4351D-03, 0.5732D-05, 0.5147D-03, & + & 0.8986D-03, 0.1007D-02, 0.9469D-03, 0.9506D-03, 0.1159D-02, & + & 0.1518D-02, 0.1865D-02, 0.2064D-02, 0.2073D-02, 0.1925D-02, & + & 0.1681D-02, 0.1401D-02, 0.1126D-02, 0.8806D-03, 0.6745D-03, & + & 0.5082D-03, 0.3782D-03, 0.2785D-03, 0.2036D-03, 0.1479D-03, & + & 0.1069D-03, 0.7687D-04, 0.5511D-04, 0.3939D-04, 0.2808D-04, & + & 0.1997D-04, 0.1418D-04, 0.1005D-04, 0.7106D-05, 0.5020D-05, & + & 0.3543D-05, 0.2496D-05, 0.1757D-05, 0.1235D-05, 0.8675D-06, & + & 0.6088D-06/ + + data (calcpts(j,26), j = 1,neta) /-.2490D-10, -.4478D-10, & + & -.7078D-10, -.1422D-09, -.2641D-09, -.4349D-09, -.8422D-09, & + & -.1633D-08, -.2776D-08, -.5104D-08, -.9995D-08, -.1603D-07, & + & -.2874D-07, -.5237D-07, -.8911D-07, -.1598D-06, -.2803D-06, & + & -.5038D-06, -.8796D-06, -.1533D-05, -.2617D-05, -.4537D-05, & + & -.7801D-05, -.1317D-04, -.2206D-04, -.3644D-04, -.5860D-04, & + & -.9246D-04, -.1406D-03, -.2029D-03, -.2731D-03, -.3271D-03, & + & -.3154D-03, -.1690D-03, 0.1905D-03, 0.7872D-03, 0.1531D-02, & + & 0.2217D-02, 0.2644D-02, 0.2781D-02, 0.2773D-02, 0.2790D-02, & + & 0.2883D-02, 0.2974D-02, 0.2965D-02, 0.2807D-02, 0.2523D-02, & + & 0.2162D-02, 0.1780D-02, 0.1420D-02, 0.1104D-02, 0.8416D-03, & + & 0.6316D-03, 0.4681D-03, 0.3436D-03, 0.2503D-03, 0.1812D-03, & + & 0.1305D-03, 0.9363D-04, 0.6694D-04, 0.4772D-04, 0.3394D-04, & + & 0.2408D-04, 0.1706D-04, 0.1206D-04, 0.8518D-05, 0.6007D-05, & + & 0.4231D-05, 0.2976D-05, 0.2092D-05, 0.1468D-05, 0.1030D-05, & + & 0.7222D-06/ + + data (calcpts(j,27), j = 1,neta) /-.1861D-10, -.4714D-10, & + & -.5830D-10, -.1150D-09, -.2267D-09, -.3674D-09, -.6322D-09, & + & -.1213D-08, -.1915D-08, -.3361D-08, -.6083D-08, -.1054D-07, & + & -.1793D-07, -.3229D-07, -.5634D-07, -.9872D-07, -.1754D-06, & + & -.3049D-06, -.5304D-06, -.9291D-06, -.1583D-05, -.2729D-05, & + & -.4670D-05, -.7874D-05, -.1317D-04, -.2164D-04, -.3451D-04, & + & -.5416D-04, -.8138D-04, -.1156D-03, -.1509D-03, -.1696D-03, & + & -.1364D-03, 0.1381D-05, 0.3043D-03, 0.8057D-03, 0.1457D-02, & + & 0.2117D-02, 0.2619D-02, 0.2886D-02, 0.2985D-02, 0.3045D-02, & + & 0.3136D-02, 0.3219D-02, 0.3210D-02, 0.3060D-02, 0.2775D-02, & + & 0.2400D-02, 0.1996D-02, 0.1603D-02, 0.1254D-02, 0.9594D-03, & + & 0.7220D-03, 0.5360D-03, 0.3939D-03, 0.2869D-03, 0.2078D-03, & + & 0.1496D-03, 0.1072D-03, 0.7659D-04, 0.5455D-04, 0.3875D-04, & + & 0.2748D-04, 0.1944D-04, 0.1374D-04, 0.9692D-05, 0.6829D-05, & + & 0.4805D-05, 0.3378D-05, 0.2372D-05, 0.1665D-05, 0.1167D-05, & + & 0.8173D-06/ + + data (calcpts(j,28), j = 1,neta) /-.1221D-10, -.1892D-10, & + & -.3565D-10, -.6203D-10, -.1164D-09, -.2009D-09, -.3449D-09, & + & -.6346D-09, -.9467D-09, -.1799D-08, -.3369D-08, -.5811D-08, & + & -.1014D-07, -.1789D-07, -.3099D-07, -.5488D-07, -.9664D-07, & + & -.1698D-06, -.2948D-06, -.5086D-06, -.8873D-06, -.1524D-05, & + & -.2600D-05, -.4375D-05, -.7292D-05, -.1205D-04, -.1922D-04, & + & -.2985D-04, -.4471D-04, -.6283D-04, -.8037D-04, -.8662D-04, & + & -.5937D-04, 0.3383D-04, 0.2353D-03, 0.5676D-03, 0.1014D-02, & + & 0.1492D-02, 0.1891D-02, 0.2147D-02, 0.2293D-02, 0.2421D-02, & + & 0.2591D-02, 0.2779D-02, 0.2896D-02, 0.2874D-02, 0.2698D-02, & + & 0.2404D-02, 0.2044D-02, 0.1673D-02, 0.1327D-02, 0.1026D-02, & + & 0.7784D-03, 0.5813D-03, 0.4289D-03, 0.3133D-03, 0.2274D-03, & + & 0.1638D-03, 0.1176D-03, 0.8402D-04, 0.5985D-04, 0.4252D-04, & + & 0.3015D-04, 0.2132D-04, 0.1506D-04, 0.1062D-04, 0.7483D-05, & + & 0.5265D-05, 0.3700D-05, 0.2597D-05, 0.1821D-05, 0.1277D-05, & + & 0.8940D-06/ + + data (calcpts(j,29), j = 1,neta) /-.4983D-11, -.9790D-11, & + & -.1290D-10, -.3188D-10, -.5737D-10, -.9069D-10, -.1687D-09, & + & -.3056D-09, -.4990D-09, -.9079D-09, -.1750D-08, -.2956D-08, & + & -.5178D-08, -.9420D-08, -.1603D-07, -.2899D-07, -.5115D-07, & + & -.8900D-07, -.1549D-06, -.2717D-06, -.4668D-06, -.8112D-06, & + & -.1373D-05, -.2324D-05, -.3879D-05, -.6359D-05, -.1017D-04, & + & -.1589D-04, -.2369D-04, -.3311D-04, -.4219D-04, -.4462D-04, & + & -.2846D-04, 0.2510D-04, 0.1398D-03, 0.3315D-03, 0.5920D-03, & + & 0.8776D-03, 0.1124D-02, 0.1291D-02, 0.1397D-02, 0.1514D-02, & + & 0.1710D-02, 0.1973D-02, 0.2224D-02, 0.2368D-02, 0.2357D-02, & + & 0.2201D-02, 0.1943D-02, 0.1636D-02, 0.1327D-02, 0.1045D-02, & + & 0.8027D-03, 0.6054D-03, 0.4498D-03, 0.3305D-03, 0.2406D-03, & + & 0.1739D-03, 0.1250D-03, 0.8948D-04, 0.6380D-04, 0.4535D-04, & + & 0.3216D-04, 0.2276D-04, 0.1608D-04, 0.1134D-04, 0.7988D-05, & + & 0.5620D-05, 0.3948D-05, 0.2772D-05, 0.1944D-05, 0.1362D-05, & + & 0.9538D-06/ + + data (calcpts(j,30), j = 1,neta) /-.2854D-11, -.4437D-11, & + & -.7638D-11, -.1380D-10, -.2918D-10, -.5391D-10, -.8799D-10, & + & -.1632D-09, -.2688D-09, -.4775D-09, -.8800D-09, -.1564D-08, & + & -.2775D-08, -.4964D-08, -.8434D-08, -.1488D-07, -.2652D-07, & + & -.4610D-07, -.8079D-07, -.1414D-06, -.2420D-06, -.4168D-06, & + & -.7136D-06, -.1200D-05, -.2009D-05, -.3292D-05, -.5263D-05, & + & -.8193D-05, -.1227D-04, -.1725D-04, -.2189D-04, -.2334D-04, & + & -.1515D-04, 0.1224D-04, 0.7142D-04, 0.1709D-03, 0.3063D-03, & + & 0.4543D-03, 0.5785D-03, 0.6537D-03, 0.6912D-03, 0.7457D-03, & + & 0.8840D-03, 0.1130D-02, 0.1433D-02, 0.1699D-02, 0.1847D-02, & + & 0.1847D-02, 0.1719D-02, 0.1508D-02, 0.1263D-02, 0.1019D-02, & + & 0.7975D-03, 0.6098D-03, 0.4581D-03, 0.3392D-03, 0.2483D-03, & + & 0.1804D-03, 0.1300D-03, 0.9327D-04, 0.6661D-04, 0.4742D-04, & + & 0.3365D-04, 0.2383D-04, 0.1684D-04, 0.1188D-04, 0.8370D-05, & + & 0.5889D-05, 0.4138D-05, 0.2905D-05, 0.2038D-05, 0.1428D-05, & + & 0.9997D-06/ + + data (calcpts(j,31), j = 1,neta) /-.9247D-12, -.2620D-11, & + & -.4429D-11, -.7357D-11, -.1432D-10, -.2601D-10, -.4498D-10, & + & -.8562D-10, -.1330D-09, -.2509D-09, -.4525D-09, -.7727D-09, & + & -.1383D-08, -.2448D-08, -.4206D-08, -.7491D-08, -.1325D-07, & + & -.2328D-07, -.4055D-07, -.7122D-07, -.1212D-06, -.2087D-06, & + & -.3586D-06, -.6048D-06, -.1010D-05, -.1663D-05, -.2651D-05, & + & -.4146D-05, -.6220D-05, -.8759D-05, -.1125D-04, -.1221D-04, & + & -.8548D-05, 0.4577D-05, 0.3298D-04, 0.8095D-04, 0.1456D-03, & + & 0.2140D-03, 0.2653D-03, 0.2830D-03, 0.2709D-03, 0.2637D-03, & + & 0.3173D-03, 0.4761D-03, 0.7347D-03, 0.1029D-02, 0.1273D-02, & + & 0.1403D-02, 0.1407D-02, 0.1307D-02, 0.1142D-02, 0.9523D-03, & + & 0.7647D-03, 0.5962D-03, 0.4544D-03, 0.3402D-03, 0.2512D-03, & + & 0.1834D-03, 0.1329D-03, 0.9566D-04, 0.6849D-04, 0.4883D-04, & + & 0.3470D-04, 0.2460D-04, 0.1740D-04, 0.1228D-04, 0.8652D-05, & + & 0.6089D-05, 0.4280D-05, 0.3004D-05, 0.2107D-05, 0.1477D-05, & + & 0.1034D-05/ + + data (calcpts(j,32), j = 1,neta) /0.2151D-11, 0.8299D-12, & + & 0.1550D-11, -.1431D-11, -.5444D-11, -.1006D-10, -.1886D-10, & + & -.3642D-10, -.5890D-10, -.1180D-09, -.2167D-09, -.3646D-09, & + & -.6557D-09, -.1191D-08, -.2029D-08, -.3601D-08, -.6539D-08, & + & -.1130D-07, -.1982D-07, -.3464D-07, -.5947D-07, -.1027D-06, & + & -.1758D-06, -.2982D-06, -.4972D-06, -.8188D-06, -.1314D-05, & + & -.2050D-05, -.3091D-05, -.4386D-05, -.5697D-05, -.6336D-05, & + & -.4837D-05, 0.1010D-05, 0.1405D-04, 0.3593D-04, 0.6474D-04, & + & 0.9324D-04, 0.1093D-03, 0.1019D-03, 0.7001D-04, 0.3092D-04, & + & 0.2157D-04, 0.8568D-04, 0.2472D-03, 0.4866D-03, 0.7427D-03, & + & 0.9454D-03, 0.1051D-02, 0.1053D-02, 0.9759D-03, 0.8503D-03, & + & 0.7063D-03, 0.5654D-03, 0.4394D-03, 0.3339D-03, 0.2494D-03, & + & 0.1837D-03, 0.1339D-03, 0.9681D-04, 0.6956D-04, 0.4972D-04, & + & 0.3540D-04, 0.2512D-04, 0.1779D-04, 0.1256D-04, 0.8858D-05, & + & 0.6235D-05, 0.4384D-05, 0.3079D-05, 0.2160D-05, 0.1514D-05, & + & 0.1060D-05/ + + data (calcpts(j,33), j = 1,neta) /-.4830D-11, -.3510D-11, & + & -.2885D-11, -.2197D-11, -.5301D-11, -.7682D-11, -.1224D-10, & + & -.2146D-10, -.3607D-10, -.6335D-10, -.1117D-09, -.1940D-09, & + & -.3413D-09, -.6064D-09, -.1037D-08, -.1847D-08, -.3234D-08, & + & -.5704D-08, -.9849D-08, -.1719D-07, -.2943D-07, -.5075D-07, & + & -.8699D-07, -.1473D-06, -.2450D-06, -.4040D-06, -.6487D-06, & + & -.1017D-05, -.1536D-05, -.2197D-05, -.2877D-05, -.3300D-05, & + & -.2760D-05, -.2738D-06, 0.5417D-05, 0.1496D-04, 0.2710D-04, & + & 0.3770D-04, 0.3981D-04, 0.2627D-04, -.5854D-05, -.5007D-04, & + & -.8679D-04, -.8547D-04, -.1608D-04, 0.1319D-03, 0.3348D-03, & + & 0.5416D-03, 0.6997D-03, 0.7792D-03, 0.7796D-03, 0.7201D-03, & + & 0.6254D-03, 0.5179D-03, 0.4134D-03, 0.3205D-03, 0.2430D-03, & + & 0.1811D-03, 0.1331D-03, 0.9683D-04, 0.6990D-04, 0.5014D-04, & + & 0.3579D-04, 0.2544D-04, 0.1804D-04, 0.1276D-04, 0.9000D-05, & + & 0.6340D-05, 0.4459D-05, 0.3132D-05, 0.2198D-05, 0.1540D-05, & + & 0.1079D-05/ + + data (calcpts(j,34), j = 1,neta) /-.4478D-11, -.5153D-11, & + & -.5308D-11, -.4177D-11, -.4213D-11, -.4759D-11, -.5756D-11, & + & -.1097D-10, -.1695D-10, -.2947D-10, -.5351D-10, -.9124D-10, & + & -.1597D-09, -.2835D-09, -.5010D-09, -.8807D-09, -.1553D-08, & + & -.2698D-08, -.4757D-08, -.8210D-08, -.1417D-07, -.2437D-07, & + & -.4186D-07, -.7064D-07, -.1181D-06, -.1950D-06, -.3131D-06, & + & -.4943D-06, -.7498D-06, -.1078D-05, -.1435D-05, -.1678D-05, & + & -.1527D-05, -.5054D-06, 0.1898D-05, 0.5895D-05, 0.1073D-04, & + & 0.1406D-04, 0.1199D-04, 0.9194D-07, -.2455D-04, -.6061D-04, & + & -.9966D-04, -.1249D-03, -.1138D-03, -.4696D-04, 0.7833D-04, & + & 0.2402D-03, 0.3989D-03, 0.5166D-03, 0.5738D-03, 0.5720D-03, & + & 0.5266D-03, 0.4559D-03, 0.3765D-03, 0.2997D-03, 0.2318D-03, & + & 0.1754D-03, 0.1305D-03, 0.9577D-04, 0.6957D-04, 0.5013D-04, & + & 0.3592D-04, 0.2560D-04, 0.1818D-04, 0.1287D-04, 0.9093D-05, & + & 0.6410D-05, 0.4511D-05, 0.3170D-05, 0.2224D-05, 0.1560D-05, & + & 0.1093D-05/ + + data (calcpts(j,35), j = 1,neta) /-.1445D-10, -.1011D-11, & + & 0.7187D-12, -.4568D-11, -.1821D-11, -.4338D-11, -.3443D-11, & + & -.5130D-11, -.7749D-11, -.1404D-10, -.2392D-10, -.4275D-10, & + & -.7507D-10, -.1339D-09, -.2362D-09, -.4118D-09, -.7348D-09, & + & -.1279D-08, -.2235D-08, -.3895D-08, -.6681D-08, -.1161D-07, & + & -.1988D-07, -.3368D-07, -.5648D-07, -.9351D-07, -.1508D-06, & + & -.2386D-06, -.3626D-06, -.5248D-06, -.7084D-06, -.8508D-06, & + & -.8231D-06, -.4278D-06, 0.5567D-06, 0.2181D-05, 0.3960D-05, & + & 0.4671D-05, 0.2131D-05, -.6248D-05, -.2267D-04, -.4762D-04, & + & -.7831D-04, -.1071D-03, -.1211D-03, -.1046D-03, -.4569D-04, & + & 0.5467D-04, 0.1784D-03, 0.2957D-03, 0.3805D-03, 0.4201D-03, & + & 0.4170D-03, 0.3824D-03, 0.3301D-03, 0.2720D-03, 0.2161D-03, & + & 0.1668D-03, 0.1260D-03, 0.9353D-04, 0.6854D-04, 0.4972D-04, & + & 0.3579D-04, 0.2560D-04, 0.1822D-04, 0.1293D-04, 0.9145D-05, & + & 0.6452D-05, 0.4545D-05, 0.3195D-05, 0.2244D-05, 0.1573D-05, & + & 0.1102D-05/ + + data (calcpts(j,36), j = 1,neta) /0.6876D-11, -.4528D-12, & + & 0.3776D-11, 0.3938D-12, -.4144D-11, 0.7553D-12, -.3980D-11, & + & -.1515D-11, -.4962D-11, -.7698D-11, -.1130D-10, -.2065D-10, & + & -.3616D-10, -.6477D-10, -.1112D-09, -.1966D-09, -.3543D-09, & + & -.6119D-09, -.1063D-08, -.1860D-08, -.3216D-08, -.5546D-08, & + & -.9528D-08, -.1609D-07, -.2715D-07, -.4477D-07, -.7242D-07, & + & -.1148D-06, -.1757D-06, -.2565D-06, -.3483D-06, -.4296D-06, & + & -.4394D-06, -.2954D-06, 0.9171D-07, 0.7169D-06, 0.1319D-05, & + & 0.1220D-05, -.7291D-06, -.6002D-05, -.1603D-04, -.3165D-04, & + & -.5234D-04, -.7523D-04, -.9426D-04, -.1001D-03, -.8223D-04, & + & -.3349D-04, 0.4377D-04, 0.1353D-03, 0.2199D-03, 0.2796D-03, & + & 0.3062D-03, 0.3022D-03, 0.2761D-03, 0.2377D-03, 0.1954D-03, & + & 0.1549D-03, 0.1194D-03, 0.9004D-04, 0.6675D-04, 0.4884D-04, & + & 0.3538D-04, 0.2544D-04, 0.1818D-04, 0.1293D-04, 0.9162D-05, & + & 0.6474D-05, 0.4563D-05, 0.3211D-05, 0.2256D-05, 0.1582D-05, & + & 0.1109D-05/ + + data (calcpts(j,37), j = 1,neta) /0.3214D-11, 0.2471D-11, & + & 0.1989D-11, 0.4786D-11, 0.2349D-11, -.4747D-11, 0.3463D-12, & + & 0.2695D-12, -.4435D-13, -.1458D-11, -.6294D-11, -.9686D-11, & + & -.1874D-10, -.2966D-10, -.5306D-10, -.9410D-10, -.1660D-09, & + & -.2915D-09, -.5026D-09, -.8926D-09, -.1533D-08, -.2640D-08, & + & -.4533D-08, -.7698D-08, -.1291D-07, -.2141D-07, -.3468D-07, & + & -.5509D-07, -.8459D-07, -.1242D-06, -.1711D-06, -.2145D-06, & + & -.2301D-06, -.1838D-06, -.3719D-07, 0.1903D-06, 0.3566D-06, & + & 0.1064D-06, -.1167D-05, -.4265D-05, -.1005D-04, -.1920D-04, & + & -.3191D-04, -.4735D-04, -.6312D-04, -.7473D-04, -.7563D-04, & + & -.5884D-04, -.2025D-04, 0.3754D-04, 0.1038D-03, 0.1636D-03, & + & 0.2047D-03, 0.2223D-03, 0.2181D-03, 0.1986D-03, 0.1705D-03, & + & 0.1398D-03, 0.1107D-03, 0.8517D-04, 0.6412D-04, 0.4747D-04, & + & 0.3469D-04, 0.2511D-04, 0.1803D-04, 0.1287D-04, 0.9141D-05, & + & 0.6472D-05, 0.4569D-05, 0.3217D-05, 0.2262D-05, 0.1588D-05, & + & 0.1113D-05/ + + data (calcpts(j,38), j = 1,neta) /0.2265D-10, -.4611D-11, & + & 0.1382D-10, 0.1316D-10, -.3562D-11, -.2469D-11, -.3007D-12, & + & -.6720D-11, 0.3697D-11, -.9792D-12, -.1845D-11, -.3928D-11, & + & -.8268D-11, -.1260D-10, -.2389D-10, -.4290D-10, -.7696D-10, & + & -.1363D-09, -.2383D-09, -.4171D-09, -.7147D-09, -.1251D-08, & + & -.2138D-08, -.3636D-08, -.6118D-08, -.1016D-07, -.1648D-07, & + & -.2633D-07, -.4057D-07, -.5986D-07, -.8323D-07, -.1064D-06, & + & -.1190D-06, -.1063D-06, -.5577D-07, 0.2084D-07, 0.4457D-07, & + & -.1681D-06, -.9323D-06, -.2673D-05, -.5877D-05, -.1100D-04, & + & -.1834D-04, -.2781D-04, -.3861D-04, -.4890D-04, -.5543D-04, & + & -.5375D-04, -.3926D-04, -.9647D-05, 0.3266D-04, 0.7984D-04, & + & 0.1215D-03, 0.1495D-03, 0.1608D-03, 0.1569D-03, 0.1422D-03, & + & 0.1218D-03, 0.9973D-04, 0.7881D-04, 0.6055D-04, 0.4554D-04, & + & 0.3367D-04, 0.2458D-04, 0.1776D-04, 0.1274D-04, 0.9085D-05, & + & 0.6448D-05, 0.4561D-05, 0.3217D-05, 0.2265D-05, 0.1590D-05, & + & 0.1116D-05/ + + data (calcpts(j,39), j = 1,neta) /0.8899D-11, 0.2293D-10, & + & 0.1677D-11, -.1608D-10, 0.2425D-11, -.1380D-10, 0.4994D-11, & + & 0.2777D-12, 0.8584D-11, 0.6138D-11, 0.2812D-11, 0.1515D-11, & + & -.1299D-11, -.8634D-11, -.1286D-10, -.2092D-10, -.3649D-10, & + & -.6586D-10, -.1145D-09, -.2014D-09, -.3462D-09, -.5964D-09, & + & -.1022D-08, -.1742D-08, -.2924D-08, -.4869D-08, -.7902D-08, & + & -.1260D-07, -.1952D-07, -.2905D-07, -.4074D-07, -.5301D-07, & + & -.6136D-07, -.5983D-07, -.4423D-07, -.2299D-07, -.3755D-07, & + & -.1818D-06, -.6164D-06, -.1563D-05, -.3287D-05, -.6063D-05, & + & -.1012D-04, -.1557D-04, -.2225D-04, -.2948D-04, -.3591D-04, & + & -.3926D-04, -.3647D-04, -.2462D-04, -.2424D-05, 0.2807D-04, & + & 0.6125D-04, 0.8998D-04, 0.1088D-03, 0.1158D-03, 0.1124D-03, & + & 0.1016D-03, 0.8679D-04, 0.7093D-04, 0.5596D-04, 0.4296D-04, & + & 0.3226D-04, 0.2383D-04, 0.1737D-04, 0.1254D-04, 0.8988D-05, & + & 0.6403D-05, 0.4540D-05, 0.3208D-05, 0.2262D-05, 0.1590D-05, & + & 0.1116D-05/ + + data (calcpts(j,40), j = 1,neta) /0.3289D-10, 0.2708D-10, & + & 0.3539D-10, -.6742D-11, 0.5593D-11, 0.7691D-11, 0.2261D-10, & + & 0.8058D-11, -.1388D-12, 0.9135D-11, 0.1398D-10, -.2515D-11, & + & 0.1087D-11, -.2156D-11, -.3048D-11, -.1035D-10, -.1705D-10, & + & -.3096D-10, -.5363D-10, -.9460D-10, -.1621D-09, -.2806D-09, & + & -.4827D-09, -.8212D-09, -.1382D-08, -.2294D-08, -.3755D-08, & + & -.5997D-08, -.9319D-08, -.1391D-07, -.1973D-07, -.2600D-07, & + & -.3104D-07, -.3247D-07, -.2878D-07, -.2572D-07, -.4432D-07, & + & -.1324D-06, -.3711D-06, -.8743D-06, -.1782D-05, -.3251D-05, & + & -.5431D-05, -.8440D-05, -.1229D-04, -.1682D-04, -.2151D-04, & + & -.2537D-04, -.2682D-04, -.2382D-04, -.1447D-04, 0.1894D-05, & + & 0.2362D-04, 0.4674D-04, 0.6637D-04, 0.7893D-04, 0.8326D-04, & + & 0.8034D-04, 0.7236D-04, 0.6169D-04, 0.5034D-04, 0.3966D-04, & + & 0.3040D-04, 0.2281D-04, 0.1683D-04, 0.1226D-04, 0.8842D-05, & + & 0.6330D-05, 0.4506D-05, 0.3192D-05, 0.2254D-05, 0.1587D-05, & + & 0.1116D-05/ + + data (calcpts(j,41), j = 1,neta) /0.8070D-10, 0.7208D-10, & + & -.9969D-11, 0.4621D-10, 0.3142D-10, 0.1773D-10, 0.2619D-10, & + & 0.5520D-11, 0.1387D-10, -.2577D-11, 0.4067D-11, -.4187D-11, & + & 0.1809D-11, 0.1111D-11, 0.3716D-11, -.1177D-11, -.5532D-11, & + & -.9871D-11, -.2146D-10, -.4289D-10, -.7489D-10, -.1314D-09, & + & -.2265D-09, -.3856D-09, -.6518D-09, -.1086D-08, -.1774D-08, & + & -.2838D-08, -.4438D-08, -.6668D-08, -.9526D-08, -.1275D-07, & + & -.1562D-07, -.1721D-07, -.1718D-07, -.1892D-07, -.3309D-07, & + & -.8376D-07, -.2116D-06, -.4746D-06, -.9454D-06, -.1708D-05, & + & -.2854D-05, -.4465D-05, -.6595D-05, -.9230D-05, -.1222D-04, & + & -.1518D-04, -.1741D-04, -.1781D-04, -.1502D-04, -.7817D-05, & + & 0.4090D-05, 0.1945D-04, 0.3544D-04, 0.4878D-04, 0.5709D-04, & + & 0.5967D-04, 0.5728D-04, 0.5143D-04, 0.4375D-04, 0.3564D-04, & + & 0.2805D-04, 0.2148D-04, 0.1609D-04, 0.1187D-04, 0.8635D-05, & + & 0.6223D-05, 0.4450D-05, 0.3165D-05, 0.2241D-05, 0.1581D-05, & + & 0.1113D-05/ + + data (calcpts(j,42), j = 1,neta) /-.5846D-10, -.7014D-10, & + & -.5778D-10, -.1180D-09, -.2375D-10, -.5015D-10, -.7008D-11, & + & 0.8792D-11, -.1201D-10, -.3614D-10, -.1938D-10, -.1763D-10, & + & 0.7249D-11, -.6352D-11, -.4248D-11, -.9391D-11, -.7513D-11, & + & -.1266D-10, -.1417D-10, -.2237D-10, -.3978D-10, -.6331D-10, & + & -.1093D-09, -.1839D-09, -.3089D-09, -.5148D-09, -.8423D-09, & + & -.1355D-08, -.2121D-08, -.3203D-08, -.4610D-08, -.6246D-08, & + & -.7828D-08, -.9010D-08, -.9846D-08, -.1204D-07, -.2119D-07, & + & -.4927D-07, -.1165D-06, -.2519D-06, -.4931D-06, -.8844D-06, & + & -.1476D-05, -.2321D-05, -.3462D-05, -.4926D-05, -.6685D-05, & + & -.8617D-05, -.1044D-04, -.1166D-04, -.1152D-04, -.9118D-05, & + & -.3686D-05, 0.4897D-05, 0.1567D-04, 0.2668D-04, 0.3570D-04, & + & 0.4116D-04, 0.4267D-04, 0.4075D-04, 0.3648D-04, 0.3097D-04, & + & 0.2520D-04, 0.1981D-04, 0.1515D-04, 0.1134D-04, 0.8355D-05, & + & 0.6075D-05, 0.4374D-05, 0.3126D-05, 0.2221D-05, 0.1572D-05, & + & 0.1108D-05/ + + data (calcpts(j,43), j = 1,neta) /0.1136D-10, -.8782D-10, & + & 0.6688D-10, -.2130D-10, 0.8003D-10, 0.2656D-10, -.1288D-10, & + & -.8851D-11, -.1165D-10, -.1624D-11, 0.1652D-11, 0.3481D-11, & + & -.9166D-11, -.8690D-11, -.1727D-11, 0.2107D-11, 0.7933D-11, & + & -.2786D-11, -.5017D-11, -.1410D-10, -.1768D-10, -.3233D-10, & + & -.4968D-10, -.8618D-10, -.1465D-09, -.2441D-09, -.3988D-09, & + & -.6432D-09, -.1010D-08, -.1531D-08, -.2219D-08, -.3050D-08, & + & -.3898D-08, -.4655D-08, -.5410D-08, -.7109D-08, -.1256D-07, & + & -.2769D-07, -.6255D-07, -.1316D-06, -.2538D-06, -.4523D-06, & + & -.7542D-06, -.1189D-05, -.1789D-05, -.2576D-05, -.3560D-05, & + & -.4712D-05, -.5939D-05, -.7035D-05, -.7651D-05, -.7277D-05, & + & -.5307D-05, -.1264D-05, 0.4879D-05, 0.1241D-04, 0.1996D-04, & + & 0.2602D-04, 0.2959D-04, 0.3043D-04, 0.2893D-04, 0.2583D-04, & + & 0.2188D-04, 0.1779D-04, 0.1397D-04, 0.1067D-04, 0.7984D-05, & + & 0.5875D-05, 0.4269D-05, 0.3070D-05, 0.2193D-05, 0.1557D-05, & + & 0.1101D-05/ + + data (calcpts(j,44), j = 1,neta) /0.2906D-09, -.1005D-09, & + & -.3852D-10, -.4085D-10, 0.4381D-10, 0.4428D-10, 0.1203D-11, & + & -.1534D-10, -.7004D-11, 0.1085D-10, 0.1420D-10, -.1206D-10, & + & 0.4450D-11, 0.9734D-11, -.1428D-10, 0.5013D-12, -.3193D-11, & + & 0.5180D-11, 0.8894D-12, -.6236D-12, -.1257D-10, -.1550D-10, & + & -.2144D-10, -.4033D-10, -.6840D-10, -.1162D-09, -.1881D-09, & + & -.3056D-09, -.4808D-09, -.7301D-09, -.1067D-08, -.1479D-08, & + & -.1927D-08, -.2374D-08, -.2901D-08, -.3997D-08, -.7078D-08, & + & -.1508D-07, -.3295D-07, -.6784D-07, -.1293D-06, -.2292D-06, & + & -.3817D-06, -.6034D-06, -.9124D-06, -.1326D-05, -.1859D-05, & + & -.2509D-05, -.3253D-05, -.4018D-05, -.4658D-05, -.4929D-05, & + & -.4484D-05, -.2922D-05, 0.5770D-07, 0.4431D-05, 0.9675D-05, & + & 0.1484D-04, 0.1891D-04, 0.2124D-04, 0.2167D-04, 0.2052D-04, & + & 0.1825D-04, 0.1545D-04, 0.1254D-04, 0.9835D-05, 0.7509D-05, & + & 0.5613D-05, 0.4126D-05, 0.2995D-05, 0.2154D-05, 0.1537D-05, & + & 0.1091D-05/ + + data (calcpts(j,45), j = 1,neta) /0.6116D-10, 0.3562D-09, & + & 0.3791D-09, 0.2375D-09, 0.1795D-09, 0.2456D-09, 0.2054D-09, & + & 0.3163D-09, 0.1831D-09, 0.1081D-09, 0.5660D-10, 0.8214D-10, & + & 0.7798D-10, 0.1560D-10, 0.1258D-10, 0.2074D-10, 0.3867D-10, & + & 0.6209D-11, 0.2225D-10, 0.1446D-10, 0.1357D-10, 0.4389D-11, & + & -.7446D-11, -.1488D-10, -.2801D-10, -.5172D-10, -.8844D-10, & + & -.1439D-09, -.2279D-09, -.3493D-09, -.5138D-09, -.7197D-09, & + & -.9534D-09, -.1207D-08, -.1533D-08, -.2187D-08, -.3875D-08, & + & -.8040D-08, -.1711D-07, -.3462D-07, -.6532D-07, -.1152D-06, & + & -.1917D-06, -.3035D-06, -.4610D-06, -.6749D-06, -.9555D-06, & + & -.1309D-05, -.1734D-05, -.2207D-05, -.2676D-05, -.3038D-05, & + & -.3120D-05, -.2687D-05, -.1476D-05, 0.7008D-06, 0.3801D-05, & + & 0.7441D-05, 0.1096D-04, 0.1369D-04, 0.1519D-04, 0.1540D-04, & + & 0.1452D-04, 0.1289D-04, 0.1089D-04, 0.8827D-05, 0.6918D-05, & + & 0.5277D-05, 0.3942D-05, 0.2896D-05, 0.2101D-05, 0.1509D-05, & + & 0.1076D-05/ + + data (calcpts(j,46), j = 1,neta) /0.1917D-09, -.1535D-09, & + & 0.4083D-09, 0.2116D-09, 0.9985D-10, -.3683D-11, 0.6403D-10, & + & 0.2144D-10, 0.7432D-11, 0.7975D-10, -.1710D-10, 0.2668D-10, & + & -.1262D-10, 0.4799D-11, 0.3884D-11, -.4044D-11, 0.4642D-11, & + & -.6977D-11, 0.6772D-11, 0.2195D-10, 0.1218D-10, 0.8504D-11, & + & -.4265D-11, -.5370D-11, -.1092D-10, -.2660D-10, -.4248D-10, & + & -.7007D-10, -.1082D-09, -.1669D-09, -.2471D-09, -.3489D-09, & + & -.4687D-09, -.6066D-09, -.7951D-09, -.1165D-08, -.2068D-08, & + & -.4211D-08, -.8778D-08, -.1752D-07, -.3277D-07, -.5755D-07, & + & -.9563D-07, -.1516D-06, -.2311D-06, -.3402D-06, -.4856D-06, & + & -.6733D-06, -.9060D-06, -.1180D-05, -.1478D-05, -.1760D-05, & + & -.1953D-05, -.1940D-05, -.1557D-05, -.6336D-06, 0.9465D-06, & + & 0.3136D-05, 0.5659D-05, 0.8059D-05, 0.9882D-05, 0.1085D-04, & + & 0.1093D-04, 0.1026D-04, 0.9090D-05, 0.7666D-05, 0.6207D-05, & + & 0.4860D-05, 0.3705D-05, 0.2766D-05, 0.2031D-05, 0.1472D-05, & + & 0.1057D-05/ + + data (calcpts(j,47), j = 1,neta) /0.2895D-09, -.2610D-09, & + & -.3456D-09, -.1412D-09, -.3047D-10, -.2021D-10, -.2062D-09, & + & -.9289D-10, 0.4744D-10, -.9101D-10, -.2432D-10, -.1832D-10, & + & 0.5847D-10, -.2453D-10, -.3673D-10, -.2271D-10, 0.1469D-10, & + & -.5788D-11, -.7590D-11, -.1979D-10, 0.1805D-10, -.6081D-11, & + & -.2603D-11, -.8448D-11, -.6680D-11, -.1677D-10, -.2327D-10, & + & -.3327D-10, -.5595D-10, -.7616D-10, -.1179D-09, -.1698D-09, & + & -.2286D-09, -.3027D-09, -.4085D-09, -.6112D-09, -.1086D-08, & + & -.2176D-08, -.4463D-08, -.8801D-08, -.1634D-07, -.2859D-07, & + & -.4746D-07, -.7531D-07, -.1151D-06, -.1702D-06, -.2447D-06, & + & -.3423D-06, -.4663D-06, -.6178D-06, -.7926D-06, -.9777D-06, & + & -.1144D-05, -.1239D-05, -.1182D-05, -.8625D-06, -.1674D-06, & + & 0.9738D-06, 0.2517D-05, 0.4263D-05, 0.5896D-05, 0.7111D-05, & + & 0.7731D-05, 0.7740D-05, 0.7242D-05, 0.6402D-05, 0.5391D-05, & + & 0.4360D-05, 0.3411D-05, 0.2599D-05, 0.1938D-05, 0.1422D-05, & + & 0.1030D-05/ + + data (calcpts(j,48), j = 1,neta) /-.1464D-09, 0.1705D-10, & + & 0.2130D-09, -.6478D-10, 0.5286D-09, 0.1417D-09, 0.3096D-09, & + & 0.1552D-09, -.5639D-10, 0.1330D-09, 0.1519D-09, 0.5894D-10, & + & 0.5478D-10, 0.4993D-10, 0.4679D-10, -.7341D-10, 0.3779D-10, & + & 0.4836D-10, 0.5389D-10, 0.6009D-11, -.5886D-12, 0.1044D-10, & + & -.2832D-11, 0.1719D-10, 0.4355D-11, -.2739D-11, -.1025D-10, & + & -.1470D-10, -.1767D-10, -.3432D-10, -.5392D-10, -.7840D-10, & + & -.1105D-09, -.1499D-09, -.2074D-09, -.3156D-09, -.5618D-09, & + & -.1113D-08, -.2252D-08, -.4395D-08, -.8110D-08, -.1414D-07, & + & -.2344D-07, -.3724D-07, -.5702D-07, -.8466D-07, -.1223D-06, & + & -.1724D-06, -.2372D-06, -.3185D-06, -.4163D-06, -.5270D-06, & + & -.6404D-06, -.7353D-06, -.7752D-06, -.7035D-06, -.4463D-06, & + & 0.7188D-07, 0.8923D-06, 0.1977D-05, 0.3184D-05, 0.4294D-05, & + & 0.5103D-05, 0.5499D-05, 0.5475D-05, 0.5106D-05, 0.4503D-05, & + & 0.3787D-05, 0.3060D-05, 0.2392D-05, 0.1821D-05, 0.1357D-05, & + & 0.9954D-06/ + + data (calcpts(j,49), j = 1,neta) /0.5682D-09, 0.1002D-08, & + & -.8636D-09, 0.3879D-09, -.6704D-09, -.1877D-09, 0.6433D-10, & + & 0.4983D-09, 0.2832D-09, 0.1430D-09, -.1107D-09, -.2155D-09, & + & -.7760D-10, 0.9064D-10, 0.5010D-10, 0.5425D-10, -.2434D-10, & + & 0.2420D-11, -.3557D-10, -.2176D-10, 0.2093D-10, 0.3055D-11, & + & -.5441D-12, 0.2863D-11, 0.5720D-12, -.4297D-11, -.8496D-11, & + & 0.8641D-12, -.1555D-10, -.1598D-10, -.2747D-10, -.3948D-10, & + & -.5439D-10, -.7508D-10, -.1040D-09, -.1614D-09, -.2881D-09, & + & -.5647D-09, -.1129D-08, -.2184D-08, -.4008D-08, -.6967D-08, & + & -.1154D-07, -.1834D-07, -.2814D-07, -.4188D-07, -.6078D-07, & + & -.8618D-07, -.1195D-06, -.1623D-06, -.2151D-06, -.2778D-06, & + & -.3471D-06, -.4155D-06, -.4677D-06, -.4778D-06, -.4068D-06, & + & -.2046D-06, 0.1783D-06, 0.7663D-06, 0.1528D-05, 0.2361D-05, & + & 0.3115D-05, 0.3654D-05, 0.3904D-05, 0.3867D-05, 0.3595D-05, & + & 0.3165D-05, 0.2658D-05, 0.2146D-05, 0.1677D-05, 0.1275D-05, & + & 0.9499D-06/ + + data (dlaeta(j), j = 1,neta) / & + & -6d0, -5.83333333d0, -5.66666667d0, -5.5d0, -5.33333333d0, & + & -5.16666667d0, -5d0, -4.83333333d0, -4.66666667d0, -4.5d0, & + & -4.33333333d0, -4.16666667d0, -4d0, -3.83333333d0, & + & -3.66666667d0, -3.5d0, -3.33333333d0, -3.16666667d0, -3d0, & + & -2.83333333d0, -2.66666667d0, -2.5d0, -2.33333333d0, & + & -2.16666667d0, -2d0, -1.83333333d0, -1.66666667d0, -1.5d0, & + & -1.33333333d0, -1.16666667d0, -1d0, -0.83333333d0, -0.66666667d0,& + & -0.5d0, -0.33333333d0, -0.16666667d0, 0d0, 0.16666667d0, & + & 0.33333333d0, 0.5d0, 0.66666667d0, 0.83333333d0, 1d0, & + & 1.16666667d0, 1.33333333d0, 1.5d0, 1.66666667d0, 1.83333333d0, & + & 2d0, 2.16666667d0, 2.33333333d0, 2.5d0, 2.66666667d0, & + & 2.83333333d0, 3d0, 3.16666667d0, 3.33333333d0, 3.5d0, & + & 3.66666667d0, 3.83333333d0, 4d0, 4.16666667d0, 4.33333333d0, & + & 4.5d0, 4.66666667d0, 4.83333333d0, 5d0, 5.16666667d0, & + & 5.33333333d0, 5.5d0, 5.66666667d0, 5.83333333d0, 6d0/ + + data (dlaxi(j), j = 1,nxi) / & + & -3d0, -2.83333333d0, -2.66666667d0, -2.5d0, -2.33333333d0, & + & -2.16666667d0, -2d0, -1.83333333d0, -1.66666667d0, -1.5d0, & + & -1.33333333d0, -1.16666667d0, -1d0, -0.83333333d0, -0.66666667d0,& + & -0.5d0, -0.33333333d0, -0.16666667d0, 0d0, 0.16666667d0, & + & 0.33333333d0, 0.5d0, 0.66666667d0, 0.83333333d0, 1d0, & + & 1.16666667d0, 1.33333333d0, 1.5d0, 1.66666667d0, 1.83333333d0, & + & 2d0, 2.16666667d0, 2.33333333d0, 2.5d0, 2.66666667d0, & + & 2.83333333d0, 3d0, 3.16666667d0, 3.33333333d0, 3.5d0, & + & 3.66666667d0, 3.83333333d0, 4d0, 4.16666667d0, 4.33333333d0, & + & 4.5d0, 4.66666667d0, 4.83333333d0, 5d0/ + + dleta = dlog10(eta) + dlxi = dlog10(xi) + if (dlxi .le. dlaxi(1)) dlxi = dlaxi(1) + if (dlxi .ge. dlaxi(nxi)) dlxi = dlaxi(nxi) + if (dleta .ge. dlaeta(neta)) dleta = dlaeta(neta) + if (dleta .le. dlaeta(1)) dleta = dlaeta(1) + call locate(dlaeta,neta, dleta, ieta) + call locate(dlaxi, nxi, dlxi, ixi) +! interpolating between the appropriate points + delxi = 1d0/6d0 + deleta = 1d0/6d0 +! lagrange 3-pt. + if (ixi .le. 2) ixi = 2 + if (ixi .ge. 48) ixi = 48 + if (ieta .le. 2) ieta = 2 + if (ieta .ge. 72) ieta = 72 + pxi = (dlxi - dlaxi(ixi))/delxi + f(-1) = pxi*(pxi-1d0)/2d0*calcpts(ieta-1,ixi-1) + & + & (1d0 - pxi**2)*calcpts(ieta-1,ixi) + & + & pxi*(pxi+1d0)/2d0*calcpts(ieta-1,ixi+1) + f(0) = pxi*(pxi-1d0)/2d0*calcpts(ieta,ixi-1) + & + & (1d0 - pxi**2)*calcpts(ieta,ixi) + & + & pxi*(pxi+1d0)/2d0*calcpts(ieta,ixi+1) + f(1) = pxi*(pxi-1d0)/2d0*calcpts(ieta+1,ixi-1) + & + & (1d0 - pxi**2)*calcpts(ieta+1,ixi) + & + & pxi*(pxi+1d0)/2d0*calcpts(ieta+1,ixi+1) + peta = (dleta - dlaeta(ieta))/deleta + h1_FLg = peta*(peta-1d0)/2d0*f(-1) + & + & (1d0 - peta**2)*f(0) + & + & peta*(peta+1d0)/2d0*f(1) +!MB + + peta*(peta+1d0)/2d0*f(1) + return + END + +! ========================================== + double precision function h1bar_Lg(eta,xi) +! ========================================== + +! eq (12) in PLB347 (1995) 143 - 151 for the longitudinal piece +! MSbar scheme +! This routine is called subclbar in the original code. +! Called sclbar in updated code (03/06/96). + + implicit none + integer neta, nxi + parameter (neta = 73, nxi = 49) + double precision calcpts(neta, nxi), dlaeta(neta), dlaxi(nxi) + double precision eta, xi, dleta, dlxi + double precision pxi, peta, f(-1:1), delxi, deleta + integer j, ieta, ixi + + data (calcpts(j, 1), j = 1,neta) /0.7071D-08, 0.8567D-08, & + & 0.1038D-07, 0.1257D-07, 0.1524D-07, 0.1846D-07, 0.2236D-07, & + & 0.2710D-07, 0.3283D-07, 0.3978D-07, 0.4822D-07, 0.5844D-07, & + & 0.7084D-07, 0.8591D-07, 0.1042D-06, 0.1265D-06, 0.1537D-06, & + & 0.1870D-06, 0.2279D-06, 0.2786D-06, 0.3418D-06, 0.4217D-06, & + & 0.5243D-06, 0.6586D-06, 0.8386D-06, 0.1086D-05, 0.1434D-05, & + & 0.1933D-05, 0.2658D-05, 0.3705D-05, 0.5187D-05, 0.7191D-05, & + & 0.9704D-05, 0.1252D-04, 0.1518D-04, 0.1707D-04, 0.1771D-04, & + & 0.1701D-04, 0.1527D-04, 0.1299D-04, 0.1059D-04, 0.8349D-05, & + & 0.6403D-05, 0.4797D-05, 0.3525D-05, 0.2546D-05, 0.1816D-05, & + & 0.1282D-05, 0.8938D-06, 0.6230D-06, 0.4303D-06, 0.2961D-06, & + & 0.2068D-06, 0.1394D-06, 0.9358D-07, 0.6473D-07, 0.4295D-07, & + & 0.3262D-07, 0.1892D-07, 0.1412D-07, 0.1085D-07, 0.8620D-08, & + & 0.7103D-08, 0.6068D-08, 0.5363D-08, -.1784D-08, -.2111D-08, & + & -.2334D-08, -.2486D-08, -.2589D-08, -.2660D-08, -.2708D-08, & + & -.2741D-08/ + + data (calcpts(j, 2), j = 1,neta) /0.1038D-07, 0.1257D-07, & + & 0.1523D-07, 0.1845D-07, 0.2236D-07, 0.2709D-07, 0.3282D-07, & + & 0.3977D-07, 0.4818D-07, 0.5839D-07, 0.7077D-07, 0.8577D-07, & + & 0.1040D-06, 0.1261D-06, 0.1529D-06, 0.1857D-06, 0.2256D-06, & + & 0.2745D-06, 0.3345D-06, 0.4089D-06, 0.5016D-06, 0.6189D-06, & + & 0.7695D-06, 0.9666D-06, 0.1231D-05, 0.1593D-05, 0.2104D-05, & + & 0.2837D-05, 0.3901D-05, 0.5438D-05, 0.7612D-05, 0.1055D-04, & + & 0.1424D-04, 0.1838D-04, 0.2228D-04, 0.2506D-04, 0.2600D-04, & + & 0.2497D-04, 0.2241D-04, 0.1906D-04, 0.1554D-04, 0.1225D-04, & + & 0.9395D-05, 0.7042D-05, 0.5175D-05, 0.3742D-05, 0.2663D-05, & + & 0.1879D-05, 0.1317D-05, 0.9144D-06, 0.6334D-06, 0.4387D-06, & + & 0.2970D-06, 0.2074D-06, 0.1398D-06, 0.9388D-07, 0.6503D-07, & + & 0.4321D-07, 0.3288D-07, 0.1917D-07, 0.1438D-07, 0.1111D-07, & + & 0.8879D-08, 0.7360D-08, 0.6325D-08, 0.5620D-08, 0.5140D-08, & + & 0.4813D-08, 0.4590D-08, 0.4438D-08, 0.4335D-08, 0.4264D-08, & + & 0.4216D-08/ + + data (calcpts(j, 3), j = 1,neta) /0.1522D-07, 0.1844D-07, & + & 0.2234D-07, 0.2707D-07, 0.3280D-07, 0.3974D-07, 0.4815D-07, & + & 0.5834D-07, 0.7068D-07, 0.8565D-07, 0.1038D-06, 0.1258D-06, & + & 0.1525D-06, 0.1850D-06, 0.2244D-06, 0.2724D-06, 0.3309D-06, & + & 0.4026D-06, 0.4907D-06, 0.5998D-06, 0.7358D-06, 0.9079D-06, & + & 0.1129D-05, 0.1418D-05, 0.1805D-05, 0.2338D-05, 0.3087D-05, & + & 0.4163D-05, 0.5723D-05, 0.7978D-05, 0.1117D-04, 0.1548D-04, & + & 0.2090D-04, 0.2696D-04, 0.3269D-04, 0.3676D-04, 0.3814D-04, & + & 0.3662D-04, 0.3287D-04, 0.2796D-04, 0.2279D-04, 0.1796D-04, & + & 0.1378D-04, 0.1033D-04, 0.7581D-05, 0.5477D-05, 0.3902D-05, & + & 0.2753D-05, 0.1925D-05, 0.1338D-05, 0.9239D-06, 0.6335D-06, & + & 0.4377D-06, 0.2956D-06, 0.1991D-06, 0.1380D-06, 0.9217D-07, & + & 0.6328D-07, 0.4146D-07, 0.2447D-07, 0.1743D-07, 0.1263D-07, & + & 0.9369D-08, 0.4751D-09, -.1043D-08, -.2076D-08, -.2780D-08, & + & -.3260D-08, -.3587D-08, -.3809D-08, -.3961D-08, -.4065D-08, & + & -.4135D-08/ + + data (calcpts(j, 4), j = 1,neta) /0.2234D-07, 0.2706D-07, & + & 0.3278D-07, 0.3972D-07, 0.4813D-07, 0.5831D-07, 0.7065D-07, & + & 0.8560D-07, 0.1037D-06, 0.1257D-06, 0.1523D-06, 0.1846D-06, & + & 0.2238D-06, 0.2714D-06, 0.3292D-06, 0.3996D-06, 0.4856D-06, & + & 0.5907D-06, 0.7200D-06, 0.8801D-06, 0.1080D-05, 0.1332D-05, & + & 0.1656D-05, 0.2081D-05, 0.2649D-05, 0.3430D-05, 0.4529D-05, & + & 0.6107D-05, 0.8395D-05, 0.1171D-04, 0.1638D-04, 0.2272D-04, & + & 0.3066D-04, 0.3956D-04, 0.4796D-04, 0.5393D-04, 0.5596D-04, & + & 0.5373D-04, 0.4823D-04, 0.4102D-04, 0.3344D-04, 0.2636D-04, & + & 0.2021D-04, 0.1515D-04, 0.1113D-04, 0.8040D-05, 0.5732D-05, & + & 0.4043D-05, 0.2826D-05, 0.1960D-05, 0.1359D-05, 0.9340D-06, & + & 0.6419D-06, 0.4389D-06, 0.2964D-06, 0.2064D-06, 0.1387D-06, & + & 0.9274D-07, 0.6384D-07, 0.4204D-07, 0.3172D-07, 0.1801D-07, & + & 0.1322D-07, 0.9956D-08, 0.7730D-08, -.4522D-09, -.1485D-08, & + & -.2189D-08, -.2668D-08, -.2995D-08, -.3218D-08, -.3369D-08, & + & -.3473D-08/ + + data (calcpts(j, 5), j = 1,neta) /0.3277D-07, 0.3971D-07, & + & 0.4810D-07, 0.5828D-07, 0.7061D-07, 0.8555D-07, 0.1036D-06, & + & 0.1256D-06, 0.1522D-06, 0.1844D-06, 0.2235D-06, 0.2708D-06, & + & 0.3283D-06, 0.3982D-06, 0.4830D-06, 0.5863D-06, 0.7124D-06, & + & 0.8667D-06, 0.1056D-05, 0.1291D-05, 0.1584D-05, 0.1954D-05, & + & 0.2430D-05, 0.3052D-05, 0.3886D-05, 0.5032D-05, 0.6644D-05, & + & 0.8958D-05, 0.1231D-04, 0.1717D-04, 0.2403D-04, 0.3332D-04, & + & 0.4497D-04, 0.5803D-04, 0.7035D-04, 0.7913D-04, 0.8209D-04, & + & 0.7883D-04, 0.7075D-04, 0.6016D-04, 0.4905D-04, 0.3866D-04, & + & 0.2965D-04, 0.2222D-04, 0.1633D-04, 0.1179D-04, 0.8411D-05, & + & 0.5937D-05, 0.4149D-05, 0.2887D-05, 0.1997D-05, 0.1377D-05, & + & 0.9428D-06, 0.6499D-06, 0.4463D-06, 0.3037D-06, 0.2070D-06, & + & 0.1459D-06, 0.9995D-07, 0.7108D-07, 0.4928D-07, 0.3230D-07, & + & 0.2527D-07, 0.2048D-07, 0.1055D-07, 0.8328D-08, 0.6813D-08, & + & 0.5781D-08, 0.5079D-08, 0.4599D-08, 0.4273D-08, 0.4051D-08, & + & 0.3899D-08/ + + data (calcpts(j, 6), j = 1,neta) /0.4805D-07, 0.5822D-07, & + & 0.7053D-07, 0.8545D-07, 0.1035D-06, 0.1254D-06, 0.1520D-06, & + & 0.1842D-06, 0.2231D-06, 0.2704D-06, 0.3277D-06, 0.3971D-06, & + & 0.4815D-06, 0.5839D-06, 0.7082D-06, 0.8597D-06, 0.1045D-05, & + & 0.1271D-05, 0.1549D-05, 0.1893D-05, 0.2323D-05, 0.2866D-05, & + & 0.3563D-05, 0.4475D-05, 0.5698D-05, 0.7377D-05, 0.9741D-05, & + & 0.1313D-04, 0.1806D-04, 0.2517D-04, 0.3524D-04, 0.4885D-04, & + & 0.6594D-04, 0.8508D-04, 0.1032D-03, 0.1160D-03, 0.1204D-03, & + & 0.1156D-03, 0.1037D-03, 0.8819D-04, 0.7189D-04, 0.5667D-04, & + & 0.4346D-04, 0.3256D-04, 0.2392D-04, 0.1729D-04, 0.1232D-04, & + & 0.8691D-05, 0.6081D-05, 0.4225D-05, 0.2921D-05, 0.2010D-05, & + & 0.1380D-05, 0.9449D-06, 0.6514D-06, 0.4410D-06, 0.3051D-06, & + & 0.2084D-06, 0.1406D-06, 0.9476D-07, 0.6592D-07, 0.4414D-07, & + & 0.3385D-07, 0.2016D-07, 0.1538D-07, 0.1212D-07, 0.9899D-08, & + & 0.8387D-08, 0.6908D-09, -.1138D-10, -.4898D-09, -.8155D-09, & + & -.1037D-08/ + + data (calcpts(j, 7), j = 1,neta) /0.7044D-07, 0.8534D-07, & + & 0.1034D-06, 0.1253D-06, 0.1518D-06, 0.1839D-06, 0.2228D-06, & + & 0.2699D-06, 0.3270D-06, 0.3963D-06, 0.4803D-06, 0.5821D-06, & + & 0.7057D-06, 0.8558D-06, 0.1038D-05, 0.1260D-05, 0.1531D-05, & + & 0.1863D-05, 0.2270D-05, 0.2775D-05, 0.3405D-05, 0.4200D-05, & + & 0.5222D-05, 0.6559D-05, 0.8351D-05, 0.1081D-04, 0.1428D-04, & + & 0.1925D-04, 0.2646D-04, 0.3688D-04, 0.5164D-04, 0.7160D-04, & + & 0.9666D-04, 0.1247D-03, 0.1512D-03, 0.1701D-03, 0.1764D-03, & + & 0.1694D-03, 0.1520D-03, 0.1292D-03, 0.1053D-03, 0.8300D-04, & + & 0.6365D-04, 0.4768D-04, 0.3504D-04, 0.2532D-04, 0.1805D-04, & + & 0.1274D-04, 0.8887D-05, 0.6193D-05, 0.4276D-05, 0.2941D-05, & + & 0.2053D-05, 0.1382D-05, 0.9261D-06, 0.6392D-06, 0.4224D-06, & + & 0.3199D-06, 0.1833D-06, 0.1356D-06, 0.1032D-06, 0.8102D-07, & + & 0.6595D-07, 0.5567D-07, 0.4867D-07, 0.4390D-07, 0.4065D-07, & + & 0.3843D-07, 0.3693D-07, 0.3590D-07, 0.3520D-07, 0.3472D-07, & + & 0.3440D-07/ + + data (calcpts(j, 8), j = 1,neta) /0.1032D-06, 0.1250D-06, & + & 0.1515D-06, 0.1835D-06, 0.2223D-06, 0.2694D-06, 0.3264D-06, & + & 0.3955D-06, 0.4791D-06, 0.5806D-06, 0.7037D-06, 0.8529D-06, & + & 0.1034D-05, 0.1254D-05, 0.1521D-05, 0.1846D-05, 0.2243D-05, & + & 0.2729D-05, 0.3326D-05, 0.4065D-05, 0.4988D-05, 0.6154D-05, & + & 0.7650D-05, 0.9609D-05, 0.1223D-04, 0.1583D-04, 0.2091D-04, & + & 0.2819D-04, 0.3875D-04, 0.5401D-04, 0.7562D-04, 0.1049D-03, & + & 0.1415D-03, 0.1826D-03, 0.2215D-03, 0.2492D-03, 0.2585D-03, & + & 0.2481D-03, 0.2226D-03, 0.1892D-03, 0.1542D-03, 0.1215D-03, & + & 0.9315D-04, 0.6981D-04, 0.5128D-04, 0.3707D-04, 0.2644D-04, & + & 0.1866D-04, 0.1302D-04, 0.9091D-05, 0.6303D-05, 0.4304D-05, & + & 0.2964D-05, 0.2075D-05, 0.1403D-05, 0.9480D-06, 0.6617D-06, & + & 0.4450D-06, 0.3427D-06, 0.2064D-06, 0.1589D-06, 0.1265D-06, & + & 0.1045D-06, 0.8944D-07, 0.1253D-07, 0.5554D-08, 0.8006D-09, & + & -.2439D-08, -.4644D-08, -.6148D-08, -.7172D-08, -.7870D-08, & + & -.8345D-08/ + + data (calcpts(j, 9), j = 1,neta) /0.1510D-06, 0.1829D-06, & + & 0.2216D-06, 0.2685D-06, 0.3253D-06, 0.3941D-06, 0.4775D-06, & + & 0.5786D-06, 0.7010D-06, 0.8495D-06, 0.1030D-05, 0.1248D-05, & + & 0.1513D-05, 0.1834D-05, 0.2225D-05, 0.2701D-05, 0.3282D-05, & + & 0.3992D-05, 0.4866D-05, 0.5948D-05, 0.7297D-05, 0.9002D-05, & + & 0.1119D-04, 0.1406D-04, 0.1789D-04, 0.2316D-04, 0.3058D-04, & + & 0.4123D-04, 0.5667D-04, 0.7900D-04, 0.1106D-03, 0.1534D-03, & + & 0.2071D-03, 0.2673D-03, 0.3241D-03, 0.3646D-03, 0.3781D-03, & + & 0.3629D-03, 0.3255D-03, 0.2765D-03, 0.2252D-03, 0.1775D-03, & + & 0.1361D-03, 0.1019D-03, 0.7488D-04, 0.5409D-04, 0.3859D-04, & + & 0.2717D-04, 0.1898D-04, 0.1318D-04, 0.9152D-05, 0.6280D-05, & + & 0.4277D-05, 0.2938D-05, 0.1983D-05, 0.1379D-05, 0.9252D-06, & + & 0.6396D-06, 0.4236D-06, 0.2553D-06, 0.1859D-06, 0.1387D-06, & + & 0.3983D-07, 0.1788D-07, 0.2928D-08, -.7253D-08, -.1419D-07, & + & -.1892D-07, -.2214D-07, -.2433D-07, -.2583D-07, -.2685D-07, & + & -.2754D-07/ + + data (calcpts(j,10), j = 1,neta) /0.2207D-06, 0.2674D-06, & + & 0.3239D-06, 0.3924D-06, 0.4755D-06, 0.5761D-06, 0.6980D-06, & + & 0.8458D-06, 0.1025D-05, 0.1242D-05, 0.1505D-05, 0.1824D-05, & + & 0.2211D-05, 0.2681D-05, 0.3252D-05, 0.3948D-05, 0.4797D-05, & + & 0.5836D-05, 0.7113D-05, 0.8694D-05, 0.1066D-04, 0.1316D-04, & + & 0.1636D-04, 0.2054D-04, 0.2614D-04, 0.3384D-04, 0.4467D-04, & + & 0.6022D-04, 0.8277D-04, 0.1154D-03, 0.1615D-03, 0.2240D-03, & + & 0.3025D-03, 0.3905D-03, 0.4737D-03, 0.5328D-03, 0.5527D-03, & + & 0.5302D-03, 0.4753D-03, 0.4036D-03, 0.3286D-03, 0.2589D-03, & + & 0.1984D-03, 0.1486D-03, 0.1092D-03, 0.7896D-04, 0.5628D-04, & + & 0.3968D-04, 0.2778D-04, 0.1927D-04, 0.1335D-04, 0.9172D-05, & + & 0.6298D-05, 0.4299D-05, 0.2963D-05, 0.2012D-05, 0.1345D-05, & + & 0.9590D-06, 0.6082D-06, 0.4600D-06, 0.2924D-06, 0.2235D-06, & + & 0.1100D-06, 0.7802D-07, 0.5624D-07, 0.4141D-07, 0.3130D-07, & + & 0.2441D-07, 0.1972D-07, 0.1652D-07, 0.1435D-07, 0.1286D-07, & + & 0.1185D-07/ + + data (calcpts(j,11), j = 1,neta) /0.3220D-06, 0.3901D-06, & + & 0.4725D-06, 0.5725D-06, 0.6937D-06, 0.8405D-06, 0.1018D-05, & + & 0.1234D-05, 0.1495D-05, 0.1811D-05, 0.2195D-05, 0.2661D-05, & + & 0.3226D-05, 0.3912D-05, 0.4745D-05, 0.5760D-05, 0.6999D-05, & + & 0.8514D-05, 0.1038D-04, 0.1268D-04, 0.1556D-04, 0.1919D-04, & + & 0.2385D-04, 0.2996D-04, 0.3812D-04, 0.4934D-04, 0.6512D-04, & + & 0.8776D-04, 0.1206D-03, 0.1681D-03, 0.2354D-03, 0.3265D-03, & + & 0.4410D-03, 0.5695D-03, 0.6909D-03, 0.7773D-03, 0.8061D-03, & + & 0.7730D-03, 0.6925D-03, 0.5877D-03, 0.4781D-03, 0.3765D-03, & + & 0.2886D-03, 0.2162D-03, 0.1589D-03, 0.1148D-03, 0.8193D-04, & + & 0.5780D-04, 0.4049D-04, 0.2811D-04, 0.1949D-04, 0.1344D-04, & + & 0.9262D-05, 0.6335D-05, 0.4346D-05, 0.3018D-05, 0.2074D-05, & + & 0.1411D-05, 0.1028D-05, 0.6800D-06, 0.4667D-06, 0.3667D-06, & + & 0.2320D-06, 0.1856D-06, 0.1540D-06, 0.1325D-06, 0.1178D-06, & + & 0.1078D-06, 0.1010D-06, 0.9635D-07, 0.9319D-07, 0.9104D-07, & + & 0.8957D-07/ + + data (calcpts(j,12), j = 1,neta) /0.4683D-06, 0.5674D-06, & + & 0.6873D-06, 0.8327D-06, 0.1009D-05, 0.1222D-05, 0.1481D-05, & + & 0.1795D-05, 0.2174D-05, 0.2635D-05, 0.3193D-05, 0.3870D-05, & + & 0.4692D-05, 0.5689D-05, 0.6901D-05, 0.8377D-05, 0.1018D-04, & + & 0.1238D-04, 0.1509D-04, 0.1844D-04, 0.2262D-04, 0.2790D-04, & + & 0.3468D-04, 0.4354D-04, 0.5541D-04, 0.7170D-04, 0.9460D-04, & + & 0.1275D-03, 0.1751D-03, 0.2441D-03, 0.3418D-03, 0.4742D-03, & + & 0.6407D-03, 0.8277D-03, 0.1005D-02, 0.1130D-02, 0.1172D-02, & + & 0.1123D-02, 0.1005D-02, 0.8521D-03, 0.6927D-03, 0.5450D-03, & + & 0.4176D-03, 0.3128D-03, 0.2299D-03, 0.1662D-03, 0.1186D-03, & + & 0.8370D-04, 0.5860D-04, 0.4075D-04, 0.2823D-04, 0.1950D-04, & + & 0.1342D-04, 0.9210D-05, 0.6376D-05, 0.4340D-05, 0.3028D-05, & + & 0.2093D-05, 0.1437D-05, 0.1060D-05, 0.7149D-06, 0.5039D-06, & + & 0.4057D-06, 0.2720D-06, 0.2264D-06, 0.1953D-06, 0.1741D-06, & + & 0.1597D-06, 0.1499D-06, 0.1431D-06, 0.1386D-06, 0.1355D-06, & + & 0.1334D-06/ + + data (calcpts(j,13), j = 1,neta) /0.6783D-06, 0.8219D-06, & + & 0.9956D-06, 0.1206D-05, 0.1462D-05, 0.1771D-05, 0.2145D-05, & + & 0.2600D-05, 0.3150D-05, 0.3817D-05, 0.4626D-05, 0.5606D-05, & + & 0.6796D-05, 0.8242D-05, 0.9996D-05, 0.1213D-04, 0.1474D-04, & + & 0.1793D-04, 0.2186D-04, 0.2671D-04, 0.3276D-04, 0.4041D-04, & + & 0.5021D-04, 0.6303D-04, 0.8018D-04, 0.1037D-03, 0.1368D-03, & + & 0.1842D-03, 0.2531D-03, 0.3527D-03, 0.4939D-03, 0.6854D-03, & + & 0.9269D-03, 0.1198D-02, 0.1455D-02, 0.1638D-02, 0.1697D-02, & + & 0.1625D-02, 0.1452D-02, 0.1229D-02, 0.9978D-03, 0.7844D-03, & + & 0.6007D-03, 0.4499D-03, 0.3307D-03, 0.2392D-03, 0.1708D-03, & + & 0.1206D-03, 0.8451D-04, 0.5882D-04, 0.4067D-04, 0.2798D-04, & + & 0.1955D-04, 0.1315D-04, 0.9469D-05, 0.6745D-05, 0.4676D-05, & + & 0.3051D-05, 0.2398D-05, 0.1953D-05, 0.9828D-06, 0.7760D-06, & + & 0.6353D-06, 0.5393D-06, 0.4738D-06, 0.4293D-06, 0.3989D-06, & + & 0.3782D-06, 0.3641D-06, 0.3545D-06, 0.3480D-06, 0.3435D-06, & + & 0.3405D-06/ + + data (calcpts(j,14), j = 1,neta) /0.9761D-06, 0.1183D-05, & + & 0.1433D-05, 0.1736D-05, 0.2103D-05, 0.2548D-05, 0.3087D-05, & + & 0.3741D-05, 0.4532D-05, 0.5492D-05, 0.6656D-05, 0.8067D-05, & + & 0.9780D-05, 0.1186D-04, 0.1438D-04, 0.1746D-04, 0.2121D-04, & + & 0.2580D-04, 0.3145D-04, 0.3843D-04, 0.4712D-04, 0.5811D-04, & + & 0.7220D-04, 0.9060D-04, 0.1152D-03, 0.1490D-03, 0.1964D-03, & + & 0.2644D-03, 0.3630D-03, 0.5058D-03, 0.7084D-03, 0.9837D-03, & + & 0.1331D-02, 0.1722D-02, 0.2093D-02, 0.2357D-02, 0.2442D-02, & + & 0.2335D-02, 0.2083D-02, 0.1759D-02, 0.1425D-02, 0.1118D-02, & + & 0.8558D-03, 0.6404D-03, 0.4707D-03, 0.3408D-03, 0.2433D-03, & + & 0.1714D-03, 0.1205D-03, 0.8340D-04, 0.5819D-04, 0.4026D-04, & + & 0.2781D-04, 0.1890D-04, 0.1263D-04, 0.9049D-05, 0.6393D-05, & + & 0.4368D-05, 0.2775D-05, 0.2145D-05, 0.1714D-05, 0.7546D-06, & + & 0.5551D-06, 0.4189D-06, 0.3261D-06, 0.2630D-06, 0.2199D-06, & + & 0.1906D-06, 0.1707D-06, 0.1570D-06, 0.1478D-06, 0.1414D-06, & + & 0.1371D-06/ + + data (calcpts(j,15), j = 1,neta) /0.1392D-05, 0.1687D-05, & + & 0.2044D-05, 0.2476D-05, 0.3000D-05, 0.3635D-05, 0.4404D-05, & + & 0.5337D-05, 0.6465D-05, 0.7835D-05, 0.9495D-05, 0.1151D-04, & + & 0.1395D-04, 0.1692D-04, 0.2052D-04, 0.2491D-04, 0.3026D-04, & + & 0.3680D-04, 0.4485D-04, 0.5480D-04, 0.6719D-04, 0.8283D-04, & + & 0.1029D-03, 0.1290D-03, 0.1640D-03, 0.2119D-03, 0.2792D-03, & + & 0.3756D-03, 0.5155D-03, 0.7180D-03, 0.1006D-02, 0.1397D-02, & + & 0.1893D-02, 0.2452D-02, 0.2984D-02, 0.3362D-02, 0.3482D-02, & + & 0.3324D-02, 0.2956D-02, 0.2488D-02, 0.2009D-02, 0.1574D-02, & + & 0.1203D-02, 0.9001D-03, 0.6612D-03, 0.4787D-03, 0.3412D-03, & + & 0.2412D-03, 0.1686D-03, 0.1173D-03, 0.8115D-04, 0.5598D-04, & + & 0.3859D-04, 0.2589D-04, 0.1793D-04, 0.1186D-04, 0.8419D-05, & + & 0.5190D-05, 0.3898D-05, 0.2351D-05, 0.1751D-05, 0.6754D-06, & + & 0.3970D-06, 0.2070D-06, 0.7757D-07, -.1055D-07, -.7060D-07, & + & -.1115D-06, -.1394D-06, -.1584D-06, -.1713D-06, -.1801D-06, & + & -.1862D-06/ + + data (calcpts(j,16), j = 1,neta) /0.1963D-05, 0.2378D-05, & + & 0.2881D-05, 0.3490D-05, 0.4229D-05, 0.5124D-05, 0.6208D-05, & + & 0.7522D-05, 0.9113D-05, 0.1104D-04, 0.1338D-04, 0.1622D-04, & + & 0.1966D-04, 0.2384D-04, 0.2892D-04, 0.3510D-04, 0.4264D-04, & + & 0.5186D-04, 0.6319D-04, 0.7719D-04, 0.9463D-04, 0.1166D-03, & + & 0.1448D-03, 0.1815D-03, 0.2304D-03, 0.2975D-03, 0.3914D-03, & + & 0.5261D-03, 0.7214D-03, 0.1005D-02, 0.1407D-02, 0.1957D-02, & + & 0.2654D-02, 0.3445D-02, 0.4200D-02, 0.4737D-02, 0.4905D-02, & + & 0.4672D-02, 0.4139D-02, 0.3467D-02, 0.2788D-02, 0.2177D-02, & + & 0.1661D-02, 0.1242D-02, 0.9134D-03, 0.6611D-03, 0.4721D-03, & + & 0.3337D-03, 0.2342D-03, 0.1627D-03, 0.1128D-03, 0.7755D-04, & + & 0.5352D-04, 0.3630D-04, 0.2484D-04, 0.1728D-04, 0.1149D-04, & + & 0.7571D-05, 0.5140D-05, 0.3272D-05, 0.2453D-05, 0.1894D-05, & + & 0.8474D-06, 0.5881D-06, 0.4114D-06, 0.2911D-06, 0.2091D-06, & + & 0.1532D-06, 0.1152D-06, 0.8923D-07, 0.7155D-07, 0.5952D-07, & + & 0.5132D-07/ + + data (calcpts(j,17), j = 1,neta) /0.2719D-05, 0.3294D-05, & + & 0.3990D-05, 0.4835D-05, 0.5858D-05, 0.7098D-05, 0.8599D-05, & + & 0.1042D-04, 0.1262D-04, 0.1530D-04, 0.1854D-04, 0.2247D-04, & + & 0.2724D-04, 0.3303D-04, 0.4005D-04, 0.4862D-04, 0.5906D-04, & + & 0.7181D-04, 0.8748D-04, 0.1068D-03, 0.1309D-03, 0.1613D-03, & + & 0.2001D-03, 0.2506D-03, 0.3179D-03, 0.4097D-03, 0.5383D-03, & + & 0.7223D-03, 0.9891D-03, 0.1376D-02, 0.1929D-02, 0.2685D-02, & + & 0.3648D-02, 0.4749D-02, 0.5806D-02, 0.6560D-02, 0.6792D-02, & + & 0.6451D-02, 0.5686D-02, 0.4731D-02, 0.3782D-02, 0.2938D-02, & + & 0.2236D-02, 0.1671D-02, 0.1228D-02, 0.8906D-03, 0.6366D-03, & + & 0.4510D-03, 0.3165D-03, 0.2206D-03, 0.1529D-03, 0.1054D-03, & + & 0.7247D-04, 0.5007D-04, 0.3397D-04, 0.2328D-04, 0.1627D-04, & + & 0.1085D-04, 0.7844D-05, 0.4920D-05, 0.3835D-05, 0.2430D-05, & + & 0.1926D-05, 0.1583D-05, 0.6827D-06, 0.5235D-06, 0.4149D-06, & + & 0.3410D-06, 0.2907D-06, 0.2563D-06, 0.2329D-06, 0.2170D-06, & + & 0.2062D-06/ + + data (calcpts(j,18), j = 1,neta) /0.3677D-05, 0.4455D-05, & + & 0.5396D-05, 0.6538D-05, 0.7922D-05, 0.9598D-05, 0.1163D-04, & + & 0.1409D-04, 0.1707D-04, 0.2068D-04, 0.2507D-04, 0.3038D-04, & + & 0.3683D-04, 0.4466D-04, 0.5415D-04, 0.6572D-04, 0.7983D-04, & + & 0.9706D-04, 0.1182D-03, 0.1443D-03, 0.1768D-03, 0.2176D-03, & + & 0.2697D-03, 0.3374D-03, 0.4273D-03, 0.5497D-03, 0.7207D-03, & + & 0.9649D-03, 0.1319D-02, 0.1833D-02, 0.2568D-02, 0.3579D-02, & + & 0.4879D-02, 0.6374D-02, 0.7823D-02, 0.8865D-02, 0.9184D-02, & + & 0.8698D-02, 0.7616D-02, 0.6282D-02, 0.4975D-02, 0.3839D-02, & + & 0.2909D-02, 0.2170D-02, 0.1597D-02, 0.1158D-02, 0.8295D-03, & + & 0.5883D-03, 0.4137D-03, 0.2884D-03, 0.2003D-03, 0.1379D-03, & + & 0.9479D-04, 0.6551D-04, 0.4453D-04, 0.3054D-04, 0.2084D-04, & + & 0.1450D-04, 0.9540D-05, 0.6857D-05, 0.4815D-05, 0.3211D-05, & + & 0.1906D-05, 0.1471D-05, 0.1174D-05, 0.9723D-06, 0.1680D-06, & + & 0.7420D-07, 0.1038D-07, -.3316D-07, -.6282D-07, -.8302D-07, & + & -.9678D-07/ + + data (calcpts(j,19), j = 1,neta) /0.4815D-05, 0.5834D-05, & + & 0.7067D-05, 0.8563D-05, 0.1038D-04, 0.1257D-04, 0.1523D-04, & + & 0.1845D-04, 0.2236D-04, 0.2709D-04, 0.3283D-04, 0.3979D-04, & + & 0.4823D-04, 0.5848D-04, 0.7091D-04, 0.8605D-04, 0.1045D-03, & + & 0.1270D-03, 0.1547D-03, 0.1887D-03, 0.2310D-03, 0.2842D-03, & + & 0.3518D-03, 0.4393D-03, 0.5551D-03, 0.7123D-03, 0.9310D-03, & + & 0.1242D-02, 0.1694D-02, 0.2349D-02, 0.3290D-02, 0.4593D-02, & + & 0.6281D-02, 0.8248D-02, 0.1018D-01, 0.1159D-01, 0.1204D-01, & + & 0.1138D-01, 0.9887D-02, 0.8062D-02, 0.6306D-02, 0.4815D-02, & + & 0.3625D-02, 0.2697D-02, 0.1984D-02, 0.1442D-02, 0.1035D-02, & + & 0.7363D-03, 0.5187D-03, 0.3626D-03, 0.2517D-03, 0.1742D-03, & + & 0.1200D-03, 0.8207D-04, 0.5639D-04, 0.3855D-04, 0.2627D-04, & + & 0.1773D-04, 0.1218D-04, 0.8433D-05, 0.5453D-05, 0.3663D-05, & + & 0.2898D-05, 0.1710D-05, 0.1355D-05, 0.1113D-05, 0.2814D-06, & + & 0.1690D-06, 0.9258D-07, 0.4042D-07, 0.4880D-08, -.1932D-07, & + & -.3580D-07/ + + data (calcpts(j,20), j = 1,neta) /0.6052D-05, 0.7332D-05, & + & 0.8882D-05, 0.1076D-04, 0.1304D-04, 0.1580D-04, 0.1914D-04, & + & 0.2319D-04, 0.2810D-04, 0.3405D-04, 0.4126D-04, 0.5000D-04, & + & 0.6060D-04, 0.7348D-04, 0.8909D-04, 0.1081D-03, 0.1313D-03, & + & 0.1595D-03, 0.1941D-03, 0.2368D-03, 0.2896D-03, 0.3558D-03, & + & 0.4397D-03, 0.5479D-03, 0.6905D-03, 0.8828D-03, 0.1149D-02, & + & 0.1527D-02, 0.2073D-02, 0.2866D-02, 0.4009D-02, 0.5604D-02, & + & 0.7695D-02, 0.1017D-01, 0.1265D-01, 0.1452D-01, 0.1516D-01, & + & 0.1433D-01, 0.1237D-01, 0.9951D-02, 0.7656D-02, 0.5758D-02, & + & 0.4289D-02, 0.3177D-02, 0.2336D-02, 0.1702D-02, 0.1227D-02, & + & 0.8756D-03, 0.6190D-03, 0.4342D-03, 0.3023D-03, 0.2098D-03, & + & 0.1449D-03, 0.9966D-04, 0.6879D-04, 0.4702D-04, 0.3254D-04, & + & 0.2208D-04, 0.1546D-04, 0.1077D-04, 0.7606D-05, 0.5022D-05, & + & 0.3505D-05, 0.2924D-05, 0.1862D-05, 0.1593D-05, 0.1409D-05, & + & 0.6174D-06, 0.5323D-06, 0.4742D-06, 0.4347D-06, 0.4077D-06, & + & 0.3894D-06/ + + data (calcpts(j,21), j = 1,neta) /0.7225D-05, 0.8754D-05, & + & 0.1060D-04, 0.1285D-04, 0.1557D-04, 0.1886D-04, 0.2285D-04, & + & 0.2769D-04, 0.3354D-04, 0.4064D-04, 0.4925D-04, 0.5969D-04, & + & 0.7234D-04, 0.8770D-04, 0.1063D-03, 0.1290D-03, 0.1566D-03, & + & 0.1902D-03, 0.2314D-03, 0.2821D-03, 0.3446D-03, 0.4228D-03, & + & 0.5215D-03, 0.6482D-03, 0.8139D-03, 0.1036D-02, 0.1341D-02, & + & 0.1772D-02, 0.2391D-02, 0.3291D-02, 0.4591D-02, 0.6420D-02, & + & 0.8852D-02, 0.1179D-01, 0.1482D-01, 0.1722D-01, 0.1815D-01, & + & 0.1725D-01, 0.1484D-01, 0.1179D-01, 0.8890D-02, 0.6547D-02, & + & 0.4798D-02, 0.3523D-02, 0.2586D-02, 0.1889D-02, 0.1369D-02, & + & 0.9817D-03, 0.6970D-03, 0.4904D-03, 0.3405D-03, 0.2364D-03, & + & 0.1636D-03, 0.1165D-03, 0.7802D-04, 0.5204D-04, 0.3676D-04, & + & 0.2420D-04, 0.1352D-04, 0.1079D-04, 0.8921D-05, 0.7650D-05, & + & 0.1180D-06, -.4722D-06, -.8743D-06, -.1148D-05, -.1335D-05, & + & -.1462D-05, -.1548D-05, -.1607D-05, -.1648D-05, -.1675D-05, & + & -.1694D-05/ + + data (calcpts(j,22), j = 1,neta) /0.8126D-05, 0.9846D-05, & + & 0.1193D-04, 0.1445D-04, 0.1751D-04, 0.2121D-04, 0.2570D-04, & + & 0.3114D-04, 0.3772D-04, 0.4571D-04, 0.5539D-04, 0.6712D-04, & + & 0.8135D-04, 0.9862D-04, 0.1195D-03, 0.1450D-03, 0.1760D-03, & + & 0.2137D-03, 0.2598D-03, 0.3164D-03, 0.3862D-03, 0.4730D-03, & + & 0.5821D-03, 0.7212D-03, 0.9018D-03, 0.1142D-02, 0.1468D-02, & + & 0.1925D-02, 0.2577D-02, 0.3522D-02, 0.4889D-02, 0.6829D-02, & + & 0.9448D-02, 0.1269D-01, 0.1617D-01, 0.1908D-01, 0.2047D-01, & + & 0.1972D-01, 0.1705D-01, 0.1345D-01, 0.9946D-02, 0.7133D-02, & + & 0.5103D-02, 0.3690D-02, 0.2694D-02, 0.1972D-02, 0.1441D-02, & + & 0.1041D-02, 0.7446D-03, 0.5284D-03, 0.3724D-03, 0.2599D-03, & + & 0.1772D-03, 0.1258D-03, 0.8889D-04, 0.5733D-04, 0.4279D-04, & + & 0.3074D-04, 0.2041D-04, 0.1124D-04, 0.9540D-05, 0.8379D-05, & + & 0.9215D-06, 0.3822D-06, 0.1478D-07, -.2354D-06, -.4059D-06, & + & -.5221D-06, -.6012D-06, -.6551D-06, -.6919D-06, -.7169D-06, & + & -.7339D-06/ + + data (calcpts(j,23), j = 1,neta) /0.8555D-05, 0.1037D-04, & + & 0.1256D-04, 0.1521D-04, 0.1843D-04, 0.2233D-04, 0.2706D-04, & + & 0.3278D-04, 0.3971D-04, 0.4812D-04, 0.5831D-04, 0.7066D-04, & + & 0.8563D-04, 0.1038D-03, 0.1258D-03, 0.1526D-03, 0.1851D-03, & + & 0.2247D-03, 0.2731D-03, 0.3323D-03, 0.4050D-03, 0.4952D-03, & + & 0.6079D-03, 0.7506D-03, 0.9342D-03, 0.1175D-02, 0.1500D-02, & + & 0.1948D-02, 0.2582D-02, 0.3494D-02, 0.4813D-02, 0.6696D-02, & + & 0.9276D-02, 0.1255D-01, 0.1623D-01, 0.1956D-01, 0.2150D-01, & + & 0.2122D-01, 0.1870D-01, 0.1484D-01, 0.1085D-01, 0.7583D-02, & + & 0.5254D-02, 0.3705D-02, 0.2674D-02, 0.1958D-02, 0.1439D-02, & + & 0.1054D-02, 0.7605D-03, 0.5451D-03, 0.3902D-03, 0.2743D-03, & + & 0.1917D-03, 0.1316D-03, 0.9125D-04, 0.6188D-04, 0.4216D-04, & + & 0.3112D-04, 0.2148D-04, 0.1279D-04, 0.1140D-04, 0.3796D-05, & + & 0.3154D-05, 0.2717D-05, 0.2418D-05, 0.2215D-05, 0.2077D-05, & + & 0.1983D-05, 0.1919D-05, 0.1875D-05, 0.1845D-05, 0.1825D-05, & + & 0.1811D-05/ + + data (calcpts(j,24), j = 1,neta) /0.8413D-05, 0.1019D-04, & + & 0.1235D-04, 0.1496D-04, 0.1813D-04, 0.2196D-04, 0.2661D-04, & + & 0.3224D-04, 0.3905D-04, 0.4732D-04, 0.5734D-04, 0.6948D-04, & + & 0.8420D-04, 0.1020D-03, 0.1237D-03, 0.1500D-03, 0.1819D-03, & + & 0.2207D-03, 0.2680D-03, 0.3259D-03, 0.3968D-03, 0.4842D-03, & + & 0.5930D-03, 0.7296D-03, 0.9037D-03, 0.1130D-02, 0.1429D-02, & + & 0.1837D-02, 0.2406D-02, 0.3215D-02, 0.4381D-02, 0.6047D-02, & + & 0.8359D-02, 0.1138D-01, 0.1491D-01, 0.1838D-01, 0.2084D-01, & + & 0.2132D-01, 0.1945D-01, 0.1584D-01, 0.1168D-01, 0.8046D-02, & + & 0.5399D-02, 0.3674D-02, 0.2589D-02, 0.1882D-02, 0.1394D-02, & + & 0.1027D-02, 0.7572D-03, 0.5472D-03, 0.3965D-03, 0.2795D-03, & + & 0.1985D-03, 0.1375D-03, 0.9440D-04, 0.6770D-04, 0.4313D-04, & + & 0.3334D-04, 0.2454D-04, 0.1643D-04, 0.8770D-05, 0.8095D-05, & + & 0.7637D-05, 0.6570D-06, 0.4437D-06, 0.2984D-06, 0.1995D-06, & + & 0.1320D-06, 0.8611D-07, 0.5480D-07, 0.3347D-07, 0.1894D-07, & + & 0.9044D-08/ + + data (calcpts(j,25), j = 1,neta) /0.7746D-05, 0.9385D-05, & + & 0.1137D-04, 0.1377D-04, 0.1669D-04, 0.2022D-04, 0.2450D-04, & + & 0.2968D-04, 0.3595D-04, 0.4356D-04, 0.5279D-04, 0.6396D-04, & + & 0.7750D-04, 0.9393D-04, 0.1138D-03, 0.1380D-03, 0.1673D-03, & + & 0.2030D-03, 0.2464D-03, 0.2993D-03, 0.3640D-03, 0.4435D-03, & + & 0.5418D-03, 0.6644D-03, 0.8191D-03, 0.1017D-02, 0.1276D-02, & + & 0.1623D-02, 0.2097D-02, 0.2763D-02, 0.3711D-02, 0.5062D-02, & + & 0.6951D-02, 0.9470D-02, 0.1255D-01, 0.1582D-01, 0.1854D-01, & + & 0.1980D-01, 0.1897D-01, 0.1619D-01, 0.1236D-01, 0.8615D-02, & + & 0.5685D-02, 0.3727D-02, 0.2527D-02, 0.1798D-02, 0.1322D-02, & + & 0.9898D-03, 0.7401D-03, 0.5472D-03, 0.3930D-03, 0.2873D-03, & + & 0.2008D-03, 0.1385D-03, 0.9903D-04, 0.6815D-04, 0.4528D-04, & + & 0.2999D-04, 0.2199D-04, 0.1441D-04, 0.1379D-04, 0.6702D-05, & + & 0.6414D-05, 0.6217D-05, -.5833D-06, -.6745D-06, -.7366D-06, & + & -.7790D-06, -.8078D-06, -.8274D-06, -.8408D-06, -.8499D-06, & + & -.8561D-06/ + + data (calcpts(j,26), j = 1,neta) /0.6715D-05, 0.8136D-05, & + & 0.9855D-05, 0.1194D-04, 0.1447D-04, 0.1753D-04, 0.2123D-04, & + & 0.2573D-04, 0.3117D-04, 0.3776D-04, 0.4576D-04, 0.5544D-04, & + & 0.6718D-04, 0.8141D-04, 0.9864D-04, 0.1196D-03, 0.1450D-03, & + & 0.1758D-03, 0.2132D-03, 0.2589D-03, 0.3145D-03, 0.3827D-03, & + & 0.4666D-03, 0.5705D-03, 0.7003D-03, 0.8648D-03, 0.1076D-02, & + & 0.1354D-02, 0.1727D-02, 0.2241D-02, 0.2960D-02, 0.3976D-02, & + & 0.5397D-02, 0.7320D-02, 0.9753D-02, 0.1251D-01, 0.1514D-01, & + & 0.1691D-01, 0.1715D-01, 0.1558D-01, 0.1263D-01, 0.9184D-02, & + & 0.6147D-02, 0.3950D-02, 0.2568D-02, 0.1754D-02, 0.1266D-02, & + & 0.9457D-03, 0.7134D-03, 0.5339D-03, 0.3943D-03, 0.2873D-03, & + & 0.2062D-03, 0.1459D-03, 0.1026D-03, 0.7161D-04, 0.5138D-04, & + & 0.3698D-04, 0.2292D-04, 0.1576D-04, 0.8751D-05, 0.8521D-05, & + & 0.1697D-05, 0.1590D-05, 0.1517D-05, 0.1467D-05, 0.1433D-05, & + & 0.1410D-05, 0.1394D-05, 0.1384D-05, 0.1376D-05, 0.1371D-05, & + & 0.1368D-05/ + + data (calcpts(j,27), j = 1,neta) /0.5527D-05, 0.6697D-05, & + & 0.8112D-05, 0.9828D-05, 0.1191D-04, 0.1443D-04, 0.1748D-04, & + & 0.2118D-04, 0.2565D-04, 0.3108D-04, 0.3766D-04, 0.4563D-04, & + & 0.5529D-04, 0.6700D-04, 0.8117D-04, 0.9838D-04, 0.1193D-03, & + & 0.1446D-03, 0.1753D-03, 0.2127D-03, 0.2582D-03, 0.3138D-03, & + & 0.3820D-03, 0.4658D-03, 0.5698D-03, 0.7001D-03, 0.8652D-03, & + & 0.1078D-02, 0.1359D-02, 0.1736D-02, 0.2254D-02, 0.2975D-02, & + & 0.3975D-02, 0.5336D-02, 0.7100D-02, 0.9208D-02, 0.1142D-01, & + & 0.1330D-01, 0.1427D-01, 0.1389D-01, 0.1213D-01, 0.9453D-02, & + & 0.6646D-02, 0.4334D-02, 0.2749D-02, 0.1791D-02, 0.1239D-02, & + & 0.9080D-03, 0.6858D-03, 0.5201D-03, 0.3907D-03, 0.2893D-03, & + & 0.2107D-03, 0.1511D-03, 0.1076D-03, 0.7520D-04, 0.5248D-04, & + & 0.3666D-04, 0.2566D-04, 0.1810D-04, 0.1261D-04, 0.8501D-05, & + & 0.6429D-05, 0.4380D-05, 0.3013D-05, 0.2324D-05, 0.1642D-05, & + & 0.1631D-05, 0.9573D-06, 0.9524D-06, 0.9491D-06, 0.9468D-06, & + & 0.9452D-06/ + + data (calcpts(j,28), j = 1,neta) /0.4356D-05, 0.5278D-05, & + & 0.6393D-05, 0.7746D-05, 0.9385D-05, 0.1137D-04, 0.1377D-04, & + & 0.1669D-04, 0.2022D-04, 0.2450D-04, 0.2968D-04, 0.3596D-04, & + & 0.4357D-04, 0.5279D-04, 0.6396D-04, 0.7751D-04, 0.9394D-04, & + & 0.1139D-03, 0.1380D-03, 0.1674D-03, 0.2031D-03, 0.2466D-03, & + & 0.2997D-03, 0.3648D-03, 0.4450D-03, 0.5445D-03, 0.6690D-03, & + & 0.8273D-03, 0.1031D-02, 0.1300D-02, 0.1660D-02, 0.2150D-02, & + & 0.2822D-02, 0.3731D-02, 0.4925D-02, 0.6402D-02, 0.8068D-02, & + & 0.9700D-02, 0.1093D-01, 0.1138D-01, 0.1074D-01, 0.9100D-02, & + & 0.6902D-02, 0.4741D-02, 0.3044D-02, 0.1922D-02, 0.1261D-02, & + & 0.8844D-03, 0.6548D-03, 0.4977D-03, 0.3789D-03, 0.2847D-03, & + & 0.2103D-03, 0.1528D-03, 0.1097D-03, 0.7798D-04, 0.5441D-04, & + & 0.3824D-04, 0.2613D-04, 0.1806D-04, 0.1267D-04, 0.8635D-05, & + & 0.5944D-05, 0.3927D-05, 0.3250D-05, 0.1909D-05, 0.1237D-05, & + & 0.1233D-05, 0.5641D-06, 0.5624D-06, 0.5613D-06, 0.5605D-06, & + & 0.5600D-06/ + + data (calcpts(j,29), j = 1,neta) /0.3316D-05, 0.4017D-05, & + & 0.4866D-05, 0.5896D-05, 0.7143D-05, 0.8654D-05, 0.1048D-04, & + & 0.1270D-04, 0.1539D-04, 0.1864D-04, 0.2259D-04, 0.2737D-04, & + & 0.3316D-04, 0.4018D-04, 0.4868D-04, 0.5898D-04, 0.7148D-04, & + & 0.8663D-04, 0.1050D-03, 0.1273D-03, 0.1544D-03, 0.1873D-03, & + & 0.2274D-03, 0.2764D-03, 0.3363D-03, 0.4102D-03, 0.5017D-03, & + & 0.6164D-03, 0.7619D-03, 0.9490D-03, 0.1194D-02, 0.1520D-02, & + & 0.1957D-02, 0.2541D-02, 0.3310D-02, 0.4278D-02, 0.5426D-02, & + & 0.6659D-02, 0.7797D-02, 0.8574D-02, 0.8706D-02, 0.8034D-02, & + & 0.6662D-02, 0.4955D-02, 0.3351D-02, 0.2133D-02, 0.1347D-02, & + & 0.8913D-03, 0.6316D-03, 0.4717D-03, 0.3603D-03, 0.2743D-03, & + & 0.2056D-03, 0.1516D-03, 0.1102D-03, 0.7889D-04, 0.5555D-04, & + & 0.3887D-04, 0.2687D-04, 0.1887D-04, 0.1287D-04, 0.8864D-05, & + & 0.6196D-05, 0.4195D-05, 0.2861D-05, 0.1528D-05, 0.8609D-06, & + & 0.8608D-06, 0.1940D-06, 0.1939D-06, 0.1939D-06, 0.1938D-06, & + & 0.1938D-06/ + + data (calcpts(j,30), j = 1,neta) /0.2456D-05, 0.2976D-05, & + & 0.3605D-05, 0.4368D-05, 0.5292D-05, 0.6411D-05, 0.7767D-05, & + & 0.9411D-05, 0.1140D-04, 0.1381D-04, 0.1674D-04, 0.2027D-04, & + & 0.2456D-04, 0.2976D-04, 0.3606D-04, 0.4369D-04, 0.5294D-04, & + & 0.6415D-04, 0.7774D-04, 0.9423D-04, 0.1142D-03, 0.1385D-03, & + & 0.1680D-03, 0.2040D-03, 0.2478D-03, 0.3016D-03, 0.3675D-03, & + & 0.4493D-03, 0.5515D-03, 0.6804D-03, 0.8454D-03, 0.1060D-02, & + & 0.1340D-02, 0.1708D-02, 0.2186D-02, 0.2794D-02, 0.3532D-02, & + & 0.4376D-02, 0.5249D-02, 0.6019D-02, 0.6490D-02, 0.6471D-02, & + & 0.5869D-02, 0.4789D-02, 0.3513D-02, 0.2351D-02, 0.1490D-02, & + & 0.9437D-03, 0.6290D-03, 0.4496D-03, 0.3378D-03, 0.2583D-03, & + & 0.1967D-03, 0.1476D-03, 0.1085D-03, 0.7861D-04, 0.5603D-04, & + & 0.3942D-04, 0.2812D-04, 0.1948D-04, 0.1350D-04, 0.9509D-05, & + & 0.6184D-05, 0.4190D-05, 0.2860D-05, 0.2196D-05, 0.1531D-05, & + & 0.8655D-06, 0.8663D-06, 0.2002D-06, 0.2006D-06, 0.2009D-06, & + & 0.2010D-06/ + + data (calcpts(j,31), j = 1,neta) /0.1782D-05, 0.2159D-05, & + & 0.2615D-05, 0.3168D-05, 0.3839D-05, 0.4650D-05, 0.5634D-05, & + & 0.6826D-05, 0.8269D-05, 0.1002D-04, 0.1214D-04, 0.1471D-04, & + & 0.1782D-04, 0.2159D-04, 0.2615D-04, 0.3169D-04, 0.3839D-04, & + & 0.4652D-04, 0.5637D-04, 0.6831D-04, 0.8278D-04, 0.1003D-03, & + & 0.1217D-03, 0.1476D-03, 0.1791D-03, 0.2175D-03, 0.2644D-03, & + & 0.3220D-03, 0.3931D-03, 0.4814D-03, 0.5922D-03, 0.7325D-03, & + & 0.9115D-03, 0.1141D-02, 0.1435D-02, 0.1805D-02, 0.2259D-02, & + & 0.2796D-02, 0.3394D-02, 0.3997D-02, 0.4507D-02, 0.4786D-02, & + & 0.4704D-02, 0.4211D-02, 0.3395D-02, 0.2465D-02, 0.1639D-02, & + & 0.1036D-02, 0.6582D-03, 0.4417D-03, 0.3174D-03, 0.2395D-03, & + & 0.1833D-03, 0.1396D-03, 0.1045D-03, 0.7664D-04, 0.5541D-04, & + & 0.3948D-04, 0.2819D-04, 0.1956D-04, 0.1358D-04, 0.9596D-05, & + & 0.6273D-05, 0.4280D-05, 0.2951D-05, 0.2288D-05, 0.1623D-05, & + & 0.9582D-06, 0.9592D-06, 0.2932D-06, 0.2937D-06, 0.2940D-06, & + & 0.2942D-06/ + + data (calcpts(j,32), j = 1,neta) /0.1272D-05, 0.1541D-05, & + & 0.1866D-05, 0.2261D-05, 0.2740D-05, 0.3319D-05, 0.4021D-05, & + & 0.4872D-05, 0.5902D-05, 0.7150D-05, 0.8664D-05, 0.1050D-04, & + & 0.1272D-04, 0.1541D-04, 0.1866D-04, 0.2261D-04, 0.2740D-04, & + & 0.3320D-04, 0.4022D-04, 0.4874D-04, 0.5904D-04, 0.7155D-04, & + & 0.8673D-04, 0.1051D-03, 0.1274D-03, 0.1546D-03, 0.1876D-03, & + & 0.2278D-03, 0.2770D-03, 0.3373D-03, 0.4117D-03, 0.5039D-03, & + & 0.6187D-03, 0.7624D-03, 0.9419D-03, 0.1164D-02, 0.1437D-02, & + & 0.1763D-02, 0.2141D-02, 0.2555D-02, 0.2964D-02, 0.3298D-02, & + & 0.3459D-02, 0.3363D-02, 0.2980D-02, 0.2382D-02, 0.1717D-02, & + & 0.1136D-02, 0.7172D-03, 0.4566D-03, 0.3082D-03, 0.2229D-03, & + & 0.1680D-03, 0.1290D-03, 0.9783D-04, 0.7330D-04, 0.5406D-04, & + & 0.3879D-04, 0.2751D-04, 0.1953D-04, 0.1356D-04, 0.9569D-05, & + & 0.6245D-05, 0.4252D-05, 0.2923D-05, 0.2259D-05, 0.1594D-05, & + & 0.9291D-06, 0.2634D-06, 0.2640D-06, 0.2645D-06, 0.2648D-06, & + & 0.2650D-06/ + + data (calcpts(j,33), j = 1,neta) /0.8970D-06, 0.1087D-05, & + & 0.1317D-05, 0.1595D-05, 0.1933D-05, 0.2341D-05, 0.2837D-05, & + & 0.3437D-05, 0.4163D-05, 0.5044D-05, 0.6112D-05, 0.7404D-05, & + & 0.8970D-05, 0.1087D-04, 0.1317D-04, 0.1595D-04, 0.1933D-04, & + & 0.2341D-04, 0.2837D-04, 0.3437D-04, 0.4163D-04, 0.5045D-04, & + & 0.6112D-04, 0.7405D-04, 0.8972D-04, 0.1087D-03, 0.1317D-03, & + & 0.1597D-03, 0.1936D-03, 0.2347D-03, 0.2848D-03, 0.3457D-03, & + & 0.4200D-03, 0.5106D-03, 0.6210D-03, 0.7547D-03, 0.9159D-03, & + & 0.1109D-02, 0.1336D-02, 0.1597D-02, 0.1879D-02, 0.2154D-02, & + & 0.2370D-02, 0.2463D-02, 0.2373D-02, 0.2087D-02, 0.1657D-02, & + & 0.1189D-02, 0.7842D-03, 0.4950D-03, 0.3161D-03, 0.2139D-03, & + & 0.1556D-03, 0.1179D-03, 0.9002D-04, 0.6880D-04, 0.5155D-04, & + & 0.3760D-04, 0.2763D-04, 0.1966D-04, 0.1368D-04, 0.9687D-05, & + & 0.7028D-05, 0.5033D-05, 0.3036D-05, 0.2372D-05, 0.1707D-05, & + & 0.1042D-05, 0.1042D-05, 0.3762D-06, 0.3766D-06, 0.3768D-06, & + & 0.3770D-06/ + + data (calcpts(j,34), j = 1,neta) /0.6268D-06, 0.7595D-06, & + & 0.9200D-06, 0.1115D-05, 0.1351D-05, 0.1636D-05, 0.1982D-05, & + & 0.2402D-05, 0.2909D-05, 0.3525D-05, 0.4271D-05, 0.5174D-05, & + & 0.6268D-05, 0.7595D-05, 0.9200D-05, 0.1115D-04, 0.1350D-04, & + & 0.1636D-04, 0.1982D-04, 0.2401D-04, 0.2908D-04, 0.3523D-04, & + & 0.4268D-04, 0.5169D-04, 0.6260D-04, 0.7581D-04, 0.9176D-04, & + & 0.1110D-03, 0.1343D-03, 0.1624D-03, 0.1961D-03, 0.2367D-03, & + & 0.2851D-03, 0.3429D-03, 0.4115D-03, 0.4925D-03, 0.5880D-03, & + & 0.7006D-03, 0.8336D-03, 0.9893D-03, 0.1167D-02, 0.1358D-02, & + & 0.1540D-02, 0.1681D-02, 0.1733D-02, 0.1659D-02, 0.1450D-02, & + & 0.1146D-02, 0.8190D-03, 0.5392D-03, 0.3403D-03, 0.2178D-03, & + & 0.1480D-03, 0.1076D-03, 0.8157D-04, 0.6259D-04, 0.4758D-04, & + & 0.3556D-04, 0.2612D-04, 0.1887D-04, 0.1348D-04, 0.9490D-05, & + & 0.6696D-05, 0.4633D-05, 0.3236D-05, 0.2238D-05, 0.1572D-05, & + & 0.1106D-05, 0.7737D-06, 0.5075D-06, 0.3744D-06, 0.3079D-06, & + & 0.1747D-06/ + + data (calcpts(j,35), j = 1,neta) /0.4350D-06, 0.5271D-06, & + & 0.6385D-06, 0.7736D-06, 0.9373D-06, 0.1136D-05, 0.1376D-05, & + & 0.1667D-05, 0.2019D-05, 0.2446D-05, 0.2964D-05, 0.3591D-05, & + & 0.4350D-05, 0.5271D-05, 0.6385D-05, 0.7735D-05, 0.9372D-05, & + & 0.1135D-04, 0.1375D-04, 0.1666D-04, 0.2018D-04, 0.2445D-04, & + & 0.2961D-04, 0.3585D-04, 0.4340D-04, 0.5253D-04, 0.6354D-04, & + & 0.7681D-04, 0.9277D-04, 0.1119D-03, 0.1347D-03, 0.1618D-03, & + & 0.1937D-03, 0.2310D-03, 0.2742D-03, 0.3239D-03, 0.3809D-03, & + & 0.4467D-03, 0.5232D-03, 0.6132D-03, 0.7186D-03, 0.8385D-03, & + & 0.9666D-03, 0.1088D-02, 0.1179D-02, 0.1209D-02, 0.1152D-02, & + & 0.1002D-02, 0.7892D-03, 0.5624D-03, 0.3697D-03, 0.2333D-03, & + & 0.1496D-03, 0.1018D-03, 0.7418D-04, 0.5625D-04, 0.4316D-04, & + & 0.3279D-04, 0.2447D-04, 0.1795D-04, 0.1296D-04, 0.9234D-05, & + & 0.6505D-05, 0.4508D-05, 0.3110D-05, 0.2178D-05, 0.1446D-05, & + & 0.9797D-06, 0.6468D-06, 0.4471D-06, 0.3140D-06, 0.1808D-06, & + & 0.1142D-06/ + + data (calcpts(j,36), j = 1,neta) /0.3005D-06, 0.3641D-06, & + & 0.4410D-06, 0.5343D-06, 0.6474D-06, 0.7844D-06, 0.9503D-06, & + & 0.1151D-05, 0.1395D-05, 0.1690D-05, 0.2047D-05, 0.2480D-05, & + & 0.3005D-05, 0.3641D-05, 0.4410D-05, 0.5343D-05, 0.6473D-05, & + & 0.7842D-05, 0.9500D-05, 0.1151D-04, 0.1394D-04, 0.1688D-04, & + & 0.2044D-04, 0.2475D-04, 0.2996D-04, 0.3624D-04, 0.4381D-04, & + & 0.5293D-04, 0.6385D-04, 0.7688D-04, 0.9234D-04, 0.1105D-03, & + & 0.1317D-03, 0.1561D-03, 0.1837D-03, 0.2147D-03, 0.2492D-03, & + & 0.2879D-03, 0.3319D-03, 0.3831D-03, 0.4434D-03, 0.5142D-03, & + & 0.5948D-03, 0.6807D-03, 0.7617D-03, 0.8210D-03, 0.8378D-03, & + & 0.7949D-03, 0.6898D-03, 0.5417D-03, 0.3854D-03, 0.2531D-03, & + & 0.1597D-03, 0.1025D-03, 0.6996D-04, 0.5100D-04, 0.3870D-04, & + & 0.2972D-04, 0.2253D-04, 0.1688D-04, 0.1235D-04, 0.8956D-05, & + & 0.6359D-05, 0.4494D-05, 0.3096D-05, 0.2163D-05, 0.1497D-05, & + & 0.1031D-05, 0.6979D-06, 0.4981D-06, 0.2982D-06, 0.2317D-06, & + & 0.1651D-06/ + + data (calcpts(j,37), j = 1,neta) /0.2068D-06, 0.2505D-06, & + & 0.3035D-06, 0.3677D-06, 0.4455D-06, 0.5397D-06, 0.6539D-06, & + & 0.7923D-06, 0.9597D-06, 0.1163D-05, 0.1409D-05, 0.1707D-05, & + & 0.2068D-05, 0.2505D-05, 0.3035D-05, 0.3677D-05, 0.4454D-05, & + & 0.5396D-05, 0.6537D-05, 0.7918D-05, 0.9589D-05, 0.1161D-04, & + & 0.1406D-04, 0.1703D-04, 0.2060D-04, 0.2492D-04, 0.3011D-04, & + & 0.3636D-04, 0.4383D-04, 0.5271D-04, 0.6320D-04, 0.7547D-04, & + & 0.8960D-04, 0.1057D-03, 0.1236D-03, 0.1432D-03, 0.1645D-03, & + & 0.1875D-03, 0.2130D-03, 0.2420D-03, 0.2759D-03, 0.3161D-03, & + & 0.3636D-03, 0.4177D-03, 0.4753D-03, 0.5293D-03, 0.5682D-03, & + & 0.5779D-03, 0.5467D-03, 0.4734D-03, 0.3711D-03, 0.2636D-03, & + & 0.1730D-03, 0.1092D-03, 0.7015D-04, 0.4791D-04, 0.3500D-04, & + & 0.2655D-04, 0.2036D-04, 0.1550D-04, 0.1157D-04, 0.8508D-05, & + & 0.6110D-05, 0.4379D-05, 0.3046D-05, 0.2114D-05, 0.1514D-05, & + & 0.1048D-05, 0.7145D-06, 0.5147D-06, 0.3148D-06, 0.2482D-06, & + & 0.1816D-06/ + + data (calcpts(j,38), j = 1,neta) /0.1419D-06, 0.1719D-06, & + & 0.2082D-06, 0.2523D-06, 0.3057D-06, 0.3703D-06, 0.4487D-06, & + & 0.5436D-06, 0.6585D-06, 0.7978D-06, 0.9667D-06, 0.1171D-05, & + & 0.1419D-05, 0.1719D-05, 0.2082D-05, 0.2523D-05, 0.3056D-05, & + & 0.3702D-05, 0.4485D-05, 0.5433D-05, 0.6579D-05, 0.7968D-05, & + & 0.9649D-05, 0.1168D-04, 0.1413D-04, 0.1709D-04, 0.2065D-04, & + & 0.2492D-04, 0.3002D-04, 0.3607D-04, 0.4320D-04, 0.5149D-04, & + & 0.6098D-04, 0.7165D-04, 0.8339D-04, 0.9600D-04, 0.1093D-03, & + & 0.1234D-03, 0.1383D-03, 0.1548D-03, 0.1737D-03, 0.1960D-03, & + & 0.2228D-03, 0.2547D-03, 0.2911D-03, 0.3297D-03, 0.3658D-03, & + & 0.3915D-03, 0.3972D-03, 0.3750D-03, 0.3241D-03, 0.2537D-03, & + & 0.1801D-03, 0.1181D-03, 0.7455D-04, 0.4790D-04, 0.3279D-04, & + & 0.2393D-04, 0.1820D-04, 0.1394D-04, 0.1061D-04, 0.7880D-05, & + & 0.5815D-05, 0.4149D-05, 0.2950D-05, 0.2084D-05, 0.1417D-05, & + & 0.1017D-05, 0.6842D-06, 0.2843D-06, 0.2844D-06, 0.2178D-06, & + & 0.1512D-06/ + + data (calcpts(j,39), j = 1,neta) /0.9721D-07, 0.1178D-06, & + & 0.1427D-06, 0.1729D-06, 0.2094D-06, 0.2537D-06, 0.3074D-06, & + & 0.3724D-06, 0.4511D-06, 0.5466D-06, 0.6623D-06, 0.8023D-06, & + & 0.9720D-06, 0.1178D-05, 0.1427D-05, 0.1728D-05, 0.2094D-05, & + & 0.2537D-05, 0.3073D-05, 0.3722D-05, 0.4507D-05, 0.5459D-05, & + & 0.6610D-05, 0.8000D-05, 0.9679D-05, 0.1170D-04, 0.1414D-04, & + & 0.1705D-04, 0.2054D-04, 0.2466D-04, 0.2951D-04, 0.3513D-04, & + & 0.4153D-04, 0.4867D-04, 0.5644D-04, 0.6466D-04, 0.7316D-04, & + & 0.8184D-04, 0.9078D-04, 0.1003D-03, 0.1108D-03, 0.1231D-03, & + & 0.1379D-03, 0.1558D-03, 0.1771D-03, 0.2016D-03, 0.2277D-03, & + & 0.2518D-03, 0.2689D-03, 0.2724D-03, 0.2567D-03, 0.2216D-03, & + & 0.1733D-03, 0.1230D-03, 0.8063D-04, 0.5093D-04, 0.3276D-04, & + & 0.2239D-04, 0.1640D-04, 0.1247D-04, 0.9535D-05, 0.7270D-05, & + & 0.5404D-05, 0.4005D-05, 0.2872D-05, 0.2072D-05, 0.1473D-05, & + & 0.1006D-05, 0.7395D-06, 0.4729D-06, 0.3396D-06, 0.2730D-06, & + & 0.2064D-06/ + + data (calcpts(j,40), j = 1,neta) /0.6647D-07, 0.8054D-07, & + & 0.9756D-07, 0.1182D-06, 0.1432D-06, 0.1735D-06, 0.2102D-06, & + & 0.2547D-06, 0.3085D-06, 0.3738D-06, 0.4529D-06, 0.5486D-06, & + & 0.6647D-06, 0.8053D-06, 0.9755D-06, 0.1182D-05, 0.1432D-05, & + & 0.1734D-05, 0.2101D-05, 0.2545D-05, 0.3082D-05, 0.3732D-05, & + & 0.4519D-05, 0.5470D-05, 0.6617D-05, 0.8001D-05, 0.9662D-05, & + & 0.1166D-04, 0.1403D-04, 0.1684D-04, 0.2014D-04, 0.2395D-04, & + & 0.2828D-04, 0.3308D-04, 0.3826D-04, 0.4367D-04, 0.4917D-04, & + & 0.5464D-04, 0.6008D-04, 0.6564D-04, 0.7160D-04, 0.7835D-04, & + & 0.8637D-04, 0.9616D-04, 0.1081D-03, 0.1225D-03, 0.1390D-03, & + & 0.1566D-03, 0.1729D-03, 0.1843D-03, 0.1864D-03, 0.1755D-03, & + & 0.1513D-03, 0.1183D-03, 0.8387D-04, 0.5499D-04, 0.3474D-04, & + & 0.2235D-04, 0.1530D-04, 0.1119D-04, 0.8507D-05, 0.6528D-05, & + & 0.4955D-05, 0.3703D-05, 0.2716D-05, 0.1963D-05, 0.1397D-05, & + & 0.9834D-06, 0.6902D-06, 0.4835D-06, 0.3369D-06, 0.2303D-06, & + & 0.1636D-06/ + + data (calcpts(j,41), j = 1,neta) /0.4540D-07, 0.5501D-07, & + & 0.6663D-07, 0.8073D-07, 0.9782D-07, 0.1185D-06, 0.1436D-06, & + & 0.1740D-06, 0.2107D-06, 0.2553D-06, 0.3093D-06, 0.3747D-06, & + & 0.4540D-06, 0.5501D-06, 0.6663D-06, 0.8072D-06, 0.9780D-06, & + & 0.1185D-05, 0.1435D-05, 0.1738D-05, 0.2105D-05, 0.2549D-05, & + & 0.3087D-05, 0.3736D-05, 0.4519D-05, 0.5464D-05, 0.6598D-05, & + & 0.7957D-05, 0.9578D-05, 0.1149D-04, 0.1374D-04, 0.1633D-04, & + & 0.1926D-04, 0.2250D-04, 0.2597D-04, 0.2956D-04, 0.3316D-04, & + & 0.3667D-04, 0.4005D-04, 0.4337D-04, 0.4679D-04, 0.5052D-04, & + & 0.5486D-04, 0.6013D-04, 0.6665D-04, 0.7469D-04, 0.8439D-04, & + & 0.9556D-04, 0.1074D-03, 0.1184D-03, 0.1261D-03, 0.1274D-03, & + & 0.1198D-03, 0.1033D-03, 0.8069D-04, 0.5719D-04, 0.3748D-04, & + & 0.2367D-04, 0.1524D-04, 0.1043D-04, 0.7626D-05, 0.5800D-05, & + & 0.4447D-05, 0.3374D-05, 0.2521D-05, 0.1848D-05, 0.1328D-05, & + & 0.9483D-06, 0.6683D-06, 0.4617D-06, 0.3217D-06, 0.2217D-06, & + & 0.1484D-06/ + + data (calcpts(j,42), j = 1,neta) /0.3100D-07, 0.3755D-07, & + & 0.4549D-07, 0.5512D-07, 0.6678D-07, 0.8090D-07, 0.9801D-07, & + & 0.1188D-06, 0.1439D-06, 0.1743D-06, 0.2112D-06, 0.2558D-06, & + & 0.3099D-06, 0.3755D-06, 0.4549D-06, 0.5511D-06, 0.6677D-06, & + & 0.8088D-06, 0.9797D-06, 0.1187D-05, 0.1437D-05, 0.1740D-05, & + & 0.2107D-05, 0.2550D-05, 0.3085D-05, 0.3729D-05, 0.4503D-05, & + & 0.5431D-05, 0.6536D-05, 0.7841D-05, 0.9368D-05, 0.1113D-04, & + & 0.1312D-04, 0.1531D-04, 0.1765D-04, 0.2005D-04, 0.2243D-04, & + & 0.2471D-04, 0.2685D-04, 0.2888D-04, 0.3088D-04, 0.3297D-04, & + & 0.3533D-04, 0.3814D-04, 0.4162D-04, 0.4599D-04, 0.5141D-04, & + & 0.5796D-04, 0.6552D-04, 0.7356D-04, 0.8100D-04, 0.8616D-04, & + & 0.8698D-04, 0.8179D-04, 0.7046D-04, 0.5502D-04, 0.3899D-04, & + & 0.2555D-04, 0.1615D-04, 0.1039D-04, 0.7120D-05, 0.5207D-05, & + & 0.3961D-05, 0.3035D-05, 0.2308D-05, 0.1722D-05, 0.1262D-05, & + & 0.9083D-06, 0.6484D-06, 0.4550D-06, 0.3217D-06, 0.2217D-06, & + & 0.1551D-06/ + + data (calcpts(j,43), j = 1,neta) /0.2115D-07, 0.2562D-07, & + & 0.3104D-07, 0.3760D-07, 0.4556D-07, 0.5520D-07, 0.6687D-07, & + & 0.8102D-07, 0.9814D-07, 0.1189D-06, 0.1441D-06, 0.1745D-06, & + & 0.2115D-06, 0.2562D-06, 0.3103D-06, 0.3760D-06, 0.4555D-06, & + & 0.5518D-06, 0.6684D-06, 0.8097D-06, 0.9804D-06, 0.1187D-05, & + & 0.1438D-05, 0.1740D-05, 0.2105D-05, 0.2544D-05, 0.3072D-05, & + & 0.3704D-05, 0.4457D-05, 0.5347D-05, 0.6387D-05, 0.7585D-05, & + & 0.8936D-05, 0.1042D-04, 0.1200D-04, 0.1362D-04, 0.1520D-04, & + & 0.1670D-04, 0.1808D-04, 0.1934D-04, 0.2054D-04, 0.2173D-04, & + & 0.2303D-04, 0.2453D-04, 0.2637D-04, 0.2869D-04, 0.3162D-04, & + & 0.3529D-04, 0.3972D-04, 0.4485D-04, 0.5030D-04, 0.5534D-04, & + & 0.5882D-04, 0.5935D-04, 0.5579D-04, 0.4805D-04, 0.3751D-04, & + & 0.2657D-04, 0.1742D-04, 0.1101D-04, 0.7086D-05, 0.4853D-05, & + & 0.3553D-05, 0.2700D-05, 0.2073D-05, 0.1573D-05, 0.1167D-05, & + & 0.8600D-06, 0.6200D-06, 0.4400D-06, 0.3134D-06, 0.2201D-06, & + & 0.1534D-06/ + + data (calcpts(j,44), j = 1,neta) /0.1442D-07, 0.1747D-07, & + & 0.2116D-07, 0.2564D-07, 0.3107D-07, 0.3764D-07, 0.4560D-07, & + & 0.5525D-07, 0.6692D-07, 0.8108D-07, 0.9824D-07, 0.1190D-06, & + & 0.1442D-06, 0.1747D-06, 0.2116D-06, 0.2564D-06, 0.3106D-06, & + & 0.3763D-06, 0.4558D-06, 0.5521D-06, 0.6685D-06, 0.8096D-06, & + & 0.9802D-06, 0.1186D-05, 0.1435D-05, 0.1735D-05, 0.2094D-05, & + & 0.2525D-05, 0.3039D-05, 0.3645D-05, 0.4353D-05, 0.5168D-05, & + & 0.6086D-05, 0.7095D-05, 0.8165D-05, 0.9254D-05, 0.1032D-04, & + & 0.1131D-04, 0.1221D-04, 0.1301D-04, 0.1374D-04, 0.1444D-04, & + & 0.1516D-04, 0.1597D-04, 0.1694D-04, 0.1816D-04, 0.1971D-04, & + & 0.2169D-04, 0.2416D-04, 0.2718D-04, 0.3065D-04, 0.3435D-04, & + & 0.3778D-04, 0.4014D-04, 0.4048D-04, 0.3803D-04, 0.3275D-04, & + & 0.2556D-04, 0.1811D-04, 0.1187D-04, 0.7499D-05, 0.4826D-05, & + & 0.3306D-05, 0.2419D-05, 0.1840D-05, 0.1413D-05, 0.1073D-05, & + & 0.7996D-06, 0.5863D-06, 0.4197D-06, 0.2997D-06, 0.2130D-06, & + & 0.1463D-06/ + + data (calcpts(j,45), j = 1,neta) /0.9834D-08, 0.1192D-07, & + & 0.1443D-07, 0.1749D-07, 0.2119D-07, 0.2567D-07, 0.3110D-07, & + & 0.3768D-07, 0.4564D-07, 0.5530D-07, 0.6700D-07, 0.8117D-07, & + & 0.9834D-07, 0.1191D-06, 0.1443D-06, 0.1748D-06, 0.2118D-06, & + & 0.2566D-06, 0.3108D-06, 0.3765D-06, 0.4559D-06, 0.5521D-06, & + & 0.6685D-06, 0.8090D-06, 0.9786D-06, 0.1183D-05, 0.1428D-05, & + & 0.1722D-05, 0.2072D-05, 0.2485D-05, 0.2968D-05, 0.3523D-05, & + & 0.4148D-05, 0.4833D-05, 0.5559D-05, 0.6296D-05, 0.7012D-05, & + & 0.7676D-05, 0.8269D-05, 0.8788D-05, 0.9244D-05, 0.9661D-05, & + & 0.1007D-04, 0.1051D-04, 0.1102D-04, 0.1166D-04, 0.1247D-04, & + & 0.1351D-04, 0.1485D-04, 0.1653D-04, 0.1857D-04, 0.2094D-04, & + & 0.2345D-04, 0.2578D-04, 0.2738D-04, 0.2760D-04, 0.2593D-04, & + & 0.2233D-04, 0.1743D-04, 0.1234D-04, 0.8090D-05, 0.5112D-05, & + & 0.3293D-05, 0.2254D-05, 0.1654D-05, 0.1254D-05, 0.9610D-06, & + & 0.7277D-06, 0.5477D-06, 0.4011D-06, 0.2877D-06, 0.2077D-06, & + & 0.1477D-06/ + + data (calcpts(j,46), j = 1,neta) /0.6703D-08, 0.8121D-08, & + & 0.9837D-08, 0.1192D-07, 0.1444D-07, 0.1750D-07, 0.2120D-07, & + & 0.2568D-07, 0.3111D-07, 0.3769D-07, 0.4567D-07, 0.5532D-07, & + & 0.6702D-07, 0.8121D-07, 0.9836D-07, 0.1192D-06, 0.1444D-06, & + & 0.1749D-06, 0.2119D-06, 0.2566D-06, 0.3108D-06, 0.3763D-06, & + & 0.4556D-06, 0.5514D-06, 0.6670D-06, 0.8063D-06, 0.9734D-06, & + & 0.1174D-05, 0.1412D-05, 0.1694D-05, 0.2022D-05, 0.2400D-05, & + & 0.2825D-05, 0.3292D-05, 0.3785D-05, 0.4284D-05, 0.4768D-05, & + & 0.5214D-05, 0.5608D-05, 0.5947D-05, 0.6237D-05, 0.6492D-05, & + & 0.6730D-05, 0.6974D-05, 0.7248D-05, 0.7579D-05, 0.7998D-05, & + & 0.8541D-05, 0.9245D-05, 0.1015D-04, 0.1129D-04, 0.1268D-04, & + & 0.1429D-04, 0.1600D-04, 0.1758D-04, 0.1867D-04, 0.1881D-04, & + & 0.1768D-04, 0.1522D-04, 0.1187D-04, 0.8410D-05, 0.5511D-05, & + & 0.3483D-05, 0.2243D-05, 0.1537D-05, 0.1125D-05, 0.8554D-06, & + & 0.6561D-06, 0.4988D-06, 0.3721D-06, 0.2728D-06, 0.1974D-06, & + & 0.1408D-06/ + + data (calcpts(j,47), j = 1,neta) /0.4567D-08, 0.5534D-08, & + & 0.6703D-08, 0.8122D-08, 0.9841D-08, 0.1192D-07, 0.1444D-07, & + & 0.1750D-07, 0.2120D-07, 0.2568D-07, 0.3112D-07, 0.3770D-07, & + & 0.4567D-07, 0.5534D-07, 0.6703D-07, 0.8121D-07, 0.9838D-07, & + & 0.1192D-06, 0.1444D-06, 0.1749D-06, 0.2118D-06, 0.2564D-06, & + & 0.3105D-06, 0.3757D-06, 0.4545D-06, 0.5494D-06, 0.6633D-06, & + & 0.7997D-06, 0.9622D-06, 0.1154D-05, 0.1378D-05, 0.1635D-05, & + & 0.1925D-05, 0.2242D-05, 0.2577D-05, 0.2916D-05, 0.3243D-05, & + & 0.3544D-05, 0.3808D-05, 0.4032D-05, 0.4219D-05, 0.4378D-05, & + & 0.4520D-05, 0.4658D-05, 0.4807D-05, 0.4980D-05, 0.5197D-05, & + & 0.5476D-05, 0.5841D-05, 0.6317D-05, 0.6932D-05, 0.7708D-05, & + & 0.8653D-05, 0.9745D-05, 0.1091D-04, 0.1199D-04, 0.1273D-04, & + & 0.1283D-04, 0.1205D-04, 0.1037D-04, 0.8089D-05, 0.5729D-05, & + & 0.3755D-05, 0.2372D-05, 0.1527D-05, 0.1047D-05, 0.7661D-06, & + & 0.5821D-06, 0.4461D-06, 0.3387D-06, 0.2527D-06, 0.1854D-06, & + & 0.1334D-06/ + + data (calcpts(j,48), j = 1,neta) /0.3113D-08, 0.3771D-08, & + & 0.4568D-08, 0.5535D-08, 0.6707D-08, 0.8125D-08, 0.9843D-08, & + & 0.1193D-07, 0.1445D-07, 0.1750D-07, 0.2121D-07, 0.2569D-07, & + & 0.3113D-07, 0.3771D-07, 0.4568D-07, 0.5534D-07, 0.6705D-07, & + & 0.8122D-07, 0.9839D-07, 0.1192D-06, 0.1443D-06, 0.1748D-06, & + & 0.2116D-06, 0.2561D-06, 0.3097D-06, 0.3744D-06, 0.4520D-06, & + & 0.5450D-06, 0.6557D-06, 0.7863D-06, 0.9388D-06, 0.1114D-05, & + & 0.1311D-05, 0.1527D-05, 0.1755D-05, 0.1986D-05, 0.2208D-05, & + & 0.2411D-05, 0.2588D-05, 0.2738D-05, 0.2860D-05, 0.2962D-05, & + & 0.3048D-05, 0.3128D-05, 0.3210D-05, 0.3302D-05, 0.3414D-05, & + & 0.3557D-05, 0.3744D-05, 0.3991D-05, 0.4314D-05, 0.4731D-05, & + & 0.5259D-05, 0.5902D-05, 0.6646D-05, 0.7437D-05, 0.8169D-05, & + & 0.8672D-05, 0.8739D-05, 0.8207D-05, 0.7063D-05, 0.5512D-05, & + & 0.3904D-05, 0.2558D-05, 0.1616D-05, 0.1041D-05, 0.7134D-06, & + & 0.5221D-06, 0.3968D-06, 0.3048D-06, 0.2315D-06, 0.1728D-06, & + & 0.1261D-06/ + + data (calcpts(j,49), j = 1,neta) /0.2121D-08, 0.2570D-08, & + & 0.3113D-08, 0.3772D-08, 0.4570D-08, 0.5536D-08, 0.6708D-08, & + & 0.8127D-08, 0.9844D-08, 0.1193D-07, 0.1445D-07, 0.1751D-07, & + & 0.2121D-07, 0.2570D-07, 0.3113D-07, 0.3771D-07, 0.4569D-07, & + & 0.5535D-07, 0.6704D-07, 0.8121D-07, 0.9834D-07, 0.1191D-06, & + & 0.1442D-06, 0.1745D-06, 0.2111D-06, 0.2551D-06, 0.3080D-06, & + & 0.3714D-06, 0.4468D-06, 0.5358D-06, 0.6397D-06, 0.7591D-06, & + & 0.8934D-06, 0.1040D-05, 0.1195D-05, 0.1352D-05, 0.1503D-05, & + & 0.1641D-05, 0.1761D-05, 0.1861D-05, 0.1942D-05, 0.2007D-05, & + & 0.2061D-05, 0.2109D-05, 0.2155D-05, 0.2205D-05, 0.2263D-05, & + & 0.2336D-05, 0.2431D-05, 0.2557D-05, 0.2724D-05, 0.2944D-05, & + & 0.3228D-05, 0.3586D-05, 0.4024D-05, 0.4530D-05, 0.5069D-05, & + & 0.5567D-05, 0.5910D-05, 0.5955D-05, 0.5592D-05, 0.4813D-05, & + & 0.3756D-05, 0.2660D-05, 0.1743D-05, 0.1101D-05, 0.7091D-06, & + & 0.4858D-06, 0.3558D-06, 0.2705D-06, 0.2078D-06, 0.1578D-06, & + & 0.1178D-06/ + + data (dlaeta(j), j = 1,neta) / & + & -6d0, -5.83333333d0, -5.66666667d0, -5.5d0, -5.33333333d0, & + & -5.16666667d0, -5d0, -4.83333333d0, -4.66666667d0, -4.5d0, & + & -4.33333333d0, -4.16666667d0, -4d0, -3.83333333d0, & + & -3.66666667d0, -3.5d0, -3.33333333d0, -3.16666667d0, -3d0, & + & -2.83333333d0, -2.66666667d0, -2.5d0, -2.33333333d0, & + & -2.16666667d0, -2d0, -1.83333333d0, -1.66666667d0, -1.5d0, & + & -1.33333333d0, -1.16666667d0, -1d0, -0.83333333d0, -0.66666667d0,& + & -0.5d0, -0.33333333d0, -0.16666667d0, 0d0, 0.16666667d0, & + & 0.33333333d0, 0.5d0, 0.66666667d0, 0.83333333d0, 1d0, & + & 1.16666667d0, 1.33333333d0, 1.5d0, 1.66666667d0, 1.83333333d0, & + & 2d0, 2.16666667d0, 2.33333333d0, 2.5d0, 2.66666667d0, & + & 2.83333333d0, 3d0, 3.16666667d0, 3.33333333d0, 3.5d0, & + & 3.66666667d0, 3.83333333d0, 4d0, 4.16666667d0, 4.33333333d0, & + & 4.5d0, 4.66666667d0, 4.83333333d0, 5d0, 5.16666667d0, & + & 5.33333333d0, 5.5d0, 5.66666667d0, 5.83333333d0, 6d0/ + + data (dlaxi(j), j = 1,nxi) / & + & -3d0, -2.83333333d0, -2.66666667d0, -2.5d0, -2.33333333d0, & + & -2.16666667d0, -2d0, -1.83333333d0, -1.66666667d0, -1.5d0, & + & -1.33333333d0, -1.16666667d0, -1d0, -0.83333333d0, -0.66666667d0,& + & -0.5d0, -0.33333333d0, -0.16666667d0, 0d0, 0.16666667d0, & + & 0.33333333d0, 0.5d0, 0.66666667d0, 0.83333333d0, 1d0, & + & 1.16666667d0, 1.33333333d0, 1.5d0, 1.66666667d0, 1.83333333d0, & + & 2d0, 2.16666667d0, 2.33333333d0, 2.5d0, 2.66666667d0, & + & 2.83333333d0, 3d0, 3.16666667d0, 3.33333333d0, 3.5d0, & + & 3.66666667d0, 3.83333333d0, 4d0, 4.16666667d0, 4.33333333d0, & + & 4.5d0, 4.66666667d0, 4.83333333d0, 5d0/ + + dleta = dlog10(eta) + dlxi = dlog10(xi) + if (dlxi .le. dlaxi(1)) dlxi = dlaxi(1) + if (dlxi .ge. dlaxi(nxi)) dlxi = dlaxi(nxi) + if (dleta .ge. dlaeta(neta)) dleta = dlaeta(neta) + if (dleta .le. dlaeta(1)) dleta = dlaeta(1) + call locate(dlaeta,neta, dleta, ieta) + call locate(dlaxi, nxi, dlxi, ixi) +! interpolating between the appropriate points + delxi = 1d0/6d0 + deleta = 1d0/6d0 +! lagrange 3-pt. + if (ixi .le. 2) ixi = 2 + if (ixi .ge. 48) ixi = 48 + if (ieta .le. 2) ieta = 2 + if (ixi .ge. 72) ieta = 72 + pxi = (dlxi - dlaxi(ixi))/delxi + f(-1) = pxi*(pxi-1d0)/2d0*calcpts(ieta-1,ixi-1) + & + & (1d0 - pxi**2)*calcpts(ieta-1,ixi) + & + & pxi*(pxi+1d0)/2d0*calcpts(ieta-1,ixi+1) + f(0) = pxi*(pxi-1d0)/2d0*calcpts(ieta,ixi-1) + & + & (1d0 - pxi**2)*calcpts(ieta,ixi) + & + & pxi*(pxi+1d0)/2d0*calcpts(ieta,ixi+1) + f(1) = pxi*(pxi-1d0)/2d0*calcpts(ieta+1,ixi-1) + & + & (1d0 - pxi**2)*calcpts(ieta+1,ixi) + & + & pxi*(pxi+1d0)/2d0*calcpts(ieta+1,ixi+1) + peta = (dleta - dlaeta(ieta))/deleta + h1bar_Lg = peta*(peta-1d0)/2d0*f(-1) + & + & (1d0 - peta**2)*f(0) + & + & peta*(peta+1d0)/2d0*f(1) +!MB + + peta*(peta+1d0)/2d0*f(1) + return + END + +!DECK ID>, QCORRT. + +! ======================================== + double precision function h1_HTq(eta,xi) +! ======================================== + +! eq (26) in PLB347 (1995) 143 - 151 for the transverse piece +! MSbar scheme +! This routine is called subcqht in the original code. +! Called schqt in updated code (03/06/96). + + implicit none + integer neta, nxi + parameter (neta = 73, nxi = 49) + double precision calcpts(neta, nxi), dlaeta(neta), dlaxi(nxi) + double precision eta, xi, dleta, dlxi + double precision pxi, peta, f(-1:1), delxi, deleta + integer j, ieta, ixi + + data (calcpts(j, 1), j = 1,neta) /-.9757D-09, -.1701D-08, & + & -.2961D-08, -.5155D-08, -.8967D-08, -.1559D-07, -.2708D-07, & + & -.4703D-07, -.8158D-07, -.1415D-06, -.2452D-06, -.4245D-06, & + & -.7345D-06, -.1270D-05, -.2194D-05, -.3787D-05, -.6531D-05, & + & -.1125D-04, -.1936D-04, -.3327D-04, -.5709D-04, -.9784D-04, & + & -.1674D-03, -.2859D-03, -.4868D-03, -.8266D-03, -.1398D-02, & + & -.2352D-02, -.3932D-02, -.6512D-02, -.1065D-01, -.1711D-01, & + & -.2682D-01, -.4073D-01, -.5935D-01, -.8225D-01, -.1077D+00, & + & -.1325D+00, -.1534D+00, -.1673D+00, -.1729D+00, -.1704D+00, & + & -.1612D+00, -.1472D+00, -.1307D+00, -.1132D+00, -.9612D-01, & + & -.8027D-01, -.6602D-01, -.5365D-01, -.4317D-01, -.3440D-01, & + & -.2727D-01, -.2137D-01, -.1673D-01, -.1295D-01, -.1003D-01, & + & -.7682D-02, -.5769D-02, -.4444D-02, -.3410D-02, -.2522D-02, & + & -.1930D-02, -.1485D-02, -.1039D-02, -.7414D-03, -.5931D-03, & + & -.4443D-03, -.2950D-03, -.2956D-03, -.1459D-03, -.1462D-03, & + & -.1464D-03/ + + data (calcpts(j, 2), j = 1,neta) /-.9756D-09, -.1701D-08, & + & -.2961D-08, -.5155D-08, -.8966D-08, -.1559D-07, -.2708D-07, & + & -.4701D-07, -.8156D-07, -.1415D-06, -.2452D-06, -.4245D-06, & + & -.7345D-06, -.1270D-05, -.2194D-05, -.3786D-05, -.6529D-05, & + & -.1125D-04, -.1936D-04, -.3327D-04, -.5708D-04, -.9783D-04, & + & -.1674D-03, -.2857D-03, -.4866D-03, -.8264D-03, -.1397D-02, & + & -.2352D-02, -.3932D-02, -.6511D-02, -.1065D-01, -.1711D-01, & + & -.2682D-01, -.4073D-01, -.5935D-01, -.8225D-01, -.1076D+00, & + & -.1325D+00, -.1534D+00, -.1673D+00, -.1729D+00, -.1704D+00, & + & -.1612D+00, -.1472D+00, -.1307D+00, -.1132D+00, -.9610D-01, & + & -.8026D-01, -.6600D-01, -.5363D-01, -.4316D-01, -.3439D-01, & + & -.2725D-01, -.2135D-01, -.1672D-01, -.1293D-01, -.1001D-01, & + & -.7667D-02, -.5903D-02, -.4428D-02, -.3395D-02, -.2507D-02, & + & -.1914D-02, -.1470D-02, -.1023D-02, -.8760D-03, -.5777D-03, & + & -.4288D-03, -.2796D-03, -.2801D-03, -.1305D-03, -.1308D-03, & + & -.1309D-03/ + + data (calcpts(j, 3), j = 1,neta) /-.9753D-09, -.1700D-08, & + & -.2960D-08, -.5153D-08, -.8964D-08, -.1558D-07, -.2707D-07, & + & -.4701D-07, -.8154D-07, -.1414D-06, -.2450D-06, -.4243D-06, & + & -.7343D-06, -.1270D-05, -.2193D-05, -.3785D-05, -.6528D-05, & + & -.1124D-04, -.1935D-04, -.3325D-04, -.5708D-04, -.9781D-04, & + & -.1673D-03, -.2857D-03, -.4866D-03, -.8262D-03, -.1397D-02, & + & -.2351D-02, -.3931D-02, -.6510D-02, -.1064D-01, -.1710D-01, & + & -.2681D-01, -.4072D-01, -.5934D-01, -.8223D-01, -.1076D+00, & + & -.1325D+00, -.1533D+00, -.1673D+00, -.1729D+00, -.1704D+00, & + & -.1612D+00, -.1472D+00, -.1307D+00, -.1132D+00, -.9611D-01, & + & -.8024D-01, -.6598D-01, -.5376D-01, -.4314D-01, -.3437D-01, & + & -.2723D-01, -.2133D-01, -.1670D-01, -.1291D-01, -.9990D-02, & + & -.7644D-02, -.5881D-02, -.4405D-02, -.3372D-02, -.2484D-02, & + & -.1892D-02, -.1447D-02, -.1001D-02, -.8533D-03, -.5550D-03, & + & -.4062D-03, -.2570D-03, -.2575D-03, -.1079D-03, -.1081D-03, & + & -.1083D-03/ + + data (calcpts(j, 4), j = 1,neta) /-.9749D-09, -.1699D-08, & + & -.2960D-08, -.5150D-08, -.8961D-08, -.1558D-07, -.2706D-07, & + & -.4698D-07, -.8151D-07, -.1414D-06, -.2450D-06, -.4241D-06, & + & -.7340D-06, -.1269D-05, -.2192D-05, -.3785D-05, -.6526D-05, & + & -.1124D-04, -.1934D-04, -.3325D-04, -.5704D-04, -.9777D-04, & + & -.1673D-03, -.2855D-03, -.4864D-03, -.8260D-03, -.1397D-02, & + & -.2351D-02, -.3930D-02, -.6508D-02, -.1064D-01, -.1710D-01, & + & -.2680D-01, -.4071D-01, -.5932D-01, -.8222D-01, -.1076D+00, & + & -.1325D+00, -.1533D+00, -.1673D+00, -.1729D+00, -.1704D+00, & + & -.1611D+00, -.1472D+00, -.1306D+00, -.1132D+00, -.9609D-01, & + & -.8020D-01, -.6610D-01, -.5373D-01, -.4325D-01, -.3448D-01, & + & -.2720D-01, -.2144D-01, -.1666D-01, -.1288D-01, -.9957D-02, & + & -.7611D-02, -.5847D-02, -.4372D-02, -.3339D-02, -.2601D-02, & + & -.1859D-02, -.1414D-02, -.1118D-02, -.8201D-03, -.5218D-03, & + & -.3729D-03, -.3737D-03, -.2243D-03, -.2246D-03, -.7488D-04, & + & -.7505D-04/ + + data (calcpts(j, 5), j = 1,neta) /-.9743D-09, -.1698D-08, & + & -.2958D-08, -.5147D-08, -.8956D-08, -.1557D-07, -.2705D-07, & + & -.4696D-07, -.8146D-07, -.1413D-06, -.2448D-06, -.4240D-06, & + & -.7335D-06, -.1268D-05, -.2191D-05, -.3781D-05, -.6522D-05, & + & -.1124D-04, -.1933D-04, -.3323D-04, -.5702D-04, -.9773D-04, & + & -.1672D-03, -.2855D-03, -.4862D-03, -.8256D-03, -.1396D-02, & + & -.2350D-02, -.3928D-02, -.6505D-02, -.1064D-01, -.1709D-01, & + & -.2679D-01, -.4069D-01, -.5930D-01, -.8219D-01, -.1076D+00, & + & -.1324D+00, -.1533D+00, -.1672D+00, -.1729D+00, -.1703D+00, & + & -.1611D+00, -.1472D+00, -.1306D+00, -.1132D+00, -.9609D-01, & + & -.8015D-01, -.6605D-01, -.5368D-01, -.4320D-01, -.3444D-01, & + & -.2730D-01, -.2140D-01, -.1661D-01, -.1298D-01, -.9909D-02, & + & -.7712D-02, -.5799D-02, -.4473D-02, -.3440D-02, -.2552D-02, & + & -.1960D-02, -.1365D-02, -.1069D-02, -.7713D-03, -.6230D-03, & + & -.4742D-03, -.3249D-03, -.1755D-03, -.1758D-03, -.1761D-03, & + & -.2626D-04/ + + data (calcpts(j, 6), j = 1,neta) /-.9735D-09, -.1697D-08, & + & -.2955D-08, -.5144D-08, -.8947D-08, -.1555D-07, -.2702D-07, & + & -.4691D-07, -.8139D-07, -.1411D-06, -.2447D-06, -.4236D-06, & + & -.7330D-06, -.1267D-05, -.2189D-05, -.3779D-05, -.6517D-05, & + & -.1123D-04, -.1932D-04, -.3320D-04, -.5697D-04, -.9766D-04, & + & -.1671D-03, -.2853D-03, -.4858D-03, -.8250D-03, -.1395D-02, & + & -.2348D-02, -.3925D-02, -.6501D-02, -.1063D-01, -.1708D-01, & + & -.2678D-01, -.4067D-01, -.5927D-01, -.8214D-01, -.1075D+00, & + & -.1324D+00, -.1532D+00, -.1672D+00, -.1728D+00, -.1703D+00, & + & -.1611D+00, -.1472D+00, -.1306D+00, -.1132D+00, -.9608D-01, & + & -.8023D-01, -.6598D-01, -.5361D-01, -.4313D-01, -.3436D-01, & + & -.2723D-01, -.2132D-01, -.1669D-01, -.1291D-01, -.9987D-02, & + & -.7641D-02, -.5877D-02, -.4402D-02, -.3369D-02, -.2480D-02, & + & -.1888D-02, -.1444D-02, -.1147D-02, -.8498D-03, -.5515D-03, & + & -.4026D-03, -.2534D-03, -.2540D-03, -.1043D-03, -.1046D-03, & + & -.1047D-03/ + + data (calcpts(j, 7), j = 1,neta) /-.9721D-09, -.1695D-08, & + & -.2951D-08, -.5137D-08, -.8936D-08, -.1553D-07, -.2698D-07, & + & -.4686D-07, -.8129D-07, -.1410D-06, -.2443D-06, -.4231D-06, & + & -.7321D-06, -.1266D-05, -.2187D-05, -.3774D-05, -.6510D-05, & + & -.1121D-04, -.1930D-04, -.3317D-04, -.5691D-04, -.9755D-04, & + & -.1669D-03, -.2849D-03, -.4853D-03, -.8241D-03, -.1394D-02, & + & -.2346D-02, -.3921D-02, -.6495D-02, -.1062D-01, -.1707D-01, & + & -.2676D-01, -.4064D-01, -.5922D-01, -.8209D-01, -.1075D+00, & + & -.1323D+00, -.1531D+00, -.1671D+00, -.1727D+00, -.1702D+00, & + & -.1610D+00, -.1471D+00, -.1306D+00, -.1131D+00, -.9606D-01, & + & -.8013D-01, -.6602D-01, -.5365D-01, -.4318D-01, -.3441D-01, & + & -.2727D-01, -.2137D-01, -.1674D-01, -.1295D-01, -.1003D-01, & + & -.7686D-02, -.5772D-02, -.4447D-02, -.3414D-02, -.2526D-02, & + & -.1933D-02, -.1489D-02, -.1042D-02, -.7449D-03, -.5966D-03, & + & -.4477D-03, -.2985D-03, -.5991D-03, -.1494D-03, -.1497D-03, & + & -.1498D-03/ + + data (calcpts(j, 8), j = 1,neta) /-.9703D-09, -.1691D-08, & + & -.2945D-08, -.5127D-08, -.8919D-08, -.1550D-07, -.2693D-07, & + & -.4678D-07, -.8114D-07, -.1407D-06, -.2438D-06, -.4223D-06, & + & -.7308D-06, -.1264D-05, -.2183D-05, -.3768D-05, -.6498D-05, & + & -.1119D-04, -.1926D-04, -.3311D-04, -.5682D-04, -.9739D-04, & + & -.1666D-03, -.2846D-03, -.4845D-03, -.8229D-03, -.1392D-02, & + & -.2342D-02, -.3917D-02, -.6486D-02, -.1061D-01, -.1705D-01, & + & -.2672D-01, -.4059D-01, -.5917D-01, -.8200D-01, -.1074D+00, & + & -.1322D+00, -.1530D+00, -.1670D+00, -.1726D+00, -.1702D+00, & + & -.1610D+00, -.1471D+00, -.1305D+00, -.1131D+00, -.9603D-01, & + & -.8013D-01, -.6602D-01, -.5365D-01, -.4318D-01, -.3441D-01, & + & -.2727D-01, -.2137D-01, -.1674D-01, -.1295D-01, -.1003D-01, & + & -.7682D-02, -.5768D-02, -.4443D-02, -.3410D-02, -.2522D-02, & + & -.1930D-02, -.1485D-02, -.1039D-02, -.7411D-03, -.5928D-03, & + & -.4439D-03, -.2947D-03, -.2952D-03, -.1456D-03, -.1459D-03, & + & -.1460D-03/ + + data (calcpts(j, 9), j = 1,neta) /-.9676D-09, -.1687D-08, & + & -.2937D-08, -.5112D-08, -.8895D-08, -.1546D-07, -.2687D-07, & + & -.4664D-07, -.8092D-07, -.1403D-06, -.2433D-06, -.4212D-06, & + & -.7289D-06, -.1260D-05, -.2177D-05, -.3759D-05, -.6482D-05, & + & -.1117D-04, -.1922D-04, -.3304D-04, -.5668D-04, -.9717D-04, & + & -.1663D-03, -.2839D-03, -.4836D-03, -.8212D-03, -.1389D-02, & + & -.2338D-02, -.3909D-02, -.6474D-02, -.1059D-01, -.1701D-01, & + & -.2668D-01, -.4052D-01, -.5907D-01, -.8188D-01, -.1072D+00, & + & -.1320D+00, -.1528D+00, -.1668D+00, -.1725D+00, -.1700D+00, & + & -.1608D+00, -.1470D+00, -.1304D+00, -.1130D+00, -.9599D-01, & + & -.8021D-01, -.6595D-01, -.5358D-01, -.4310D-01, -.3448D-01, & + & -.2719D-01, -.2129D-01, -.1666D-01, -.1288D-01, -.9954D-02, & + & -.7607D-02, -.5844D-02, -.4518D-02, -.3335D-02, -.2597D-02, & + & -.1855D-02, -.1410D-02, -.1114D-02, -.8161D-03, -.6677D-03, & + & -.3689D-03, -.3697D-03, -.2202D-03, -.2206D-03, -.7083D-04, & + & -.7100D-04/ + + data (calcpts(j,10), j = 1,neta) /-.9636D-09, -.1680D-08, & + & -.2925D-08, -.5093D-08, -.8858D-08, -.1540D-07, -.2675D-07, & + & -.4646D-07, -.8061D-07, -.1398D-06, -.2423D-06, -.4196D-06, & + & -.7262D-06, -.1256D-05, -.2169D-05, -.3745D-05, -.6458D-05, & + & -.1113D-04, -.1915D-04, -.3292D-04, -.5650D-04, -.9684D-04, & + & -.1657D-03, -.2829D-03, -.4819D-03, -.8185D-03, -.1384D-02, & + & -.2331D-02, -.3897D-02, -.6455D-02, -.1056D-01, -.1697D-01, & + & -.2661D-01, -.4042D-01, -.5892D-01, -.8169D-01, -.1070D+00, & + & -.1318D+00, -.1526D+00, -.1666D+00, -.1723D+00, -.1698D+00, & + & -.1607D+00, -.1468D+00, -.1304D+00, -.1130D+00, -.9592D-01, & + & -.8004D-01, -.6593D-01, -.5355D-01, -.4308D-01, -.3445D-01, & + & -.2717D-01, -.2141D-01, -.1663D-01, -.1285D-01, -.9924D-02, & + & -.7578D-02, -.5814D-02, -.4489D-02, -.3306D-02, -.2567D-02, & + & -.1975D-02, -.1380D-02, -.1084D-02, -.7864D-03, -.6381D-03, & + & -.4892D-03, -.3400D-03, -.1905D-03, -.1909D-03, -.1912D-03, & + & -.4133D-04/ + + data (calcpts(j,11), j = 1,neta) /-.9579D-09, -.1670D-08, & + & -.2909D-08, -.5063D-08, -.8807D-08, -.1531D-07, -.2660D-07, & + & -.4619D-07, -.8015D-07, -.1390D-06, -.2409D-06, -.4172D-06, & + & -.7221D-06, -.1249D-05, -.2157D-05, -.3724D-05, -.6425D-05, & + & -.1107D-04, -.1905D-04, -.3275D-04, -.5621D-04, -.9635D-04, & + & -.1649D-03, -.2816D-03, -.4796D-03, -.8148D-03, -.1378D-02, & + & -.2320D-02, -.3880D-02, -.6428D-02, -.1051D-01, -.1690D-01, & + & -.2650D-01, -.4027D-01, -.5871D-01, -.8143D-01, -.1067D+00, & + & -.1314D+00, -.1522D+00, -.1662D+00, -.1719D+00, -.1695D+00, & + & -.1604D+00, -.1467D+00, -.1302D+00, -.1128D+00, -.9583D-01, & + & -.8002D-01, -.6590D-01, -.5353D-01, -.4305D-01, -.3442D-01, & + & -.2714D-01, -.2138D-01, -.1660D-01, -.1296D-01, -.9893D-02, & + & -.7696D-02, -.5782D-02, -.4457D-02, -.3424D-02, -.2535D-02, & + & -.1943D-02, -.1498D-02, -.1052D-02, -.7544D-03, -.6061D-03, & + & -.4573D-03, -.3081D-03, -.3086D-03, -.1590D-03, -.1592D-03, & + & -.1594D-03/ + + data (calcpts(j,12), j = 1,neta) /-.9496D-09, -.1655D-08, & + & -.2882D-08, -.5018D-08, -.8732D-08, -.1518D-07, -.2638D-07, & + & -.4581D-07, -.7948D-07, -.1379D-06, -.2389D-06, -.4138D-06, & + & -.7163D-06, -.1239D-05, -.2140D-05, -.3695D-05, -.6374D-05, & + & -.1098D-04, -.1890D-04, -.3250D-04, -.5580D-04, -.9566D-04, & + & -.1637D-03, -.2796D-03, -.4764D-03, -.8092D-03, -.1369D-02, & + & -.2305D-02, -.3856D-02, -.6388D-02, -.1045D-01, -.1680D-01, & + & -.2635D-01, -.4005D-01, -.5842D-01, -.8104D-01, -.1062D+00, & + & -.1309D+00, -.1517D+00, -.1657D+00, -.1714D+00, -.1691D+00, & + & -.1601D+00, -.1464D+00, -.1300D+00, -.1127D+00, -.9571D-01, & + & -.7993D-01, -.6581D-01, -.5358D-01, -.4310D-01, -.3433D-01, & + & -.2719D-01, -.2128D-01, -.1665D-01, -.1286D-01, -.9941D-02, & + & -.7594D-02, -.5830D-02, -.4504D-02, -.3321D-02, -.2583D-02, & + & -.1841D-02, -.1396D-02, -.1099D-02, -.8019D-03, -.6536D-03, & + & -.5047D-03, -.3555D-03, -.2061D-03, -.2064D-03, -.5667D-04, & + & -.5683D-04/ + + data (calcpts(j,13), j = 1,neta) /-.9376D-09, -.1635D-08, & + & -.2848D-08, -.4956D-08, -.8623D-08, -.1499D-07, -.2605D-07, & + & -.4526D-07, -.7853D-07, -.1362D-06, -.2361D-06, -.4090D-06, & + & -.7079D-06, -.1224D-05, -.2116D-05, -.3653D-05, -.6303D-05, & + & -.1086D-04, -.1870D-04, -.3215D-04, -.5520D-04, -.9465D-04, & + & -.1620D-03, -.2768D-03, -.4716D-03, -.8013D-03, -.1356D-02, & + & -.2284D-02, -.3821D-02, -.6331D-02, -.1036D-01, -.1666D-01, & + & -.2614D-01, -.3974D-01, -.5798D-01, -.8048D-01, -.1055D+00, & + & -.1301D+00, -.1509D+00, -.1649D+00, -.1707D+00, -.1685D+00, & + & -.1596D+00, -.1460D+00, -.1297D+00, -.1124D+00, -.9551D-01, & + & -.7983D-01, -.6570D-01, -.5347D-01, -.4298D-01, -.3436D-01, & + & -.2707D-01, -.2131D-01, -.1668D-01, -.1289D-01, -.9969D-02, & + & -.7622D-02, -.5858D-02, -.4383D-02, -.3350D-02, -.2611D-02, & + & -.1869D-02, -.1424D-02, -.1128D-02, -.8301D-03, -.5318D-03, & + & -.3829D-03, -.3837D-03, -.2342D-03, -.2346D-03, -.8482D-04, & + & -.8498D-04/ + + data (calcpts(j,14), j = 1,neta) /-.9204D-09, -.1605D-08, & + & -.2795D-08, -.4866D-08, -.8469D-08, -.1473D-07, -.2560D-07, & + & -.4445D-07, -.7715D-07, -.1338D-06, -.2320D-06, -.4019D-06, & + & -.6958D-06, -.1204D-05, -.2080D-05, -.3592D-05, -.6199D-05, & + & -.1068D-04, -.1840D-04, -.3164D-04, -.5435D-04, -.9320D-04, & + & -.1596D-03, -.2727D-03, -.4649D-03, -.7900D-03, -.1337D-02, & + & -.2253D-02, -.3769D-02, -.6250D-02, -.1023D-01, -.1646D-01, & + & -.2583D-01, -.3929D-01, -.5737D-01, -.7968D-01, -.1046D+00, & + & -.1291D+00, -.1497D+00, -.1638D+00, -.1697D+00, -.1676D+00, & + & -.1588D+00, -.1454D+00, -.1292D+00, -.1121D+00, -.9525D-01, & + & -.7958D-01, -.6559D-01, -.5335D-01, -.4286D-01, -.3424D-01, & + & -.2709D-01, -.2133D-01, -.1655D-01, -.1291D-01, -.9990D-02, & + & -.7643D-02, -.5878D-02, -.4403D-02, -.3369D-02, -.2481D-02, & + & -.1889D-02, -.1444D-02, -.9974D-03, -.8498D-03, -.5515D-03, & + & -.4026D-03, -.2534D-03, -.2539D-03, -.1043D-03, -.1045D-03, & + & -.1047D-03/ + + data (calcpts(j,15), j = 1,neta) /-.8962D-09, -.1563D-08, & + & -.2722D-08, -.4740D-08, -.8250D-08, -.1435D-07, -.2495D-07, & + & -.4333D-07, -.7521D-07, -.1305D-06, -.2262D-06, -.3921D-06, & + & -.6789D-06, -.1175D-05, -.2030D-05, -.3508D-05, -.6055D-05, & + & -.1044D-04, -.1798D-04, -.3094D-04, -.5313D-04, -.9118D-04, & + & -.1562D-03, -.2669D-03, -.4551D-03, -.7740D-03, -.1311D-02, & + & -.2209D-02, -.3699D-02, -.6135D-02, -.1005D-01, -.1617D-01, & + & -.2540D-01, -.3866D-01, -.5649D-01, -.7854D-01, -.1032D+00, & + & -.1275D+00, -.1481D+00, -.1622D+00, -.1683D+00, -.1663D+00, & + & -.1578D+00, -.1445D+00, -.1285D+00, -.1115D+00, -.9485D-01, & + & -.7930D-01, -.6530D-01, -.5320D-01, -.4285D-01, -.3422D-01, & + & -.2707D-01, -.2116D-01, -.1653D-01, -.1289D-01, -.9964D-02, & + & -.7616D-02, -.5851D-02, -.4375D-02, -.3342D-02, -.2603D-02, & + & -.1861D-02, -.1416D-02, -.1120D-02, -.8220D-03, -.5236D-03, & + & -.3747D-03, -.3755D-03, -.2260D-03, -.2264D-03, -.7662D-04, & + & -.7679D-04/ + + data (calcpts(j,16), j = 1,neta) /-.8625D-09, -.1504D-08, & + & -.2621D-08, -.4566D-08, -.7948D-08, -.1382D-07, -.2404D-07, & + & -.4176D-07, -.7252D-07, -.1259D-06, -.2183D-06, -.3784D-06, & + & -.6554D-06, -.1134D-05, -.1961D-05, -.3389D-05, -.5854D-05, & + & -.1010D-04, -.1740D-04, -.2994D-04, -.5146D-04, -.8834D-04, & + & -.1514D-03, -.2589D-03, -.4418D-03, -.7518D-03, -.1274D-02, & + & -.2149D-02, -.3600D-02, -.5975D-02, -.9793D-02, -.1577D-01, & + & -.2479D-01, -.3777D-01, -.5526D-01, -.7694D-01, -.1012D+00, & + & -.1253D+00, -.1458D+00, -.1599D+00, -.1662D+00, -.1645D+00, & + & -.1563D+00, -.1433D+00, -.1275D+00, -.1108D+00, -.9428D-01, & + & -.7886D-01, -.6500D-01, -.5289D-01, -.4268D-01, -.3404D-01, & + & -.2689D-01, -.2113D-01, -.1649D-01, -.1285D-01, -.9927D-02, & + & -.7578D-02, -.5813D-02, -.4487D-02, -.3303D-02, -.2564D-02, & + & -.1972D-02, -.1377D-02, -.1080D-02, -.7829D-03, -.6345D-03, & + & -.4856D-03, -.3363D-03, -.1869D-03, -.1872D-03, -.1874D-03, & + & -.3761D-04/ + + data (calcpts(j,17), j = 1,neta) /-.8172D-09, -.1426D-08, & + & -.2485D-08, -.4329D-08, -.7537D-08, -.1312D-07, -.2281D-07, & + & -.3965D-07, -.6887D-07, -.1196D-06, -.2075D-06, -.3598D-06, & + & -.6235D-06, -.1080D-05, -.1868D-05, -.3230D-05, -.5580D-05, & + & -.9629D-05, -.1660D-04, -.2859D-04, -.4918D-04, -.8450D-04, & + & -.1449D-03, -.2481D-03, -.4236D-03, -.7215D-03, -.1224D-02, & + & -.2066D-02, -.3465D-02, -.5756D-02, -.9444D-02, -.1523D-01, & + & -.2397D-01, -.3657D-01, -.5358D-01, -.7474D-01, -.9852D-01, & + & -.1222D+00, -.1426D+00, -.1568D+00, -.1633D+00, -.1619D+00, & + & -.1541D+00, -.1415D+00, -.1261D+00, -.1097D+00, -.9348D-01, & + & -.7826D-01, -.6453D-01, -.5255D-01, -.4248D-01, -.3383D-01, & + & -.2682D-01, -.2105D-01, -.1641D-01, -.1277D-01, -.9846D-02, & + & -.7497D-02, -.5731D-02, -.4404D-02, -.3370D-02, -.2481D-02, & + & -.1889D-02, -.1444D-02, -.9970D-03, -.8494D-03, -.5510D-03, & + & -.4021D-03, -.2528D-03, -.2533D-03, -.1037D-03, -.1039D-03, & + & -.1040D-03/ + + data (calcpts(j,18), j = 1,neta) /-.7578D-09, -.1323D-08, & + & -.2305D-08, -.4019D-08, -.7001D-08, -.1219D-07, -.2121D-07, & + & -.3688D-07, -.6411D-07, -.1114D-06, -.1933D-06, -.3355D-06, & + & -.5817D-06, -.1008D-05, -.1745D-05, -.3020D-05, -.5221D-05, & + & -.9018D-05, -.1556D-04, -.2683D-04, -.4618D-04, -.7943D-04, & + & -.1364D-03, -.2337D-03, -.3996D-03, -.6815D-03, -.1157D-02, & + & -.1957D-02, -.3286D-02, -.5468D-02, -.8983D-02, -.1451D-01, & + & -.2287D-01, -.3496D-01, -.5134D-01, -.7178D-01, -.9490D-01, & + & -.1181D+00, -.1382D+00, -.1524D+00, -.1592D+00, -.1584D+00, & + & -.1511D+00, -.1391D+00, -.1242D+00, -.1082D+00, -.9234D-01, & + & -.7741D-01, -.6394D-01, -.5208D-01, -.4199D-01, -.3363D-01, & + & -.2661D-01, -.2099D-01, -.1634D-01, -.1270D-01, -.9773D-02, & + & -.7572D-02, -.5805D-02, -.4328D-02, -.3294D-02, -.2554D-02, & + & -.1961D-02, -.1366D-02, -.1070D-02, -.7719D-03, -.6235D-03, & + & -.4745D-03, -.3253D-03, -.1758D-03, -.1761D-03, -.1763D-03, & + & -.2648D-04/ + + data (calcpts(j,19), j = 1,neta) /-.6837D-09, -.1194D-08, & + & -.2083D-08, -.3632D-08, -.6331D-08, -.1103D-07, -.1920D-07, & + & -.3342D-07, -.5811D-07, -.1010D-06, -.1756D-06, -.3049D-06, & + & -.5291D-06, -.9180D-06, -.1591D-05, -.2756D-05, -.4770D-05, & + & -.8247D-05, -.1425D-04, -.2460D-04, -.4242D-04, -.7304D-04, & + & -.1256D-03, -.2156D-03, -.3694D-03, -.6310D-03, -.1073D-02, & + & -.1818D-02, -.3060D-02, -.5101D-02, -.8399D-02, -.1359D-01, & + & -.2148D-01, -.3290D-01, -.4845D-01, -.6795D-01, -.9016D-01, & + & -.1126D+00, -.1323D+00, -.1466D+00, -.1537D+00, -.1536D+00, & + & -.1470D+00, -.1357D+00, -.1216D+00, -.1062D+00, -.9079D-01, & + & -.7624D-01, -.6307D-01, -.5150D-01, -.4153D-01, -.3330D-01, & + & -.2642D-01, -.2079D-01, -.1629D-01, -.1264D-01, -.9713D-02, & + & -.7510D-02, -.5743D-02, -.4415D-02, -.3380D-02, -.2490D-02, & + & -.1897D-02, -.1452D-02, -.1005D-02, -.8569D-03, -.5584D-03, & + & -.4095D-03, -.2602D-03, -.2606D-03, -.1110D-03, -.1112D-03, & + & -.1113D-03/ + + data (calcpts(j,20), j = 1,neta) /-.5962D-09, -.1042D-08, & + & -.1819D-08, -.3174D-08, -.5539D-08, -.9657D-08, -.1683D-07, & + & -.2932D-07, -.5105D-07, -.8884D-07, -.1546D-06, -.2687D-06, & + & -.4670D-06, -.8111D-06, -.1407D-05, -.2442D-05, -.4233D-05, & + & -.7332D-05, -.1269D-04, -.2195D-04, -.3790D-04, -.6541D-04, & + & -.1127D-03, -.1939D-03, -.3329D-03, -.5701D-03, -.9723D-03, & + & -.1651D-02, -.2786D-02, -.4658D-02, -.7690D-02, -.1248D-01, & + & -.1977D-01, -.3039D-01, -.4490D-01, -.6321D-01, -.8422D-01, & + & -.1057D+00, -.1249D+00, -.1390D+00, -.1466D+00, -.1472D+00, & + & -.1416D+00, -.1313D+00, -.1180D+00, -.1034D+00, -.8867D-01, & + & -.7465D-01, -.6189D-01, -.5070D-01, -.4100D-01, -.3275D-01, & + & -.2600D-01, -.2051D-01, -.1600D-01, -.1250D-01, -.9717D-02, & + & -.7362D-02, -.5743D-02, -.4264D-02, -.3228D-02, -.2488D-02, & + & -.1894D-02, -.1449D-02, -.1002D-02, -.8541D-03, -.5555D-03, & + & -.4065D-03, -.2571D-03, -.2576D-03, -.1079D-03, -.1081D-03, & + & -.1082D-03/ + + data (calcpts(j,21), j = 1,neta) /-.5001D-09, -.8748D-09, & + & -.1529D-08, -.2673D-08, -.4668D-08, -.8149D-08, -.1422D-07, & + & -.2481D-07, -.4325D-07, -.7538D-07, -.1314D-06, -.2288D-06, & + & -.3982D-06, -.6928D-06, -.1205D-05, -.2093D-05, -.3636D-05, & + & -.6313D-05, -.1095D-04, -.1898D-04, -.3286D-04, -.5686D-04, & + & -.9827D-04, -.1695D-03, -.2919D-03, -.5014D-03, -.8579D-03, & + & -.1462D-02, -.2475D-02, -.4152D-02, -.6880D-02, -.1120D-01, & + & -.1781D-01, -.2748D-01, -.4076D-01, -.5762D-01, -.7714D-01, & + & -.9737D-01, -.1157D+00, -.1297D+00, -.1376D+00, -.1391D+00, & + & -.1346D+00, -.1255D+00, -.1134D+00, -.9984D-01, -.8594D-01, & + & -.7260D-01, -.6036D-01, -.4950D-01, -.4014D-01, -.3222D-01, & + & -.2560D-01, -.2025D-01, -.1588D-01, -.1237D-01, -.9580D-02, & + & -.7372D-02, -.5601D-02, -.4271D-02, -.3234D-02, -.2493D-02, & + & -.1899D-02, -.1453D-02, -.1006D-02, -.8581D-03, -.5595D-03, & + & -.4104D-03, -.2610D-03, -.2614D-03, -.1117D-03, -.1119D-03, & + & -.1120D-03/ + + data (calcpts(j,22), j = 1,neta) /-.4031D-09, -.7061D-09, & + & -.1236D-08, -.2163D-08, -.3785D-08, -.6618D-08, -.1157D-07, & + & -.2022D-07, -.3532D-07, -.6168D-07, -.1077D-06, -.1879D-06, & + & -.3279D-06, -.5717D-06, -.9962D-06, -.1736D-05, -.3023D-05, & + & -.5262D-05, -.9154D-05, -.1592D-04, -.2764D-04, -.4797D-04, & + & -.8319D-04, -.1440D-03, -.2489D-03, -.4291D-03, -.7372D-03, & + & -.1261D-02, -.2144D-02, -.3612D-02, -.6008D-02, -.9826D-02, & + & -.1569D-01, -.2430D-01, -.3619D-01, -.5140D-01, -.6916D-01, & + & -.8779D-01, -.1050D+00, -.1185D+00, -.1268D+00, -.1292D+00, & + & -.1260D+00, -.1184D+00, -.1077D+00, -.9531D-01, -.8244D-01, & + & -.6995D-01, -.5838D-01, -.4804D-01, -.3906D-01, -.3142D-01, & + & -.2505D-01, -.1975D-01, -.1552D-01, -.1215D-01, -.9361D-02, & + & -.7300D-02, -.5526D-02, -.4194D-02, -.3156D-02, -.2415D-02, & + & -.1820D-02, -.1374D-02, -.1077D-02, -.7786D-03, -.6298D-03, & + & -.4806D-03, -.3312D-03, -.1816D-03, -.1818D-03, -.1820D-03, & + & -.3212D-04/ + + data (calcpts(j,23), j = 1,neta) /-.3134D-09, -.5500D-09, & + & -.9646D-09, -.1691D-08, -.2965D-08, -.5197D-08, -.9103D-08, & + & -.1595D-07, -.2791D-07, -.4887D-07, -.8554D-07, -.1496D-06, & + & -.2617D-06, -.4577D-06, -.7999D-06, -.1398D-05, -.2442D-05, & + & -.4264D-05, -.7442D-05, -.1298D-04, -.2263D-04, -.3942D-04, & + & -.6863D-04, -.1193D-03, -.2070D-03, -.3584D-03, -.6184D-03, & + & -.1063D-02, -.1815D-02, -.3071D-02, -.5132D-02, -.8431D-02, & + & -.1352D-01, -.2103D-01, -.3146D-01, -.4487D-01, -.6066D-01, & + & -.7742D-01, -.9319D-01, -.1060D+00, -.1144D+00, -.1176D+00, & + & -.1158D+00, -.1098D+00, -.1007D+00, -.8980D-01, -.7819D-01, & + & -.6671D-01, -.5595D-01, -.4624D-01, -.3773D-01, -.3045D-01, & + & -.2434D-01, -.1928D-01, -.1516D-01, -.1184D-01, -.9195D-02, & + & -.7100D-02, -.5428D-02, -.4094D-02, -.3205D-02, -.2463D-02, & + & -.1868D-02, -.1421D-02, -.9738D-03, -.8254D-03, -.5265D-03, & + & -.3772D-03, -.3777D-03, -.2281D-03, -.2283D-03, -.7849D-04, & + & -.7860D-04/ + + data (calcpts(j,24), j = 1,neta) /-.2374D-09, -.4175D-09, & + & -.7336D-09, -.1290D-08, -.2266D-08, -.3981D-08, -.6991D-08, & + & -.1228D-07, -.2155D-07, -.3782D-07, -.6639D-07, -.1165D-06, & + & -.2044D-06, -.3585D-06, -.6283D-06, -.1102D-05, -.1931D-05, & + & -.3384D-05, -.5927D-05, -.1038D-04, -.1816D-04, -.3176D-04, & + & -.5551D-04, -.9690D-04, -.1689D-03, -.2937D-03, -.5089D-03, & + & -.8786D-03, -.1507D-02, -.2562D-02, -.4301D-02, -.7096D-02, & + & -.1143D-01, -.1785D-01, -.2680D-01, -.3838D-01, -.5210D-01, & + & -.6683D-01, -.8092D-01, -.9276D-01, -.1010D+00, -.1049D+00, & + & -.1044D+00, -.1000D+00, -.9264D-01, -.8337D-01, -.7319D-01, & + & -.6290D-01, -.5307D-01, -.4410D-01, -.3615D-01, -.2930D-01, & + & -.2349D-01, -.1868D-01, -.1473D-01, -.1154D-01, -.8972D-02, & + & -.6932D-02, -.5333D-02, -.4087D-02, -.3106D-02, -.2363D-02, & + & -.1782D-02, -.1350D-02, -.1007D-02, -.7538D-03, -.5598D-03, & + & -.4254D-03, -.3059D-03, -.2312D-03, -.1714D-03, -.1265D-03, & + & -.9662D-04/ + + data (calcpts(j,25), j = 1,neta) /-.1774D-09, -.3127D-09, & + & -.5509D-09, -.9707D-09, -.1710D-08, -.3011D-08, -.5303D-08, & + & -.9337D-08, -.1643D-07, -.2893D-07, -.5093D-07, -.8963D-07, & + & -.1577D-06, -.2775D-06, -.4880D-06, -.8585D-06, -.1510D-05, & + & -.2655D-05, -.4667D-05, -.8202D-05, -.1440D-04, -.2529D-04, & + & -.4437D-04, -.7774D-04, -.1360D-03, -.2376D-03, -.4134D-03, & + & -.7165D-03, -.1234D-02, -.2107D-02, -.3550D-02, -.5880D-02, & + & -.9503D-02, -.1489D-01, -.2243D-01, -.3223D-01, -.4391D-01, & + & -.5654D-01, -.6882D-01, -.7940D-01, -.8719D-01, -.9148D-01, & + & -.9209D-01, -.8928D-01, -.8370D-01, -.7615D-01, -.6751D-01, & + & -.5853D-01, -.4976D-01, -.4162D-01, -.3432D-01, -.2795D-01, & + & -.2252D-01, -.1797D-01, -.1421D-01, -.1116D-01, -.8697D-02, & + & -.6743D-02, -.5201D-02, -.3983D-02, -.3046D-02, -.2317D-02, & + & -.1751D-02, -.1318D-02, -.9900D-03, -.7512D-03, -.5570D-03, & + & -.4076D-03, -.3029D-03, -.2282D-03, -.1684D-03, -.1235D-03, & + & -.9358D-04/ + + data (calcpts(j,26), j = 1,neta) /-.1325D-09, -.2341D-09, & + & -.4132D-09, -.7299D-09, -.1289D-08, -.2275D-08, -.4017D-08, & + & -.7092D-08, -.1251D-07, -.2209D-07, -.3899D-07, -.6881D-07, & + & -.1214D-06, -.2143D-06, -.3779D-06, -.6668D-06, -.1176D-05, & + & -.2075D-05, -.3658D-05, -.6450D-05, -.1136D-04, -.2001D-04, & + & -.3524D-04, -.6195D-04, -.1088D-03, -.1906D-03, -.3328D-03, & + & -.5788D-03, -.1000D-02, -.1713D-02, -.2896D-02, -.4811D-02, & + & -.7796D-02, -.1225D-01, -.1850D-01, -.2664D-01, -.3638D-01, & + & -.4699D-01, -.5742D-01, -.6661D-01, -.7368D-01, -.7806D-01, & + & -.7950D-01, -.7808D-01, -.7415D-01, -.6833D-01, -.6128D-01, & + & -.5369D-01, -.4608D-01, -.3885D-01, -.3225D-01, -.2642D-01, & + & -.2140D-01, -.1715D-01, -.1363D-01, -.1074D-01, -.8402D-02, & + & -.6534D-02, -.5034D-02, -.3874D-02, -.2966D-02, -.2251D-02, & + & -.1714D-02, -.1281D-02, -.9678D-03, -.7288D-03, -.5345D-03, & + & -.4000D-03, -.2953D-03, -.2205D-03, -.1606D-03, -.1157D-03, & + & -.8582D-04/ + + data (calcpts(j,27), j = 1,neta) /-.9971D-10, -.1765D-09, & + & -.3122D-09, -.5525D-09, -.9778D-09, -.1730D-08, -.3060D-08, & + & -.5415D-08, -.9575D-08, -.1694D-07, -.2997D-07, -.5302D-07, & + & -.9377D-07, -.1659D-06, -.2933D-06, -.5187D-06, -.9174D-06, & + & -.1622D-05, -.2867D-05, -.5068D-05, -.8950D-05, -.1581D-04, & + & -.2790D-04, -.4919D-04, -.8659D-04, -.1521D-03, -.2663D-03, & + & -.4644D-03, -.8047D-03, -.1381D-02, -.2340D-02, -.3896D-02, & + & -.6326D-02, -.9956D-02, -.1506D-01, -.2172D-01, -.2972D-01, & + & -.3847D-01, -.4714D-01, -.5491D-01, -.6110D-01, -.6527D-01, & + & -.6720D-01, -.6685D-01, -.6439D-01, -.6017D-01, -.5472D-01, & + & -.4851D-01, -.4210D-01, -.3585D-01, -.3001D-01, -.2477D-01, & + & -.2020D-01, -.1628D-01, -.1299D-01, -.1028D-01, -.8074D-02, & + & -.6307D-02, -.4880D-02, -.3763D-02, -.2884D-02, -.2213D-02, & + & -.1675D-02, -.1272D-02, -.9585D-03, -.7193D-03, -.5399D-03, & + & -.4053D-03, -.3006D-03, -.2257D-03, -.1659D-03, -.1359D-03, & + & -.9100D-04/ + + data (calcpts(j,28), j = 1,neta) /-.7575D-10, -.1343D-09, & + & -.2379D-09, -.4217D-09, -.7476D-09, -.1325D-08, -.2348D-08, & + & -.4161D-08, -.7371D-08, -.1306D-07, -.2316D-07, -.4103D-07, & + & -.7270D-07, -.1288D-06, -.2282D-06, -.4043D-06, -.7165D-06, & + & -.1269D-05, -.2247D-05, -.3980D-05, -.7042D-05, -.1246D-04, & + & -.2204D-04, -.3892D-04, -.6865D-04, -.1208D-03, -.2119D-03, & + & -.3702D-03, -.6426D-03, -.1105D-02, -.1875D-02, -.3125D-02, & + & -.5081D-02, -.8007D-02, -.1212D-01, -.1750D-01, -.2397D-01, & + & -.3107D-01, -.3814D-01, -.4455D-01, -.4980D-01, -.5355D-01, & + & -.5564D-01, -.5603D-01, -.5474D-01, -.5193D-01, -.4793D-01, & + & -.4311D-01, -.3787D-01, -.3262D-01, -.2758D-01, -.2296D-01, & + & -.1886D-01, -.1530D-01, -.1228D-01, -.9767D-02, -.7703D-02, & + & -.6038D-02, -.4698D-02, -.3625D-02, -.2790D-02, -.2133D-02, & + & -.1625D-02, -.1236D-02, -.9374D-03, -.6981D-03, -.5336D-03, & + & -.3989D-03, -.2941D-03, -.2192D-03, -.1593D-03, -.1294D-03, & + & -.8445D-04/ + + data (calcpts(j,29), j = 1,neta) /-.5802D-10, -.1030D-09, & + & -.1826D-09, -.3241D-09, -.5753D-09, -.1021D-08, -.1811D-08, & + & -.3214D-08, -.5700D-08, -.1011D-07, -.1795D-07, -.3184D-07, & + & -.5649D-07, -.1002D-06, -.1778D-06, -.3154D-06, -.5596D-06, & + & -.9924D-06, -.1760D-05, -.3121D-05, -.5529D-05, -.9797D-05, & + & -.1735D-04, -.3068D-04, -.5418D-04, -.9549D-04, -.1677D-03, & + & -.2933D-03, -.5096D-03, -.8771D-03, -.1490D-02, -.2486D-02, & + & -.4045D-02, -.6378D-02, -.9662D-02, -.1396D-01, -.1912D-01, & + & -.2480D-01, -.3048D-01, -.3568D-01, -.4000D-01, -.4322D-01, & + & -.4524D-01, -.4603D-01, -.4556D-01, -.4389D-01, -.4116D-01, & + & -.3760D-01, -.3353D-01, -.2925D-01, -.2502D-01, -.2105D-01, & + & -.1744D-01, -.1425D-01, -.1151D-01, -.9213D-02, -.7295D-02, & + & -.5747D-02, -.4480D-02, -.3481D-02, -.2674D-02, -.2047D-02, & + & -.1569D-02, -.1195D-02, -.8956D-03, -.6712D-03, -.5065D-03, & + & -.3868D-03, -.2820D-03, -.2071D-03, -.1622D-03, -.1172D-03, & + & -.8727D-04/ + + data (calcpts(j,30), j = 1,neta) /-.4465D-10, -.7931D-10, & + & -.1408D-09, -.2500D-09, -.4441D-09, -.7886D-09, -.1400D-08, & + & -.2487D-08, -.4415D-08, -.7840D-08, -.1393D-07, -.2473D-07, & + & -.4390D-07, -.7797D-07, -.1384D-06, -.2457D-06, -.4364D-06, & + & -.7745D-06, -.1375D-05, -.2440D-05, -.4326D-05, -.7672D-05, & + & -.1360D-04, -.2406D-04, -.4253D-04, -.7503D-04, -.1318D-03, & + & -.2308D-03, -.4013D-03, -.6912D-03, -.1175D-02, -.1961D-02, & + & -.3193D-02, -.5037D-02, -.7633D-02, -.1103D-01, -.1511D-01, & + & -.1961D-01, -.2411D-01, -.2825D-01, -.3174D-01, -.3441D-01, & + & -.3622D-01, -.3714D-01, -.3718D-01, -.3633D-01, -.3462D-01, & + & -.3216D-01, -.2915D-01, -.2581D-01, -.2237D-01, -.1905D-01, & + & -.1595D-01, -.1315D-01, -.1071D-01, -.8630D-02, -.6874D-02, & + & -.5443D-02, -.4264D-02, -.3324D-02, -.2577D-02, -.1979D-02, & + & -.1515D-02, -.1156D-02, -.8717D-03, -.6621D-03, -.4974D-03, & + & -.3776D-03, -.2728D-03, -.2129D-03, -.1529D-03, -.1080D-03, & + & -.7802D-04/ + + data (calcpts(j,31), j = 1,neta) /-.3440D-10, -.6113D-10, & + & -.1086D-09, -.1929D-09, -.3429D-09, -.6091D-09, -.1082D-08, & + & -.1923D-08, -.3415D-08, -.6069D-08, -.1078D-07, -.1916D-07, & + & -.3404D-07, -.6048D-07, -.1074D-06, -.1908D-06, -.3390D-06, & + & -.6021D-06, -.1069D-05, -.1899D-05, -.3368D-05, -.5977D-05, & + & -.1060D-04, -.1877D-04, -.3319D-04, -.5857D-04, -.1030D-03, & + & -.1803D-03, -.3138D-03, -.5406D-03, -.9193D-03, -.1535D-02, & + & -.2500D-02, -.3944D-02, -.5979D-02, -.8639D-02, -.1184D-01, & + & -.1536D-01, -.1890D-01, -.2216D-01, -.2492D-01, -.2709D-01, & + & -.2861D-01, -.2951D-01, -.2980D-01, -.2947D-01, -.2851D-01, & + & -.2694D-01, -.2485D-01, -.2238D-01, -.1970D-01, -.1700D-01, & + & -.1440D-01, -.1200D-01, -.9863D-02, -.8004D-02, -.6424D-02, & + & -.5112D-02, -.4037D-02, -.3155D-02, -.2453D-02, -.1899D-02, & + & -.1450D-02, -.1106D-02, -.8366D-03, -.6419D-03, -.4772D-03, & + & -.3573D-03, -.2674D-03, -.2075D-03, -.1476D-03, -.1176D-03, & + & -.8762D-04/ + + data (calcpts(j,32), j = 1,neta) /-.2646D-10, -.4703D-10, & + & -.8355D-10, -.1485D-09, -.2640D-09, -.4692D-09, -.8339D-09, & + & -.1482D-08, -.2633D-08, -.4681D-08, -.8322D-08, -.1479D-07, & + & -.2628D-07, -.4672D-07, -.8298D-07, -.1475D-06, -.2621D-06, & + & -.4657D-06, -.8273D-06, -.1470D-05, -.2608D-05, -.4629D-05, & + & -.8211D-05, -.1455D-04, -.2573D-04, -.4543D-04, -.7989D-04, & + & -.1399D-03, -.2436D-03, -.4197D-03, -.7140D-03, -.1193D-02, & + & -.1942D-02, -.3065D-02, -.4646D-02, -.6713D-02, -.9201D-02, & + & -.1194D-01, -.1469D-01, -.1723D-01, -.1939D-01, -.2111D-01, & + & -.2235D-01, -.2315D-01, -.2353D-01, -.2348D-01, -.2301D-01, & + & -.2209D-01, -.2074D-01, -.1901D-01, -.1703D-01, -.1492D-01, & + & -.1282D-01, -.1082D-01, -.8980D-02, -.7357D-02, -.5955D-02, & + & -.4776D-02, -.3775D-02, -.2968D-02, -.2325D-02, -.1801D-02, & + & -.1382D-02, -.1067D-02, -.8126D-03, -.6178D-03, -.4680D-03, & + & -.3481D-03, -.2582D-03, -.1983D-03, -.1383D-03, -.1083D-03, & + & -.7837D-04/ + + data (calcpts(j,33), j = 1,neta) /-.2028D-10, -.3607D-10, & + & -.6408D-10, -.1139D-09, -.2026D-09, -.3601D-09, -.6402D-09, & + & -.1138D-08, -.2022D-08, -.3596D-08, -.6394D-08, -.1136D-07, & + & -.2020D-07, -.3592D-07, -.6381D-07, -.1134D-06, -.2017D-06, & + & -.3583D-06, -.6367D-06, -.1131D-05, -.2008D-05, -.3565D-05, & + & -.6325D-05, -.1121D-04, -.1983D-04, -.3501D-04, -.6158D-04, & + & -.1079D-03, -.1878D-03, -.3237D-03, -.5507D-03, -.9200D-03, & + & -.1498D-02, -.2365D-02, -.3585D-02, -.5180D-02, -.7100D-02, & + & -.9213D-02, -.1133D-01, -.1330D-01, -.1497D-01, -.1631D-01, & + & -.1731D-01, -.1798D-01, -.1835D-01, -.1844D-01, -.1825D-01, & + & -.1776D-01, -.1695D-01, -.1583D-01, -.1444D-01, -.1288D-01, & + & -.1124D-01, -.9618D-02, -.8088D-02, -.6698D-02, -.5473D-02, & + & -.4416D-02, -.3534D-02, -.2801D-02, -.2187D-02, -.1708D-02, & + & -.1319D-02, -.1019D-02, -.7796D-03, -.5998D-03, -.4500D-03, & + & -.3451D-03, -.2551D-03, -.1952D-03, -.1502D-03, -.1052D-03, & + & -.7526D-04/ + + data (calcpts(j,34), j = 1,neta) /-.1548D-10, -.2753D-10, & + & -.4892D-10, -.8700D-10, -.1547D-09, -.2750D-09, -.4890D-09, & + & -.8695D-09, -.1545D-08, -.2748D-08, -.4886D-08, -.8686D-08, & + & -.1544D-07, -.2746D-07, -.4879D-07, -.8674D-07, -.1542D-06, & + & -.2741D-06, -.4870D-06, -.8655D-06, -.1536D-05, -.2728D-05, & + & -.4841D-05, -.8578D-05, -.1518D-04, -.2680D-04, -.4715D-04, & + & -.8263D-04, -.1438D-03, -.2480D-03, -.4219D-03, -.7048D-03, & + & -.1148D-02, -.1812D-02, -.2747D-02, -.3969D-02, -.5440D-02, & + & -.7059D-02, -.8685D-02, -.1019D-01, -.1148D-01, -.1251D-01, & + & -.1329D-01, -.1383D-01, -.1416D-01, -.1430D-01, -.1425D-01, & + & -.1401D-01, -.1356D-01, -.1289D-01, -.1198D-01, -.1089D-01, & + & -.9674D-02, -.8414D-02, -.7176D-02, -.6017D-02, -.4969D-02, & + & -.4050D-02, -.3261D-02, -.2598D-02, -.2052D-02, -.1607D-02, & + & -.1251D-02, -.9661D-03, -.7414D-03, -.5675D-03, -.4311D-03, & + & -.3217D-03, -.2468D-03, -.1868D-03, -.1418D-03, -.9683D-04, & + & -.8184D-04/ + + data (calcpts(j,35), j = 1,neta) /-.1176D-10, -.2091D-10, & + & -.3717D-10, -.6610D-10, -.1176D-09, -.2090D-09, -.3716D-09, & + & -.6608D-09, -.1174D-08, -.2089D-08, -.3714D-08, -.6603D-08, & + & -.1174D-07, -.2088D-07, -.3710D-07, -.6597D-07, -.1173D-06, & + & -.2085D-06, -.3705D-06, -.6584D-06, -.1169D-05, -.2076D-05, & + & -.3683D-05, -.6527D-05, -.1155D-04, -.2040D-04, -.3589D-04, & + & -.6290D-04, -.1095D-03, -.1888D-03, -.3212D-03, -.5366D-03, & + & -.8741D-03, -.1379D-02, -.2091D-02, -.3022D-02, -.4142D-02, & + & -.5375D-02, -.6612D-02, -.7758D-02, -.8741D-02, -.9532D-02, & + & -.1013D-01, -.1056D-01, -.1084D-01, -.1098D-01, -.1100D-01, & + & -.1090D-01, -.1066D-01, -.1028D-01, -.9728D-02, -.9012D-02, & + & -.8163D-02, -.7228D-02, -.6268D-02, -.5330D-02, -.4457D-02, & + & -.3671D-02, -.2984D-02, -.2398D-02, -.1906D-02, -.1503D-02, & + & -.1175D-02, -.9116D-03, -.7033D-03, -.5384D-03, -.4110D-03, & + & -.3120D-03, -.2356D-03, -.1771D-03, -.1321D-03, -.9912D-04, & + & -.7362D-04/ + + data (calcpts(j,36), j = 1,neta) /-.8892D-11, -.1581D-10, & + & -.2811D-10, -.4998D-10, -.8890D-10, -.1581D-09, -.2810D-09, & + & -.4998D-09, -.8883D-09, -.1580D-08, -.2810D-08, -.4996D-08, & + & -.8882D-08, -.1580D-07, -.2807D-07, -.4991D-07, -.8876D-07, & + & -.1578D-06, -.2804D-06, -.4983D-06, -.8847D-06, -.1571D-05, & + & -.2788D-05, -.4941D-05, -.8744D-05, -.1544D-04, -.2717D-04, & + & -.4762D-04, -.8290D-04, -.1429D-03, -.2432D-03, -.4063D-03, & + & -.6619D-03, -.1045D-02, -.1584D-02, -.2288D-02, -.3136D-02, & + & -.4070D-02, -.5007D-02, -.5874D-02, -.6620D-02, -.7220D-02, & + & -.7678D-02, -.8011D-02, -.8234D-02, -.8364D-02, -.8411D-02, & + & -.8378D-02, -.8261D-02, -.8053D-02, -.7736D-02, -.7299D-02, & + & -.6743D-02, -.6090D-02, -.5378D-02, -.4650D-02, -.3945D-02, & + & -.3290D-02, -.2705D-02, -.2194D-02, -.1760D-02, -.1396D-02, & + & -.1099D-02, -.8578D-03, -.6645D-03, -.5115D-03, -.3916D-03, & + & -.2986D-03, -.2267D-03, -.1712D-03, -.1277D-03, -.9622D-04, & + & -.7223D-04/ + + data (calcpts(j,37), j = 1,neta) /-.6692D-11, -.1190D-10, & + & -.2115D-10, -.3762D-10, -.6691D-10, -.1190D-09, -.2115D-09, & + & -.3762D-09, -.6687D-09, -.1189D-08, -.2115D-08, -.3761D-08, & + & -.6687D-08, -.1189D-07, -.2113D-07, -.3758D-07, -.6683D-07, & + & -.1188D-06, -.2111D-06, -.3752D-06, -.6662D-06, -.1183D-05, & + & -.2100D-05, -.3721D-05, -.6585D-05, -.1163D-04, -.2046D-04, & + & -.3586D-04, -.6244D-04, -.1077D-03, -.1832D-03, -.3060D-03, & + & -.4985D-03, -.7868D-03, -.1193D-02, -.1724D-02, -.2362D-02, & + & -.3065D-02, -.3771D-02, -.4425D-02, -.4986D-02, -.5439D-02, & + & -.5787D-02, -.6041D-02, -.6216D-02, -.6326D-02, -.6379D-02, & + & -.6379D-02, -.6326D-02, -.6217D-02, -.6042D-02, -.5789D-02, & + & -.5448D-02, -.5021D-02, -.4524D-02, -.3984D-02, -.3437D-02, & + & -.2909D-02, -.2421D-02, -.1985D-02, -.1608D-02, -.1287D-02, & + & -.1020D-02, -.8012D-03, -.6243D-03, -.4834D-03, -.3709D-03, & + & -.2840D-03, -.2165D-03, -.1640D-03, -.1235D-03, -.9201D-04, & + & -.6951D-04/ + + data (calcpts(j,38), j = 1,neta) /-.5013D-11, -.8916D-11, & + & -.1585D-10, -.2818D-10, -.5013D-10, -.8914D-10, -.1585D-09, & + & -.2819D-09, -.5010D-09, -.8911D-09, -.1585D-08, -.2818D-08, & + & -.5011D-08, -.8911D-08, -.1584D-07, -.2816D-07, -.5008D-07, & + & -.8901D-07, -.1582D-06, -.2812D-06, -.4993D-06, -.8866D-06, & + & -.1574D-05, -.2789D-05, -.4935D-05, -.8717D-05, -.1534D-04, & + & -.2688D-04, -.4680D-04, -.8069D-04, -.1373D-03, -.2294D-03, & + & -.3737D-03, -.5898D-03, -.8941D-03, -.1292D-02, -.1771D-02, & + & -.2298D-02, -.2827D-02, -.3317D-02, -.3738D-02, -.4078D-02, & + & -.4339D-02, -.4531D-02, -.4666D-02, -.4755D-02, -.4804D-02, & + & -.4819D-02, -.4799D-02, -.4744D-02, -.4650D-02, -.4508D-02, & + & -.4310D-02, -.4048D-02, -.3721D-02, -.3345D-02, -.2940D-02, & + & -.2530D-02, -.2137D-02, -.1776D-02, -.1453D-02, -.1175D-02, & + & -.9379D-03, -.7415D-03, -.5826D-03, -.4521D-03, -.3501D-03, & + & -.2677D-03, -.2047D-03, -.1552D-03, -.1177D-03, -.8770D-04, & + & -.6671D-04/ + + data (calcpts(j,39), j = 1,neta) /-.3741D-11, -.6654D-11, & + & -.1183D-10, -.2104D-10, -.3742D-10, -.6653D-10, -.1183D-09, & + & -.2104D-09, -.3740D-09, -.6651D-09, -.1183D-08, -.2103D-08, & + & -.3740D-08, -.6652D-08, -.1182D-07, -.2102D-07, -.3738D-07, & + & -.6644D-07, -.1181D-06, -.2099D-06, -.3727D-06, -.6618D-06, & + & -.1175D-05, -.2082D-05, -.3684D-05, -.6508D-05, -.1145D-04, & + & -.2007D-04, -.3494D-04, -.6024D-04, -.1025D-03, -.1713D-03, & + & -.2790D-03, -.4403D-03, -.6675D-03, -.9646D-03, -.1322D-02, & + & -.1715D-02, -.2110D-02, -.2476D-02, -.2791D-02, -.3045D-02, & + & -.3240D-02, -.3385D-02, -.3487D-02, -.3557D-02, -.3599D-02, & + & -.3617D-02, -.3614D-02, -.3589D-02, -.3539D-02, -.3461D-02, & + & -.3349D-02, -.3196D-02, -.2996D-02, -.2749D-02, -.2466D-02, & + & -.2164D-02, -.1858D-02, -.1568D-02, -.1299D-02, -.1062D-02, & + & -.8571D-03, -.6832D-03, -.5408D-03, -.4223D-03, -.3293D-03, & + & -.2543D-03, -.1943D-03, -.1494D-03, -.1134D-03, -.8486D-04, & + & -.6387D-04/ + + data (calcpts(j,40), j = 1,neta) /-.2780D-11, -.4945D-11, & + & -.8790D-11, -.1563D-10, -.2781D-10, -.4944D-10, -.8792D-10, & + & -.1564D-09, -.2779D-09, -.4943D-09, -.8792D-09, -.1563D-08, & + & -.2780D-08, -.4944D-08, -.8786D-08, -.1562D-07, -.2778D-07, & + & -.4939D-07, -.8778D-07, -.1560D-06, -.2770D-06, -.4919D-06, & + & -.8731D-06, -.1547D-05, -.2739D-05, -.4837D-05, -.8511D-05, & + & -.1492D-04, -.2597D-04, -.4478D-04, -.7619D-04, -.1273D-03, & + & -.2074D-03, -.3273D-03, -.4962D-03, -.7170D-03, -.9827D-03, & + & -.1275D-02, -.1569D-02, -.1841D-02, -.2074D-02, -.2263D-02, & + & -.2409D-02, -.2517D-02, -.2594D-02, -.2647D-02, -.2681D-02, & + & -.2699D-02, -.2703D-02, -.2693D-02, -.2668D-02, -.2626D-02, & + & -.2564D-02, -.2477D-02, -.2360D-02, -.2208D-02, -.2023D-02, & + & -.1812D-02, -.1586D-02, -.1360D-02, -.1145D-02, -.9475D-03, & + & -.7736D-03, -.6222D-03, -.4962D-03, -.3913D-03, -.3058D-03, & + & -.2368D-03, -.1828D-03, -.1408D-03, -.1063D-03, -.8082D-04, & + & -.6132D-04/ + + data (calcpts(j,41), j = 1,neta) /-.2059D-11, -.3662D-11, & + & -.6509D-11, -.1158D-10, -.2059D-10, -.3661D-10, -.6510D-10, & + & -.1158D-09, -.2058D-09, -.3660D-09, -.6511D-09, -.1158D-08, & + & -.2058D-08, -.3661D-08, -.6506D-08, -.1157D-07, -.2057D-07, & + & -.3657D-07, -.6500D-07, -.1155D-06, -.2051D-06, -.3643D-06, & + & -.6465D-06, -.1146D-05, -.2028D-05, -.3582D-05, -.6303D-05, & + & -.1105D-04, -.1923D-04, -.3316D-04, -.5642D-04, -.9427D-04, & + & -.1536D-03, -.2424D-03, -.3674D-03, -.5310D-03, -.7278D-03, & + & -.9443D-03, -.1162D-02, -.1363D-02, -.1536D-02, -.1676D-02, & + & -.1784D-02, -.1864D-02, -.1922D-02, -.1962D-02, -.1988D-02, & + & -.2004D-02, -.2011D-02, -.2008D-02, -.1996D-02, -.1974D-02, & + & -.1940D-02, -.1891D-02, -.1825D-02, -.1736D-02, -.1622D-02, & + & -.1484D-02, -.1327D-02, -.1160D-02, -.9928D-03, -.8341D-03, & + & -.6894D-03, -.5615D-03, -.4517D-03, -.3587D-03, -.2823D-03, & + & -.2208D-03, -.1713D-03, -.1323D-03, -.1008D-03, -.7679D-04, & + & -.5729D-04/ + + data (calcpts(j,42), j = 1,neta) /-.1520D-11, -.2703D-11, & + & -.4804D-11, -.8545D-11, -.1520D-10, -.2702D-10, -.4806D-10, & + & -.8547D-10, -.1519D-09, -.2702D-09, -.4806D-09, -.8545D-09, & + & -.1519D-08, -.2702D-08, -.4802D-08, -.8540D-08, -.1519D-07, & + & -.2700D-07, -.4798D-07, -.8528D-07, -.1514D-06, -.2689D-06, & + & -.4773D-06, -.8459D-06, -.1497D-05, -.2644D-05, -.4653D-05, & + & -.8154D-05, -.1420D-04, -.2448D-04, -.4165D-04, -.6959D-04, & + & -.1134D-03, -.1789D-03, -.2712D-03, -.3920D-03, -.5372D-03, & + & -.6971D-03, -.8576D-03, -.1006D-02, -.1134D-02, -.1237D-02, & + & -.1317D-02, -.1376D-02, -.1419D-02, -.1449D-02, -.1469D-02, & + & -.1482D-02, -.1489D-02, -.1490D-02, -.1485D-02, -.1474D-02, & + & -.1455D-02, -.1428D-02, -.1391D-02, -.1340D-02, -.1274D-02, & + & -.1189D-02, -.1086D-02, -.9692D-03, -.8460D-03, -.7231D-03, & + & -.6067D-03, -.5007D-03, -.4073D-03, -.3272D-03, -.2599D-03, & + & -.2045D-03, -.1595D-03, -.1234D-03, -.9489D-04, -.7254D-04, & + & -.5514D-04/ + + data (calcpts(j,43), j = 1,neta) /-.1118D-11, -.1989D-11, & + & -.3535D-11, -.6287D-11, -.1118D-10, -.1988D-10, -.3536D-10, & + & -.6289D-10, -.1118D-09, -.1988D-09, -.3536D-09, -.6287D-09, & + & -.1118D-08, -.1988D-08, -.3534D-08, -.6284D-08, -.1118D-07, & + & -.1986D-07, -.3531D-07, -.6275D-07, -.1114D-06, -.1979D-06, & + & -.3512D-06, -.6224D-06, -.1102D-05, -.1946D-05, -.3424D-05, & + & -.6000D-05, -.1045D-04, -.1801D-04, -.3065D-04, -.5121D-04, & + & -.8342D-04, -.1317D-03, -.1996D-03, -.2884D-03, -.3953D-03, & + & -.5129D-03, -.6310D-03, -.7404D-03, -.8344D-03, -.9105D-03, & + & -.9691D-03, -.1013D-02, -.1044D-02, -.1066D-02, -.1082D-02, & + & -.1092D-02, -.1097D-02, -.1100D-02, -.1098D-02, -.1093D-02, & + & -.1084D-02, -.1069D-02, -.1048D-02, -.1020D-02, -.9815D-03, & + & -.9317D-03, -.8684D-03, -.7922D-03, -.7063D-03, -.6156D-03, & + & -.5255D-03, -.4402D-03, -.3628D-03, -.2947D-03, -.2365D-03, & + & -.1876D-03, -.1474D-03, -.1149D-03, -.8879D-04, -.6824D-04, & + & -.5204D-04/ + + data (calcpts(j,44), j = 1,neta) /-.8203D-12, -.1459D-11, & + & -.2593D-11, -.4612D-11, -.8204D-11, -.1459D-10, -.2594D-10, & + & -.4614D-10, -.8200D-10, -.1458D-09, -.2594D-09, -.4613D-09, & + & -.8202D-09, -.1459D-08, -.2592D-08, -.4610D-08, -.8198D-08, & + & -.1457D-07, -.2590D-07, -.4604D-07, -.8174D-07, -.1452D-06, & + & -.2576D-06, -.4566D-06, -.8081D-06, -.1427D-05, -.2512D-05, & + & -.4402D-05, -.7664D-05, -.1321D-04, -.2248D-04, -.3757D-04, & + & -.6120D-04, -.9659D-04, -.1464D-03, -.2116D-03, -.2900D-03, & + & -.3763D-03, -.4630D-03, -.5432D-03, -.6122D-03, -.6679D-03, & + & -.7110D-03, -.7430D-03, -.7662D-03, -.7826D-03, -.7939D-03, & + & -.8015D-03, -.8062D-03, -.8086D-03, -.8088D-03, -.8068D-03, & + & -.8022D-03, -.7944D-03, -.7828D-03, -.7667D-03, -.7451D-03, & + & -.7161D-03, -.6790D-03, -.6323D-03, -.5761D-03, -.5130D-03, & + & -.4466D-03, -.3806D-03, -.3185D-03, -.2621D-03, -.2128D-03, & + & -.1705D-03, -.1351D-03, -.1060D-03, -.8242D-04, -.6367D-04, & + & -.4882D-04/ + + data (calcpts(j,45), j = 1,neta) /-.6004D-12, -.1068D-11, & + & -.1898D-11, -.3376D-11, -.6005D-11, -.1068D-10, -.1899D-10, & + & -.3377D-10, -.6002D-10, -.1068D-09, -.1899D-09, -.3376D-09, & + & -.6003D-09, -.1068D-08, -.1897D-08, -.3374D-08, -.6001D-08, & + & -.1067D-07, -.1896D-07, -.3370D-07, -.5983D-07, -.1062D-06, & + & -.1886D-06, -.3342D-06, -.5915D-06, -.1045D-05, -.1838D-05, & + & -.3222D-05, -.5610D-05, -.9672D-05, -.1646D-04, -.2750D-04, & + & -.4479D-04, -.7070D-04, -.1072D-03, -.1549D-03, -.2123D-03, & + & -.2754D-03, -.3389D-03, -.3976D-03, -.4481D-03, -.4889D-03, & + & -.5204D-03, -.5439D-03, -.5608D-03, -.5729D-03, -.5812D-03, & + & -.5869D-03, -.5906D-03, -.5927D-03, -.5935D-03, -.5929D-03, & + & -.5908D-03, -.5869D-03, -.5807D-03, -.5718D-03, -.5596D-03, & + & -.5434D-03, -.5222D-03, -.4948D-03, -.4602D-03, -.4188D-03, & + & -.3725D-03, -.3239D-03, -.2758D-03, -.2305D-03, -.1895D-03, & + & -.1537D-03, -.1229D-03, -.9744D-04, -.7629D-04, -.5934D-04, & + & -.4584D-04/ + + data (calcpts(j,46), j = 1,neta) /-.4382D-12, -.7794D-12, & + & -.1385D-11, -.2464D-11, -.4383D-11, -.7793D-11, -.1386D-10, & + & -.2465D-10, -.4381D-10, -.7791D-10, -.1386D-09, -.2464D-09, & + & -.4381D-09, -.7792D-09, -.1385D-08, -.2463D-08, -.4380D-08, & + & -.7785D-08, -.1384D-07, -.2459D-07, -.4367D-07, -.7755D-07, & + & -.1376D-06, -.2439D-06, -.4317D-06, -.7625D-06, -.1342D-05, & + & -.2351D-05, -.4094D-05, -.7059D-05, -.1201D-04, -.2007D-04, & + & -.3269D-04, -.5160D-04, -.7822D-04, -.1130D-03, -.1549D-03, & + & -.2010D-03, -.2473D-03, -.2902D-03, -.3270D-03, -.3568D-03, & + & -.3798D-03, -.3969D-03, -.4093D-03, -.4181D-03, -.4243D-03, & + & -.4285D-03, -.4313D-03, -.4330D-03, -.4338D-03, -.4339D-03, & + & -.4331D-03, -.4312D-03, -.4281D-03, -.4233D-03, -.4165D-03, & + & -.4073D-03, -.3952D-03, -.3795D-03, -.3590D-03, -.3339D-03, & + & -.3036D-03, -.2697D-03, -.2342D-03, -.1992D-03, -.1662D-03, & + & -.1365D-03, -.1106D-03, -.8839D-04, -.6994D-04, -.5479D-04, & + & -.4249D-04/ + + data (calcpts(j,47), j = 1,neta) /-.3191D-12, -.5675D-12, & + & -.1009D-11, -.1794D-11, -.3191D-11, -.5674D-11, -.1009D-10, & + & -.1795D-10, -.3190D-10, -.5673D-10, -.1009D-09, -.1794D-09, & + & -.3190D-09, -.5674D-09, -.1008D-08, -.1793D-08, -.3189D-08, & + & -.5668D-08, -.1007D-07, -.1791D-07, -.3179D-07, -.5646D-07, & + & -.1002D-06, -.1776D-06, -.3143D-06, -.5552D-06, -.9769D-06, & + & -.1712D-05, -.2981D-05, -.5140D-05, -.8745D-05, -.1461D-04, & + & -.2380D-04, -.3757D-04, -.5695D-04, -.8230D-04, -.1128D-03, & + & -.1464D-03, -.1801D-03, -.2113D-03, -.2381D-03, -.2598D-03, & + & -.2765D-03, -.2890D-03, -.2980D-03, -.3045D-03, -.3090D-03, & + & -.3120D-03, -.3141D-03, -.3155D-03, -.3162D-03, -.3165D-03, & + & -.3162D-03, -.3154D-03, -.3139D-03, -.3114D-03, -.3077D-03, & + & -.3026D-03, -.2957D-03, -.2868D-03, -.2752D-03, -.2603D-03, & + & -.2417D-03, -.2195D-03, -.1948D-03, -.1690D-03, -.1435D-03, & + & -.1197D-03, -.9825D-04, -.7935D-04, -.6345D-04, -.5010D-04, & + & -.3915D-04/ + + data (calcpts(j,48), j = 1,neta) /-.2319D-12, -.4124D-12, & + & -.7330D-12, -.1304D-11, -.2319D-11, -.4123D-11, -.7332D-11, & + & -.1304D-10, -.2318D-10, -.4122D-10, -.7332D-10, -.1304D-09, & + & -.2318D-09, -.4123D-09, -.7327D-09, -.1303D-08, -.2317D-08, & + & -.4119D-08, -.7321D-08, -.1301D-07, -.2310D-07, -.4103D-07, & + & -.7282D-07, -.1291D-06, -.2284D-06, -.4035D-06, -.7099D-06, & + & -.1244D-05, -.2166D-05, -.3735D-05, -.6355D-05, -.1062D-04, & + & -.1730D-04, -.2730D-04, -.4139D-04, -.5981D-04, -.8197D-04, & + & -.1064D-03, -.1309D-03, -.1535D-03, -.1730D-03, -.1888D-03, & + & -.2010D-03, -.2100D-03, -.2166D-03, -.2213D-03, -.2245D-03, & + & -.2268D-03, -.2283D-03, -.2293D-03, -.2300D-03, -.2303D-03, & + & -.2303D-03, -.2299D-03, -.2292D-03, -.2280D-03, -.2261D-03, & + & -.2233D-03, -.2195D-03, -.2143D-03, -.2077D-03, -.1992D-03, & + & -.1883D-03, -.1747D-03, -.1585D-03, -.1406D-03, -.1218D-03, & + & -.1034D-03, -.8612D-04, -.7060D-04, -.5695D-04, -.4555D-04, & + & -.3595D-04/ + + data (calcpts(j,49), j = 1,neta) /-.1681D-12, -.2990D-12, & + & -.5315D-12, -.9453D-12, -.1681D-11, -.2990D-11, -.5317D-11, & + & -.9456D-11, -.1681D-10, -.2989D-10, -.5317D-10, -.9454D-10, & + & -.1681D-09, -.2990D-09, -.5313D-09, -.9449D-09, -.1680D-08, & + & -.2987D-08, -.5309D-08, -.9436D-08, -.1675D-07, -.2975D-07, & + & -.5281D-07, -.9359D-07, -.1656D-06, -.2926D-06, -.5148D-06, & + & -.9022D-06, -.1571D-05, -.2708D-05, -.4608D-05, -.7700D-05, & + & -.1254D-04, -.1980D-04, -.3001D-04, -.4337D-04, -.5944D-04, & + & -.7713D-04, -.9489D-04, -.1113D-03, -.1255D-03, -.1369D-03, & + & -.1457D-03, -.1523D-03, -.1571D-03, -.1604D-03, -.1628D-03, & + & -.1645D-03, -.1656D-03, -.1663D-03, -.1668D-03, -.1671D-03, & + & -.1672D-03, -.1671D-03, -.1668D-03, -.1662D-03, -.1652D-03, & + & -.1638D-03, -.1617D-03, -.1588D-03, -.1550D-03, -.1502D-03, & + & -.1439D-03, -.1359D-03, -.1260D-03, -.1143D-03, -.1012D-03, & + & -.8765D-04, -.7430D-04, -.6185D-04, -.5062D-04, -.4087D-04, & + & -.3257D-04/ + + data (dlaeta(j), j = 1,neta) / & + & -6d0, -5.83333333d0, -5.66666667d0, -5.5d0, -5.33333333d0, & + & -5.16666667d0, -5d0, -4.83333333d0, -4.66666667d0, -4.5d0, & + & -4.33333333d0, -4.16666667d0, -4d0, -3.83333333d0, & + & -3.66666667d0, -3.5d0, -3.33333333d0, -3.16666667d0, -3d0, & + & -2.83333333d0, -2.66666667d0, -2.5d0, -2.33333333d0, & + & -2.16666667d0, -2d0, -1.83333333d0, -1.66666667d0, -1.5d0, & + & -1.33333333d0, -1.16666667d0, -1d0, -0.83333333d0, -0.66666667d0,& + & -0.5d0, -0.33333333d0, -0.16666667d0, 0d0, 0.16666667d0, & + & 0.33333333d0, 0.5d0, 0.66666667d0, 0.83333333d0, 1d0, & + & 1.16666667d0, 1.33333333d0, 1.5d0, 1.66666667d0, 1.83333333d0, & + & 2d0, 2.16666667d0, 2.33333333d0, 2.5d0, 2.66666667d0, & + & 2.83333333d0, 3d0, 3.16666667d0, 3.33333333d0, 3.5d0, & + & 3.66666667d0, 3.83333333d0, 4d0, 4.16666667d0, 4.33333333d0, & + & 4.5d0, 4.66666667d0, 4.83333333d0, 5d0, 5.16666667d0, & + & 5.33333333d0, 5.5d0, 5.66666667d0, 5.83333333d0, 6d0/ + + data (dlaxi(j), j = 1,nxi) / & + & -3d0, -2.83333333d0, -2.66666667d0, -2.5d0, -2.33333333d0, & + & -2.16666667d0, -2d0, -1.83333333d0, -1.66666667d0, -1.5d0, & + & -1.33333333d0, -1.16666667d0, -1d0, -0.83333333d0, -0.66666667d0,& + & -0.5d0, -0.33333333d0, -0.16666667d0, 0d0, 0.16666667d0, & + & 0.33333333d0, 0.5d0, 0.66666667d0, 0.83333333d0, 1d0, & + & 1.16666667d0, 1.33333333d0, 1.5d0, 1.66666667d0, 1.83333333d0, & + & 2d0, 2.16666667d0, 2.33333333d0, 2.5d0, 2.66666667d0, & + & 2.83333333d0, 3d0, 3.16666667d0, 3.33333333d0, 3.5d0, & + & 3.66666667d0, 3.83333333d0, 4d0, 4.16666667d0, 4.33333333d0, & + & 4.5d0, 4.66666667d0, 4.83333333d0, 5d0/ + + dleta = dlog10(eta) + dlxi = dlog10(xi) + if (dlxi .le. dlaxi(1)) dlxi = dlaxi(1) + if (dlxi .ge. dlaxi(nxi)) dlxi = dlaxi(nxi) + if (dleta .ge. dlaeta(neta)) dleta = dlaeta(neta) + if (dleta .le. dlaeta(1)) dleta = dlaeta(1) + call locate(dlaeta,neta, dleta, ieta) + call locate(dlaxi, nxi, dlxi, ixi) +! interpolating between the appropriate points + delxi = 1d0/6d0 + deleta = 1d0/6d0 +! lagrange 3-pt. + if (ixi .le. 2) ixi = 2 + if (ixi .ge. 48) ixi = 48 + if (ieta .le. 2) ieta = 2 + if (ieta .ge. 72) ieta = 72 + pxi = (dlxi - dlaxi(ixi))/delxi + f(-1) = pxi*(pxi-1d0)/2d0*calcpts(ieta-1,ixi-1) + & + & (1d0 - pxi**2)*calcpts(ieta-1,ixi) + & + & pxi*(pxi+1d0)/2d0*calcpts(ieta-1,ixi+1) + f(0) = pxi*(pxi-1d0)/2d0*calcpts(ieta,ixi-1) + & + & (1d0 - pxi**2)*calcpts(ieta,ixi) + & + & pxi*(pxi+1d0)/2d0*calcpts(ieta,ixi+1) + f(1) = pxi*(pxi-1d0)/2d0*calcpts(ieta+1,ixi-1) + & + & (1d0 - pxi**2)*calcpts(ieta+1,ixi) + & + & pxi*(pxi+1d0)/2d0*calcpts(ieta+1,ixi+1) + peta = (dleta - dlaeta(ieta))/deleta + h1_HTq = peta*(peta-1d0)/2d0*f(-1) + & + & (1d0 - peta**2)*f(0) + & + & peta*(peta+1d0)/2d0*f(1) +!MB + + peta*(peta+1d0)/2d0*f(1) + return + END + +! =========================================== + double precision function h1bar_HTq(eta,xi) +! =========================================== + +! eq (27) in PLB347 (1995) 143 - 151 for the transverse piece +! MSbar scheme +! This routine is called subcqhtbar in the original code. +! Called sqtbar in updated code (03/06/96). + + implicit none + integer neta, nxi + parameter (neta = 73, nxi = 49) + double precision calcpts(neta, nxi), dlaeta(neta), dlaxi(nxi) + double precision eta, xi, dleta, dlxi + double precision pxi, peta, f(-1:1), delxi, deleta + integer j, ieta, ixi + + data (calcpts(j, 1), j = 1,neta) /0.9803D-10, 0.1739D-09, & + & 0.3086D-09, 0.5482D-09, 0.9743D-09, 0.1731D-08, 0.3078D-08, & + & 0.5473D-08, 0.9724D-08, 0.1729D-07, 0.3076D-07, 0.5469D-07, & + & 0.9724D-07, 0.1729D-06, 0.3073D-06, 0.5465D-06, 0.9718D-06, & + & 0.1727D-05, 0.3070D-05, 0.5455D-05, 0.9683D-05, 0.1719D-04, & + & 0.3050D-04, 0.5401D-04, 0.9550D-04, 0.1684D-03, 0.2957D-03, & + & 0.5166D-03, 0.8955D-03, 0.1534D-02, 0.2586D-02, 0.4266D-02, & + & 0.6826D-02, 0.1052D-01, 0.1546D-01, 0.2147D-01, 0.2798D-01, & + & 0.3406D-01, 0.3874D-01, 0.4130D-01, 0.4150D-01, 0.3958D-01, & + & 0.3613D-01, 0.3180D-01, 0.2716D-01, 0.2264D-01, 0.1849D-01, & + & 0.1485D-01, 0.1178D-01, 0.9225D-02, 0.7162D-02, 0.5499D-02, & + & 0.4200D-02, 0.3187D-02, 0.2403D-02, 0.1803D-02, 0.1348D-02, & + & 0.1000D-02, 0.7489D-03, 0.5516D-03, 0.4103D-03, 0.2962D-03, & + & 0.2103D-03, 0.1530D-03, 0.1099D-03, 0.8117D-04, 0.6703D-04, & + & 0.3763D-04, 0.3803D-04, 0.2330D-04, 0.2349D-04, 0.8619D-05, & + & 0.8705D-05/ + + data (calcpts(j, 2), j = 1,neta) /0.9804D-10, 0.1739D-09, & + & 0.3085D-09, 0.5481D-09, 0.9742D-09, 0.1731D-08, 0.3077D-08, & + & 0.5472D-08, 0.9723D-08, 0.1729D-07, 0.3076D-07, 0.5468D-07, & + & 0.9722D-07, 0.1729D-06, 0.3073D-06, 0.5464D-06, 0.9717D-06, & + & 0.1727D-05, 0.3069D-05, 0.5455D-05, 0.9682D-05, 0.1719D-04, & + & 0.3050D-04, 0.5401D-04, 0.9548D-04, 0.1684D-03, 0.2957D-03, & + & 0.5165D-03, 0.8953D-03, 0.1534D-02, 0.2586D-02, 0.4265D-02, & + & 0.6827D-02, 0.1052D-01, 0.1546D-01, 0.2147D-01, 0.2797D-01, & + & 0.3407D-01, 0.3875D-01, 0.4129D-01, 0.4150D-01, 0.3958D-01, & + & 0.3613D-01, 0.3180D-01, 0.2716D-01, 0.2264D-01, 0.1850D-01, & + & 0.1486D-01, 0.1177D-01, 0.9227D-02, 0.7149D-02, 0.5501D-02, & + & 0.4202D-02, 0.3189D-02, 0.2405D-02, 0.1804D-02, 0.1350D-02, & + & 0.1002D-02, 0.7507D-03, 0.5534D-03, 0.4121D-03, 0.2980D-03, & + & 0.2120D-03, 0.1548D-03, 0.1117D-03, 0.8293D-04, 0.5380D-04, & + & 0.3939D-04, 0.2480D-04, 0.2507D-04, 0.1026D-04, 0.1039D-04, & + & 0.1047D-04/ + + data (calcpts(j, 3), j = 1,neta) /0.9802D-10, 0.1739D-09, & + & 0.3085D-09, 0.5481D-09, 0.9742D-09, 0.1731D-08, 0.3077D-08, & + & 0.5472D-08, 0.9722D-08, 0.1729D-07, 0.3076D-07, 0.5468D-07, & + & 0.9722D-07, 0.1729D-06, 0.3072D-06, 0.5464D-06, 0.9717D-06, & + & 0.1727D-05, 0.3069D-05, 0.5454D-05, 0.9682D-05, 0.1719D-04, & + & 0.3049D-04, 0.5400D-04, 0.9548D-04, 0.1684D-03, 0.2956D-03, & + & 0.5165D-03, 0.8953D-03, 0.1534D-02, 0.2585D-02, 0.4265D-02, & + & 0.6825D-02, 0.1052D-01, 0.1546D-01, 0.2147D-01, 0.2798D-01, & + & 0.3406D-01, 0.3873D-01, 0.4130D-01, 0.4150D-01, 0.3958D-01, & + & 0.3613D-01, 0.3180D-01, 0.2716D-01, 0.2264D-01, 0.1849D-01, & + & 0.1485D-01, 0.1178D-01, 0.9223D-02, 0.7160D-02, 0.5497D-02, & + & 0.4198D-02, 0.3184D-02, 0.2401D-02, 0.1800D-02, 0.1345D-02, & + & 0.9976D-03, 0.7463D-03, 0.5490D-03, 0.4077D-03, 0.2936D-03, & + & 0.2227D-03, 0.1654D-03, 0.1223D-03, 0.7854D-04, 0.6441D-04, & + & 0.5000D-04, 0.3540D-04, 0.2068D-04, 0.2087D-04, 0.5994D-05, & + & 0.6081D-05/ + + data (calcpts(j, 4), j = 1,neta) /0.9800D-10, 0.1739D-09, & + & 0.3085D-09, 0.5480D-09, 0.9740D-09, 0.1731D-08, 0.3077D-08, & + & 0.5471D-08, 0.9721D-08, 0.1729D-07, 0.3075D-07, 0.5467D-07, & + & 0.9720D-07, 0.1729D-06, 0.3072D-06, 0.5463D-06, 0.9715D-06, & + & 0.1727D-05, 0.3069D-05, 0.5454D-05, 0.9680D-05, 0.1718D-04, & + & 0.3049D-04, 0.5399D-04, 0.9547D-04, 0.1684D-03, 0.2956D-03, & + & 0.5164D-03, 0.8952D-03, 0.1533D-02, 0.2585D-02, 0.4264D-02, & + & 0.6824D-02, 0.1052D-01, 0.1546D-01, 0.2147D-01, 0.2797D-01, & + & 0.3407D-01, 0.3873D-01, 0.4129D-01, 0.4149D-01, 0.3959D-01, & + & 0.3613D-01, 0.3181D-01, 0.2716D-01, 0.2264D-01, 0.1850D-01, & + & 0.1485D-01, 0.1178D-01, 0.9225D-02, 0.7161D-02, 0.5498D-02, & + & 0.4199D-02, 0.3186D-02, 0.2402D-02, 0.1801D-02, 0.1347D-02, & + & 0.9991D-03, 0.7478D-03, 0.5506D-03, 0.4092D-03, 0.2951D-03, & + & 0.2242D-03, 0.1519D-03, 0.1088D-03, 0.8006D-04, 0.6593D-04, & + & 0.5152D-04, 0.3692D-04, 0.2220D-04, 0.2239D-04, 0.7513D-05, & + & 0.7599D-05/ + + data (calcpts(j, 5), j = 1,neta) /0.9798D-10, 0.1738D-09, & + & 0.3084D-09, 0.5479D-09, 0.9738D-09, 0.1730D-08, 0.3076D-08, & + & 0.5470D-08, 0.9718D-08, 0.1728D-07, 0.3074D-07, 0.5466D-07, & + & 0.9718D-07, 0.1728D-06, 0.3071D-06, 0.5462D-06, 0.9713D-06, & + & 0.1726D-05, 0.3068D-05, 0.5452D-05, 0.9678D-05, 0.1718D-04, & + & 0.3048D-04, 0.5398D-04, 0.9544D-04, 0.1683D-03, 0.2955D-03, & + & 0.5163D-03, 0.8950D-03, 0.1533D-02, 0.2584D-02, 0.4263D-02, & + & 0.6823D-02, 0.1052D-01, 0.1546D-01, 0.2146D-01, 0.2797D-01, & + & 0.3406D-01, 0.3872D-01, 0.4130D-01, 0.4149D-01, 0.3958D-01, & + & 0.3613D-01, 0.3180D-01, 0.2715D-01, 0.2263D-01, 0.1849D-01, & + & 0.1486D-01, 0.1177D-01, 0.9228D-02, 0.7150D-02, 0.5502D-02, & + & 0.4202D-02, 0.3189D-02, 0.2406D-02, 0.1805D-02, 0.1350D-02, & + & 0.1002D-02, 0.7510D-03, 0.5538D-03, 0.3974D-03, 0.2984D-03, & + & 0.2124D-03, 0.1551D-03, 0.1120D-03, 0.8327D-04, 0.5414D-04, & + & 0.3973D-04, 0.2513D-04, 0.2541D-04, 0.1059D-04, 0.1072D-04, & + & 0.1081D-04/ + + data (calcpts(j, 6), j = 1,neta) /0.9794D-10, 0.1738D-09, & + & 0.3083D-09, 0.5477D-09, 0.9735D-09, 0.1730D-08, 0.3075D-08, & + & 0.5468D-08, 0.9715D-08, 0.1728D-07, 0.3073D-07, 0.5464D-07, & + & 0.9715D-07, 0.1728D-06, 0.3070D-06, 0.5460D-06, 0.9710D-06, & + & 0.1726D-05, 0.3067D-05, 0.5450D-05, 0.9674D-05, 0.1718D-04, & + & 0.3047D-04, 0.5396D-04, 0.9541D-04, 0.1683D-03, 0.2954D-03, & + & 0.5161D-03, 0.8947D-03, 0.1532D-02, 0.2584D-02, 0.4262D-02, & + & 0.6821D-02, 0.1052D-01, 0.1546D-01, 0.2146D-01, 0.2796D-01, & + & 0.3405D-01, 0.3872D-01, 0.4128D-01, 0.4148D-01, 0.3958D-01, & + & 0.3612D-01, 0.3180D-01, 0.2716D-01, 0.2263D-01, 0.1849D-01, & + & 0.1486D-01, 0.1177D-01, 0.9228D-02, 0.7149D-02, 0.5501D-02, & + & 0.4201D-02, 0.3188D-02, 0.2405D-02, 0.1804D-02, 0.1349D-02, & + & 0.1001D-02, 0.7498D-03, 0.5525D-03, 0.4112D-03, 0.2971D-03, & + & 0.2111D-03, 0.1539D-03, 0.1108D-03, 0.8203D-04, 0.6790D-04, & + & 0.3849D-04, 0.3889D-04, 0.2416D-04, 0.9350D-05, 0.9477D-05, & + & 0.9564D-05/ + + data (calcpts(j, 7), j = 1,neta) /0.9790D-10, 0.1737D-09, & + & 0.3081D-09, 0.5474D-09, 0.9730D-09, 0.1729D-08, 0.3073D-08, & + & 0.5465D-08, 0.9711D-08, 0.1727D-07, 0.3072D-07, 0.5461D-07, & + & 0.9710D-07, 0.1727D-06, 0.3069D-06, 0.5457D-06, 0.9705D-06, & + & 0.1725D-05, 0.3065D-05, 0.5448D-05, 0.9670D-05, 0.1717D-04, & + & 0.3046D-04, 0.5394D-04, 0.9537D-04, 0.1682D-03, 0.2953D-03, & + & 0.5159D-03, 0.8943D-03, 0.1532D-02, 0.2582D-02, 0.4260D-02, & + & 0.6819D-02, 0.1051D-01, 0.1545D-01, 0.2145D-01, 0.2795D-01, & + & 0.3404D-01, 0.3871D-01, 0.4127D-01, 0.4147D-01, 0.3956D-01, & + & 0.3612D-01, 0.3180D-01, 0.2715D-01, 0.2263D-01, 0.1849D-01, & + & 0.1486D-01, 0.1177D-01, 0.9229D-02, 0.7150D-02, 0.5501D-02, & + & 0.4202D-02, 0.3189D-02, 0.2405D-02, 0.1804D-02, 0.1349D-02, & + & 0.1001D-02, 0.7501D-03, 0.5528D-03, 0.4114D-03, 0.2973D-03, & + & 0.2114D-03, 0.1541D-03, 0.1110D-03, 0.8225D-04, 0.6811D-04, & + & 0.3871D-04, 0.3911D-04, 0.2438D-04, 0.9568D-05, 0.9695D-05, & + & 0.9782D-05/ + + data (calcpts(j, 8), j = 1,neta) /0.9783D-10, 0.1736D-09, & + & 0.3079D-09, 0.5470D-09, 0.9723D-09, 0.1728D-08, 0.3071D-08, & + & 0.5461D-08, 0.9704D-08, 0.1726D-07, 0.3069D-07, 0.5457D-07, & + & 0.9703D-07, 0.1726D-06, 0.3066D-06, 0.5453D-06, 0.9698D-06, & + & 0.1724D-05, 0.3063D-05, 0.5444D-05, 0.9663D-05, 0.1715D-04, & + & 0.3043D-04, 0.5390D-04, 0.9530D-04, 0.1681D-03, 0.2951D-03, & + & 0.5155D-03, 0.8937D-03, 0.1531D-02, 0.2581D-02, 0.4258D-02, & + & 0.6815D-02, 0.1051D-01, 0.1544D-01, 0.2144D-01, 0.2794D-01, & + & 0.3404D-01, 0.3870D-01, 0.4126D-01, 0.4146D-01, 0.3956D-01, & + & 0.3611D-01, 0.3178D-01, 0.2714D-01, 0.2263D-01, 0.1848D-01, & + & 0.1485D-01, 0.1178D-01, 0.9218D-02, 0.7154D-02, 0.5505D-02, & + & 0.4206D-02, 0.3192D-02, 0.2409D-02, 0.1807D-02, 0.1353D-02, & + & 0.1005D-02, 0.7385D-03, 0.5562D-03, 0.3999D-03, 0.3008D-03, & + & 0.2148D-03, 0.1575D-03, 0.1144D-03, 0.8568D-04, 0.5654D-04, & + & 0.4213D-04, 0.2753D-04, 0.2781D-04, 0.1299D-04, 0.1312D-04, & + & 0.1321D-04/ + + data (calcpts(j, 9), j = 1,neta) /0.9773D-10, 0.1734D-09, & + & 0.3076D-09, 0.5464D-09, 0.9713D-09, 0.1726D-08, 0.3068D-08, & + & 0.5455D-08, 0.9693D-08, 0.1724D-07, 0.3066D-07, 0.5451D-07, & + & 0.9693D-07, 0.1724D-06, 0.3063D-06, 0.5447D-06, 0.9688D-06, & + & 0.1722D-05, 0.3060D-05, 0.5438D-05, 0.9653D-05, 0.1714D-04, & + & 0.3040D-04, 0.5384D-04, 0.9520D-04, 0.1679D-03, 0.2948D-03, & + & 0.5150D-03, 0.8928D-03, 0.1529D-02, 0.2578D-02, 0.4254D-02, & + & 0.6808D-02, 0.1050D-01, 0.1543D-01, 0.2143D-01, 0.2792D-01, & + & 0.3401D-01, 0.3868D-01, 0.4125D-01, 0.4145D-01, 0.3954D-01, & + & 0.3611D-01, 0.3177D-01, 0.2715D-01, 0.2263D-01, 0.1848D-01, & + & 0.1486D-01, 0.1177D-01, 0.9223D-02, 0.7158D-02, 0.5509D-02, & + & 0.4209D-02, 0.3195D-02, 0.2412D-02, 0.1810D-02, 0.1355D-02, & + & 0.1008D-02, 0.7413D-03, 0.5440D-03, 0.4026D-03, 0.3035D-03, & + & 0.2175D-03, 0.1603D-03, 0.1171D-03, 0.8839D-04, 0.5926D-04, & + & 0.4485D-04, 0.3025D-04, 0.3052D-04, 0.1571D-04, 0.1584D-04, & + & 0.1592D-04/ + + data (calcpts(j,10), j = 1,neta) /0.9756D-10, 0.1731D-09, & + & 0.3071D-09, 0.5456D-09, 0.9697D-09, 0.1723D-08, 0.3063D-08, & + & 0.5447D-08, 0.9679D-08, 0.1721D-07, 0.3062D-07, 0.5443D-07, & + & 0.9678D-07, 0.1721D-06, 0.3058D-06, 0.5439D-06, 0.9673D-06, & + & 0.1719D-05, 0.3055D-05, 0.5430D-05, 0.9637D-05, 0.1711D-04, & + & 0.3035D-04, 0.5376D-04, 0.9505D-04, 0.1677D-03, 0.2943D-03, & + & 0.5142D-03, 0.8915D-03, 0.1527D-02, 0.2575D-02, 0.4248D-02, & + & 0.6801D-02, 0.1048D-01, 0.1541D-01, 0.2141D-01, 0.2790D-01, & + & 0.3398D-01, 0.3866D-01, 0.4121D-01, 0.4142D-01, 0.3952D-01, & + & 0.3609D-01, 0.3177D-01, 0.2714D-01, 0.2261D-01, 0.1847D-01, & + & 0.1485D-01, 0.1177D-01, 0.9215D-02, 0.7149D-02, 0.5499D-02, & + & 0.4199D-02, 0.3185D-02, 0.2401D-02, 0.1799D-02, 0.1344D-02, & + & 0.9965D-03, 0.7451D-03, 0.5477D-03, 0.4064D-03, 0.2922D-03, & + & 0.2212D-03, 0.1640D-03, 0.1208D-03, 0.9209D-04, 0.6295D-04, & + & 0.4854D-04, 0.3394D-04, 0.1922D-04, 0.1940D-04, 0.1953D-04, & + & 0.4614D-05/ + + data (calcpts(j,11), j = 1,neta) /0.9733D-10, 0.1727D-09, & + & 0.3064D-09, 0.5443D-09, 0.9675D-09, 0.1719D-08, 0.3056D-08, & + & 0.5434D-08, 0.9656D-08, 0.1717D-07, 0.3055D-07, 0.5431D-07, & + & 0.9657D-07, 0.1717D-06, 0.3052D-06, 0.5427D-06, 0.9650D-06, & + & 0.1715D-05, 0.3048D-05, 0.5417D-05, 0.9615D-05, 0.1707D-04, & + & 0.3029D-04, 0.5364D-04, 0.9484D-04, 0.1673D-03, 0.2937D-03, & + & 0.5131D-03, 0.8895D-03, 0.1524D-02, 0.2570D-02, 0.4240D-02, & + & 0.6788D-02, 0.1047D-01, 0.1539D-01, 0.2138D-01, 0.2786D-01, & + & 0.3395D-01, 0.3862D-01, 0.4118D-01, 0.4139D-01, 0.3949D-01, & + & 0.3606D-01, 0.3175D-01, 0.2711D-01, 0.2261D-01, 0.1847D-01, & + & 0.1484D-01, 0.1176D-01, 0.9213D-02, 0.7146D-02, 0.5496D-02, & + & 0.4195D-02, 0.3180D-02, 0.2411D-02, 0.1809D-02, 0.1354D-02, & + & 0.1006D-02, 0.7398D-03, 0.5425D-03, 0.4010D-03, 0.3019D-03, & + & 0.2159D-03, 0.1586D-03, 0.1155D-03, 0.8672D-04, 0.5758D-04, & + & 0.4316D-04, 0.2856D-04, 0.2883D-04, 0.1402D-04, 0.1415D-04, & + & 0.1423D-04/ + + data (calcpts(j,12), j = 1,neta) /0.9701D-10, 0.1721D-09, & + & 0.3054D-09, 0.5425D-09, 0.9642D-09, 0.1714D-08, 0.3046D-08, & + & 0.5416D-08, 0.9625D-08, 0.1712D-07, 0.3044D-07, 0.5412D-07, & + & 0.9624D-07, 0.1712D-06, 0.3041D-06, 0.5409D-06, 0.9619D-06, & + & 0.1710D-05, 0.3038D-05, 0.5400D-05, 0.9584D-05, 0.1702D-04, & + & 0.3019D-04, 0.5346D-04, 0.9453D-04, 0.1667D-03, 0.2927D-03, & + & 0.5115D-03, 0.8867D-03, 0.1519D-02, 0.2562D-02, 0.4228D-02, & + & 0.6769D-02, 0.1044D-01, 0.1535D-01, 0.2133D-01, 0.2781D-01, & + & 0.3388D-01, 0.3855D-01, 0.4112D-01, 0.4133D-01, 0.3945D-01, & + & 0.3602D-01, 0.3172D-01, 0.2710D-01, 0.2260D-01, 0.1846D-01, & + & 0.1484D-01, 0.1176D-01, 0.9208D-02, 0.7154D-02, 0.5502D-02, & + & 0.4200D-02, 0.3185D-02, 0.2400D-02, 0.1799D-02, 0.1343D-02, & + & 0.1010D-02, 0.7437D-03, 0.5463D-03, 0.4048D-03, 0.2906D-03, & + & 0.2196D-03, 0.1623D-03, 0.1191D-03, 0.9040D-04, 0.6126D-04, & + & 0.4684D-04, 0.3224D-04, 0.1751D-04, 0.1769D-04, 0.1782D-04, & + & 0.2904D-05/ + + data (calcpts(j,13), j = 1,neta) /0.9653D-10, 0.1713D-09, & + & 0.3039D-09, 0.5399D-09, 0.9596D-09, 0.1705D-08, 0.3031D-08, & + & 0.5390D-08, 0.9577D-08, 0.1703D-07, 0.3030D-07, 0.5386D-07, & + & 0.9577D-07, 0.1703D-06, 0.3027D-06, 0.5382D-06, 0.9572D-06, & + & 0.1701D-05, 0.3023D-05, 0.5373D-05, 0.9537D-05, 0.1693D-04, & + & 0.3004D-04, 0.5321D-04, 0.9408D-04, 0.1659D-03, 0.2913D-03, & + & 0.5091D-03, 0.8826D-03, 0.1512D-02, 0.2551D-02, 0.4210D-02, & + & 0.6742D-02, 0.1040D-01, 0.1530D-01, 0.2126D-01, 0.2773D-01, & + & 0.3380D-01, 0.3846D-01, 0.4104D-01, 0.4126D-01, 0.3938D-01, & + & 0.3598D-01, 0.3168D-01, 0.2707D-01, 0.2257D-01, 0.1845D-01, & + & 0.1482D-01, 0.1175D-01, 0.9208D-02, 0.7152D-02, 0.5498D-02, & + & 0.4195D-02, 0.3179D-02, 0.2408D-02, 0.1806D-02, 0.1350D-02, & + & 0.1002D-02, 0.7506D-03, 0.5531D-03, 0.4116D-03, 0.2974D-03, & + & 0.2113D-03, 0.1540D-03, 0.1108D-03, 0.8206D-04, 0.6791D-04, & + & 0.3849D-04, 0.3888D-04, 0.2415D-04, 0.2433D-04, 0.9458D-05, & + & 0.9543D-05/ + + data (calcpts(j,14), j = 1,neta) /0.9585D-10, 0.1701D-09, & + & 0.3017D-09, 0.5360D-09, 0.9528D-09, 0.1693D-08, 0.3010D-08, & + & 0.5352D-08, 0.9510D-08, 0.1691D-07, 0.3008D-07, 0.5348D-07, & + & 0.9509D-07, 0.1691D-06, 0.3005D-06, 0.5344D-06, 0.9504D-06, & + & 0.1689D-05, 0.3002D-05, 0.5335D-05, 0.9470D-05, 0.1681D-04, & + & 0.2983D-04, 0.5283D-04, 0.9341D-04, 0.1648D-03, 0.2893D-03, & + & 0.5056D-03, 0.8766D-03, 0.1502D-02, 0.2534D-02, 0.4184D-02, & + & 0.6704D-02, 0.1034D-01, 0.1522D-01, 0.2116D-01, 0.2761D-01, & + & 0.3367D-01, 0.3833D-01, 0.4091D-01, 0.4114D-01, 0.3930D-01, & + & 0.3591D-01, 0.3162D-01, 0.2703D-01, 0.2253D-01, 0.1843D-01, & + & 0.1481D-01, 0.1174D-01, 0.9207D-02, 0.7131D-02, 0.5490D-02, & + & 0.4200D-02, 0.3182D-02, 0.2396D-02, 0.1808D-02, 0.1352D-02, & + & 0.1004D-02, 0.7369D-03, 0.5542D-03, 0.3976D-03, 0.2983D-03, & + & 0.2122D-03, 0.1549D-03, 0.1117D-03, 0.8293D-04, 0.5377D-04, & + & 0.3935D-04, 0.2474D-04, 0.2500D-04, 0.1018D-04, 0.1031D-04, & + & 0.1039D-04/ + + data (calcpts(j,15), j = 1,neta) /0.9484D-10, 0.1683D-09, & + & 0.2986D-09, 0.5305D-09, 0.9430D-09, 0.1676D-08, 0.2979D-08, & + & 0.5297D-08, 0.9412D-08, 0.1674D-07, 0.2977D-07, 0.5293D-07, & + & 0.9412D-07, 0.1674D-06, 0.2975D-06, 0.5290D-06, 0.9407D-06, & + & 0.1672D-05, 0.2971D-05, 0.5281D-05, 0.9373D-05, 0.1664D-04, & + & 0.2953D-04, 0.5229D-04, 0.9248D-04, 0.1631D-03, 0.2864D-03, & + & 0.5006D-03, 0.8680D-03, 0.1488D-02, 0.2511D-02, 0.4147D-02, & + & 0.6646D-02, 0.1026D-01, 0.1511D-01, 0.2102D-01, 0.2744D-01, & + & 0.3347D-01, 0.3814D-01, 0.4072D-01, 0.4099D-01, 0.3916D-01, & + & 0.3580D-01, 0.3155D-01, 0.2697D-01, 0.2249D-01, 0.1839D-01, & + & 0.1478D-01, 0.1173D-01, 0.9194D-02, 0.7127D-02, 0.5482D-02, & + & 0.4189D-02, 0.3185D-02, 0.2397D-02, 0.1809D-02, 0.1352D-02, & + & 0.1003D-02, 0.7511D-03, 0.5532D-03, 0.4115D-03, 0.2971D-03, & + & 0.2110D-03, 0.1536D-03, 0.1104D-03, 0.8161D-04, 0.6744D-04, & + & 0.3800D-04, 0.3839D-04, 0.2365D-04, 0.2383D-04, 0.8947D-05, & + & 0.9030D-05/ + + data (calcpts(j,16), j = 1,neta) /0.9341D-10, 0.1658D-09, & + & 0.2941D-09, 0.5226D-09, 0.9290D-09, 0.1651D-08, 0.2935D-08, & + & 0.5219D-08, 0.9272D-08, 0.1649D-07, 0.2933D-07, 0.5215D-07, & + & 0.9273D-07, 0.1649D-06, 0.2930D-06, 0.5211D-06, 0.9268D-06, & + & 0.1647D-05, 0.2927D-05, 0.5203D-05, 0.9235D-05, 0.1640D-04, & + & 0.2909D-04, 0.5153D-04, 0.9111D-04, 0.1607D-03, 0.2823D-03, & + & 0.4934D-03, 0.8558D-03, 0.1467D-02, 0.2477D-02, 0.4092D-02, & + & 0.6564D-02, 0.1014D-01, 0.1494D-01, 0.2081D-01, 0.2718D-01, & + & 0.3319D-01, 0.3784D-01, 0.4044D-01, 0.4073D-01, 0.3894D-01, & + & 0.3563D-01, 0.3141D-01, 0.2687D-01, 0.2244D-01, 0.1834D-01, & + & 0.1475D-01, 0.1170D-01, 0.9181D-02, 0.7122D-02, 0.5486D-02, & + & 0.4189D-02, 0.3183D-02, 0.2393D-02, 0.1804D-02, 0.1346D-02, & + & 0.9968D-03, 0.7442D-03, 0.5461D-03, 0.4042D-03, 0.3047D-03, & + & 0.2185D-03, 0.1611D-03, 0.1178D-03, 0.8900D-04, 0.5981D-04, & + & 0.4536D-04, 0.3073D-04, 0.3099D-04, 0.1617D-04, 0.1628D-04, & + & 0.1637D-04/ + + data (calcpts(j,17), j = 1,neta) /0.9140D-10, 0.1622D-09, & + & 0.2878D-09, 0.5114D-09, 0.9091D-09, 0.1616D-08, 0.2872D-08, & + & 0.5107D-08, 0.9075D-08, 0.1614D-07, 0.2871D-07, 0.5104D-07, & + & 0.9076D-07, 0.1614D-06, 0.2868D-06, 0.5100D-06, 0.9071D-06, & + & 0.1612D-05, 0.2865D-05, 0.5092D-05, 0.9038D-05, 0.1605D-04, & + & 0.2847D-04, 0.5044D-04, 0.8919D-04, 0.1574D-03, 0.2764D-03, & + & 0.4832D-03, 0.8382D-03, 0.1438D-02, 0.2428D-02, 0.4014D-02, & + & 0.6444D-02, 0.9965D-02, 0.1470D-01, 0.2049D-01, 0.2681D-01, & + & 0.3278D-01, 0.3741D-01, 0.4002D-01, 0.4037D-01, 0.3863D-01, & + & 0.3538D-01, 0.3122D-01, 0.2673D-01, 0.2233D-01, 0.1826D-01, & + & 0.1470D-01, 0.1167D-01, 0.9149D-02, 0.7108D-02, 0.5465D-02, & + & 0.4178D-02, 0.3168D-02, 0.2391D-02, 0.1800D-02, 0.1341D-02, & + & 0.1006D-02, 0.7379D-03, 0.5545D-03, 0.3973D-03, 0.2977D-03, & + & 0.2113D-03, 0.1538D-03, 0.1105D-03, 0.8168D-04, 0.6746D-04, & + & 0.3800D-04, 0.3836D-04, 0.2361D-04, 0.8782D-05, 0.8897D-05, & + & 0.8976D-05/ + + data (calcpts(j,18), j = 1,neta) /0.8860D-10, 0.1573D-09, & + & 0.2791D-09, 0.4959D-09, 0.8816D-09, 0.1567D-08, 0.2785D-08, & + & 0.4953D-08, 0.8802D-08, 0.1565D-07, 0.2784D-07, 0.4950D-07, & + & 0.8801D-07, 0.1565D-06, 0.2782D-06, 0.4947D-06, 0.8797D-06, & + & 0.1564D-05, 0.2779D-05, 0.4939D-05, 0.8766D-05, 0.1557D-04, & + & 0.2762D-04, 0.4892D-04, 0.8653D-04, 0.1527D-03, 0.2682D-03, & + & 0.4689D-03, 0.8138D-03, 0.1396D-02, 0.2360D-02, 0.3904D-02, & + & 0.6272D-02, 0.9714D-02, 0.1435D-01, 0.2004D-01, 0.2626D-01, & + & 0.3217D-01, 0.3678D-01, 0.3942D-01, 0.3983D-01, 0.3817D-01, & + & 0.3502D-01, 0.3095D-01, 0.2653D-01, 0.2218D-01, 0.1817D-01, & + & 0.1462D-01, 0.1162D-01, 0.9119D-02, 0.7079D-02, 0.5455D-02, & + & 0.4161D-02, 0.3161D-02, 0.2381D-02, 0.1787D-02, 0.1342D-02, & + & 0.9912D-03, 0.7374D-03, 0.5534D-03, 0.3960D-03, 0.2961D-03, & + & 0.2096D-03, 0.1520D-03, 0.1086D-03, 0.7971D-04, 0.6547D-04, & + & 0.5098D-04, 0.3633D-04, 0.2157D-04, 0.2173D-04, 0.6842D-05, & + & 0.6917D-05/ + + data (calcpts(j,19), j = 1,neta) /0.8482D-10, 0.1506D-09, & + & 0.2673D-09, 0.4749D-09, 0.8443D-09, 0.1501D-08, 0.2668D-08, & + & 0.4744D-08, 0.8430D-08, 0.1499D-07, 0.2667D-07, 0.4741D-07, & + & 0.8431D-07, 0.1499D-06, 0.2664D-06, 0.4738D-06, 0.8427D-06, & + & 0.1498D-05, 0.2662D-05, 0.4730D-05, 0.8397D-05, 0.1491D-04, & + & 0.2646D-04, 0.4687D-04, 0.8290D-04, 0.1463D-03, 0.2570D-03, & + & 0.4495D-03, 0.7805D-03, 0.1340D-02, 0.2266D-02, 0.3752D-02, & + & 0.6036D-02, 0.9363D-02, 0.1386D-01, 0.1939D-01, 0.2547D-01, & + & 0.3127D-01, 0.3585D-01, 0.3853D-01, 0.3902D-01, 0.3751D-01, & + & 0.3448D-01, 0.3054D-01, 0.2622D-01, 0.2195D-01, 0.1800D-01, & + & 0.1451D-01, 0.1154D-01, 0.9062D-02, 0.7047D-02, 0.5424D-02, & + & 0.4152D-02, 0.3145D-02, 0.2376D-02, 0.1795D-02, 0.1333D-02, & + & 0.9950D-03, 0.7403D-03, 0.5407D-03, 0.3978D-03, 0.2977D-03, & + & 0.2110D-03, 0.1532D-03, 0.1098D-03, 0.8080D-04, 0.6651D-04, & + & 0.3700D-04, 0.3733D-04, 0.2255D-04, 0.2271D-04, 0.7810D-05, & + & 0.7881D-05/ + + data (calcpts(j,20), j = 1,neta) /0.7986D-10, 0.1418D-09, & + & 0.2517D-09, 0.4474D-09, 0.7953D-09, 0.1414D-08, 0.2513D-08, & + & 0.4469D-08, 0.7942D-08, 0.1413D-07, 0.2512D-07, 0.4467D-07, & + & 0.7942D-07, 0.1413D-06, 0.2510D-06, 0.4464D-06, 0.7938D-06, & + & 0.1411D-05, 0.2508D-05, 0.4457D-05, 0.7912D-05, 0.1405D-04, & + & 0.2493D-04, 0.4416D-04, 0.7812D-04, 0.1379D-03, 0.2423D-03, & + & 0.4239D-03, 0.7362D-03, 0.1265D-02, 0.2140D-02, 0.3548D-02, & + & 0.5716D-02, 0.8883D-02, 0.1318D-01, 0.1849D-01, 0.2436D-01, & + & 0.3002D-01, 0.3454D-01, 0.3727D-01, 0.3788D-01, 0.3654D-01, & + & 0.3370D-01, 0.2993D-01, 0.2577D-01, 0.2163D-01, 0.1777D-01, & + & 0.1435D-01, 0.1142D-01, 0.8980D-02, 0.6985D-02, 0.5391D-02, & + & 0.4121D-02, 0.3137D-02, 0.2363D-02, 0.1778D-02, 0.1328D-02, & + & 0.9888D-03, 0.7330D-03, 0.5476D-03, 0.4042D-03, 0.2886D-03, & + & 0.2167D-03, 0.1588D-03, 0.1152D-03, 0.8615D-04, 0.5680D-04, & + & 0.4225D-04, 0.2756D-04, 0.1276D-04, 0.1290D-04, 0.1300D-04, & + & -.1933D-05/ + + data (calcpts(j,21), j = 1,neta) /0.7364D-10, 0.1308D-09, & + & 0.2322D-09, 0.4128D-09, 0.7339D-09, 0.1304D-08, 0.2319D-08, & + & 0.4124D-08, 0.7329D-08, 0.1304D-07, 0.2318D-07, 0.4122D-07, & + & 0.7330D-07, 0.1304D-06, 0.2317D-06, 0.4120D-06, 0.7326D-06, & + & 0.1302D-05, 0.2314D-05, 0.4113D-05, 0.7302D-05, 0.1297D-04, & + & 0.2301D-04, 0.4076D-04, 0.7211D-04, 0.1273D-03, 0.2237D-03, & + & 0.3915D-03, 0.6803D-03, 0.1169D-02, 0.1980D-02, 0.3287D-02, & + & 0.5304D-02, 0.8258D-02, 0.1229D-01, 0.1729D-01, 0.2287D-01, & + & 0.2830D-01, 0.3273D-01, 0.3549D-01, 0.3628D-01, 0.3517D-01, & + & 0.3260D-01, 0.2908D-01, 0.2514D-01, 0.2116D-01, 0.1744D-01, & + & 0.1412D-01, 0.1126D-01, 0.8865D-02, 0.6916D-02, 0.5332D-02, & + & 0.4094D-02, 0.3115D-02, 0.2349D-02, 0.1775D-02, 0.1322D-02, & + & 0.9960D-03, 0.7388D-03, 0.5525D-03, 0.4084D-03, 0.2924D-03, & + & 0.2202D-03, 0.1621D-03, 0.1184D-03, 0.8922D-04, 0.5982D-04, & + & 0.4522D-04, 0.3049D-04, 0.3068D-04, 0.1581D-04, 0.1590D-04, & + & 0.1596D-04/ + + data (calcpts(j,22), j = 1,neta) /0.6623D-10, 0.1177D-09, & + & 0.2090D-09, 0.3714D-09, 0.6605D-09, 0.1174D-08, 0.2087D-08, & + & 0.3712D-08, 0.6597D-08, 0.1173D-07, 0.2087D-07, 0.3711D-07, & + & 0.6598D-07, 0.1173D-06, 0.2085D-06, 0.3708D-06, 0.6595D-06, & + & 0.1172D-05, 0.2083D-05, 0.3703D-05, 0.6573D-05, 0.1167D-04, & + & 0.2071D-04, 0.3670D-04, 0.6493D-04, 0.1146D-03, 0.2015D-03, & + & 0.3527D-03, 0.6130D-03, 0.1054D-02, 0.1787D-02, 0.2969D-02, & + & 0.4798D-02, 0.7487D-02, 0.1117D-01, 0.1578D-01, 0.2096D-01, & + & 0.2608D-01, 0.3034D-01, 0.3312D-01, 0.3410D-01, 0.3330D-01, & + & 0.3108D-01, 0.2789D-01, 0.2425D-01, 0.2052D-01, 0.1698D-01, & + & 0.1379D-01, 0.1103D-01, 0.8707D-02, 0.6800D-02, 0.5253D-02, & + & 0.4030D-02, 0.3071D-02, 0.2328D-02, 0.1748D-02, 0.1307D-02, & + & 0.9787D-03, 0.7349D-03, 0.5475D-03, 0.4027D-03, 0.3013D-03, & + & 0.2137D-03, 0.1554D-03, 0.1115D-03, 0.8225D-04, 0.6777D-04, & + & 0.5312D-04, 0.3836D-04, 0.2353D-04, 0.2364D-04, 0.8718D-05, & + & 0.8771D-05/ + + data (calcpts(j,23), j = 1,neta) /0.5794D-10, 0.1030D-09, & + & 0.1829D-09, 0.3251D-09, 0.5782D-09, 0.1028D-08, 0.1827D-08, & + & 0.3250D-08, 0.5776D-08, 0.1027D-07, 0.1827D-07, 0.3249D-07, & + & 0.5776D-07, 0.1027D-06, 0.1826D-06, 0.3247D-06, 0.5774D-06, & + & 0.1026D-05, 0.1824D-05, 0.3242D-05, 0.5756D-05, 0.1022D-04, & + & 0.1814D-04, 0.3214D-04, 0.5686D-04, 0.1004D-03, 0.1765D-03, & + & 0.3090D-03, 0.5373D-03, 0.9244D-03, 0.1568D-02, 0.2608D-02, & + & 0.4221D-02, 0.6599D-02, 0.9870D-02, 0.1399D-01, 0.1868D-01, & + & 0.2338D-01, 0.2740D-01, 0.3016D-01, 0.3134D-01, 0.3088D-01, & + & 0.2908D-01, 0.2633D-01, 0.2306D-01, 0.1963D-01, 0.1634D-01, & + & 0.1333D-01, 0.1071D-01, 0.8483D-02, 0.6647D-02, 0.5151D-02, & + & 0.3957D-02, 0.3017D-02, 0.2296D-02, 0.1726D-02, 0.1297D-02, & + & 0.9662D-03, 0.7208D-03, 0.5323D-03, 0.3868D-03, 0.2848D-03, & + & 0.2119D-03, 0.1533D-03, 0.1092D-03, 0.7987D-04, 0.5032D-04, & + & 0.3562D-04, 0.3583D-04, 0.2097D-04, 0.2107D-04, 0.6131D-05, & + & 0.6176D-05/ + + data (calcpts(j,24), j = 1,neta) /0.4927D-10, 0.8757D-10, & + & 0.1556D-09, 0.2766D-09, 0.4919D-09, 0.8745D-09, 0.1555D-08, & + & 0.2765D-08, 0.4915D-08, 0.8741D-08, 0.1555D-07, 0.2764D-07, & + & 0.4915D-07, 0.8742D-07, 0.1554D-06, 0.2763D-06, 0.4913D-06, & + & 0.8733D-06, 0.1552D-05, 0.2759D-05, 0.4898D-05, 0.8697D-05, & + & 0.1543D-04, 0.2735D-04, 0.4839D-04, 0.8545D-04, 0.1503D-03, & + & 0.2631D-03, 0.4576D-03, 0.7877D-03, 0.1337D-02, 0.2226D-02, & + & 0.3607D-02, 0.5649D-02, 0.8470D-02, 0.1205D-01, 0.1616D-01, & + & 0.2035D-01, 0.2403D-01, 0.2670D-01, 0.2803D-01, 0.2794D-01, & + & 0.2662D-01, 0.2436D-01, 0.2154D-01, 0.1851D-01, 0.1552D-01, & + & 0.1275D-01, 0.1029D-01, 0.8201D-02, 0.6450D-02, 0.5021D-02, & + & 0.3871D-02, 0.2965D-02, 0.2252D-02, 0.1692D-02, 0.1274D-02, & + & 0.9557D-03, 0.7087D-03, 0.5191D-03, 0.3878D-03, 0.2854D-03, & + & 0.2121D-03, 0.1532D-03, 0.1090D-03, 0.7959D-04, 0.6496D-04, & + & 0.5021D-04, 0.3538D-04, 0.2050D-04, 0.2058D-04, 0.5633D-05, & + & 0.5670D-05/ + + data (calcpts(j,25), j = 1,neta) /0.4076D-10, 0.7246D-10, & + & 0.1287D-09, 0.2289D-09, 0.4072D-09, 0.7238D-09, 0.1287D-08, & + & 0.2289D-08, 0.4068D-08, 0.7236D-08, 0.1287D-07, 0.2288D-07, & + & 0.4069D-07, 0.7237D-07, 0.1286D-06, 0.2287D-06, 0.4067D-06, & + & 0.7229D-06, 0.1285D-05, 0.2284D-05, 0.4055D-05, 0.7200D-05, & + & 0.1278D-04, 0.2264D-04, 0.4007D-04, 0.7075D-04, 0.1244D-03, & + & 0.2180D-03, 0.3791D-03, 0.6528D-03, 0.1109D-02, 0.1847D-02, & + & 0.2996D-02, 0.4701D-02, 0.7065D-02, 0.1008D-01, 0.1358D-01, & + & 0.1719D-01, 0.2045D-01, 0.2294D-01, 0.2435D-01, 0.2459D-01, & + & 0.2374D-01, 0.2201D-01, 0.1972D-01, 0.1713D-01, 0.1451D-01, & + & 0.1202D-01, 0.9781D-02, 0.7837D-02, 0.6189D-02, 0.4843D-02, & + & 0.3753D-02, 0.2882D-02, 0.2192D-02, 0.1657D-02, 0.1251D-02, & + & 0.9304D-03, 0.6969D-03, 0.5213D-03, 0.3893D-03, 0.2864D-03, & + & 0.2128D-03, 0.1537D-03, 0.1094D-03, 0.7983D-04, 0.6513D-04, & + & 0.3533D-04, 0.3547D-04, 0.2057D-04, 0.2063D-04, 0.5677D-05, & + & 0.5708D-05/ + + data (calcpts(j,26), j = 1,neta) /0.3290D-10, 0.5849D-10, & + & 0.1039D-09, 0.1848D-09, 0.3287D-09, 0.5844D-09, 0.1039D-08, & + & 0.1848D-08, 0.3285D-08, 0.5843D-08, 0.1039D-07, 0.1848D-07, & + & 0.3285D-07, 0.5843D-07, 0.1038D-06, 0.1847D-06, 0.3284D-06, & + & 0.5837D-06, 0.1038D-05, 0.1844D-05, 0.3274D-05, 0.5814D-05, & + & 0.1032D-04, 0.1829D-04, 0.3236D-04, 0.5714D-04, 0.1005D-03, & + & 0.1761D-03, 0.3064D-03, 0.5277D-03, 0.8966D-03, 0.1495D-02, & + & 0.2427D-02, 0.3813D-02, 0.5742D-02, 0.8218D-02, 0.1111D-01, & + & 0.1414D-01, 0.1693D-01, 0.1915D-01, 0.2055D-01, 0.2102D-01, & + & 0.2059D-01, 0.1940D-01, 0.1763D-01, 0.1554D-01, 0.1332D-01, & + & 0.1115D-01, 0.9167D-02, 0.7406D-02, 0.5896D-02, 0.4635D-02, & + & 0.3607D-02, 0.2772D-02, 0.2120D-02, 0.1612D-02, 0.1218D-02, & + & 0.9103D-03, 0.6754D-03, 0.4990D-03, 0.3663D-03, 0.2780D-03, & + & 0.2041D-03, 0.1448D-03, 0.1004D-03, 0.7070D-04, 0.5594D-04, & + & 0.4110D-04, 0.2621D-04, 0.2629D-04, 0.1134D-04, 0.1138D-04, & + & 0.1140D-04/ + + data (calcpts(j,27), j = 1,neta) /0.2600D-10, 0.4624D-10, & + & 0.8217D-10, 0.1461D-09, 0.2599D-09, 0.4621D-09, 0.8217D-09, & + & 0.1462D-08, 0.2598D-08, 0.4620D-08, 0.8218D-08, 0.1461D-07, & + & 0.2598D-07, 0.4621D-07, 0.8212D-07, 0.1460D-06, 0.2597D-06, & + & 0.4616D-06, 0.8204D-06, 0.1458D-05, 0.2589D-05, 0.4598D-05, & + & 0.8160D-05, 0.1446D-04, 0.2559D-04, 0.4520D-04, 0.7950D-04, & + & 0.1393D-03, 0.2424D-03, 0.4176D-03, 0.7099D-03, 0.1184D-02, & + & 0.1925D-02, 0.3027D-02, 0.4566D-02, 0.6551D-02, 0.8883D-02, & + & 0.1135D-01, 0.1367D-01, 0.1558D-01, 0.1688D-01, 0.1748D-01, & + & 0.1738D-01, 0.1664D-01, 0.1539D-01, 0.1378D-01, 0.1200D-01, & + & 0.1019D-01, 0.8465D-02, 0.6910D-02, 0.5540D-02, 0.4384D-02, & + & 0.3434D-02, 0.2666D-02, 0.2040D-02, 0.1558D-02, 0.1176D-02, & + & 0.8971D-03, 0.6761D-03, 0.4989D-03, 0.3657D-03, 0.2770D-03, & + & 0.2029D-03, 0.1435D-03, 0.1139D-03, 0.8413D-04, 0.5432D-04, & + & 0.3945D-04, 0.3954D-04, 0.2459D-04, 0.2463D-04, 0.9662D-05, & + & 0.9681D-05/ + + data (calcpts(j,28), j = 1,neta) /0.2019D-10, 0.3591D-10, & + & 0.6382D-10, 0.1135D-09, 0.2019D-09, 0.3589D-09, 0.6383D-09, & + & 0.1135D-08, 0.2018D-08, 0.3589D-08, 0.6383D-08, 0.1135D-07, & + & 0.2018D-07, 0.3589D-07, 0.6378D-07, 0.1134D-06, 0.2017D-06, & + & 0.3586D-06, 0.6373D-06, 0.1133D-05, 0.2011D-05, 0.3571D-05, & + & 0.6339D-05, 0.1123D-04, 0.1988D-04, 0.3511D-04, 0.6177D-04, & + & 0.1082D-03, 0.1884D-03, 0.3246D-03, 0.5519D-03, 0.9212D-03, & + & 0.1498D-02, 0.2359D-02, 0.3563D-02, 0.5121D-02, 0.6964D-02, & + & 0.8933D-02, 0.1081D-01, 0.1240D-01, 0.1354D-01, 0.1417D-01, & + & 0.1427D-01, 0.1389D-01, 0.1307D-01, 0.1192D-01, 0.1056D-01, & + & 0.9108D-02, 0.7674D-02, 0.6336D-02, 0.5136D-02, 0.4101D-02, & + & 0.3232D-02, 0.2533D-02, 0.1947D-02, 0.1492D-02, 0.1139D-02, & + & 0.8581D-03, 0.6512D-03, 0.4883D-03, 0.3548D-03, 0.2657D-03, & + & 0.1914D-03, 0.1469D-03, 0.1022D-03, 0.7239D-04, 0.5754D-04, & + & 0.4263D-04, 0.2770D-04, 0.2775D-04, 0.1278D-04, 0.1280D-04, & + & 0.1281D-04/ + + data (calcpts(j,29), j = 1,neta) /0.1546D-10, 0.2749D-10, & + & 0.4886D-10, 0.8690D-10, 0.1546D-09, 0.2748D-09, 0.4887D-09, & + & 0.8692D-09, 0.1545D-08, 0.2748D-08, 0.4887D-08, 0.8689D-08, & + & 0.1545D-07, 0.2748D-07, 0.4884D-07, 0.8685D-07, 0.1544D-06, & + & 0.2745D-06, 0.4879D-06, 0.8673D-06, 0.1540D-05, 0.2735D-05, & + & 0.4853D-05, 0.8601D-05, 0.1522D-04, 0.2689D-04, 0.4730D-04, & + & 0.8288D-04, 0.1443D-03, 0.2487D-03, 0.4229D-03, 0.7061D-03, & + & 0.1149D-02, 0.1810D-02, 0.2737D-02, 0.3941D-02, 0.5371D-02, & + & 0.6910D-02, 0.8397D-02, 0.9680D-02, 0.1065D-01, 0.1124D-01, & + & 0.1145D-01, 0.1129D-01, 0.1081D-01, 0.1005D-01, 0.9070D-02, & + & 0.7967D-02, 0.6826D-02, 0.5717D-02, 0.4696D-02, 0.3793D-02, & + & 0.3020D-02, 0.2373D-02, 0.1845D-02, 0.1422D-02, 0.1087D-02, & + & 0.8231D-03, 0.6214D-03, 0.4670D-03, 0.3481D-03, 0.2589D-03, & + & 0.1844D-03, 0.1397D-03, 0.1100D-03, 0.8011D-04, 0.5022D-04, & + & 0.3530D-04, 0.3535D-04, 0.2038D-04, 0.2041D-04, 0.5425D-05, & + & 0.5435D-05/ + + data (calcpts(j,30), j = 1,neta) /0.1170D-10, 0.2081D-10, & + & 0.3698D-10, 0.6577D-10, 0.1170D-09, 0.2080D-09, 0.3699D-09, & + & 0.6579D-09, 0.1169D-08, 0.2080D-08, 0.3699D-08, 0.6577D-08, & + & 0.1169D-07, 0.2080D-07, 0.3696D-07, 0.6573D-07, 0.1169D-06, & + & 0.2078D-06, 0.3693D-06, 0.6564D-06, 0.1166D-05, 0.2070D-05, & + & 0.3673D-05, 0.6510D-05, 0.1152D-04, 0.2035D-04, 0.3581D-04, & + & 0.6274D-04, 0.1092D-03, 0.1883D-03, 0.3203D-03, 0.5349D-03, & + & 0.8706D-03, 0.1372D-02, 0.2077D-02, 0.2994D-02, 0.4087D-02, & + & 0.5271D-02, 0.6427D-02, 0.7443D-02, 0.8232D-02, 0.8751D-02, & + & 0.8997D-02, 0.8982D-02, 0.8728D-02, 0.8257D-02, 0.7602D-02, & + & 0.6810D-02, 0.5944D-02, 0.5065D-02, 0.4224D-02, 0.3456D-02, & + & 0.2782D-02, 0.2208D-02, 0.1731D-02, 0.1343D-02, 0.1033D-02, & + & 0.7865D-03, 0.5963D-03, 0.4490D-03, 0.3358D-03, 0.2494D-03, & + & 0.1853D-03, 0.1375D-03, 0.1002D-03, 0.7333D-04, 0.5391D-04, & + & 0.3897D-04, 0.2851D-04, 0.2103D-04, 0.1505D-04, 0.1056D-04, & + & 0.7572D-05/ + + data (calcpts(j,31), j = 1,neta) /0.8769D-11, 0.1560D-10, & + & 0.2772D-10, 0.4930D-10, 0.8769D-10, 0.1559D-09, 0.2773D-09, & + & 0.4931D-09, 0.8765D-09, 0.1559D-08, 0.2773D-08, 0.4930D-08, & + & 0.8766D-08, 0.1559D-07, 0.2771D-07, 0.4927D-07, 0.8763D-07, & + & 0.1558D-06, 0.2768D-06, 0.4921D-06, 0.8737D-06, 0.1552D-05, & + & 0.2754D-05, 0.4880D-05, 0.8637D-05, 0.1526D-04, 0.2684D-04, & + & 0.4704D-04, 0.8189D-04, 0.1412D-03, 0.2402D-03, 0.4011D-03, & + & 0.6531D-03, 0.1030D-02, 0.1560D-02, 0.2250D-02, 0.3076D-02, & + & 0.3974D-02, 0.4858D-02, 0.5647D-02, 0.6275D-02, 0.6712D-02, & + & 0.6952D-02, 0.7007D-02, 0.6892D-02, 0.6622D-02, 0.6211D-02, & + & 0.5678D-02, 0.5058D-02, 0.4395D-02, 0.3728D-02, 0.3098D-02, & + & 0.2526D-02, 0.2029D-02, 0.1606D-02, 0.1256D-02, 0.9722D-03, & + & 0.7462D-03, 0.5675D-03, 0.4289D-03, 0.3231D-03, 0.2410D-03, & + & 0.1798D-03, 0.1335D-03, 0.9759D-04, 0.7218D-04, 0.5274D-04, & + & 0.3928D-04, 0.2881D-04, 0.1983D-04, 0.1535D-04, 0.1085D-04, & + & 0.7861D-05/ + + data (calcpts(j,32), j = 1,neta) /0.6519D-11, 0.1160D-10, & + & 0.2061D-10, 0.3665D-10, 0.6520D-10, 0.1159D-09, 0.2061D-09, & + & 0.3666D-09, 0.6517D-09, 0.1159D-08, 0.2062D-08, 0.3665D-08, & + & 0.6518D-08, 0.1159D-07, 0.2060D-07, 0.3664D-07, 0.6515D-07, & + & 0.1158D-06, 0.2058D-06, 0.3658D-06, 0.6496D-06, 0.1154D-05, & + & 0.2047D-05, 0.3629D-05, 0.6422D-05, 0.1134D-04, 0.1996D-04, & + & 0.3498D-04, 0.6089D-04, 0.1050D-03, 0.1786D-03, 0.2984D-03, & + & 0.4859D-03, 0.7664D-03, 0.1161D-02, 0.1676D-02, 0.2293D-02, & + & 0.2967D-02, 0.3634D-02, 0.4235D-02, 0.4725D-02, 0.5080D-02, & + & 0.5296D-02, 0.5379D-02, 0.5342D-02, 0.5198D-02, 0.4954D-02, & + & 0.4617D-02, 0.4200D-02, 0.3725D-02, 0.3224D-02, 0.2727D-02, & + & 0.2258D-02, 0.1837D-02, 0.1471D-02, 0.1162D-02, 0.9064D-03, & + & 0.7009D-03, 0.5369D-03, 0.4070D-03, 0.3070D-03, 0.2308D-03, & + & 0.1725D-03, 0.1277D-03, 0.9475D-04, 0.6932D-04, 0.5137D-04, & + & 0.3640D-04, 0.2742D-04, 0.1993D-04, 0.1394D-04, 0.9449D-05, & + & 0.6453D-05/ + + data (calcpts(j,33), j = 1,neta) /0.4816D-11, 0.8566D-11, & + & 0.1522D-10, 0.2708D-10, 0.4816D-10, 0.8564D-10, 0.1523D-09, & + & 0.2709D-09, 0.4814D-09, 0.8562D-09, 0.1523D-08, 0.2708D-08, & + & 0.4815D-08, 0.8564D-08, 0.1522D-07, 0.2706D-07, 0.4813D-07, & + & 0.8555D-07, 0.1521D-06, 0.2703D-06, 0.4799D-06, 0.8522D-06, & + & 0.1513D-05, 0.2681D-05, 0.4744D-05, 0.8380D-05, 0.1474D-04, & + & 0.2584D-04, 0.4499D-04, 0.7756D-04, 0.1320D-03, 0.2205D-03, & + & 0.3591D-03, 0.5665D-03, 0.8584D-03, 0.1239D-02, 0.1697D-02, & + & 0.2198D-02, 0.2696D-02, 0.3149D-02, 0.3523D-02, 0.3804D-02, & + & 0.3986D-02, 0.4076D-02, 0.4081D-02, 0.4010D-02, 0.3872D-02, & + & 0.3668D-02, 0.3403D-02, 0.3084D-02, 0.2726D-02, 0.2352D-02, & + & 0.1984D-02, 0.1640D-02, 0.1331D-02, 0.1065D-02, 0.8402D-03, & + & 0.6552D-03, 0.5045D-03, 0.3865D-03, 0.2938D-03, 0.2220D-03, & + & 0.1667D-03, 0.1248D-03, 0.9188D-04, 0.6793D-04, 0.4996D-04, & + & 0.3798D-04, 0.2750D-04, 0.2001D-04, 0.1552D-04, 0.1102D-04, & + & 0.8025D-05/ + + data (calcpts(j,34), j = 1,neta) /0.3536D-11, 0.6289D-11, & + & 0.1118D-10, 0.1988D-10, 0.3536D-10, 0.6287D-10, 0.1118D-09, & + & 0.1989D-09, 0.3534D-09, 0.6286D-09, 0.1118D-08, 0.1988D-08, & + & 0.3535D-08, 0.6287D-08, 0.1117D-07, 0.1987D-07, 0.3534D-07, & + & 0.6281D-07, 0.1116D-06, 0.1984D-06, 0.3523D-06, 0.6257D-06, & + & 0.1110D-05, 0.1968D-05, 0.3483D-05, 0.6152D-05, 0.1083D-04, & + & 0.1897D-04, 0.3303D-04, 0.5695D-04, 0.9689D-04, 0.1619D-03, & + & 0.2637D-03, 0.4161D-03, 0.6305D-03, 0.9107D-03, 0.1247D-02, & + & 0.1616D-02, 0.1985D-02, 0.2322D-02, 0.2604D-02, 0.2820D-02, & + & 0.2968D-02, 0.3052D-02, 0.3076D-02, 0.3048D-02, 0.2973D-02, & + & 0.2854D-02, 0.2692D-02, 0.2489D-02, 0.2249D-02, 0.1983D-02, & + & 0.1707D-02, 0.1436D-02, 0.1185D-02, 0.9606D-03, 0.7668D-03, & + & 0.6041D-03, 0.4696D-03, 0.3620D-03, 0.2767D-03, 0.2094D-03, & + & 0.1585D-03, 0.1181D-03, 0.8813D-04, 0.6567D-04, 0.4769D-04, & + & 0.3571D-04, 0.2672D-04, 0.1923D-04, 0.1473D-04, 0.1024D-04, & + & 0.7239D-05/ + + data (calcpts(j,35), j = 1,neta) /0.2583D-11, 0.4593D-11, & + & 0.8164D-11, 0.1452D-10, 0.2583D-10, 0.4592D-10, 0.8167D-10, & + & 0.1453D-09, 0.2582D-09, 0.4592D-09, 0.8167D-09, 0.1452D-08, & + & 0.2582D-08, 0.4592D-08, 0.8162D-08, 0.1451D-07, 0.2581D-07, & + & 0.4588D-07, 0.8154D-07, 0.1449D-06, 0.2573D-06, 0.4570D-06, & + & 0.8111D-06, 0.1438D-05, 0.2544D-05, 0.4494D-05, 0.7907D-05, & + & 0.1386D-04, 0.2413D-04, 0.4160D-04, 0.7078D-04, 0.1183D-03, & + & 0.1926D-03, 0.3040D-03, 0.4607D-03, 0.6655D-03, 0.9118D-03, & + & 0.1182D-02, 0.1452D-02, 0.1701D-02, 0.1910D-02, 0.2074D-02, & + & 0.2190D-02, 0.2262D-02, 0.2293D-02, 0.2288D-02, 0.2250D-02, & + & 0.2183D-02, 0.2087D-02, 0.1963D-02, 0.1810D-02, 0.1631D-02, & + & 0.1435D-02, 0.1233D-02, 0.1036D-02, 0.8523D-03, 0.6897D-03, & + & 0.5492D-03, 0.4326D-03, 0.3354D-03, 0.2591D-03, 0.1977D-03, & + & 0.1498D-03, 0.1123D-03, 0.8387D-04, 0.6289D-04, 0.4641D-04, & + & 0.3442D-04, 0.2543D-04, 0.1794D-04, 0.1344D-04, 0.8945D-05, & + & 0.7447D-05/ + + data (calcpts(j,36), j = 1,neta) /0.1878D-11, 0.3341D-11, & + & 0.5938D-11, 0.1056D-10, 0.1879D-10, 0.3340D-10, 0.5940D-10, & + & 0.1056D-09, 0.1878D-09, 0.3340D-09, 0.5940D-09, 0.1056D-08, & + & 0.1878D-08, 0.3340D-08, 0.5936D-08, 0.1056D-07, 0.1877D-07, & + & 0.3337D-07, 0.5931D-07, 0.1054D-06, 0.1872D-06, 0.3324D-06, & + & 0.5900D-06, 0.1046D-05, 0.1851D-05, 0.3269D-05, 0.5751D-05, & + & 0.1008D-04, 0.1755D-04, 0.3026D-04, 0.5148D-04, 0.8602D-04, & + & 0.1401D-03, 0.2211D-03, 0.3352D-03, 0.4842D-03, 0.6635D-03, & + & 0.8605D-03, 0.1058D-02, 0.1239D-02, 0.1394D-02, 0.1516D-02, & + & 0.1604D-02, 0.1663D-02, 0.1694D-02, 0.1700D-02, 0.1684D-02, & + & 0.1647D-02, 0.1591D-02, 0.1517D-02, 0.1423D-02, 0.1310D-02, & + & 0.1178D-02, 0.1035D-02, 0.8878D-03, 0.7447D-03, 0.6124D-03, & + & 0.4948D-03, 0.3937D-03, 0.3099D-03, 0.2395D-03, 0.1841D-03, & + & 0.1407D-03, 0.1062D-03, 0.7922D-04, 0.5974D-04, 0.4476D-04, & + & 0.3277D-04, 0.2377D-04, 0.1778D-04, 0.1328D-04, 0.8780D-05, & + & 0.7282D-05/ + + data (calcpts(j,37), j = 1,neta) /0.1361D-11, 0.2420D-11, & + & 0.4302D-11, 0.7651D-11, 0.1361D-10, 0.2420D-10, 0.4303D-10, & + & 0.7654D-10, 0.1360D-09, 0.2419D-09, 0.4304D-09, 0.7652D-09, & + & 0.1361D-08, 0.2420D-08, 0.4301D-08, 0.7648D-08, 0.1360D-07, & + & 0.2417D-07, 0.4297D-07, 0.7637D-07, 0.1356D-06, 0.2408D-06, & + & 0.4274D-06, 0.7575D-06, 0.1341D-05, 0.2368D-05, 0.4167D-05, & + & 0.7302D-05, 0.1271D-04, 0.2192D-04, 0.3730D-04, 0.6232D-04, & + & 0.1015D-03, 0.1602D-03, 0.2429D-03, 0.3509D-03, 0.4808D-03, & + & 0.6237D-03, 0.7669D-03, 0.8990D-03, 0.1012D-02, 0.1101D-02, & + & 0.1168D-02, 0.1214D-02, 0.1241D-02, 0.1252D-02, 0.1247D-02, & + & 0.1229D-02, 0.1197D-02, 0.1153D-02, 0.1097D-02, 0.1027D-02, & + & 0.9440D-03, 0.8481D-03, 0.7439D-03, 0.6371D-03, 0.5338D-03, & + & 0.4384D-03, 0.3538D-03, 0.2812D-03, 0.2206D-03, 0.1710D-03, & + & 0.1314D-03, 0.9996D-04, 0.7554D-04, 0.5680D-04, 0.4241D-04, & + & 0.3147D-04, 0.2322D-04, 0.1722D-04, 0.1258D-04, 0.9276D-05, & + & 0.6727D-05/ + + data (calcpts(j,38), j = 1,neta) /0.9823D-12, 0.1747D-11, & + & 0.3105D-11, 0.5523D-11, 0.9824D-11, 0.1747D-10, 0.3106D-10, & + & 0.5525D-10, 0.9820D-10, 0.1746D-09, 0.3106D-09, 0.5523D-09, & + & 0.9821D-09, 0.1747D-08, 0.3104D-08, 0.5520D-08, 0.9817D-08, & + & 0.1745D-07, 0.3102D-07, 0.5513D-07, 0.9788D-07, 0.1738D-06, & + & 0.3085D-06, 0.5468D-06, 0.9677D-06, 0.1709D-05, 0.3008D-05, & + & 0.5271D-05, 0.9178D-05, 0.1582D-04, 0.2692D-04, 0.4499D-04, & + & 0.7328D-04, 0.1157D-03, 0.1753D-03, 0.2533D-03, 0.3472D-03, & + & 0.4503D-03, 0.5539D-03, 0.6495D-03, 0.7313D-03, 0.7967D-03, & + & 0.8460D-03, 0.8807D-03, 0.9029D-03, 0.9140D-03, 0.9153D-03, & + & 0.9074D-03, 0.8906D-03, 0.8654D-03, 0.8319D-03, 0.7900D-03, & + & 0.7389D-03, 0.6781D-03, 0.6084D-03, 0.5330D-03, 0.4559D-03, & + & 0.3816D-03, 0.3129D-03, 0.2522D-03, 0.2002D-03, 0.1569D-03, & + & 0.1216D-03, 0.9324D-04, 0.7090D-04, 0.5351D-04, 0.4017D-04, & + & 0.2997D-04, 0.2218D-04, 0.1633D-04, 0.1198D-04, 0.8832D-05, & + & 0.6432D-05/ + + data (calcpts(j,39), j = 1,neta) /0.7071D-12, 0.1258D-11, & + & 0.2235D-11, 0.3976D-11, 0.7072D-11, 0.1257D-10, 0.2236D-10, & + & 0.3977D-10, 0.7069D-10, 0.1257D-09, 0.2236D-09, 0.3976D-09, & + & 0.7070D-09, 0.1257D-08, 0.2235D-08, 0.3974D-08, 0.7067D-08, & + & 0.1256D-07, 0.2233D-07, 0.3969D-07, 0.7046D-07, 0.1251D-06, & + & 0.2221D-06, 0.3936D-06, 0.6967D-06, 0.1231D-05, 0.2165D-05, & + & 0.3795D-05, 0.6607D-05, 0.1139D-04, 0.1938D-04, 0.3238D-04, & + & 0.5276D-04, 0.8326D-04, 0.1262D-03, 0.1824D-03, 0.2499D-03, & + & 0.3243D-03, 0.3988D-03, 0.4678D-03, 0.5269D-03, 0.5743D-03, & + & 0.6104D-03, 0.6362D-03, 0.6535D-03, 0.6634D-03, 0.6670D-03, & + & 0.6646D-03, 0.6564D-03, 0.6425D-03, 0.6230D-03, 0.5980D-03, & + & 0.5672D-03, 0.5300D-03, 0.4858D-03, 0.4354D-03, 0.3811D-03, & + & 0.3257D-03, 0.2723D-03, 0.2232D-03, 0.1797D-03, 0.1427D-03, & + & 0.1117D-03, 0.8649D-04, 0.6640D-04, 0.5051D-04, 0.3806D-04, & + & 0.2861D-04, 0.2142D-04, 0.1587D-04, 0.1182D-04, 0.8670D-05, & + & 0.6420D-05/ + + data (calcpts(j,40), j = 1,neta) /0.5074D-12, 0.9025D-12, & + & 0.1604D-11, 0.2853D-11, 0.5075D-11, 0.9023D-11, 0.1605D-10, & + & 0.2854D-10, 0.5073D-10, 0.9022D-10, 0.1605D-09, 0.2853D-09, & + & 0.5073D-09, 0.9023D-09, 0.1604D-08, 0.2852D-08, 0.5071D-08, & + & 0.9014D-08, 0.1602D-07, 0.2848D-07, 0.5056D-07, 0.8980D-07, & + & 0.1594D-06, 0.2825D-06, 0.4999D-06, 0.8830D-06, 0.1554D-05, & + & 0.2723D-05, 0.4741D-05, 0.8174D-05, 0.1391D-04, 0.2324D-04, & + & 0.3786D-04, 0.5975D-04, 0.9057D-04, 0.1309D-03, 0.1794D-03, & + & 0.2327D-03, 0.2863D-03, 0.3358D-03, 0.3783D-03, 0.4125D-03, & + & 0.4386D-03, 0.4576D-03, 0.4706D-03, 0.4788D-03, 0.4827D-03, & + & 0.4829D-03, 0.4794D-03, 0.4723D-03, 0.4614D-03, 0.4467D-03, & + & 0.4283D-03, 0.4058D-03, 0.3789D-03, 0.3470D-03, 0.3108D-03, & + & 0.2717D-03, 0.2321D-03, 0.1939D-03, 0.1586D-03, 0.1276D-03, & + & 0.1012D-03, 0.7919D-04, 0.6120D-04, 0.4695D-04, 0.3571D-04, & + & 0.2686D-04, 0.2011D-04, 0.1501D-04, 0.1111D-04, 0.8263D-05, & + & 0.6013D-05/ + + data (calcpts(j,41), j = 1,neta) /0.3632D-12, 0.6459D-12, & + & 0.1148D-11, 0.2042D-11, 0.3632D-11, 0.6458D-11, 0.1148D-10, & + & 0.2043D-10, 0.3630D-10, 0.6457D-10, 0.1149D-09, 0.2042D-09, & + & 0.3631D-09, 0.6458D-09, 0.1148D-08, 0.2041D-08, 0.3630D-08, & + & 0.6452D-08, 0.1147D-07, 0.2038D-07, 0.3619D-07, 0.6427D-07, & + & 0.1141D-06, 0.2022D-06, 0.3578D-06, 0.6320D-06, 0.1112D-05, & + & 0.1949D-05, 0.3393D-05, 0.5850D-05, 0.9954D-05, 0.1663D-04, & + & 0.2710D-04, 0.4276D-04, 0.6483D-04, 0.9367D-04, 0.1284D-03, & + & 0.1666D-03, 0.2049D-03, 0.2404D-03, 0.2708D-03, 0.2954D-03, & + & 0.3142D-03, 0.3280D-03, 0.3377D-03, 0.3440D-03, 0.3475D-03, & + & 0.3487D-03, 0.3476D-03, 0.3443D-03, 0.3385D-03, 0.3302D-03, & + & 0.3193D-03, 0.3059D-03, 0.2896D-03, 0.2702D-03, 0.2473D-03, & + & 0.2213D-03, 0.1933D-03, 0.1650D-03, 0.1377D-03, 0.1127D-03, & + & 0.9046D-04, 0.7172D-04, 0.5598D-04, 0.4323D-04, 0.3318D-04, & + & 0.2508D-04, 0.1894D-04, 0.1414D-04, 0.1054D-04, 0.7838D-05, & + & 0.5738D-05/ + + data (calcpts(j,42), j = 1,neta) /0.2594D-12, 0.4613D-12, & + & 0.8200D-12, 0.1458D-11, 0.2594D-11, 0.4613D-11, 0.8202D-11, & + & 0.1459D-10, 0.2593D-10, 0.4612D-10, 0.8203D-10, 0.1458D-09, & + & 0.2593D-09, 0.4612D-09, 0.8197D-09, 0.1458D-08, 0.2592D-08, & + & 0.4608D-08, 0.8190D-08, 0.1456D-07, 0.2585D-07, 0.4590D-07, & + & 0.8147D-07, 0.1444D-06, 0.2555D-06, 0.4514D-06, 0.7942D-06, & + & 0.1392D-05, 0.2423D-05, 0.4178D-05, 0.7110D-05, 0.1188D-04, & + & 0.1935D-04, 0.3054D-04, 0.4630D-04, 0.6691D-04, 0.9170D-04, & + & 0.1190D-03, 0.1464D-03, 0.1717D-03, 0.1935D-03, 0.2111D-03, & + & 0.2246D-03, 0.2345D-03, 0.2416D-03, 0.2463D-03, 0.2492D-03, & + & 0.2506D-03, 0.2506D-03, 0.2492D-03, 0.2463D-03, 0.2418D-03, & + & 0.2356D-03, 0.2277D-03, 0.2179D-03, 0.2063D-03, 0.1923D-03, & + & 0.1759D-03, 0.1573D-03, 0.1373D-03, 0.1171D-03, 0.9766D-04, & + & 0.7982D-04, 0.6408D-04, 0.5073D-04, 0.3964D-04, 0.3064D-04, & + & 0.2344D-04, 0.1774D-04, 0.1339D-04, 0.1009D-04, 0.7391D-05, & + & 0.5591D-05/ + + data (calcpts(j,43), j = 1,neta) /0.1849D-12, 0.3288D-12, & + & 0.5844D-12, 0.1039D-11, 0.1849D-11, 0.3287D-11, 0.5846D-11, & + & 0.1040D-10, 0.1848D-10, 0.3287D-10, 0.5846D-10, 0.1039D-09, & + & 0.1848D-09, 0.3287D-09, 0.5842D-09, 0.1039D-08, 0.1848D-08, & + & 0.3284D-08, 0.5837D-08, 0.1037D-07, 0.1842D-07, 0.3271D-07, & + & 0.5806D-07, 0.1029D-06, 0.1821D-06, 0.3217D-06, 0.5660D-06, & + & 0.9920D-06, 0.1727D-05, 0.2978D-05, 0.5067D-05, 0.8466D-05, & + & 0.1379D-04, 0.2177D-04, 0.3300D-04, 0.4768D-04, 0.6535D-04, & + & 0.8480D-04, 0.1043D-03, 0.1224D-03, 0.1379D-03, 0.1505D-03, & + & 0.1601D-03, 0.1672D-03, 0.1723D-03, 0.1758D-03, 0.1781D-03, & + & 0.1793D-03, 0.1797D-03, 0.1793D-03, 0.1780D-03, 0.1757D-03, & + & 0.1723D-03, 0.1678D-03, 0.1620D-03, 0.1550D-03, 0.1466D-03, & + & 0.1366D-03, 0.1249D-03, 0.1116D-03, 0.9738D-04, 0.8296D-04, & + & 0.6912D-04, 0.5646D-04, 0.4534D-04, 0.3586D-04, 0.2796D-04, & + & 0.2166D-04, 0.1656D-04, 0.1251D-04, 0.9358D-05, 0.7108D-05, & + & 0.5308D-05/ + + data (calcpts(j,44), j = 1,neta) /0.1315D-12, 0.2338D-12, & + & 0.4156D-12, 0.7392D-12, 0.1315D-11, 0.2338D-11, 0.4157D-11, & + & 0.7394D-11, 0.1314D-10, 0.2337D-10, 0.4158D-10, 0.7392D-10, & + & 0.1314D-09, 0.2338D-09, 0.4155D-09, 0.7389D-09, 0.1314D-08, & + & 0.2336D-08, 0.4151D-08, 0.7378D-08, 0.1310D-07, 0.2327D-07, & + & 0.4129D-07, 0.7318D-07, 0.1295D-06, 0.2288D-06, 0.4025D-06, & + & 0.7055D-06, 0.1228D-05, 0.2118D-05, 0.3604D-05, 0.6021D-05, & + & 0.9809D-05, 0.1548D-04, 0.2347D-04, 0.3391D-04, 0.4648D-04, & + & 0.6031D-04, 0.7419D-04, 0.8705D-04, 0.9810D-04, 0.1070D-03, & + & 0.1139D-03, 0.1190D-03, 0.1227D-03, 0.1252D-03, 0.1269D-03, & + & 0.1279D-03, 0.1284D-03, 0.1284D-03, 0.1278D-03, 0.1267D-03, & + & 0.1250D-03, 0.1225D-03, 0.1192D-03, 0.1150D-03, 0.1100D-03, & + & 0.1040D-03, 0.9684D-04, 0.8850D-04, 0.7906D-04, 0.6892D-04, & + & 0.5868D-04, 0.4886D-04, 0.3989D-04, 0.3200D-04, 0.2530D-04, & + & 0.1973D-04, 0.1522D-04, 0.1162D-04, 0.8801D-05, 0.6626D-05, & + & 0.4946D-05/ + + data (calcpts(j,45), j = 1,neta) /0.9338D-13, 0.1661D-12, & + & 0.2952D-12, 0.5250D-12, 0.9339D-12, 0.1660D-11, 0.2953D-11, & + & 0.5252D-11, 0.9334D-11, 0.1660D-10, 0.2953D-10, 0.5250D-10, & + & 0.9336D-10, 0.1660D-09, 0.2951D-09, 0.5248D-09, 0.9332D-09, & + & 0.1659D-08, 0.2948D-08, 0.5240D-08, 0.9305D-08, 0.1652D-07, & + & 0.2933D-07, 0.5198D-07, 0.9199D-07, 0.1625D-06, 0.2859D-06, & + & 0.5011D-06, 0.8724D-06, 0.1504D-05, 0.2559D-05, 0.4276D-05, & + & 0.6967D-05, 0.1099D-04, 0.1667D-04, 0.2409D-04, 0.3301D-04, & + & 0.4283D-04, 0.5270D-04, 0.6183D-04, 0.6968D-04, 0.7602D-04, & + & 0.8091D-04, 0.8454D-04, 0.8715D-04, 0.8899D-04, 0.9023D-04, & + & 0.9102D-04, 0.9146D-04, 0.9159D-04, 0.9142D-04, 0.9093D-04, & + & 0.9007D-04, 0.8875D-04, 0.8693D-04, 0.8453D-04, 0.8154D-04, & + & 0.7794D-04, 0.7367D-04, 0.6859D-04, 0.6266D-04, 0.5594D-04, & + & 0.4876D-04, 0.4149D-04, 0.3453D-04, 0.2818D-04, 0.2260D-04, & + & 0.1785D-04, 0.1394D-04, 0.1074D-04, 0.8206D-05, 0.6226D-05, & + & 0.4681D-05/ + + data (calcpts(j,46), j = 1,neta) /0.6618D-13, 0.1177D-12, & + & 0.2092D-12, 0.3721D-12, 0.6619D-12, 0.1177D-11, 0.2093D-11, & + & 0.3722D-11, 0.6616D-11, 0.1177D-10, 0.2093D-10, 0.3721D-10, & + & 0.6617D-10, 0.1177D-09, 0.2092D-09, 0.3720D-09, 0.6615D-09, & + & 0.1176D-08, 0.2090D-08, 0.3714D-08, 0.6595D-08, 0.1171D-07, & + & 0.2079D-07, 0.3684D-07, 0.6520D-07, 0.1152D-06, 0.2026D-06, & + & 0.3552D-06, 0.6184D-06, 0.1066D-05, 0.1814D-05, 0.3031D-05, & + & 0.4938D-05, 0.7793D-05, 0.1181D-04, 0.1707D-04, 0.2340D-04, & + & 0.3036D-04, 0.3735D-04, 0.4382D-04, 0.4939D-04, 0.5389D-04, & + & 0.5735D-04, 0.5993D-04, 0.6179D-04, 0.6311D-04, 0.6400D-04, & + & 0.6460D-04, 0.6495D-04, 0.6512D-04, 0.6510D-04, 0.6491D-04, & + & 0.6451D-04, 0.6385D-04, 0.6288D-04, 0.6156D-04, 0.5983D-04, & + & 0.5770D-04, 0.5513D-04, 0.5209D-04, 0.4849D-04, 0.4426D-04, & + & 0.3951D-04, 0.3441D-04, 0.2927D-04, 0.2435D-04, 0.1985D-04, & + & 0.1592D-04, 0.1257D-04, 0.9799D-05, 0.7549D-05, 0.5764D-05, & + & 0.4369D-05/ + + data (calcpts(j,47), j = 1,neta) /0.4684D-13, 0.8331D-13, & + & 0.1481D-12, 0.2634D-12, 0.4684D-12, 0.8329D-12, 0.1481D-11, & + & 0.2634D-11, 0.4682D-11, 0.8328D-11, 0.1481D-10, 0.2634D-10, & + & 0.4683D-10, 0.8329D-10, 0.1480D-09, 0.2632D-09, 0.4681D-09, & + & 0.8321D-09, 0.1479D-08, 0.2629D-08, 0.4667D-08, 0.8289D-08, & + & 0.1471D-07, 0.2607D-07, 0.4614D-07, 0.8151D-07, 0.1434D-06, & + & 0.2513D-06, 0.4376D-06, 0.7545D-06, 0.1284D-05, 0.2145D-05, & + & 0.3494D-05, 0.5515D-05, 0.8361D-05, 0.1208D-04, 0.1656D-04, & + & 0.2149D-04, 0.2643D-04, 0.3101D-04, 0.3495D-04, 0.3814D-04, & + & 0.4059D-04, 0.4242D-04, 0.4374D-04, 0.4467D-04, 0.4532D-04, & + & 0.4575D-04, 0.4603D-04, 0.4618D-04, 0.4622D-04, 0.4616D-04, & + & 0.4598D-04, 0.4567D-04, 0.4518D-04, 0.4448D-04, 0.4352D-04, & + & 0.4229D-04, 0.4076D-04, 0.3894D-04, 0.3678D-04, 0.3422D-04, & + & 0.3123D-04, 0.2786D-04, 0.2426D-04, 0.2062D-04, 0.1714D-04, & + & 0.1397D-04, 0.1120D-04, 0.8828D-05, 0.6878D-05, 0.5303D-05, & + & 0.4043D-05/ + + data (calcpts(j,48), j = 1,neta) /0.3311D-13, 0.5889D-13, & + & 0.1047D-12, 0.1862D-12, 0.3311D-12, 0.5887D-12, 0.1047D-11, & + & 0.1862D-11, 0.3310D-11, 0.5886D-11, 0.1047D-10, 0.1862D-10, & + & 0.3310D-10, 0.5887D-10, 0.1046D-09, 0.1861D-09, 0.3309D-09, & + & 0.5882D-09, 0.1045D-08, 0.1858D-08, 0.3299D-08, 0.5859D-08, & + & 0.1040D-07, 0.1843D-07, 0.3262D-07, 0.5761D-07, 0.1014D-06, & + & 0.1777D-06, 0.3093D-06, 0.5333D-06, 0.9075D-06, 0.1516D-05, & + & 0.2470D-05, 0.3898D-05, 0.5910D-05, 0.8540D-05, 0.1171D-04, & + & 0.1519D-04, 0.1869D-04, 0.2192D-04, 0.2471D-04, 0.2696D-04, & + & 0.2869D-04, 0.2999D-04, 0.3092D-04, 0.3158D-04, 0.3204D-04, & + & 0.3236D-04, 0.3256D-04, 0.3268D-04, 0.3274D-04, 0.3274D-04, & + & 0.3267D-04, 0.3252D-04, 0.3228D-04, 0.3193D-04, 0.3142D-04, & + & 0.3073D-04, 0.2985D-04, 0.2877D-04, 0.2747D-04, 0.2594D-04, & + & 0.2413D-04, 0.2202D-04, 0.1964D-04, 0.1709D-04, 0.1452D-04, & + & 0.1206D-04, 0.9827D-05, 0.7877D-05, 0.6212D-05, 0.4832D-05, & + & 0.3722D-05/ + + data (calcpts(j,49), j = 1,neta) /0.2337D-13, 0.4157D-13, & + & 0.7388D-13, 0.1314D-12, 0.2337D-12, 0.4156D-12, 0.7390D-12, & + & 0.1314D-11, 0.2336D-11, 0.4155D-11, 0.7391D-11, 0.1314D-10, & + & 0.2337D-10, 0.4156D-10, 0.7386D-10, 0.1313D-09, 0.2336D-09, & + & 0.4152D-09, 0.7379D-09, 0.1312D-08, 0.2329D-08, 0.4136D-08, & + & 0.7340D-08, 0.1301D-07, 0.2302D-07, 0.4067D-07, 0.7156D-07, & + & 0.1254D-06, 0.2184D-06, 0.3765D-06, 0.6406D-06, 0.1070D-05, & + & 0.1744D-05, 0.2752D-05, 0.4172D-05, 0.6028D-05, 0.8263D-05, & + & 0.1072D-04, 0.1319D-04, 0.1548D-04, 0.1744D-04, 0.1903D-04, & + & 0.2026D-04, 0.2117D-04, 0.2183D-04, 0.2230D-04, 0.2263D-04, & + & 0.2285D-04, 0.2300D-04, 0.2309D-04, 0.2314D-04, 0.2316D-04, & + & 0.2314D-04, 0.2308D-04, 0.2296D-04, 0.2279D-04, 0.2253D-04, & + & 0.2216D-04, 0.2167D-04, 0.2104D-04, 0.2028D-04, 0.1936D-04, & + & 0.1828D-04, 0.1700D-04, 0.1550D-04, 0.1382D-04, 0.1202D-04, & + & 0.1021D-04, 0.8483D-05, 0.6900D-05, 0.5535D-05, 0.4365D-05, & + & 0.3390D-05/ + + data (dlaeta(j), j = 1,neta) / & + & -6d0, -5.83333333d0, -5.66666667d0, -5.5d0, -5.33333333d0, & + & -5.16666667d0, -5d0, -4.83333333d0, -4.66666667d0, -4.5d0, & + & -4.33333333d0, -4.16666667d0, -4d0, -3.83333333d0, & + & -3.66666667d0, -3.5d0, -3.33333333d0, -3.16666667d0, -3d0, & + & -2.83333333d0, -2.66666667d0, -2.5d0, -2.33333333d0, & + & -2.16666667d0, -2d0, -1.83333333d0, -1.66666667d0, -1.5d0, & + & -1.33333333d0, -1.16666667d0, -1d0, -0.83333333d0, -0.66666667d0,& + & -0.5d0, -0.33333333d0, -0.16666667d0, 0d0, 0.16666667d0, & + & 0.33333333d0, 0.5d0, 0.66666667d0, 0.83333333d0, 1d0, & + & 1.16666667d0, 1.33333333d0, 1.5d0, 1.66666667d0, 1.83333333d0, & + & 2d0, 2.16666667d0, 2.33333333d0, 2.5d0, 2.66666667d0, & + & 2.83333333d0, 3d0, 3.16666667d0, 3.33333333d0, 3.5d0, & + & 3.66666667d0, 3.83333333d0, 4d0, 4.16666667d0, 4.33333333d0, & + & 4.5d0, 4.66666667d0, 4.83333333d0, 5d0, 5.16666667d0, & + & 5.33333333d0, 5.5d0, 5.66666667d0, 5.83333333d0, 6d0/ + + data (dlaxi(j), j = 1,nxi) / & + & -3d0, -2.83333333d0, -2.66666667d0, -2.5d0, -2.33333333d0, & + & -2.16666667d0, -2d0, -1.83333333d0, -1.66666667d0, -1.5d0, & + & -1.33333333d0, -1.16666667d0, -1d0, -0.83333333d0, -0.66666667d0,& + & -0.5d0, -0.33333333d0, -0.16666667d0, 0d0, 0.16666667d0, & + & 0.33333333d0, 0.5d0, 0.66666667d0, 0.83333333d0, 1d0, & + & 1.16666667d0, 1.33333333d0, 1.5d0, 1.66666667d0, 1.83333333d0, & + & 2d0, 2.16666667d0, 2.33333333d0, 2.5d0, 2.66666667d0, & + & 2.83333333d0, 3d0, 3.16666667d0, 3.33333333d0, 3.5d0, & + & 3.66666667d0, 3.83333333d0, 4d0, 4.16666667d0, 4.33333333d0, & + & 4.5d0, 4.66666667d0, 4.83333333d0, 5d0/ + + dleta = dlog10(eta) + dlxi = dlog10(xi) + if (dlxi .le. dlaxi(1)) dlxi = dlaxi(1) + if (dlxi .ge. dlaxi(nxi)) dlxi = dlaxi(nxi) + if (dleta .ge. dlaeta(neta)) dleta = dlaeta(neta) + if (dleta .le. dlaeta(1)) dleta = dlaeta(1) + call locate(dlaeta,neta, dleta, ieta) + call locate(dlaxi, nxi, dlxi, ixi) +! interpolating between the appropriate points + delxi = 1d0/6d0 + deleta = 1d0/6d0 +! lagrange 3-pt. + if (ixi .le. 2) ixi = 2 + if (ixi .ge. 48) ixi = 48 + if (ieta .le. 2) ieta = 2 + if (ieta .ge. 72) ieta = 72 + pxi = (dlxi - dlaxi(ixi))/delxi + f(-1) = pxi*(pxi-1d0)/2d0*calcpts(ieta-1,ixi-1) + & + & (1d0 - pxi**2)*calcpts(ieta-1,ixi) + & + & pxi*(pxi+1d0)/2d0*calcpts(ieta-1,ixi+1) + f(0) = pxi*(pxi-1d0)/2d0*calcpts(ieta,ixi-1) + & + & (1d0 - pxi**2)*calcpts(ieta,ixi) + & + & pxi*(pxi+1d0)/2d0*calcpts(ieta,ixi+1) + f(1) = pxi*(pxi-1d0)/2d0*calcpts(ieta+1,ixi-1) + & + & (1d0 - pxi**2)*calcpts(ieta+1,ixi) + & + & pxi*(pxi+1d0)/2d0*calcpts(ieta+1,ixi+1) + peta = (dleta - dlaeta(ieta))/deleta + h1bar_HTq = peta*(peta-1d0)/2d0*f(-1) + & + & (1d0 - peta**2)*f(0) + & + & peta*(peta+1d0)/2d0*f(1) +!MB + + peta*(peta+1d0)/2d0*f(1) + return + END + +! ========================================= + double precision function h1f_LTq(eta,xi) +! ========================================= + +! eq (28) in PLB347 (1995) 143 - 151 for the transverse piece +! This also takes into account the additional mass factorizations +! necessary from a low Q^2 photon coupling to the light quark. +! MSbar scheme +! This routine is called subd1tqf in the original code. +! Gives h1_LTq for Q2 < 1.5 GeV2 (use h1_LTq for Q2 > 1.5 GeV2) + + implicit none + integer neta, nxi + parameter (neta = 45, nxi = 15) + double precision calcpts(neta,nxi), aeta(neta), axi(nxi) + double precision eta, xi, huge, small + double precision t, u, y1, y2, y3, y4 + parameter (small = 1.d-8, huge = 1.d10) + integer j, ieta, ixi + + data (calcpts(j, 1), j=1,neta) /0.d0, 0.4019D-05, 0.1896D-04, & + & 0.3899D-04, 0.6269D-04, 0.8935D-04, 0.1037D-03, 0.4849D-03, & + & 0.9762D-03, 0.1525D-02, 0.2108D-02, 0.2406D-02, 0.5362D-02, & + & 0.7965D-02, 0.1012D-01, 0.1186D-01, 0.1328D-01, 0.1443D-01, & + & 0.1537D-01, 0.1616D-01, 0.1682D-01, 0.1986D-01, 0.2073D-01, & + & 0.2096D-01, 0.2088D-01, 0.2067D-01, 0.2037D-01, 0.2001D-01, & + & 0.1965D-01, 0.1929D-01, 0.1370D-01, 0.1084D-01, 0.9107D-02, & + & 0.7934D-02, 0.7464D-02, 0.4891D-02, 0.3756D-02, 0.2645D-02, & + & 0.2090D-02, 0.1746D-02, 0.1617D-02, 0.4779D-03, 0.2775D-03, & + & 0.4104D-04, 0.d0/ +! + data (calcpts(j, 2), j=1,neta) /0.d0, 0.2321D-05, 0.1077D-04, & + & 0.2190D-04, 0.3488D-04, 0.4935D-04, 0.5706D-04, 0.2585D-03, & + & 0.5173D-03, 0.8102D-03, 0.1125D-02, 0.1287D-02, 0.2955D-02, & + & 0.4511D-02, 0.5861D-02, 0.7013D-02, 0.7984D-02, 0.8813D-02, & + & 0.9516D-02, 0.1012D-01, 0.1065D-01, 0.1352D-01, 0.1463D-01, & + & 0.1512D-01, 0.1529D-01, 0.1529D-01, 0.1518D-01, 0.1502D-01, & + & 0.1482D-01, 0.1460D-01, 0.1073D-01, 0.8586D-02, 0.7261D-02, & + & 0.6349D-02, 0.5983D-02, 0.3966D-02, 0.3061D-02, 0.2178D-02, & + & 0.1718D-02, 0.1440D-02, 0.1337D-02, 0.3998D-03, 0.2339D-03, & + & 0.3529D-04, 0.d0/ +! + data (calcpts(j, 3), j=1,neta) /0.d0, 0.5064D-06, 0.2317D-05, & + & 0.4667D-05, 0.7383D-05, 0.1040D-04, 0.1200D-04, 0.5411D-04, & + & 0.1119D-03, 0.1832D-03, 0.2663D-03, 0.3119D-03, 0.8727D-03, & + & 0.1533D-02, 0.2214D-02, 0.2874D-02, 0.3495D-02, 0.4073D-02, & + & 0.4602D-02, 0.5091D-02, 0.5538D-02, 0.8424D-02, 0.9777D-02, & + & 0.1046D-01, 0.1080D-01, 0.1095D-01, 0.1098D-01, 0.1094D-01, & + & 0.1086D-01, 0.1075D-01, 0.8148D-02, 0.6592D-02, 0.5609D-02, & + & 0.4921D-02, 0.4650D-02, 0.3110D-02, 0.2411D-02, 0.1722D-02, & + & 0.1371D-02, 0.1150D-02, 0.1067D-02, 0.3261D-03, 0.1892D-03, & + & 0.2870D-04, 0.d0/ +! + data (calcpts(j, 4), j=1,neta) /0.d0, 0.5228D-08, 0.2381D-07, & + & 0.4875D-07, 0.7962D-07, 0.1172D-06, 0.1388D-06, 0.1292D-05, & + & 0.4892D-05, 0.1220D-04, 0.2403D-04, 0.3177D-04, 0.1790D-03, & + & 0.4347D-03, 0.7627D-03, 0.1131D-02, 0.1518D-02, 0.1906D-02, & + & 0.2291D-02, 0.2660D-02, 0.3014D-02, 0.5617D-02, 0.7014D-02, & + & 0.7787D-02, 0.8220D-02, 0.8455D-02, 0.8574D-02, 0.8612D-02, & + & 0.8603D-02, 0.8558D-02, 0.6753D-02, 0.5525D-02, 0.4737D-02, & + & 0.4176D-02, 0.3954D-02, 0.2678D-02, 0.2087D-02, 0.1502D-02, & + & 0.1196D-02, 0.1007D-02, 0.9338D-03, 0.2877D-03, 0.1692D-03, & + & 0.2625D-04, 0.d0/ +! + data (calcpts(j, 5), j=1,neta) /0.d0, 0.9101D-12, 0.4199D-10, & + & 0.2486D-09, 0.7987D-09, 0.1908D-08, 0.2745D-08, 0.1169D-06, & + & 0.6378D-06, 0.1896D-05, 0.4197D-05, 0.5822D-05, 0.4473D-04, & + & 0.1310D-03, 0.2623D-03, 0.4305D-03, 0.6257D-03, 0.8389D-03, & + & 0.1064D-02, 0.1294D-02, 0.1525D-02, 0.3522D-02, 0.4800D-02, & + & 0.5585D-02, 0.6078D-02, 0.6383D-02, 0.6571D-02, 0.6681D-02, & + & 0.6738D-02, 0.6764D-02, 0.5665D-02, 0.4725D-02, 0.4088D-02, & + & 0.3632D-02, 0.3446D-02, 0.2369D-02, 0.1861D-02, 0.1347D-02, & + & 0.1081D-02, 0.9132D-03, 0.8487D-03, 0.2657D-03, 0.1563D-03, & + & 0.2511D-04, 0.d0/ +! + data (calcpts(j, 6), j=1,neta) /0.d0, 0.2657D-12, 0.1234D-10, & + & 0.7333D-10, 0.2366D-09, 0.5664D-09, 0.8165D-09, 0.3585D-07, & + & 0.2016D-06, 0.6159D-06, 0.1399D-05, 0.1963D-05, 0.1675D-04, & + & 0.5327D-04, 0.1141D-03, 0.1979D-03, 0.3015D-03, 0.4212D-03, & + & 0.5532D-03, 0.6942D-03, 0.8411D-03, 0.2292D-02, 0.3371D-02, & + & 0.4096D-02, 0.4583D-02, 0.4909D-02, 0.5129D-02, 0.5277D-02, & + & 0.5371D-02, 0.5431D-02, 0.4823D-02, 0.4098D-02, 0.3584D-02, & + & 0.3204D-02, 0.3046D-02, 0.2125D-02, 0.1683D-02, 0.1229D-02, & + & 0.9890D-03, 0.8394D-03, 0.7798D-03, 0.2471D-03, 0.1470D-03, & + & 0.2343D-04, 0.d0/ +! + data (calcpts(j, 7), j=1,neta) /0.d0, 0.2199D-12, 0.1022D-10, & + & 0.6069D-10, 0.1959D-09, 0.4690D-09, 0.6762D-09, 0.2974D-07, & + & 0.1674D-06, 0.5122D-06, 0.1165D-05, 0.1637D-05, 0.1405D-04, & + & 0.4497D-04, 0.9692D-04, 0.1690D-03, 0.2589D-03, 0.3633D-03, & + & 0.4793D-03, 0.6040D-03, 0.7347D-03, 0.2058D-02, 0.3074D-02, & + & 0.3776D-02, 0.4248D-02, 0.4574D-02, 0.4796D-02, 0.4949D-02, & + & 0.5048D-02, 0.5115D-02, 0.4613D-02, 0.3939D-02, 0.3453D-02, & + & 0.3095D-02, 0.2944D-02, 0.2064D-02, 0.1636D-02, 0.1198D-02, & + & 0.9665D-03, 0.8193D-03, 0.7636D-03, 0.2445D-03, 0.1445D-03, & + & 0.2312D-04, 0.d0/ +! + data (calcpts(j, 8), j=1,neta) /0.d0, 0.1569D-12, 0.7293D-11, & + & 0.4330D-10, 0.1397D-09, 0.3345D-09, 0.4823D-09, 0.2118D-07, & + & 0.1189D-06, 0.3635D-06, 0.8253D-06, 0.1158D-05, 0.9902D-05, & + & 0.3158D-04, 0.6792D-04, 0.1184D-03, 0.1815D-03, 0.2548D-03, & + & 0.3369D-03, 0.4252D-03, 0.5186D-03, 0.1495D-02, 0.2288D-02, & + & 0.2862D-02, 0.3269D-02, 0.3558D-02, 0.3766D-02, 0.3914D-02, & + & 0.4020D-02, 0.4095D-02, 0.3882D-02, 0.3377D-02, 0.2991D-02, & + & 0.2703D-02, 0.2580D-02, 0.1839D-02, 0.1469D-02, 0.1086D-02, & + & 0.8801D-03, 0.7482D-03, 0.6992D-03, 0.2261D-03, 0.1353D-03, & + & 0.2217D-04, 0.d0/ +! + data (calcpts(j, 9), j=1,neta) /0.d0, 0.1509D-12, 0.7016D-11, & + & 0.4166D-10, 0.1344D-09, 0.3218D-09, 0.4636D-09, 0.2035D-07, & + & 0.1142D-06, 0.3489D-06, 0.7914D-06, 0.1111D-05, 0.9461D-05, & + & 0.3008D-04, 0.6453D-04, 0.1122D-03, 0.1716D-03, 0.2406D-03, & + & 0.3174D-03, 0.4000D-03, 0.4874D-03, 0.1394D-02, 0.2127D-02, & + & 0.2660D-02, 0.3038D-02, 0.3311D-02, 0.3506D-02, 0.3646D-02, & + & 0.3748D-02, 0.3820D-02, 0.3657D-02, 0.3196D-02, 0.2844D-02, & + & 0.2571D-02, 0.2460D-02, 0.1764D-02, 0.1415D-02, 0.1049D-02, & + & 0.8515D-03, 0.7264D-03, 0.6773D-03, 0.2231D-03, 0.1328D-03, & + & 0.2174D-04, 0.d0/ +! + data (calcpts(j,10), j=1,neta) /0.d0, 0.1441D-12, 0.6693D-11, & + & 0.3978D-10, 0.1282D-09, 0.3069D-09, 0.4423D-09, 0.1938D-07, & + & 0.1087D-06, 0.3317D-06, 0.7515D-06, 0.1054D-05, 0.8930D-05, & + & 0.2825D-04, 0.6027D-04, 0.1043D-03, 0.1588D-03, 0.2217D-03, & + & 0.2913D-03, 0.3657D-03, 0.4437D-03, 0.1233D-02, 0.1845D-02, & + & 0.2274D-02, 0.2570D-02, 0.2775D-02, 0.2918D-02, 0.3018D-02, & + & 0.3085D-02, 0.3134D-02, 0.2930D-02, 0.2574D-02, 0.2306D-02, & + & 0.2102D-02, 0.2018D-02, 0.1478D-02, 0.1200D-02, 0.9031D-03, & + & 0.7391D-03, 0.6339D-03, 0.5926D-03, 0.1992D-03, 0.1202D-03, & + & 0.2022D-04, 0.d0/ +! + data (calcpts(j,11), j=1,neta) /0.d0, 0.1434D-12, 0.6663D-11, & + & 0.3955D-10, 0.1276D-09, 0.3054D-09, 0.4402D-09, 0.1929D-07, & + & 0.1082D-06, 0.3299D-06, 0.7475D-06, 0.1048D-05, 0.8874D-05, & + & 0.2804D-04, 0.5983D-04, 0.1035D-03, 0.1574D-03, 0.2197D-03, & + & 0.2885D-03, 0.3621D-03, 0.4391D-03, 0.1215D-02, 0.1814D-02, & + & 0.2226D-02, 0.2508D-02, 0.2697D-02, 0.2825D-02, 0.2909D-02, & + & 0.2961D-02, 0.2994D-02, 0.2604D-02, 0.2208D-02, 0.1946D-02, & + & 0.1758D-02, 0.1681D-02, 0.1229D-02, 0.1005D-02, 0.7642D-03, & + & 0.6311D-03, 0.5433D-03, 0.5108D-03, 0.1779D-03, 0.1087D-03, & + & 0.1860D-04, 0.d0/ +! + data (calcpts(j,12), j=1,neta) /0.d0, 0.1433D-12, 0.6657D-11, & + & 0.3953D-10, 0.1275D-09, 0.3053D-09, 0.4401D-09, 0.1929D-07, & + & 0.1081D-06, 0.3297D-06, 0.7470D-06, 0.1048D-05, 0.8868D-05, & + & 0.2804D-04, 0.5979D-04, 0.1034D-03, 0.1574D-03, 0.2196D-03, & + & 0.2883D-03, 0.3619D-03, 0.4391D-03, 0.1216D-02, 0.1818D-02, & + & 0.2238D-02, 0.2525D-02, 0.2720D-02, 0.2855D-02, 0.2943D-02, & + & 0.3000D-02, 0.3036D-02, 0.2630D-02, 0.2171D-02, 0.1860D-02, & + & 0.1643D-02, 0.1555D-02, 0.1076D-02, 0.8619D-03, 0.6490D-03, & + & 0.5361D-03, 0.4630D-03, 0.4353D-03, 0.1560D-03, 0.9623D-04, & + & 0.1727D-04, 0.d0/ +! + data (calcpts(j,13), j=1,neta) /0.d0, 0.1401D-12, 0.6668D-11, & + & 0.3954D-10, 0.1275D-09, 0.3053D-09, 0.4398D-09, 0.1928D-07, & + & 0.1081D-06, 0.3296D-06, 0.7470D-06, 0.1048D-05, 0.8868D-05, & + & 0.2804D-04, 0.5979D-04, 0.1034D-03, 0.1574D-03, 0.2196D-03, & + & 0.2883D-03, 0.3621D-03, 0.4389D-03, 0.1217D-02, 0.1821D-02, & + & 0.2244D-02, 0.2535D-02, 0.2736D-02, 0.2876D-02, 0.2970D-02, & + & 0.3035D-02, 0.3074D-02, 0.2727D-02, 0.2277D-02, 0.1956D-02, & + & 0.1722D-02, 0.1625D-02, 0.1073D-02, 0.8265D-03, 0.5928D-03, & + & 0.4775D-03, 0.4067D-03, 0.3804D-03, 0.1358D-03, 0.8456D-04, & + & 0.1560D-04, 0.d0/ +! + data (calcpts(j,14), j=1,neta) /0.d0, 0.4279D-12, 0.7533D-11, & + & 0.4041D-10, 0.1273D-09, 0.3024D-09, 0.4428D-09, 0.1926D-07, & + & 0.1081D-06, 0.3296D-06, 0.7469D-06, 0.1048D-05, 0.8865D-05, & + & 0.2804D-04, 0.5978D-04, 0.1034D-03, 0.1574D-03, 0.2196D-03, & + & 0.2885D-03, 0.3621D-03, 0.4392D-03, 0.1218D-02, 0.1824D-02, & + & 0.2249D-02, 0.2541D-02, 0.2744D-02, 0.2886D-02, 0.2982D-02, & + & 0.3050D-02, 0.3091D-02, 0.2793D-02, 0.2369D-02, 0.2064D-02, & + & 0.1838D-02, 0.1744D-02, 0.1188D-02, 0.9171D-03, 0.6428D-03, & + & 0.5015D-03, 0.4140D-03, 0.3816D-03, 0.1146D-03, 0.7074D-04, & + & 0.1332D-04, 0.d0/ +! + data (calcpts(j,15), j=1,neta) /0.d0, 0.0000D+00, 0.8481D-11, & + & 0.1250D-10, 0.1173D-09, 0.3631D-09, 0.4731D-09, 0.1937D-07, & + & 0.1080D-06, 0.3296D-06, 0.7471D-06, 0.1048D-05, 0.8865D-05, & + & 0.2802D-04, 0.5976D-04, 0.1034D-03, 0.1574D-03, 0.2196D-03, & + & 0.2885D-03, 0.3619D-03, 0.4391D-03, 0.1218D-02, 0.1824D-02, & + & 0.2249D-02, 0.2543D-02, 0.2745D-02, 0.2888D-02, 0.2985D-02, & + & 0.3051D-02, 0.3095D-02, 0.2802D-02, 0.2385D-02, 0.2084D-02, & + & 0.1860D-02, 0.1769D-02, 0.1219D-02, 0.9522D-03, 0.6765D-03, & + & 0.5313D-03, 0.4398D-03, 0.4059D-03, 0.1124D-03, 0.6680D-04, & + & 0.1251D-04, 0.d0/ +! + data (aeta(j), j = 1,neta) /small, 0.1000d-02, 0.3000d-02, & + & 0.5000d-02, 0.7000d-02, 0.9000d-02, 0.1000d-01, 0.3000d-01, & + & 0.5000d-01, 0.7000d-01, 0.9000d-01, 0.1000d+00, 0.2000d+00, & + & 0.3000d+00, 0.4000d+00, 0.5000d+00, 0.6000d+00, 0.7000d+00, & + & 0.8000d+00, 0.9000d+00, 0.1000d+01, 0.2000d+01, 0.3000d+01, & + & 0.4000d+01, 0.5000d+01, 0.6000d+01, 0.7000d+01, 0.8000d+01, & + & 0.9000d+01, 0.1000d+02, 0.3000d+02, 0.5000d+02, 0.7000d+02, & + & 0.9000d+02, 0.1000d+03, 0.2000d+03, 0.3000d+03, 0.5000d+03, & + & 0.7000d+03, 0.9000d+03, 0.1000d+04, 0.5000d+04, 0.1000d+05, & + & 0.1000d+06, huge/ +! + data (axi(j), j = 1,nxi) /0.1000d-01, 0.3162d-01, 0.1000d+00, & + & 0.3162d+00, 0.1000d+01, 0.2500d+01, 0.3162d+01, 0.7500d+01, & + & 0.1000d+02, 0.3162d+02, 0.1000d+03, 0.3162d+03, 0.1000d+04, & + & 0.5000d+04, 0.1000d+05/ +! +! here we have to choose the array elements that will go into the +! interpolation. + call locate(aeta, neta, eta, ieta) + call locate(axi, nxi, xi, ixi) + if (ieta .le. 1) ieta = 1 + if (ieta .gt. (neta - 1)) ieta = neta - 1 + if (ixi .le. 1) ixi = 1 + if (ixi .gt. (nxi - 1)) ixi = nxi - 1 + y1 = calcpts(ieta,ixi) + y2 = calcpts(ieta+1,ixi) + y3 = calcpts(ieta+1,ixi+1) + y4 = calcpts(ieta,ixi+1) +! interpolating between the points + t = (eta - aeta(ieta))/(aeta(ieta + 1) - aeta(ieta)) + u = (xi - axi(ixi))/(axi(ixi + 1) - axi(ixi)) + h1f_LTq = (1.d0 - t)*(1.d0 - u)*y1 + t*(1.d0 - u)*y2 + & + & t*u*y3 + (1.d0 - t)*u*y4 + + return + END + +! ========================================= + double precision function h1_LTq(eta,xi) +! ========================================= + +! eq (28) in PLB347 (1995) 143 - 151 for the transverse piece +! MSbar scheme +! This routine is called subd1tq in the original code. +! Gives h1_LTq for Q2 > 1.5 GeV2 (use h1f_LTq for Q2 < 1.5 GeV2) +! Called sclqt in updated code (03/06/96). + + implicit none + integer neta, nxi + parameter (neta = 73, nxi = 49) + double precision calcpts(neta, nxi), dlaeta(neta), dlaxi(nxi) + double precision eta, xi, dleta, dlxi + double precision pxi, peta, f(-1:1), delxi, deleta + integer j, ieta, ixi + + data (calcpts(j, 1), j = 1,neta) /0.2418D-16, 0.9248D-16, & + & 0.3534D-15, 0.1349D-14, 0.5144D-14, 0.1956D-13, 0.7412D-13, & + & 0.2795D-12, 0.1046D-11, 0.3876D-11, 0.1417D-10, 0.5081D-10, & + & 0.1778D-09, 0.6021D-09, 0.1964D-08, 0.6116D-08, 0.1817D-07, & + & 0.5128D-07, 0.1377D-06, 0.3524D-06, 0.8631D-06, 0.2031D-05, & + & 0.4617D-05, 0.1017D-04, 0.2177D-04, 0.4545D-04, 0.9263D-04, & + & 0.1844D-03, 0.3577D-03, 0.6750D-03, 0.1232D-02, 0.2160D-02, & + & 0.3605D-02, 0.5666D-02, 0.8313D-02, 0.1131D-01, 0.1428D-01, & + & 0.1683D-01, 0.1868D-01, 0.1970D-01, 0.1988D-01, 0.1925D-01, & + & 0.1794D-01, 0.1616D-01, 0.1410D-01, 0.1198D-01, 0.9952D-02, & + & 0.8106D-02, 0.6494D-02, 0.5132D-02, 0.4007D-02, 0.3097D-02, & + & 0.2373D-02, 0.1806D-02, 0.1364D-02, 0.1025D-02, 0.7660D-03, & + & 0.5700D-03, 0.4222D-03, 0.3117D-03, 0.2294D-03, 0.1682D-03, & + & 0.1230D-03, 0.8970D-04, 0.6527D-04, 0.4739D-04, 0.3434D-04, & + & 0.2483D-04, 0.1791D-04, 0.1291D-04, 0.9285D-05, 0.6669D-05, & + & 0.4784D-05/ + + data (calcpts(j, 2), j = 1,neta) /0.1123D-16, 0.4299D-16, & + & 0.1644D-15, 0.6287D-15, 0.2400D-14, 0.9147D-14, 0.3479D-13, & + & 0.1318D-12, 0.4970D-12, 0.1860D-11, 0.6894D-11, 0.2520D-10, & + & 0.9034D-10, 0.3161D-09, 0.1071D-08, 0.3488D-08, 0.1087D-07, & + & 0.3229D-07, 0.9114D-07, 0.2447D-06, 0.6258D-06, 0.1532D-05, & + & 0.3602D-05, 0.8169D-05, 0.1794D-04, 0.3830D-04, 0.7952D-04, & + & 0.1608D-03, 0.3164D-03, 0.6040D-03, 0.1114D-02, 0.1971D-02, & + & 0.3317D-02, 0.5253D-02, 0.7759D-02, 0.1063D-01, 0.1349D-01, & + & 0.1597D-01, 0.1781D-01, 0.1886D-01, 0.1908D-01, 0.1852D-01, & + & 0.1731D-01, 0.1561D-01, 0.1366D-01, 0.1163D-01, 0.9669D-02, & + & 0.7886D-02, 0.6324D-02, 0.5003D-02, 0.3910D-02, 0.3025D-02, & + & 0.2321D-02, 0.1767D-02, 0.1336D-02, 0.1004D-02, 0.7509D-03, & + & 0.5590D-03, 0.4145D-03, 0.3060D-03, 0.2253D-03, 0.1653D-03, & + & 0.1209D-03, 0.8825D-04, 0.6423D-04, 0.4665D-04, 0.3381D-04, & + & 0.2445D-04, 0.1765D-04, 0.1272D-04, 0.9156D-05, 0.6579D-05, & + & 0.4719D-05/ + + data (calcpts(j, 3), j = 1,neta) /0.5218D-17, 0.1998D-16, & + & 0.7647D-16, 0.2925D-15, 0.1118D-14, 0.4268D-14, 0.1626D-13, & + & 0.6185D-13, 0.2343D-12, 0.8836D-12, 0.3308D-11, 0.1226D-10, & + & 0.4481D-10, 0.1607D-09, 0.5619D-09, 0.1904D-08, 0.6199D-08, & + & 0.1932D-07, 0.5739D-07, 0.1619D-06, 0.4344D-06, 0.1110D-05, & + & 0.2715D-05, 0.6374D-05, 0.1442D-04, 0.3158D-04, 0.6700D-04, & + & 0.1381D-03, 0.2762D-03, 0.5346D-03, 0.9981D-03, 0.1785D-02, & + & 0.3032D-02, 0.4842D-02, 0.7208D-02, 0.9939D-02, 0.1270D-01, & + & 0.1512D-01, 0.1694D-01, 0.1800D-01, 0.1828D-01, 0.1781D-01, & + & 0.1668D-01, 0.1509D-01, 0.1322D-01, 0.1127D-01, 0.9386D-02, & + & 0.7664D-02, 0.6155D-02, 0.4874D-02, 0.3813D-02, 0.2953D-02, & + & 0.2267D-02, 0.1726D-02, 0.1307D-02, 0.9832D-03, 0.7359D-03, & + & 0.5481D-03, 0.4065D-03, 0.3005D-03, 0.2212D-03, 0.1624D-03, & + & 0.1189D-03, 0.8678D-04, 0.6320D-04, 0.4592D-04, 0.3329D-04, & + & 0.2409D-04, 0.1740D-04, 0.1254D-04, 0.9027D-05, 0.6488D-05, & + & 0.4656D-05/ + + data (calcpts(j, 4), j = 1,neta) /0.2424D-17, 0.9281D-17, & + & 0.3554D-16, 0.1360D-15, 0.5202D-15, 0.1988D-14, 0.7590D-14, & + & 0.2893D-13, 0.1100D-12, 0.4168D-12, 0.1572D-11, 0.5883D-11, & + & 0.2180D-10, 0.7967D-10, 0.2858D-09, 0.9992D-09, 0.3381D-08, & + & 0.1102D-07, 0.3435D-07, 0.1020D-06, 0.2876D-06, 0.7709D-06, & + & 0.1968D-05, 0.4806D-05, 0.1125D-04, 0.2538D-04, 0.5526D-04, & + & 0.1164D-03, 0.2373D-03, 0.4670D-03, 0.8841D-03, 0.1601D-02, & + & 0.2748D-02, 0.4434D-02, 0.6657D-02, 0.9254D-02, 0.1191D-01, & + & 0.1426D-01, 0.1607D-01, 0.1716D-01, 0.1749D-01, 0.1710D-01, & + & 0.1605D-01, 0.1455D-01, 0.1278D-01, 0.1091D-01, 0.9102D-02, & + & 0.7443D-02, 0.5985D-02, 0.4745D-02, 0.3717D-02, 0.2881D-02, & + & 0.2214D-02, 0.1688D-02, 0.1278D-02, 0.9624D-03, 0.7208D-03, & + & 0.5372D-03, 0.3987D-03, 0.2948D-03, 0.2172D-03, 0.1595D-03, & + & 0.1168D-03, 0.8532D-04, 0.6216D-04, 0.4518D-04, 0.3276D-04, & + & 0.2371D-04, 0.1713D-04, 0.1236D-04, 0.8898D-05, 0.6398D-05, & + & 0.4592D-05/ + + data (calcpts(j, 5), j = 1,neta) /0.1125D-17, 0.4310D-17, & + & 0.1650D-16, 0.6320D-16, 0.2418D-15, 0.9251D-15, 0.3535D-14, & + & 0.1350D-13, 0.5145D-13, 0.1956D-12, 0.7412D-12, 0.2795D-11, & + & 0.1046D-10, 0.3878D-10, 0.1417D-09, 0.5081D-09, 0.1776D-08, & + & 0.6011D-08, 0.1959D-07, 0.6104D-07, 0.1810D-06, 0.5103D-06, & + & 0.1367D-05, 0.3486D-05, 0.8489D-05, 0.1981D-04, 0.4444D-04, & + & 0.9606D-04, 0.2001D-03, 0.4016D-03, 0.7731D-03, 0.1420D-02, & + & 0.2469D-02, 0.4028D-02, 0.6110D-02, 0.8570D-02, 0.1111D-01, & + & 0.1341D-01, 0.1520D-01, 0.1631D-01, 0.1670D-01, 0.1638D-01, & + & 0.1544D-01, 0.1402D-01, 0.1233D-01, 0.1055D-01, 0.8818D-02, & + & 0.7222D-02, 0.5816D-02, 0.4617D-02, 0.3619D-02, 0.2809D-02, & + & 0.2160D-02, 0.1649D-02, 0.1250D-02, 0.9416D-03, 0.7056D-03, & + & 0.5263D-03, 0.3909D-03, 0.2892D-03, 0.2132D-03, 0.1566D-03, & + & 0.1148D-03, 0.8385D-04, 0.6111D-04, 0.4444D-04, 0.3225D-04, & + & 0.2336D-04, 0.1688D-04, 0.1217D-04, 0.8769D-05, 0.6306D-05, & + & 0.4528D-05/ + + data (calcpts(j, 6), j = 1,neta) /0.5224D-18, 0.2001D-17, & + & 0.7665D-17, 0.2936D-16, 0.1124D-15, 0.4301D-15, 0.1646D-14, & + & 0.6288D-14, 0.2400D-13, 0.9149D-13, 0.3479D-12, 0.1318D-11, & + & 0.4969D-11, 0.1860D-10, 0.6894D-10, 0.2519D-09, 0.9032D-09, & + & 0.3154D-08, 0.1068D-07, 0.3480D-07, 0.1084D-06, 0.3215D-06, & + & 0.9049D-06, 0.2420D-05, 0.6157D-05, 0.1495D-04, 0.3471D-04, & + & 0.7731D-04, 0.1653D-03, 0.3392D-03, 0.6657D-03, 0.1244D-02, & + & 0.2195D-02, 0.3627D-02, 0.5567D-02, 0.7890D-02, 0.1033D-01, & + & 0.1256D-01, 0.1432D-01, 0.1546D-01, 0.1592D-01, 0.1566D-01, & + & 0.1480D-01, 0.1348D-01, 0.1189D-01, 0.1020D-01, 0.8535D-02, & + & 0.7002D-02, 0.5646D-02, 0.4488D-02, 0.3524D-02, 0.2738D-02, & + & 0.2108D-02, 0.1610D-02, 0.1221D-02, 0.9207D-03, 0.6905D-03, & + & 0.5154D-03, 0.3830D-03, 0.2835D-03, 0.2091D-03, 0.1537D-03, & + & 0.1127D-03, 0.8240D-04, 0.6008D-04, 0.4371D-04, 0.3172D-04, & + & 0.2298D-04, 0.1662D-04, 0.1199D-04, 0.8640D-05, 0.6216D-05, & + & 0.4464D-05/ + + data (calcpts(j, 7), j = 1,neta) /0.2426D-18, 0.9293D-18, & + & 0.3560D-17, 0.1363D-16, 0.5220D-16, 0.1998D-15, 0.7649D-15, & + & 0.2925D-14, 0.1118D-13, 0.4269D-13, 0.1628D-12, 0.6186D-12, & + & 0.2344D-11, 0.8837D-11, 0.3308D-10, 0.1226D-09, 0.4479D-09, & + & 0.1605D-08, 0.5606D-08, 0.1898D-07, 0.6182D-07, 0.1925D-06, & + & 0.5700D-06, 0.1602D-05, 0.4277D-05, 0.1085D-04, 0.2621D-04, & + & 0.6041D-04, 0.1331D-03, 0.2804D-03, 0.5631D-03, 0.1073D-02, & + & 0.1928D-02, 0.3234D-02, 0.5030D-02, 0.7214D-02, 0.9542D-02, & + & 0.1171D-01, 0.1346D-01, 0.1462D-01, 0.1512D-01, 0.1494D-01, & + & 0.1417D-01, 0.1295D-01, 0.1145D-01, 0.9839D-02, 0.8252D-02, & + & 0.6782D-02, 0.5476D-02, 0.4359D-02, 0.3428D-02, 0.2665D-02, & + & 0.2054D-02, 0.1571D-02, 0.1193D-02, 0.8998D-03, 0.6755D-03, & + & 0.5045D-03, 0.3752D-03, 0.2780D-03, 0.2050D-03, 0.1509D-03, & + & 0.1107D-03, 0.8093D-04, 0.5904D-04, 0.4298D-04, 0.3120D-04, & + & 0.2261D-04, 0.1635D-04, 0.1181D-04, 0.8511D-05, 0.6124D-05, & + & 0.4401D-05/ + + data (calcpts(j, 8), j = 1,neta) /0.1126D-18, 0.4314D-18, & + & 0.1653D-17, 0.6330D-17, 0.2424D-16, 0.9284D-16, 0.3554D-15, & + & 0.1360D-14, 0.5202D-14, 0.1989D-13, 0.7591D-13, 0.2894D-12, & + & 0.1100D-11, 0.4169D-11, 0.1572D-10, 0.5882D-10, 0.2180D-09, & + & 0.7962D-09, 0.2850D-08, 0.9960D-08, 0.3371D-07, 0.1097D-06, & + & 0.3413D-06, 0.1010D-05, 0.2832D-05, 0.7536D-05, 0.1902D-04, & + & 0.4563D-04, 0.1041D-03, 0.2262D-03, 0.4664D-03, 0.9094D-03, & + & 0.1667D-02, 0.2847D-02, 0.4498D-02, 0.6543D-02, 0.8759D-02, & + & 0.1086D-01, 0.1259D-01, 0.1378D-01, 0.1432D-01, 0.1422D-01, & + & 0.1354D-01, 0.1241D-01, 0.1101D-01, 0.9482D-02, 0.7970D-02, & + & 0.6561D-02, 0.5307D-02, 0.4230D-02, 0.3330D-02, 0.2594D-02, & + & 0.2001D-02, 0.1532D-02, 0.1164D-02, 0.8790D-03, 0.6603D-03, & + & 0.4935D-03, 0.3674D-03, 0.2723D-03, 0.2010D-03, 0.1480D-03, & + & 0.1086D-03, 0.7947D-04, 0.5801D-04, 0.4224D-04, 0.3068D-04, & + & 0.2224D-04, 0.1610D-04, 0.1163D-04, 0.8382D-05, 0.6033D-05, & + & 0.4337D-05/ + + data (calcpts(j, 9), j = 1,neta) /0.5227D-19, 0.2003D-18, & + & 0.7671D-18, 0.2938D-17, 0.1126D-16, 0.4311D-16, 0.1652D-15, & + & 0.6321D-15, 0.2419D-14, 0.9252D-14, 0.3537D-13, 0.1350D-12, & + & 0.5145D-12, 0.1956D-11, 0.7413D-11, 0.2794D-10, 0.1046D-09, & + & 0.3874D-09, 0.1415D-08, 0.5064D-08, 0.1770D-07, 0.5985D-07, & + & 0.1946D-06, 0.6045D-06, 0.1785D-05, 0.4993D-05, 0.1322D-04, & + & 0.3315D-04, 0.7875D-04, 0.1771D-03, 0.3768D-03, 0.7551D-03, & + & 0.1417D-02, 0.2472D-02, 0.3978D-02, 0.5880D-02, 0.7983D-02, & + & 0.1002D-01, 0.1173D-01, 0.1293D-01, 0.1353D-01, 0.1351D-01, & + & 0.1291D-01, 0.1188D-01, 0.1056D-01, 0.9123D-02, 0.7686D-02, & + & 0.6340D-02, 0.5138D-02, 0.4103D-02, 0.3234D-02, 0.2522D-02, & + & 0.1947D-02, 0.1492D-02, 0.1135D-02, 0.8582D-03, 0.6452D-03, & + & 0.4827D-03, 0.3594D-03, 0.2666D-03, 0.1969D-03, 0.1451D-03, & + & 0.1065D-03, 0.7800D-04, 0.5697D-04, 0.4149D-04, 0.3017D-04, & + & 0.2187D-04, 0.1584D-04, 0.1144D-04, 0.8253D-05, 0.5943D-05, & + & 0.4273D-05/ + + data (calcpts(j,10), j = 1,neta) /0.2427D-19, 0.9297D-19, & + & 0.3561D-18, 0.1364D-17, 0.5227D-17, 0.2003D-16, 0.7668D-16, & + & 0.2937D-15, 0.1124D-14, 0.4302D-14, 0.1646D-13, 0.6290D-13, & + & 0.2401D-12, 0.9151D-12, 0.3479D-11, 0.1318D-10, 0.4970D-10, & + & 0.1860D-09, 0.6888D-09, 0.2511D-08, 0.8997D-08, 0.3141D-07, & + & 0.1062D-06, 0.3449D-06, 0.1069D-05, 0.3147D-05, 0.8768D-05, & + & 0.2307D-04, 0.5728D-04, 0.1342D-03, 0.2958D-03, 0.6119D-03, & + & 0.1181D-02, 0.2110D-02, 0.3471D-02, 0.5228D-02, 0.7215D-02, & + & 0.9179D-02, 0.1087D-01, 0.1209D-01, 0.1275D-01, 0.1279D-01, & + & 0.1229D-01, 0.1135D-01, 0.1012D-01, 0.8766D-02, 0.7403D-02, & + & 0.6120D-02, 0.4968D-02, 0.3974D-02, 0.3136D-02, 0.2449D-02, & + & 0.1895D-02, 0.1453D-02, 0.1107D-02, 0.8375D-03, 0.6302D-03, & + & 0.4718D-03, 0.3516D-03, 0.2610D-03, 0.1931D-03, 0.1422D-03, & + & 0.1045D-03, 0.7655D-04, 0.5592D-04, 0.4075D-04, 0.2964D-04, & + & 0.2151D-04, 0.1557D-04, 0.1126D-04, 0.8124D-05, 0.5852D-05, & + & 0.4209D-05/ + + data (calcpts(j,11), j = 1,neta) /0.1127D-19, 0.4317D-19, & + & 0.1653D-18, 0.6334D-18, 0.2427D-17, 0.9297D-17, 0.3561D-16, & + & 0.1364D-15, 0.5223D-15, 0.2000D-14, 0.7653D-14, 0.2927D-13, & + & 0.1119D-12, 0.4270D-12, 0.1627D-11, 0.6187D-11, 0.2344D-10, & + & 0.8835D-10, 0.3306D-09, 0.1224D-08, 0.4463D-08, 0.1597D-07, & + & 0.5574D-07, 0.1881D-06, 0.6101D-06, 0.1885D-05, 0.5529D-05, & + & 0.1531D-04, 0.3992D-04, 0.9777D-04, 0.2246D-03, 0.4818D-03, & + & 0.9605D-03, 0.1767D-02, 0.2981D-02, 0.4590D-02, 0.6457D-02, & + & 0.8346D-02, 0.1001D-01, 0.1125D-01, 0.1196D-01, 0.1208D-01, & + & 0.1166D-01, 0.1081D-01, 0.9681D-02, 0.8409D-02, 0.7119D-02, & + & 0.5898D-02, 0.4799D-02, 0.3844D-02, 0.3040D-02, 0.2378D-02, & + & 0.1841D-02, 0.1414D-02, 0.1078D-02, 0.8166D-03, 0.6150D-03, & + & 0.4608D-03, 0.3438D-03, 0.2553D-03, 0.1890D-03, 0.1393D-03, & + & 0.1024D-03, 0.7509D-04, 0.5489D-04, 0.4002D-04, 0.2911D-04, & + & 0.2114D-04, 0.1531D-04, 0.1108D-04, 0.7995D-05, 0.5762D-05, & + & 0.4146D-05/ + + data (calcpts(j,12), j = 1,neta) /0.5232D-20, 0.2004D-19, & + & 0.7680D-19, 0.2941D-18, 0.1127D-17, 0.4318D-17, 0.1654D-16, & + & 0.6336D-16, 0.2427D-15, 0.9293D-15, 0.3558D-14, 0.1361D-13, & + & 0.5208D-13, 0.1991D-12, 0.7597D-12, 0.2895D-11, 0.1101D-10, & + & 0.4170D-10, 0.1571D-09, 0.5877D-09, 0.2175D-08, 0.7928D-08, & + & 0.2835D-07, 0.9882D-07, 0.3330D-06, 0.1077D-05, 0.3317D-05, & + & 0.9666D-05, 0.2652D-04, 0.6827D-04, 0.1641D-03, 0.3672D-03, & + & 0.7601D-03, 0.1446D-02, 0.2514D-02, 0.3972D-02, 0.5714D-02, & + & 0.7524D-02, 0.9161D-02, 0.1042D-01, 0.1117D-01, 0.1137D-01, & + & 0.1104D-01, 0.1028D-01, 0.9240D-02, 0.8052D-02, 0.6837D-02, & + & 0.5678D-02, 0.4629D-02, 0.3716D-02, 0.2943D-02, 0.2306D-02, & + & 0.1788D-02, 0.1375D-02, 0.1049D-02, 0.7957D-03, 0.5998D-03, & + & 0.4500D-03, 0.3359D-03, 0.2498D-03, 0.1850D-03, 0.1365D-03, & + & 0.1004D-03, 0.7362D-04, 0.5385D-04, 0.3929D-04, 0.2861D-04, & + & 0.2078D-04, 0.1506D-04, 0.1089D-04, 0.7866D-05, 0.5670D-05, & + & 0.4082D-05/ + + data (calcpts(j,13), j = 1,neta) /0.2432D-20, 0.9314D-20, & + & 0.3569D-19, 0.1367D-18, 0.5238D-18, 0.2007D-17, 0.7688D-17, & + & 0.2945D-16, 0.1128D-15, 0.4320D-15, 0.1654D-14, 0.6333D-14, & + & 0.2424D-13, 0.9270D-13, 0.3543D-12, 0.1352D-11, 0.5153D-11, & + & 0.1959D-10, 0.7419D-10, 0.2795D-09, 0.1045D-08, 0.3861D-08, & + & 0.1408D-07, 0.5031D-07, 0.1750D-06, 0.5883D-06, 0.1896D-05, & + & 0.5805D-05, 0.1678D-04, 0.4548D-04, 0.1150D-03, 0.2696D-03, & + & 0.5826D-03, 0.1153D-02, 0.2075D-02, 0.3379D-02, 0.4991D-02, & + & 0.6716D-02, 0.8320D-02, 0.9593D-02, 0.1039D-01, 0.1066D-01, & + & 0.1041D-01, 0.9750D-02, 0.8799D-02, 0.7695D-02, 0.6554D-02, & + & 0.5457D-02, 0.4459D-02, 0.3588D-02, 0.2847D-02, 0.2234D-02, & + & 0.1734D-02, 0.1336D-02, 0.1021D-02, 0.7749D-03, 0.5849D-03, & + & 0.4391D-03, 0.3281D-03, 0.2441D-03, 0.1809D-03, 0.1336D-03, & + & 0.9832D-04, 0.7217D-04, 0.5282D-04, 0.3855D-04, 0.2808D-04, & + & 0.2040D-04, 0.1480D-04, 0.1071D-04, 0.7737D-05, 0.5580D-05, & + & 0.4019D-05/ + + data (calcpts(j,14), j = 1,neta) /0.1131D-20, 0.4332D-20, & + & 0.1661D-19, 0.6360D-19, 0.2436D-18, 0.9334D-18, 0.3576D-17, & + & 0.1370D-16, 0.5248D-16, 0.2010D-15, 0.7700D-15, 0.2948D-14, & + & 0.1129D-13, 0.4318D-13, 0.1652D-12, 0.6312D-12, 0.2409D-11, & + & 0.9181D-11, 0.3489D-10, 0.1321D-09, 0.4977D-09, 0.1860D-08, & + & 0.6866D-08, 0.2501D-07, 0.8922D-07, 0.3097D-06, 0.1037D-05, & + & 0.3326D-05, 0.1010D-04, 0.2886D-04, 0.7695D-04, 0.1899D-03, & + & 0.4307D-03, 0.8910D-03, 0.1670D-02, 0.2820D-02, 0.4293D-02, & + & 0.5926D-02, 0.7491D-02, 0.8774D-02, 0.9617D-02, 0.9952D-02, & + & 0.9792D-02, 0.9219D-02, 0.8360D-02, 0.7339D-02, 0.6272D-02, & + & 0.5238D-02, 0.4292D-02, 0.3459D-02, 0.2751D-02, 0.2162D-02, & + & 0.1682D-02, 0.1296D-02, 0.9921D-03, 0.7541D-03, 0.5697D-03, & + & 0.4281D-03, 0.3203D-03, 0.2384D-03, 0.1769D-03, 0.1307D-03, & + & 0.9627D-04, 0.7069D-04, 0.5178D-04, 0.3781D-04, 0.2755D-04, & + & 0.2004D-04, 0.1454D-04, 0.1053D-04, 0.7608D-05, 0.5489D-05, & + & 0.3954D-05/ + + data (calcpts(j,15), j = 1,neta) /0.5274D-21, 0.2020D-20, & + & 0.7740D-20, 0.2965D-19, 0.1136D-18, 0.4353D-18, 0.1668D-17, & + & 0.6389D-17, 0.2448D-16, 0.9377D-16, 0.3591D-15, 0.1376D-14, & + & 0.5267D-14, 0.2016D-13, 0.7716D-13, 0.2951D-12, 0.1128D-11, & + & 0.4303D-11, 0.1640D-10, 0.6230D-10, 0.2358D-09, 0.8878D-09, & + & 0.3311D-08, 0.1223D-07, 0.4447D-07, 0.1583D-06, 0.5478D-06, & + & 0.1825D-05, 0.5810D-05, 0.1746D-04, 0.4913D-04, 0.1280D-03, & + & 0.3062D-03, 0.6659D-03, 0.1307D-02, 0.2299D-02, 0.3630D-02, & + & 0.5162D-02, 0.6679D-02, 0.7965D-02, 0.8849D-02, 0.9251D-02, & + & 0.9173D-02, 0.8691D-02, 0.7920D-02, 0.6984D-02, 0.5990D-02, & + & 0.5018D-02, 0.4122D-02, 0.3330D-02, 0.2654D-02, 0.2090D-02, & + & 0.1628D-02, 0.1257D-02, 0.9634D-03, 0.7332D-03, 0.5546D-03, & + & 0.4172D-03, 0.3123D-03, 0.2328D-03, 0.1728D-03, 0.1278D-03, & + & 0.9422D-04, 0.6924D-04, 0.5073D-04, 0.3708D-04, 0.2703D-04, & + & 0.1967D-04, 0.1428D-04, 0.1034D-04, 0.7479D-05, 0.5399D-05, & + & 0.3889D-05/ + + data (calcpts(j,16), j = 1,neta) /0.2473D-21, 0.9471D-21, & + & 0.3629D-20, 0.1390D-19, 0.5327D-19, 0.2040D-18, 0.7818D-18, & + & 0.2995D-17, 0.1148D-16, 0.4397D-16, 0.1685D-15, 0.6450D-15, & + & 0.2471D-14, 0.9459D-14, 0.3621D-13, 0.1386D-12, 0.5300D-12, & + & 0.2025D-11, 0.7727D-11, 0.2943D-10, 0.1118D-09, 0.4230D-09, & + & 0.1591D-08, 0.5928D-08, 0.2187D-07, 0.7937D-07, 0.2817D-06, & + & 0.9701D-06, 0.3212D-05, 0.1012D-04, 0.2997D-04, 0.8255D-04, & + & 0.2088D-03, 0.4799D-03, 0.9918D-03, 0.1830D-02, 0.3011D-02, & + & 0.4431D-02, 0.5892D-02, 0.7172D-02, 0.8091D-02, 0.8556D-02, & + & 0.8559D-02, 0.8166D-02, 0.7484D-02, 0.6629D-02, 0.5708D-02, & + & 0.4797D-02, 0.3953D-02, 0.3202D-02, 0.2558D-02, 0.2018D-02, & + & 0.1575D-02, 0.1218D-02, 0.9348D-03, 0.7124D-03, 0.5396D-03, & + & 0.4063D-03, 0.3045D-03, 0.2271D-03, 0.1688D-03, 0.1249D-03, & + & 0.9216D-04, 0.6777D-04, 0.4969D-04, 0.3635D-04, 0.2652D-04, & + & 0.1931D-04, 0.1402D-04, 0.1016D-04, 0.7350D-05, 0.5307D-05, & + & 0.3826D-05/ + + data (calcpts(j,17), j = 1,neta) /0.1173D-21, 0.4490D-21, & + & 0.1721D-20, 0.6589D-20, 0.2525D-19, 0.9674D-19, 0.3706D-18, & + & 0.1420D-17, 0.5441D-17, 0.2084D-16, 0.7985D-16, 0.3059D-15, & + & 0.1172D-14, 0.4486D-14, 0.1718D-13, 0.6576D-13, 0.2515D-12, & + & 0.9621D-12, 0.3677D-11, 0.1403D-10, 0.5340D-10, 0.2028D-09, & + & 0.7668D-09, 0.2877D-08, 0.1072D-07, 0.3948D-07, 0.1429D-06, & + & 0.5049D-06, 0.1728D-05, 0.5670D-05, 0.1761D-04, 0.5118D-04, & + & 0.1370D-03, 0.3338D-03, 0.7298D-03, 0.1420D-02, 0.2446D-02, & + & 0.3744D-02, 0.5136D-02, 0.6400D-02, 0.7347D-02, 0.7871D-02, & + & 0.7950D-02, 0.7644D-02, 0.7049D-02, 0.6275D-02, 0.5426D-02, & + & 0.4578D-02, 0.3783D-02, 0.3074D-02, 0.2460D-02, 0.1946D-02, & + & 0.1521D-02, 0.1179D-02, 0.9061D-03, 0.6915D-03, 0.5244D-03, & + & 0.3954D-03, 0.2965D-03, 0.2215D-03, 0.1647D-03, 0.1220D-03, & + & 0.9011D-04, 0.6632D-04, 0.4866D-04, 0.3561D-04, 0.2600D-04, & + & 0.1893D-04, 0.1376D-04, 0.9977D-05, 0.7221D-05, 0.5217D-05, & + & 0.3762D-05/ + + data (calcpts(j,18), j = 1,neta) /0.5694D-22, 0.2178D-21, & + & 0.8340D-21, 0.3197D-20, 0.1224D-19, 0.4692D-19, 0.1797D-18, & + & 0.6886D-18, 0.2639D-17, 0.1011D-16, 0.3873D-16, 0.1484D-15, & + & 0.5682D-15, 0.2177D-14, 0.8335D-14, 0.3192D-13, 0.1222D-12, & + & 0.4674D-12, 0.1787D-11, 0.6827D-11, 0.2604D-10, 0.9911D-10, & + & 0.3760D-09, 0.1421D-08, 0.5325D-08, 0.1981D-07, 0.7272D-07, & + & 0.2622D-06, 0.9210D-06, 0.3125D-05, 0.1012D-04, 0.3086D-04, & + & 0.8726D-04, 0.2252D-03, 0.5222D-03, 0.1074D-02, 0.1948D-02, & + & 0.3114D-02, 0.4422D-02, 0.5658D-02, 0.6624D-02, 0.7197D-02, & + & 0.7350D-02, 0.7127D-02, 0.6615D-02, 0.5923D-02, 0.5145D-02, & + & 0.4359D-02, 0.3615D-02, 0.2946D-02, 0.2364D-02, 0.1873D-02, & + & 0.1468D-02, 0.1140D-02, 0.8775D-03, 0.6706D-03, 0.5093D-03, & + & 0.3844D-03, 0.2888D-03, 0.2159D-03, 0.1607D-03, 0.1192D-03, & + & 0.8805D-04, 0.6485D-04, 0.4762D-04, 0.3488D-04, 0.2547D-04, & + & 0.1857D-04, 0.1350D-04, 0.9792D-05, 0.7092D-05, 0.5126D-05, & + & 0.3699D-05/ + + data (calcpts(j,19), j = 1,neta) /0.2892D-22, 0.1104D-21, & + & 0.4228D-21, 0.1620D-20, 0.6209D-20, 0.2379D-19, 0.9114D-19, & + & 0.3492D-18, 0.1338D-17, 0.5126D-17, 0.1964D-16, 0.7522D-16, & + & 0.2882D-15, 0.1104D-14, 0.4228D-14, 0.1618D-13, 0.6200D-13, & + & 0.2373D-12, 0.9077D-12, 0.3470D-11, 0.1325D-10, 0.5052D-10, & + & 0.1922D-09, 0.7287D-09, 0.2744D-08, 0.1028D-07, 0.3815D-07, & + & 0.1394D-06, 0.4995D-06, 0.1739D-05, 0.5822D-05, 0.1850D-04, & + & 0.5489D-04, 0.1494D-03, 0.3666D-03, 0.7981D-03, 0.1525D-02, & + & 0.2552D-02, 0.3762D-02, 0.4955D-02, 0.5926D-02, 0.6543D-02, & + & 0.6762D-02, 0.6616D-02, 0.6188D-02, 0.5574D-02, 0.4866D-02, & + & 0.4140D-02, 0.3447D-02, 0.2817D-02, 0.2268D-02, 0.1802D-02, & + & 0.1415D-02, 0.1101D-02, 0.8490D-03, 0.6498D-03, 0.4941D-03, & + & 0.3735D-03, 0.2810D-03, 0.2103D-03, 0.1566D-03, 0.1163D-03, & + & 0.8600D-04, 0.6339D-04, 0.4659D-04, 0.3414D-04, 0.2496D-04, & + & 0.1820D-04, 0.1324D-04, 0.9609D-05, 0.6963D-05, 0.5036D-05, & + & 0.3635D-05/ + + data (calcpts(j,20), j = 1,neta) /0.1592D-22, 0.6060D-22, & + & 0.2321D-21, 0.8892D-21, 0.3408D-20, 0.1305D-19, 0.5001D-19, & + & 0.1916D-18, 0.7341D-18, 0.2813D-17, 0.1078D-16, 0.4128D-16, & + & 0.1581D-15, 0.6058D-15, 0.2321D-14, 0.8889D-14, 0.3404D-13, & + & 0.1303D-12, 0.4986D-12, 0.1907D-11, 0.7287D-11, 0.2781D-10, & + & 0.1060D-09, 0.4028D-09, 0.1524D-08, 0.5727D-08, 0.2139D-07, & + & 0.7892D-07, 0.2864D-06, 0.1015D-05, 0.3480D-05, 0.1140D-04, & + & 0.3512D-04, 0.9989D-04, 0.2573D-03, 0.5892D-03, 0.1183D-02, & + & 0.2070D-02, 0.3171D-02, 0.4304D-02, 0.5265D-02, 0.5913D-02, & + & 0.6189D-02, 0.6116D-02, 0.5766D-02, 0.5228D-02, 0.4590D-02, & + & 0.3923D-02, 0.3279D-02, 0.2690D-02, 0.2172D-02, 0.1729D-02, & + & 0.1362D-02, 0.1062D-02, 0.8204D-03, 0.6291D-03, 0.4791D-03, & + & 0.3627D-03, 0.2730D-03, 0.2046D-03, 0.1526D-03, 0.1134D-03, & + & 0.8394D-04, 0.6194D-04, 0.4556D-04, 0.3341D-04, 0.2443D-04, & + & 0.1782D-04, 0.1298D-04, 0.9426D-05, 0.6834D-05, 0.4944D-05, & + & 0.3572D-05/ + + data (calcpts(j,21), j = 1,neta) /0.9878D-23, 0.3747D-22, & + & 0.1434D-21, 0.5498D-21, 0.2108D-20, 0.8071D-20, 0.3093D-19, & + & 0.1185D-18, 0.4539D-18, 0.1740D-17, 0.6663D-17, 0.2553D-16, & + & 0.9780D-16, 0.3747D-15, 0.1435D-14, 0.5498D-14, 0.2105D-13, & + & 0.8060D-13, 0.3086D-12, 0.1180D-11, 0.4512D-11, 0.1724D-10, & + & 0.6569D-10, 0.2499D-09, 0.9476D-09, 0.3569D-08, 0.1337D-07, & + & 0.4960D-07, 0.1814D-06, 0.6490D-06, 0.2256D-05, 0.7524D-05, & + & 0.2373D-04, 0.6951D-04, 0.1854D-03, 0.4410D-03, 0.9218D-03, & + & 0.1677D-02, 0.2660D-02, 0.3717D-02, 0.4652D-02, 0.5315D-02, & + & 0.5637D-02, 0.5630D-02, 0.5352D-02, 0.4886D-02, 0.4316D-02, & + & 0.3706D-02, 0.3113D-02, 0.2562D-02, 0.2076D-02, 0.1658D-02, & + & 0.1309D-02, 0.1023D-02, 0.7917D-03, 0.6083D-03, 0.4640D-03, & + & 0.3518D-03, 0.2652D-03, 0.1989D-03, 0.1486D-03, 0.1105D-03, & + & 0.8189D-04, 0.6046D-04, 0.4451D-04, 0.3267D-04, 0.2391D-04, & + & 0.1746D-04, 0.1272D-04, 0.9243D-05, 0.6705D-05, 0.4854D-05, & + & 0.3507D-05/ + + data (calcpts(j,22), j = 1,neta) /0.7062D-23, 0.2674D-22, & + & 0.1023D-21, 0.3922D-21, 0.1503D-20, 0.5758D-20, 0.2206D-19, & + & 0.8454D-19, 0.3239D-18, 0.1241D-17, 0.4755D-17, 0.1821D-16, & + & 0.6978D-16, 0.2673D-15, 0.1024D-14, 0.3923D-14, 0.1501D-13, & + & 0.5751D-13, 0.2202D-12, 0.8422D-12, 0.3221D-11, 0.1230D-10, & + & 0.4690D-10, 0.1785D-09, 0.6773D-09, 0.2553D-08, 0.9576D-08, & + & 0.3558D-07, 0.1304D-06, 0.4683D-06, 0.1637D-05, 0.5496D-05, & + & 0.1751D-04, 0.5196D-04, 0.1410D-03, 0.3428D-03, 0.7349D-03, & + & 0.1374D-02, 0.2240D-02, 0.3207D-02, 0.4098D-02, 0.4761D-02, & + & 0.5115D-02, 0.5162D-02, 0.4949D-02, 0.4551D-02, 0.4044D-02, & + & 0.3494D-02, 0.2946D-02, 0.2436D-02, 0.1980D-02, 0.1587D-02, & + & 0.1256D-02, 0.9835D-03, 0.7632D-03, 0.5874D-03, 0.4490D-03, & + & 0.3408D-03, 0.2574D-03, 0.1933D-03, 0.1446D-03, 0.1076D-03, & + & 0.7983D-04, 0.5901D-04, 0.4347D-04, 0.3194D-04, 0.2339D-04, & + & 0.1708D-04, 0.1246D-04, 0.9060D-05, 0.6576D-05, 0.4763D-05, & + & 0.3444D-05/ + + data (calcpts(j,23), j = 1,neta) /0.5736D-23, 0.2175D-22, & + & 0.8327D-22, 0.3192D-21, 0.1223D-20, 0.4686D-20, 0.1796D-19, & + & 0.6879D-19, 0.2635D-18, 0.1010D-17, 0.3869D-17, 0.1482D-16, & + & 0.5678D-16, 0.2175D-15, 0.8331D-15, 0.3191D-14, 0.1222D-13, & + & 0.4680D-13, 0.1791D-12, 0.6852D-12, 0.2620D-11, 0.1001D-10, & + & 0.3816D-10, 0.1452D-09, 0.5510D-09, 0.2081D-08, 0.7790D-08, & + & 0.2894D-07, 0.1060D-06, 0.3809D-06, 0.1330D-05, 0.4469D-05, & + & 0.1424D-04, 0.4233D-04, 0.1152D-03, 0.2819D-03, 0.6101D-03, & + & 0.1156D-02, 0.1914D-02, 0.2787D-02, 0.3618D-02, 0.4260D-02, & + & 0.4631D-02, 0.4718D-02, 0.4562D-02, 0.4226D-02, 0.3779D-02, & + & 0.3282D-02, 0.2781D-02, 0.2310D-02, 0.1884D-02, 0.1515D-02, & + & 0.1203D-02, 0.9446D-03, 0.7346D-03, 0.5665D-03, 0.4338D-03, & + & 0.3300D-03, 0.2495D-03, 0.1876D-03, 0.1405D-03, 0.1047D-03, & + & 0.7777D-04, 0.5754D-04, 0.4244D-04, 0.3120D-04, 0.2288D-04, & + & 0.1672D-04, 0.1220D-04, 0.8877D-05, 0.6446D-05, 0.4672D-05, & + & 0.3380D-05/ + + data (calcpts(j,24), j = 1,neta) /0.5089D-23, 0.1944D-22, & + & 0.7445D-22, 0.2853D-21, 0.1093D-20, 0.4188D-20, 0.1605D-19, & + & 0.6147D-19, 0.2355D-18, 0.9023D-18, 0.3458D-17, 0.1325D-16, & + & 0.5074D-16, 0.1944D-15, 0.7446D-15, 0.2851D-14, 0.1092D-13, & + & 0.4182D-13, 0.1601D-12, 0.6123D-12, 0.2342D-11, 0.8940D-11, & + & 0.3409D-10, 0.1297D-09, 0.4920D-09, 0.1857D-08, 0.6951D-08, & + & 0.2581D-07, 0.9449D-07, 0.3390D-06, 0.1182D-05, 0.3962D-05, & + & 0.1259D-04, 0.3729D-04, 0.1011D-03, 0.2465D-03, 0.5325D-03, & + & 0.1010D-02, 0.1679D-02, 0.2462D-02, 0.3223D-02, 0.3828D-02, & + & 0.4196D-02, 0.4308D-02, 0.4196D-02, 0.3912D-02, 0.3521D-02, & + & 0.3075D-02, 0.2619D-02, 0.2184D-02, 0.1790D-02, 0.1444D-02, & + & 0.1150D-02, 0.9055D-03, 0.7061D-03, 0.5459D-03, 0.4188D-03, & + & 0.3191D-03, 0.2416D-03, 0.1821D-03, 0.1365D-03, 0.1019D-03, & + & 0.7572D-04, 0.5609D-04, 0.4140D-04, 0.3047D-04, 0.2235D-04, & + & 0.1635D-04, 0.1194D-04, 0.8694D-05, 0.6317D-05, 0.4581D-05, & + & 0.3317D-05/ + + data (calcpts(j,25), j = 1,neta) /0.4752D-23, 0.1836D-22, & + & 0.7038D-22, 0.2695D-21, 0.1032D-20, 0.3957D-20, 0.1516D-19, & + & 0.5808D-19, 0.2225D-18, 0.8525D-18, 0.3266D-17, 0.1251D-16, & + & 0.4794D-16, 0.1836D-15, 0.7035D-15, 0.2694D-14, 0.1032D-13, & + & 0.3951D-13, 0.1512D-12, 0.5784D-12, 0.2211D-11, 0.8445D-11, & + & 0.3221D-10, 0.1225D-09, 0.4647D-09, 0.1753D-08, 0.6560D-08, & + & 0.2435D-07, 0.8906D-07, 0.3190D-06, 0.1111D-05, 0.3716D-05, & + & 0.1177D-04, 0.3473D-04, 0.9371D-04, 0.2271D-03, 0.4874D-03, & + & 0.9189D-03, 0.1521D-02, 0.2228D-02, 0.2918D-02, 0.3474D-02, & + & 0.3820D-02, 0.3941D-02, 0.3857D-02, 0.3616D-02, 0.3271D-02, & + & 0.2874D-02, 0.2460D-02, 0.2061D-02, 0.1697D-02, 0.1374D-02, & + & 0.1098D-02, 0.8669D-03, 0.6777D-03, 0.5250D-03, 0.4036D-03, & + & 0.3082D-03, 0.2339D-03, 0.1764D-03, 0.1325D-03, 0.9899D-04, & + & 0.7366D-04, 0.5461D-04, 0.4037D-04, 0.2973D-04, 0.2183D-04, & + & 0.1599D-04, 0.1168D-04, 0.8510D-05, 0.6187D-05, 0.4491D-05, & + & 0.3252D-05/ + + data (calcpts(j,26), j = 1,neta) /0.4554D-23, 0.1785D-22, & + & 0.6852D-22, 0.2624D-21, 0.1004D-20, 0.3849D-20, 0.1475D-19, & + & 0.5651D-19, 0.2165D-18, 0.8293D-18, 0.3177D-17, 0.1217D-16, & + & 0.4664D-16, 0.1787D-15, 0.6843D-15, 0.2621D-14, 0.1004D-13, & + & 0.3843D-13, 0.1471D-12, 0.5628D-12, 0.2151D-11, 0.8216D-11, & + & 0.3132D-10, 0.1192D-09, 0.4520D-09, 0.1705D-08, 0.6378D-08, & + & 0.2366D-07, 0.8651D-07, 0.3097D-06, 0.1077D-05, 0.3598D-05, & + & 0.1137D-04, 0.3346D-04, 0.8996D-04, 0.2169D-03, 0.4628D-03, & + & 0.8664D-03, 0.1424D-02, 0.2072D-02, 0.2699D-02, 0.3202D-02, & + & 0.3516D-02, 0.3627D-02, 0.3555D-02, 0.3344D-02, 0.3038D-02, & + & 0.2681D-02, 0.2306D-02, 0.1941D-02, 0.1603D-02, 0.1304D-02, & + & 0.1045D-02, 0.8282D-03, 0.6494D-03, 0.5043D-03, 0.3887D-03, & + & 0.2973D-03, 0.2261D-03, 0.1709D-03, 0.1284D-03, 0.9611D-04, & + & 0.7161D-04, 0.5316D-04, 0.3932D-04, 0.2899D-04, 0.2132D-04, & + & 0.1562D-04, 0.1142D-04, 0.8327D-05, 0.6058D-05, 0.4400D-05, & + & 0.3189D-05/ + + data (calcpts(j,27), j = 1,neta) /0.4428D-23, 0.1761D-22, & + & 0.6771D-22, 0.2590D-21, 0.9912D-21, 0.3800D-20, 0.1455D-19, & + & 0.5577D-19, 0.2136D-18, 0.8187D-18, 0.3136D-17, 0.1202D-16, & + & 0.4603D-16, 0.1764D-15, 0.6754D-15, 0.2587D-14, 0.9908D-14, & + & 0.3794D-13, 0.1452D-12, 0.5555D-12, 0.2124D-11, 0.8109D-11, & + & 0.3092D-10, 0.1176D-09, 0.4459D-09, 0.1683D-08, 0.6292D-08, & + & 0.2334D-07, 0.8531D-07, 0.3054D-06, 0.1062D-05, 0.3543D-05, & + & 0.1119D-04, 0.3286D-04, 0.8811D-04, 0.2118D-03, 0.4500D-03, & + & 0.8382D-03, 0.1369D-02, 0.1977D-02, 0.2558D-02, 0.3014D-02, & + & 0.3288D-02, 0.3373D-02, 0.3299D-02, 0.3102D-02, 0.2821D-02, & + & 0.2498D-02, 0.2157D-02, 0.1822D-02, 0.1512D-02, 0.1234D-02, & + & 0.9936D-03, 0.7897D-03, 0.6210D-03, 0.4838D-03, 0.3737D-03, & + & 0.2865D-03, 0.2181D-03, 0.1652D-03, 0.1244D-03, 0.9323D-04, & + & 0.6956D-04, 0.5171D-04, 0.3828D-04, 0.2826D-04, 0.2079D-04, & + & 0.1525D-04, 0.1116D-04, 0.8144D-05, 0.5930D-05, 0.4309D-05, & + & 0.3125D-05/ + + data (calcpts(j,28), j = 1,neta) /0.4341D-23, 0.1749D-22, & + & 0.6735D-22, 0.2576D-21, 0.9849D-21, 0.3777D-20, 0.1447D-19, & + & 0.5542D-19, 0.2124D-18, 0.8136D-18, 0.3117D-17, 0.1194D-16, & + & 0.4575D-16, 0.1752D-15, 0.6714D-15, 0.2571D-14, 0.9848D-14, & + & 0.3771D-13, 0.1443D-12, 0.5520D-12, 0.2110D-11, 0.8059D-11, & + & 0.3072D-10, 0.1169D-09, 0.4432D-09, 0.1672D-08, 0.6254D-08, & + & 0.2319D-07, 0.8475D-07, 0.3033D-06, 0.1054D-05, 0.3516D-05, & + & 0.1110D-04, 0.3256D-04, 0.8724D-04, 0.2094D-03, 0.4437D-03, & + & 0.8241D-03, 0.1341D-02, 0.1926D-02, 0.2476D-02, 0.2895D-02, & + & 0.3132D-02, 0.3189D-02, 0.3096D-02, 0.2897D-02, 0.2631D-02, & + & 0.2329D-02, 0.2016D-02, 0.1710D-02, 0.1424D-02, 0.1167D-02, & + & 0.9424D-03, 0.7516D-03, 0.5929D-03, 0.4632D-03, 0.3587D-03, & + & 0.2756D-03, 0.2103D-03, 0.1596D-03, 0.1204D-03, 0.9035D-04, & + & 0.6752D-04, 0.5024D-04, 0.3725D-04, 0.2752D-04, 0.2026D-04, & + & 0.1488D-04, 0.1090D-04, 0.7960D-05, 0.5800D-05, 0.4218D-05, & + & 0.3062D-05/ + + data (calcpts(j,29), j = 1,neta) /0.4268D-23, 0.1743D-22, & + & 0.6717D-22, 0.2568D-21, 0.9821D-21, 0.3767D-20, 0.1443D-19, & + & 0.5527D-19, 0.2118D-18, 0.8114D-18, 0.3108D-17, 0.1191D-16, & + & 0.4561D-16, 0.1748D-15, 0.6694D-15, 0.2563D-14, 0.9819D-14, & + & 0.3759D-13, 0.1439D-12, 0.5505D-12, 0.2105D-11, 0.8036D-11, & + & 0.3065D-10, 0.1166D-09, 0.4419D-09, 0.1668D-08, 0.6236D-08, & + & 0.2312D-07, 0.8450D-07, 0.3024D-06, 0.1051D-05, 0.3504D-05, & + & 0.1106D-04, 0.3243D-04, 0.8684D-04, 0.2082D-03, 0.4409D-03, & + & 0.8175D-03, 0.1328D-02, 0.1902D-02, 0.2436D-02, 0.2834D-02, & + & 0.3042D-02, 0.3069D-02, 0.2950D-02, 0.2738D-02, 0.2472D-02, & + & 0.2181D-02, 0.1887D-02, 0.1603D-02, 0.1339D-02, 0.1101D-02, & + & 0.8922D-03, 0.7140D-03, 0.5650D-03, 0.4426D-03, 0.3436D-03, & + & 0.2648D-03, 0.2025D-03, 0.1539D-03, 0.1163D-03, 0.8747D-04, & + & 0.6546D-04, 0.4878D-04, 0.3621D-04, 0.2678D-04, 0.1974D-04, & + & 0.1451D-04, 0.1064D-04, 0.7777D-05, 0.5671D-05, 0.4128D-05, & + & 0.2997D-05/ + + data (calcpts(j,30), j = 1,neta) /0.4237D-23, 0.1740D-22, & + & 0.6711D-22, 0.2565D-21, 0.9807D-21, 0.3762D-20, 0.1441D-19, & + & 0.5520D-19, 0.2115D-18, 0.8103D-18, 0.3105D-17, 0.1189D-16, & + & 0.4556D-16, 0.1746D-15, 0.6686D-15, 0.2561D-14, 0.9807D-14, & + & 0.3755D-13, 0.1437D-12, 0.5498D-12, 0.2102D-11, 0.8025D-11, & + & 0.3060D-10, 0.1164D-09, 0.4413D-09, 0.1665D-08, 0.6227D-08, & + & 0.2309D-07, 0.8437D-07, 0.3020D-06, 0.1049D-05, 0.3498D-05, & + & 0.1104D-04, 0.3237D-04, 0.8664D-04, 0.2078D-03, 0.4397D-03, & + & 0.8148D-03, 0.1323D-02, 0.1893D-02, 0.2421D-02, 0.2808D-02, & + & 0.3002D-02, 0.3006D-02, 0.2862D-02, 0.2626D-02, 0.2349D-02, & + & 0.2058D-02, 0.1775D-02, 0.1506D-02, 0.1259D-02, 0.1037D-02, & + & 0.8433D-03, 0.6771D-03, 0.5374D-03, 0.4224D-03, 0.3289D-03, & + & 0.2540D-03, 0.1947D-03, 0.1483D-03, 0.1123D-03, 0.8458D-04, & + & 0.6341D-04, 0.4733D-04, 0.3518D-04, 0.2604D-04, 0.1923D-04, & + & 0.1414D-04, 0.1038D-04, 0.7594D-05, 0.5542D-05, 0.4037D-05, & + & 0.2932D-05/ + + data (calcpts(j,31), j = 1,neta) /0.4208D-23, 0.1743D-22, & + & 0.6705D-22, 0.2565D-21, 0.9801D-21, 0.3759D-20, 0.1440D-19, & + & 0.5517D-19, 0.2113D-18, 0.8097D-18, 0.3102D-17, 0.1189D-16, & + & 0.4554D-16, 0.1745D-15, 0.6681D-15, 0.2559D-14, 0.9801D-14, & + & 0.3753D-13, 0.1436D-12, 0.5495D-12, 0.2100D-11, 0.8020D-11, & + & 0.3059D-10, 0.1163D-09, 0.4410D-09, 0.1664D-08, 0.6222D-08, & + & 0.2307D-07, 0.8433D-07, 0.3018D-06, 0.1048D-05, 0.3495D-05, & + & 0.1103D-04, 0.3234D-04, 0.8656D-04, 0.2075D-03, 0.4392D-03, & + & 0.8139D-03, 0.1321D-02, 0.1891D-02, 0.2420D-02, 0.2805D-02, & + & 0.2994D-02, 0.2985D-02, 0.2823D-02, 0.2565D-02, 0.2267D-02, & + & 0.1966D-02, 0.1682D-02, 0.1420D-02, 0.1185D-02, 0.9775D-03, & + & 0.7964D-03, 0.6411D-03, 0.5104D-03, 0.4023D-03, 0.3143D-03, & + & 0.2433D-03, 0.1870D-03, 0.1427D-03, 0.1083D-03, 0.8172D-04, & + & 0.6135D-04, 0.4586D-04, 0.3414D-04, 0.2530D-04, 0.1871D-04, & + & 0.1378D-04, 0.1012D-04, 0.7412D-05, 0.5414D-05, 0.3947D-05, & + & 0.2870D-05/ + + data (calcpts(j,32), j = 1,neta) /0.4152D-23, 0.1735D-22, & + & 0.6717D-22, 0.2562D-21, 0.9799D-21, 0.3757D-20, 0.1439D-19, & + & 0.5514D-19, 0.2113D-18, 0.8095D-18, 0.3102D-17, 0.1188D-16, & + & 0.4552D-16, 0.1745D-15, 0.6679D-15, 0.2559D-14, 0.9798D-14, & + & 0.3751D-13, 0.1436D-12, 0.5493D-12, 0.2100D-11, 0.8017D-11, & + & 0.3057D-10, 0.1163D-09, 0.4410D-09, 0.1664D-08, 0.6221D-08, & + & 0.2307D-07, 0.8430D-07, 0.3017D-06, 0.1048D-05, 0.3495D-05, & + & 0.1102D-04, 0.3234D-04, 0.8652D-04, 0.2075D-03, 0.4389D-03, & + & 0.8138D-03, 0.1321D-02, 0.1893D-02, 0.2423D-02, 0.2812D-02, & + & 0.3003D-02, 0.2994D-02, 0.2821D-02, 0.2546D-02, 0.2226D-02, & + & 0.1906D-02, 0.1613D-02, 0.1350D-02, 0.1121D-02, 0.9229D-03, & + & 0.7521D-03, 0.6066D-03, 0.4842D-03, 0.3826D-03, 0.2997D-03, & + & 0.2326D-03, 0.1792D-03, 0.1372D-03, 0.1043D-03, 0.7885D-04, & + & 0.5931D-04, 0.4440D-04, 0.3311D-04, 0.2457D-04, 0.1818D-04, & + & 0.1341D-04, 0.9858D-05, 0.7227D-05, 0.5284D-05, 0.3855D-05, & + & 0.2805D-05/ + + data (calcpts(j,33), j = 1,neta) /0.4175D-23, 0.1735D-22, & + & 0.6707D-22, 0.2565D-21, 0.9798D-21, 0.3757D-20, 0.1439D-19, & + & 0.5514D-19, 0.2112D-18, 0.8094D-18, 0.3100D-17, 0.1188D-16, & + & 0.4551D-16, 0.1743D-15, 0.6679D-15, 0.2558D-14, 0.9797D-14, & + & 0.3751D-13, 0.1436D-12, 0.5492D-12, 0.2100D-11, 0.8017D-11, & + & 0.3057D-10, 0.1163D-09, 0.4408D-09, 0.1664D-08, 0.6219D-08, & + & 0.2307D-07, 0.8429D-07, 0.3017D-06, 0.1048D-05, 0.3494D-05, & + & 0.1102D-04, 0.3232D-04, 0.8651D-04, 0.2075D-03, 0.4389D-03, & + & 0.8139D-03, 0.1322D-02, 0.1895D-02, 0.2428D-02, 0.2823D-02, & + & 0.3020D-02, 0.3015D-02, 0.2841D-02, 0.2556D-02, 0.2220D-02, & + & 0.1881D-02, 0.1571D-02, 0.1300D-02, 0.1070D-02, 0.8756D-03, & + & 0.7119D-03, 0.5740D-03, 0.4589D-03, 0.3634D-03, 0.2853D-03, & + & 0.2222D-03, 0.1716D-03, 0.1316D-03, 0.1003D-03, 0.7599D-04, & + & 0.5727D-04, 0.4295D-04, 0.3207D-04, 0.2385D-04, 0.1767D-04, & + & 0.1304D-04, 0.9599D-05, 0.7044D-05, 0.5156D-05, 0.3764D-05, & + & 0.2742D-05/ + + data (calcpts(j,34), j = 1,neta) /0.4158D-23, 0.1734D-22, & + & 0.6731D-22, 0.2564D-21, 0.9796D-21, 0.3757D-20, 0.1439D-19, & + & 0.5514D-19, 0.2112D-18, 0.8094D-18, 0.3100D-17, 0.1188D-16, & + & 0.4551D-16, 0.1743D-15, 0.6678D-15, 0.2558D-14, 0.9797D-14, & + & 0.3750D-13, 0.1436D-12, 0.5492D-12, 0.2100D-11, 0.8016D-11, & + & 0.3057D-10, 0.1163D-09, 0.4408D-09, 0.1664D-08, 0.6219D-08, & + & 0.2307D-07, 0.8429D-07, 0.3017D-06, 0.1048D-05, 0.3494D-05, & + & 0.1102D-04, 0.3232D-04, 0.8651D-04, 0.2075D-03, 0.4391D-03, & + & 0.8140D-03, 0.1323D-02, 0.1898D-02, 0.2433D-02, 0.2834D-02, & + & 0.3038D-02, 0.3039D-02, 0.2871D-02, 0.2585D-02, 0.2240D-02, & + & 0.1886D-02, 0.1556D-02, 0.1271D-02, 0.1033D-02, 0.8375D-03, & + & 0.6769D-03, 0.5445D-03, 0.4352D-03, 0.3452D-03, 0.2715D-03, & + & 0.2118D-03, 0.1641D-03, 0.1261D-03, 0.9634D-04, 0.7314D-04, & + & 0.5523D-04, 0.4149D-04, 0.3104D-04, 0.2312D-04, 0.1715D-04, & + & 0.1267D-04, 0.9339D-05, 0.6861D-05, 0.5027D-05, 0.3674D-05, & + & 0.2677D-05/ + + data (calcpts(j,35), j = 1,neta) /0.4069D-23, 0.1734D-22, & + & 0.6731D-22, 0.2564D-21, 0.9805D-21, 0.3757D-20, 0.1439D-19, & + & 0.5514D-19, 0.2112D-18, 0.8094D-18, 0.3100D-17, 0.1188D-16, & + & 0.4551D-16, 0.1743D-15, 0.6678D-15, 0.2558D-14, 0.9795D-14, & + & 0.3750D-13, 0.1436D-12, 0.5492D-12, 0.2098D-11, 0.8016D-11, & + & 0.3057D-10, 0.1163D-09, 0.4408D-09, 0.1664D-08, 0.6219D-08, & + & 0.2307D-07, 0.8427D-07, 0.3017D-06, 0.1048D-05, 0.3494D-05, & + & 0.1102D-04, 0.3232D-04, 0.8651D-04, 0.2075D-03, 0.4391D-03, & + & 0.8142D-03, 0.1323D-02, 0.1899D-02, 0.2438D-02, 0.2841D-02, & + & 0.3053D-02, 0.3063D-02, 0.2903D-02, 0.2620D-02, 0.2272D-02, & + & 0.1910D-02, 0.1565D-02, 0.1264D-02, 0.1013D-02, 0.8111D-03, & + & 0.6492D-03, 0.5190D-03, 0.4135D-03, 0.3278D-03, 0.2582D-03, & + & 0.2018D-03, 0.1566D-03, 0.1207D-03, 0.9242D-04, 0.7031D-04, & + & 0.5321D-04, 0.4004D-04, 0.3000D-04, 0.2238D-04, 0.1662D-04, & + & 0.1231D-04, 0.9080D-05, 0.6678D-05, 0.4898D-05, 0.3582D-05, & + & 0.2615D-05/ + + data (calcpts(j,36), j = 1,neta) /0.4145D-23, 0.1776D-22, & + & 0.6732D-22, 0.2571D-21, 0.9791D-21, 0.3755D-20, 0.1439D-19, & + & 0.5514D-19, 0.2112D-18, 0.8094D-18, 0.3100D-17, 0.1188D-16, & + & 0.4551D-16, 0.1743D-15, 0.6678D-15, 0.2558D-14, 0.9795D-14, & + & 0.3750D-13, 0.1435D-12, 0.5492D-12, 0.2098D-11, 0.8016D-11, & + & 0.3057D-10, 0.1163D-09, 0.4408D-09, 0.1664D-08, 0.6219D-08, & + & 0.2306D-07, 0.8427D-07, 0.3015D-06, 0.1048D-05, 0.3494D-05, & + & 0.1102D-04, 0.3232D-04, 0.8651D-04, 0.2075D-03, 0.4391D-03, & + & 0.8144D-03, 0.1324D-02, 0.1901D-02, 0.2441D-02, 0.2849D-02, & + & 0.3065D-02, 0.3083D-02, 0.2930D-02, 0.2655D-02, 0.2311D-02, & + & 0.1944D-02, 0.1590D-02, 0.1275D-02, 0.1011D-02, 0.7981D-03, & + & 0.6305D-03, 0.4989D-03, 0.3950D-03, 0.3122D-03, 0.2456D-03, & + & 0.1922D-03, 0.1494D-03, 0.1154D-03, 0.8852D-04, 0.6750D-04, & + & 0.5118D-04, 0.3859D-04, 0.2897D-04, 0.2165D-04, 0.1611D-04, & + & 0.1194D-04, 0.8820D-05, 0.6495D-05, 0.4769D-05, 0.3492D-05, & + & 0.2550D-05/ + + data (calcpts(j,37), j = 1,neta) /0.4138D-23, 0.1734D-22, & + & 0.6732D-22, 0.2570D-21, 0.9789D-21, 0.3757D-20, 0.1439D-19, & + & 0.5514D-19, 0.2112D-18, 0.8094D-18, 0.3100D-17, 0.1188D-16, & + & 0.4551D-16, 0.1743D-15, 0.6678D-15, 0.2558D-14, 0.9795D-14, & + & 0.3750D-13, 0.1435D-12, 0.5492D-12, 0.2098D-11, 0.8016D-11, & + & 0.3057D-10, 0.1163D-09, 0.4408D-09, 0.1664D-08, 0.6219D-08, & + & 0.2306D-07, 0.8427D-07, 0.3015D-06, 0.1048D-05, 0.3494D-05, & + & 0.1102D-04, 0.3232D-04, 0.8651D-04, 0.2075D-03, 0.4391D-03, & + & 0.8145D-03, 0.1324D-02, 0.1902D-02, 0.2443D-02, 0.2853D-02, & + & 0.3074D-02, 0.3097D-02, 0.2952D-02, 0.2685D-02, 0.2348D-02, & + & 0.1982D-02, 0.1625D-02, 0.1301D-02, 0.1024D-02, 0.7987D-03, & + & 0.6221D-03, 0.4856D-03, 0.3806D-03, 0.2987D-03, 0.2343D-03, & + & 0.1832D-03, 0.1425D-03, 0.1102D-03, 0.8471D-04, 0.6473D-04, & + & 0.4917D-04, 0.3716D-04, 0.2795D-04, 0.2091D-04, 0.1559D-04, & + & 0.1157D-04, 0.8561D-05, 0.6312D-05, 0.4640D-05, 0.3402D-05, & + & 0.2487D-05/ + + data (calcpts(j,38), j = 1,neta) /0.3888D-23, 0.1774D-22, & + & 0.6732D-22, 0.2554D-21, 0.9805D-21, 0.3757D-20, 0.1439D-19, & + & 0.5514D-19, 0.2112D-18, 0.8094D-18, 0.3100D-17, 0.1188D-16, & + & 0.4551D-16, 0.1743D-15, 0.6678D-15, 0.2558D-14, 0.9795D-14, & + & 0.3750D-13, 0.1435D-12, 0.5492D-12, 0.2098D-11, 0.8016D-11, & + & 0.3057D-10, 0.1163D-09, 0.4408D-09, 0.1664D-08, 0.6219D-08, & + & 0.2306D-07, 0.8427D-07, 0.3015D-06, 0.1048D-05, 0.3494D-05, & + & 0.1102D-04, 0.3232D-04, 0.8651D-04, 0.2075D-03, 0.4391D-03, & + & 0.8145D-03, 0.1324D-02, 0.1902D-02, 0.2445D-02, 0.2858D-02, & + & 0.3081D-02, 0.3110D-02, 0.2970D-02, 0.2709D-02, 0.2378D-02, & + & 0.2016D-02, 0.1661D-02, 0.1332D-02, 0.1047D-02, 0.8111D-03, & + & 0.6242D-03, 0.4803D-03, 0.3712D-03, 0.2883D-03, 0.2246D-03, & + & 0.1749D-03, 0.1360D-03, 0.1052D-03, 0.8099D-04, 0.6200D-04, & + & 0.4719D-04, 0.3573D-04, 0.2693D-04, 0.2019D-04, 0.1508D-04, & + & 0.1121D-04, 0.8303D-05, 0.6129D-05, 0.4512D-05, 0.3311D-05, & + & 0.2423D-05/ + + data (calcpts(j,39), j = 1,neta) /0.3883D-23, 0.1724D-22, & + & 0.6732D-22, 0.2544D-21, 0.9805D-21, 0.3756D-20, 0.1439D-19, & + & 0.5514D-19, 0.2112D-18, 0.8094D-18, 0.3100D-17, 0.1188D-16, & + & 0.4551D-16, 0.1743D-15, 0.6678D-15, 0.2558D-14, 0.9795D-14, & + & 0.3750D-13, 0.1435D-12, 0.5492D-12, 0.2098D-11, 0.8016D-11, & + & 0.3057D-10, 0.1163D-09, 0.4408D-09, 0.1664D-08, 0.6219D-08, & + & 0.2306D-07, 0.8427D-07, 0.3015D-06, 0.1048D-05, 0.3494D-05, & + & 0.1102D-04, 0.3232D-04, 0.8651D-04, 0.2075D-03, 0.4391D-03, & + & 0.8147D-03, 0.1325D-02, 0.1904D-02, 0.2446D-02, 0.2859D-02, & + & 0.3085D-02, 0.3117D-02, 0.2982D-02, 0.2729D-02, 0.2401D-02, & + & 0.2046D-02, 0.1694D-02, 0.1365D-02, 0.1075D-02, 0.8318D-03, & + & 0.6356D-03, 0.4832D-03, 0.3680D-03, 0.2819D-03, 0.2172D-03, & + & 0.1680D-03, 0.1301D-03, 0.1005D-03, 0.7742D-04, 0.5934D-04, & + & 0.4526D-04, 0.3432D-04, 0.2591D-04, 0.1947D-04, 0.1456D-04, & + & 0.1084D-04, 0.8043D-05, 0.5948D-05, 0.4383D-05, 0.3220D-05, & + & 0.2360D-05/ + + data (calcpts(j,40), j = 1,neta) /0.4569D-23, 0.1774D-22, & + & 0.6616D-22, 0.2544D-21, 0.9809D-21, 0.3756D-20, 0.1439D-19, & + & 0.5514D-19, 0.2112D-18, 0.8094D-18, 0.3100D-17, 0.1188D-16, & + & 0.4551D-16, 0.1743D-15, 0.6678D-15, 0.2558D-14, 0.9795D-14, & + & 0.3750D-13, 0.1435D-12, 0.5492D-12, 0.2098D-11, 0.8016D-11, & + & 0.3057D-10, 0.1163D-09, 0.4408D-09, 0.1664D-08, 0.6219D-08, & + & 0.2306D-07, 0.8427D-07, 0.3015D-06, 0.1048D-05, 0.3494D-05, & + & 0.1102D-04, 0.3232D-04, 0.8651D-04, 0.2075D-03, 0.4391D-03, & + & 0.8147D-03, 0.1325D-02, 0.1904D-02, 0.2448D-02, 0.2862D-02, & + & 0.3089D-02, 0.3123D-02, 0.2993D-02, 0.2742D-02, 0.2420D-02, & + & 0.2069D-02, 0.1721D-02, 0.1394D-02, 0.1104D-02, 0.8562D-03, & + & 0.6533D-03, 0.4932D-03, 0.3709D-03, 0.2799D-03, 0.2127D-03, & + & 0.1627D-03, 0.1251D-03, 0.9633D-04, 0.7409D-04, 0.5679D-04, & + & 0.4335D-04, 0.3294D-04, 0.2491D-04, 0.1875D-04, 0.1404D-04, & + & 0.1048D-04, 0.7787D-05, 0.5764D-05, 0.4254D-05, 0.3129D-05, & + & 0.2295D-05/ + + data (calcpts(j,41), j = 1,neta) /0.4535D-23, 0.1701D-22, & + & 0.6738D-22, 0.2558D-21, 0.9793D-21, 0.3755D-20, 0.1439D-19, & + & 0.5514D-19, 0.2112D-18, 0.8094D-18, 0.3100D-17, 0.1188D-16, & + & 0.4551D-16, 0.1743D-15, 0.6678D-15, 0.2558D-14, 0.9795D-14, & + & 0.3750D-13, 0.1435D-12, 0.5492D-12, 0.2098D-11, 0.8016D-11, & + & 0.3057D-10, 0.1163D-09, 0.4408D-09, 0.1664D-08, 0.6219D-08, & + & 0.2306D-07, 0.8427D-07, 0.3015D-06, 0.1048D-05, 0.3494D-05, & + & 0.1102D-04, 0.3232D-04, 0.8651D-04, 0.2075D-03, 0.4392D-03, & + & 0.8147D-03, 0.1325D-02, 0.1904D-02, 0.2448D-02, 0.2862D-02, & + & 0.3092D-02, 0.3128D-02, 0.2998D-02, 0.2751D-02, 0.2433D-02, & + & 0.2087D-02, 0.1741D-02, 0.1418D-02, 0.1129D-02, 0.8806D-03, & + & 0.6739D-03, 0.5081D-03, 0.3795D-03, 0.2829D-03, 0.2117D-03, & + & 0.1596D-03, 0.1214D-03, 0.9278D-04, 0.7107D-04, 0.5441D-04, & + & 0.4154D-04, 0.3159D-04, 0.2393D-04, 0.1803D-04, 0.1354D-04, & + & 0.1011D-04, 0.7529D-05, 0.5583D-05, 0.4125D-05, 0.3039D-05, & + & 0.2232D-05/ + + data (calcpts(j,42), j = 1,neta) /0.5008D-23, 0.1776D-22, & + & 0.6751D-22, 0.2558D-21, 0.9809D-21, 0.3755D-20, 0.1439D-19, & + & 0.5514D-19, 0.2112D-18, 0.8092D-18, 0.3100D-17, 0.1188D-16, & + & 0.4551D-16, 0.1743D-15, 0.6678D-15, 0.2558D-14, 0.9795D-14, & + & 0.3750D-13, 0.1435D-12, 0.5492D-12, 0.2098D-11, 0.8016D-11, & + & 0.3057D-10, 0.1163D-09, 0.4408D-09, 0.1664D-08, 0.6219D-08, & + & 0.2306D-07, 0.8427D-07, 0.3015D-06, 0.1048D-05, 0.3494D-05, & + & 0.1102D-04, 0.3232D-04, 0.8651D-04, 0.2075D-03, 0.4392D-03, & + & 0.8147D-03, 0.1325D-02, 0.1904D-02, 0.2448D-02, 0.2864D-02, & + & 0.3093D-02, 0.3131D-02, 0.3003D-02, 0.2757D-02, 0.2443D-02, & + & 0.2100D-02, 0.1758D-02, 0.1437D-02, 0.1151D-02, 0.9024D-03, & + & 0.6945D-03, 0.5253D-03, 0.3918D-03, 0.2900D-03, 0.2144D-03, & + & 0.1592D-03, 0.1193D-03, 0.9015D-04, 0.6855D-04, 0.5228D-04, & + & 0.3984D-04, 0.3030D-04, 0.2297D-04, 0.1734D-04, 0.1303D-04, & + & 0.9756D-05, 0.7273D-05, 0.5401D-05, 0.3998D-05, 0.2949D-05, & + & 0.2169D-05/ + + data (calcpts(j,43), j = 1,neta) /0.4451D-23, 0.1773D-22, & + & 0.6620D-22, 0.2545D-21, 0.9812D-21, 0.3755D-20, 0.1439D-19, & + & 0.5513D-19, 0.2112D-18, 0.8094D-18, 0.3100D-17, 0.1188D-16, & + & 0.4551D-16, 0.1743D-15, 0.6678D-15, 0.2558D-14, 0.9795D-14, & + & 0.3750D-13, 0.1435D-12, 0.5492D-12, 0.2098D-11, 0.8016D-11, & + & 0.3057D-10, 0.1163D-09, 0.4408D-09, 0.1664D-08, 0.6219D-08, & + & 0.2306D-07, 0.8427D-07, 0.3015D-06, 0.1048D-05, 0.3494D-05, & + & 0.1102D-04, 0.3232D-04, 0.8651D-04, 0.2075D-03, 0.4392D-03, & + & 0.8147D-03, 0.1325D-02, 0.1904D-02, 0.2448D-02, 0.2864D-02, & + & 0.3095D-02, 0.3132D-02, 0.3006D-02, 0.2763D-02, 0.2449D-02, & + & 0.2109D-02, 0.1769D-02, 0.1451D-02, 0.1167D-02, 0.9204D-03, & + & 0.7127D-03, 0.5421D-03, 0.4059D-03, 0.3000D-03, 0.2200D-03, & + & 0.1614D-03, 0.1191D-03, 0.8873D-04, 0.6671D-04, 0.5048D-04, & + & 0.3833D-04, 0.2910D-04, 0.2205D-04, 0.1667D-04, 0.1254D-04, & + & 0.9401D-05, 0.7020D-05, 0.5222D-05, 0.3870D-05, 0.2859D-05, & + & 0.2105D-05/ + + data (calcpts(j,44), j = 1,neta) /0.4536D-23, 0.1766D-22, & + & 0.6613D-22, 0.2562D-21, 0.9802D-21, 0.3755D-20, 0.1439D-19, & + & 0.5513D-19, 0.2112D-18, 0.8095D-18, 0.3102D-17, 0.1188D-16, & + & 0.4551D-16, 0.1743D-15, 0.6678D-15, 0.2558D-14, 0.9795D-14, & + & 0.3750D-13, 0.1435D-12, 0.5492D-12, 0.2098D-11, 0.8016D-11, & + & 0.3057D-10, 0.1163D-09, 0.4408D-09, 0.1664D-08, 0.6219D-08, & + & 0.2306D-07, 0.8427D-07, 0.3015D-06, 0.1048D-05, 0.3494D-05, & + & 0.1102D-04, 0.3232D-04, 0.8651D-04, 0.2075D-03, 0.4392D-03, & + & 0.8148D-03, 0.1325D-02, 0.1904D-02, 0.2449D-02, 0.2865D-02, & + & 0.3095D-02, 0.3134D-02, 0.3008D-02, 0.2766D-02, 0.2454D-02, & + & 0.2115D-02, 0.1777D-02, 0.1462D-02, 0.1179D-02, 0.9344D-03, & + & 0.7277D-03, 0.5571D-03, 0.4196D-03, 0.3113D-03, 0.2282D-03, & + & 0.1661D-03, 0.1210D-03, 0.8875D-04, 0.6575D-04, 0.4919D-04, & + & 0.3705D-04, 0.2802D-04, 0.2120D-04, 0.1601D-04, 0.1206D-04, & + & 0.9053D-05, 0.6770D-05, 0.5043D-05, 0.3742D-05, 0.2769D-05, & + & 0.2042D-05/ + + data (calcpts(j,45), j = 1,neta) /0.4531D-23, 0.1743D-22, & + & 0.6650D-22, 0.2545D-21, 0.9850D-21, 0.3771D-20, 0.1438D-19, & + & 0.5526D-19, 0.2116D-18, 0.8094D-18, 0.3104D-17, 0.1188D-16, & + & 0.4551D-16, 0.1743D-15, 0.6679D-15, 0.2558D-14, 0.9795D-14, & + & 0.3750D-13, 0.1435D-12, 0.5492D-12, 0.2098D-11, 0.8016D-11, & + & 0.3057D-10, 0.1163D-09, 0.4408D-09, 0.1664D-08, 0.6219D-08, & + & 0.2306D-07, 0.8427D-07, 0.3015D-06, 0.1048D-05, 0.3494D-05, & + & 0.1102D-04, 0.3232D-04, 0.8651D-04, 0.2075D-03, 0.4392D-03, & + & 0.8148D-03, 0.1325D-02, 0.1904D-02, 0.2449D-02, 0.2865D-02, & + & 0.3096D-02, 0.3135D-02, 0.3009D-02, 0.2768D-02, 0.2457D-02, & + & 0.2120D-02, 0.1783D-02, 0.1469D-02, 0.1188D-02, 0.9449D-03, & + & 0.7394D-03, 0.5694D-03, 0.4317D-03, 0.3222D-03, 0.2370D-03, & + & 0.1725D-03, 0.1247D-03, 0.9030D-04, 0.6587D-04, 0.4854D-04, & + & 0.3615D-04, 0.2712D-04, 0.2043D-04, 0.1541D-04, 0.1160D-04, & + & 0.8714D-05, 0.6524D-05, 0.4866D-05, 0.3617D-05, 0.2679D-05, & + & 0.1979D-05/ + + data (calcpts(j,46), j = 1,neta) /0.4427D-23, 0.1749D-22, & + & 0.6682D-22, 0.2549D-21, 0.9752D-21, 0.3768D-20, 0.1432D-19, & + & 0.5490D-19, 0.2113D-18, 0.8091D-18, 0.3100D-17, 0.1188D-16, & + & 0.4550D-16, 0.1743D-15, 0.6677D-15, 0.2558D-14, 0.9795D-14, & + & 0.3750D-13, 0.1435D-12, 0.5492D-12, 0.2098D-11, 0.8016D-11, & + & 0.3057D-10, 0.1163D-09, 0.4408D-09, 0.1664D-08, 0.6219D-08, & + & 0.2306D-07, 0.8427D-07, 0.3015D-06, 0.1048D-05, 0.3494D-05, & + & 0.1102D-04, 0.3232D-04, 0.8651D-04, 0.2075D-03, 0.4392D-03, & + & 0.8148D-03, 0.1325D-02, 0.1904D-02, 0.2449D-02, 0.2865D-02, & + & 0.3096D-02, 0.3135D-02, 0.3011D-02, 0.2769D-02, 0.2460D-02, & + & 0.2122D-02, 0.1787D-02, 0.1474D-02, 0.1195D-02, 0.9525D-03, & + & 0.7480D-03, 0.5790D-03, 0.4416D-03, 0.3318D-03, 0.2457D-03, & + & 0.1794D-03, 0.1297D-03, 0.9321D-04, 0.6711D-04, 0.4869D-04, & + & 0.3573D-04, 0.2649D-04, 0.1980D-04, 0.1487D-04, 0.1117D-04, & + & 0.8388D-05, 0.6284D-05, 0.4692D-05, 0.3492D-05, 0.2591D-05, & + & 0.1916D-05/ + + data (calcpts(j,47), j = 1,neta) /0.4376D-23, 0.1851D-22, & + & 0.6717D-22, 0.2583D-21, 0.1000D-20, 0.3750D-20, 0.1439D-19, & + & 0.5514D-19, 0.2121D-18, 0.8097D-18, 0.3111D-17, 0.1190D-16, & + & 0.4551D-16, 0.1743D-15, 0.6681D-15, 0.2559D-14, 0.9798D-14, & + & 0.3750D-13, 0.1435D-12, 0.5492D-12, 0.2098D-11, 0.8016D-11, & + & 0.3057D-10, 0.1163D-09, 0.4408D-09, 0.1664D-08, 0.6219D-08, & + & 0.2306D-07, 0.8427D-07, 0.3015D-06, 0.1048D-05, 0.3494D-05, & + & 0.1102D-04, 0.3232D-04, 0.8651D-04, 0.2075D-03, 0.4392D-03, & + & 0.8148D-03, 0.1325D-02, 0.1904D-02, 0.2449D-02, 0.2865D-02, & + & 0.3096D-02, 0.3135D-02, 0.3012D-02, 0.2771D-02, 0.2462D-02, & + & 0.2124D-02, 0.1790D-02, 0.1478D-02, 0.1199D-02, 0.9579D-03, & + & 0.7544D-03, 0.5861D-03, 0.4492D-03, 0.3398D-03, 0.2534D-03, & + & 0.1863D-03, 0.1351D-03, 0.9705D-04, 0.6938D-04, 0.4968D-04, & + & 0.3588D-04, 0.2621D-04, 0.1937D-04, 0.1442D-04, 0.1079D-04, & + & 0.8087D-05, 0.6054D-05, 0.4524D-05, 0.3371D-05, 0.2504D-05, & + & 0.1854D-05/ + + data (calcpts(j,48), j = 1,neta) /0.5678D-23, 0.1891D-22, & + & 0.7606D-22, 0.2568D-21, 0.9618D-21, 0.3826D-20, 0.1455D-19, & + & 0.5600D-19, 0.2135D-18, 0.8070D-18, 0.3093D-17, 0.1190D-16, & + & 0.4561D-16, 0.1745D-15, 0.6681D-15, 0.2561D-14, 0.9801D-14, & + & 0.3751D-13, 0.1436D-12, 0.5492D-12, 0.2098D-11, 0.8016D-11, & + & 0.3057D-10, 0.1163D-09, 0.4408D-09, 0.1664D-08, 0.6219D-08, & + & 0.2306D-07, 0.8427D-07, 0.3015D-06, 0.1048D-05, 0.3494D-05, & + & 0.1102D-04, 0.3232D-04, 0.8651D-04, 0.2075D-03, 0.4392D-03, & + & 0.8148D-03, 0.1325D-02, 0.1904D-02, 0.2449D-02, 0.2865D-02, & + & 0.3096D-02, 0.3135D-02, 0.3012D-02, 0.2772D-02, 0.2463D-02, & + & 0.2125D-02, 0.1792D-02, 0.1481D-02, 0.1202D-02, 0.9617D-03, & + & 0.7589D-03, 0.5913D-03, 0.4551D-03, 0.3459D-03, 0.2597D-03, & + & 0.1923D-03, 0.1404D-03, 0.1013D-03, 0.7233D-04, 0.5142D-04, & + & 0.3666D-04, 0.2636D-04, 0.1919D-04, 0.1412D-04, 0.1048D-04, & + & 0.7817D-05, 0.5841D-05, 0.4362D-05, 0.3252D-05, 0.2418D-05, & + & 0.1792D-05/ + + data (calcpts(j,49), j = 1,neta) /0.3773D-23, 0.1720D-22, & + & 0.6603D-22, 0.2522D-21, 0.1040D-20, 0.3992D-20, 0.1503D-19, & + & 0.5605D-19, 0.2113D-18, 0.8140D-18, 0.3115D-17, 0.1187D-16, & + & 0.4551D-16, 0.1745D-15, 0.6692D-15, 0.2561D-14, 0.9800D-14, & + & 0.3749D-13, 0.1435D-12, 0.5492D-12, 0.2098D-11, 0.8016D-11, & + & 0.3057D-10, 0.1163D-09, 0.4408D-09, 0.1664D-08, 0.6219D-08, & + & 0.2306D-07, 0.8427D-07, 0.3015D-06, 0.1048D-05, 0.3494D-05, & + & 0.1102D-04, 0.3232D-04, 0.8651D-04, 0.2075D-03, 0.4392D-03, & + & 0.8148D-03, 0.1325D-02, 0.1904D-02, 0.2449D-02, 0.2865D-02, & + & 0.3096D-02, 0.3136D-02, 0.3012D-02, 0.2772D-02, 0.2463D-02, & + & 0.2127D-02, 0.1792D-02, 0.1482D-02, 0.1204D-02, 0.9644D-03, & + & 0.7620D-03, 0.5949D-03, 0.4593D-03, 0.3505D-03, 0.2645D-03, & + & 0.1971D-03, 0.1451D-03, 0.1054D-03, 0.7557D-04, 0.5369D-04, & + & 0.3800D-04, 0.2695D-04, 0.1931D-04, 0.1400D-04, 0.1027D-04, & + & 0.7599D-05, 0.5652D-05, 0.4212D-05, 0.3138D-05, 0.2334D-05, & + & 0.1731D-05/ + + data (dlaeta(j), j = 1,neta) / & + & -6d0, -5.83333333d0, -5.66666667d0, -5.5d0, -5.33333333d0, & + & -5.16666667d0, -5d0, -4.83333333d0, -4.66666667d0, -4.5d0, & + & -4.33333333d0, -4.16666667d0, -4d0, -3.83333333d0, & + & -3.66666667d0, -3.5d0, -3.33333333d0, -3.16666667d0, -3d0, & + & -2.83333333d0, -2.66666667d0, -2.5d0, -2.33333333d0, & + & -2.16666667d0, -2d0, -1.83333333d0, -1.66666667d0, -1.5d0, & + & -1.33333333d0, -1.16666667d0, -1d0, -0.83333333d0, -0.66666667d0,& + & -0.5d0, -0.33333333d0, -0.16666667d0, 0d0, 0.16666667d0, & + & 0.33333333d0, 0.5d0, 0.66666667d0, 0.83333333d0, 1d0, & + & 1.16666667d0, 1.33333333d0, 1.5d0, 1.66666667d0, 1.83333333d0, & + & 2d0, 2.16666667d0, 2.33333333d0, 2.5d0, 2.66666667d0, & + & 2.83333333d0, 3d0, 3.16666667d0, 3.33333333d0, 3.5d0, & + & 3.66666667d0, 3.83333333d0, 4d0, 4.16666667d0, 4.33333333d0, & + & 4.5d0, 4.66666667d0, 4.83333333d0, 5d0, 5.16666667d0, & + & 5.33333333d0, 5.5d0, 5.66666667d0, 5.83333333d0, 6d0/ + + data (dlaxi(j), j = 1,nxi) / & + & -3d0, -2.83333333d0, -2.66666667d0, -2.5d0, -2.33333333d0, & + & -2.16666667d0, -2d0, -1.83333333d0, -1.66666667d0, -1.5d0, & + & -1.33333333d0, -1.16666667d0, -1d0, -0.83333333d0, -0.66666667d0,& + & -0.5d0, -0.33333333d0, -0.16666667d0, 0d0, 0.16666667d0, & + & 0.33333333d0, 0.5d0, 0.66666667d0, 0.83333333d0, 1d0, & + & 1.16666667d0, 1.33333333d0, 1.5d0, 1.66666667d0, 1.83333333d0, & + & 2d0, 2.16666667d0, 2.33333333d0, 2.5d0, 2.66666667d0, & + & 2.83333333d0, 3d0, 3.16666667d0, 3.33333333d0, 3.5d0, & + & 3.66666667d0, 3.83333333d0, 4d0, 4.16666667d0, 4.33333333d0, & + & 4.5d0, 4.66666667d0, 4.83333333d0, 5d0/ + + dleta = dlog10(eta) + dlxi = dlog10(xi) + if (dlxi .le. dlaxi(1)) dlxi = dlaxi(1) + if (dlxi .ge. dlaxi(nxi)) dlxi = dlaxi(nxi) + if (dleta .ge. dlaeta(neta)) dleta = dlaeta(neta) + if (dleta .le. dlaeta(1)) dleta = dlaeta(1) + call locate(dlaeta,neta, dleta, ieta) + call locate(dlaxi, nxi, dlxi, ixi) +! interpolating between the appropriate points + delxi = 1d0/6d0 + deleta = 1d0/6d0 +! lagrange 3-pt. + if (ixi .le. 2) ixi = 2 + if (ixi .ge. 48) ixi = 48 + if (ieta .le. 2) ieta = 2 + if (ieta .ge. 72) ieta = 72 + pxi = (dlxi - dlaxi(ixi))/delxi + f(-1) = pxi*(pxi-1d0)/2d0*calcpts(ieta-1,ixi-1) + & + & (1d0 - pxi**2)*calcpts(ieta-1,ixi) + & + & pxi*(pxi+1d0)/2d0*calcpts(ieta-1,ixi+1) + f(0) = pxi*(pxi-1d0)/2d0*calcpts(ieta,ixi-1) + & + & (1d0 - pxi**2)*calcpts(ieta,ixi) + & + & pxi*(pxi+1d0)/2d0*calcpts(ieta,ixi+1) + f(1) = pxi*(pxi-1d0)/2d0*calcpts(ieta+1,ixi-1) + & + & (1d0 - pxi**2)*calcpts(ieta+1,ixi) + & + & pxi*(pxi+1d0)/2d0*calcpts(ieta+1,ixi+1) + peta = (dleta - dlaeta(ieta))/deleta + h1_LTq = peta*(peta-1d0)/2d0*f(-1) + & + & (1d0 - peta**2)*f(0) + & + & peta*(peta+1d0)/2d0*f(1) +!MB + + peta*(peta+1d0)/2d0*f(1) + return + END + +! =========================================== + double precision function h1bar_LTq(eta,xi) +! =========================================== + +! eq (29) in PLB347 (1995) 143 - 151 only necessary for the +! transverse piece +! MSbar scheme +! This routine is called subd1bar in the original code. +! Gives h1bar_LTq for Q2 < 1.5 GeV2 ( = 0 for Q2 > 1.5 GeV2) + + implicit none + integer neta, nxi + parameter (neta = 45, nxi = 15) + double precision calcpts(neta,nxi), aeta(neta), axi(nxi) + double precision t, u, y1, y2, y3, y4 + double precision eta, xi, huge, small + parameter (small = 1.d-8, huge = 1.d10) + integer j, ieta, ixi + + data (calcpts(j, 1), j=1,neta) /0.d0, -.3403d-06, -.1758d-05, & + & -.3760d-05, -.6194d-05, -.8975d-05, -.1049d-04, -.5149d-04, & + & -.1049d-03, -.1646d-03, -.2276d-03, -.2598d-03, -.5753d-03, & + & -.8478d-03, -.1068d-02, -.1242d-02, -.1380d-02, -.1488d-02, & + & -.1572d-02, -.1640d-02, -.1694d-02, -.1856d-02, -.1816d-02, & + & -.1742d-02, -.1662d-02, -.1589d-02, -.1518d-02, -.1453d-02, & + & -.1395d-02, -.1342d-02, -.7865d-03, -.5766d-03, -.4622d-03, & + & -.3897d-03, -.3617d-03, -.2181d-03, -.1602d-03, -.1070d-03, & + & -.8177d-04, -.6665d-04, -.6109d-04, -.1574d-04, -.8655d-05, & + & -.1086d-05, 0.d0/ +! + data (calcpts(j, 2), j=1,neta) /0.d0, -.2178d-06, -.1125d-05, & + & -.2409d-05, -.3966d-05, -.5751d-05, -.6717d-05, -.3299d-04, & + & -.6719d-04, -.1055d-03, -.1459d-03, -.1665d-03, -.3694d-03, & + & -.5449d-03, -.6870d-03, -.8000d-03, -.8888d-03, -.9588d-03, & + & -.1014d-02, -.1057d-02, -.1091d-02, -.1199d-02, -.1175d-02, & + & -.1127d-02, -.1077d-02, -.1028d-02, -.9830d-03, -.9422d-03, & + & -.9041d-03, -.8688d-03, -.5103d-03, -.3741d-03, -.3000d-03, & + & -.2528d-03, -.2346d-03, -.1416d-03, -.1039d-03, -.6963d-04, & + & -.5295d-04, -.4317d-04, -.3972d-04, -.1017d-04, -.5610d-05, & + & -.7188d-06, 0.d0/ +! + data (calcpts(j, 3), j=1,neta) /0.d0, -.5322d-07, -.2750d-06, & + & -.5883d-06, -.9690d-06, -.1405d-05, -.1641d-05, -.8070d-05, & + & -.1646d-04, -.2586d-04, -.3580d-04, -.4088d-04, -.9104d-04, & + & -.1346d-03, -.1703d-03, -.1986d-03, -.2209d-03, -.2388d-03, & + & -.2528d-03, -.2639d-03, -.2727d-03, -.3014d-03, -.2961d-03, & + & -.2847d-03, -.2724d-03, -.2604d-03, -.2490d-03, -.2386d-03, & + & -.2292d-03, -.2205d-03, -.1297d-03, -.9522d-04, -.7638d-04, & + & -.6429d-04, -.5973d-04, -.3603d-04, -.2641d-04, -.1768d-04, & + & -.1350d-04, -.1100d-04, -.1009d-04, -.2613d-05, -.1420d-05, & + & -.1778d-06, 0.d0/ +! + data (calcpts(j, 4), j=1,neta) /0.d0, -.6204d-09, -.3207d-08, & + & -.6865d-08, -.1131d-07, -.1639d-07, -.1916d-07, -.9449d-07, & + & -.1932d-06, -.3045d-06, -.4228d-06, -.4833d-06, -.1088d-05, & + & -.1624d-05, -.2069d-05, -.2429d-05, -.2718d-05, -.2949d-05, & + & -.3135d-05, -.3284d-05, -.3403d-05, -.3831d-05, -.3800d-05, & + & -.3674d-05, -.3528d-05, -.3381d-05, -.3245d-05, -.3114d-05, & + & -.2995d-05, -.2883d-05, -.1710d-05, -.1256d-05, -.1010d-05, & + & -.8503d-06, -.7902d-06, -.4776d-06, -.3498d-06, -.2352d-06, & + & -.1790d-06, -.1461d-06, -.1337d-06, -.3444d-07, -.1883d-07, & + & -.2382d-08, 0.d0/ +! + data (calcpts(j, 5), j=1,neta) /0.d0, -.4968d-15, -.2571d-14, & + & -.5505d-14, -.9076d-14, -.1318d-13, -.1541d-13, -.7657d-13, & + & -.1578d-12, -.2505d-12, -.3500d-12, -.4016d-12, -.9316d-12, & + & -.1425d-11, -.1853d-11, -.2212d-11, -.2511d-11, -.2759d-11, & + & -.2965d-11, -.3137d-11, -.3279d-11, -.3888d-11, -.3960d-11, & + & -.3893d-11, -.3784d-11, -.3660d-11, -.3535d-11, -.3412d-11, & + & -.3296d-11, -.3187d-11, -.1940d-11, -.1433d-11, -.1153d-11, & + & -.9740d-12, -.9041d-12, -.5475d-12, -.4023d-12, -.2694d-12, & + & -.2056d-12, -.1677d-12, -.1536d-12, -.3957d-13, -.2160d-13, & + & -.2823d-14, 0.d0/ +! + data (calcpts(j, 6), j=1,neta) /0.d0, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.d0/ +! + data (calcpts(j, 7), j=1,neta) /0.d0, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.d0/ +! + data (calcpts(j, 8), j=1,neta) /0.d0, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.d0/ +! + data (calcpts(j, 9), j=1,neta) /0.d0, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.d0/ +! + data (calcpts(j,10), j=1,neta) /0.d0, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.d0/ +! + data (calcpts(j,11), j=1,neta) /0.d0, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.d0/ +! + data (calcpts(j,12), j=1,neta) /0.d0, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.d0/ +! + data (calcpts(j,13), j=1,neta) /0.d0, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.d0/ +! + data (calcpts(j,14), j=1,neta) /0.d0, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.d0/ +! + data (calcpts(j,15), j=1,neta) /0.d0, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, 0.0000d+00, & + & 0.0000d+00, 0.d0/ +! + data (aeta(j), j = 1,neta) /small, 0.1000d-02, 0.3000d-02, & + & 0.5000d-02, 0.7000d-02, 0.9000d-02, 0.1000d-01, 0.3000d-01, & + & 0.5000d-01, 0.7000d-01, 0.9000d-01, 0.1000d+00, 0.2000d+00, & + & 0.3000d+00, 0.4000d+00, 0.5000d+00, 0.6000d+00, 0.7000d+00, & + & 0.8000d+00, 0.9000d+00, 0.1000d+01, 0.2000d+01, 0.3000d+01, & + & 0.4000d+01, 0.5000d+01, 0.6000d+01, 0.7000d+01, 0.8000d+01, & + & 0.9000d+01, 0.1000d+02, 0.3000d+02, 0.5000d+02, 0.7000d+02, & + & 0.9000d+02, 0.1000d+03, 0.2000d+03, 0.3000d+03, 0.5000d+03, & + & 0.7000d+03, 0.9000d+03, 0.1000d+04, 0.5000d+04, 0.1000d+05, & + & 0.1000d+06, huge/ +! + data (axi(j), j = 1,nxi) /0.1000d-01, 0.3162d-01, 0.1000d+00, & + & 0.3162d+00, 0.1000d+01, 0.2500d+01, 0.3162d+01, 0.7500d+01, & + & 0.1000d+02, 0.3162d+02, 0.1000d+03, 0.3162d+03, 0.1000d+04, & + & 0.5000d+04, 0.1000d+05/ +! +! here we have to choose the array elements that will go into the +! interpolation. + call locate(aeta, neta, eta, ieta) + call locate(axi, nxi, xi, ixi) + if (ieta .le. 1) ieta = 1 + if (ieta .gt. (neta - 1)) ieta = neta - 1 + if (ixi .le. 1) ixi = 1 + if (ixi .gt. (nxi - 1)) ixi = nxi - 1 + y1 = calcpts(ieta,ixi) + y2 = calcpts(ieta+1,ixi) + y3 = calcpts(ieta+1,ixi+1) + y4 = calcpts(ieta,ixi+1) +! interpolating between the points + t = (eta - aeta(ieta))/(aeta(ieta + 1) - aeta(ieta)) + u = (xi - axi(ixi))/(axi(ixi + 1) - axi(ixi)) + h1bar_LTq = (1.d0 - t)*(1.d0 - u)*y1 + t*(1.d0 - u)*y2 + & + & t*u*y3 + (1.d0 - t)*u*y4 + + return + END + +!DECK ID>, QCORRL. + +! =========================================== + double precision function h1_HLq(eta,xi) +! =========================================== + +! eq (26) in PLB347 (1995) 143 - 151 for the transverse piece +! MSbar scheme +! This routine is called subcqhl in the original code. +! Called schql in updated code (03/06/96). + + implicit none + integer neta, nxi + parameter (neta = 73, nxi = 49) + double precision calcpts(neta, nxi), dlaeta(neta), dlaxi(nxi) + double precision eta, xi, dleta, dlxi + double precision pxi, peta, f(-1:1), delxi, deleta + integer j, ieta, ixi + + data (calcpts(j, 1), j = 1,neta) /-.2062D-13, -.3668D-13, & + & -.6520D-13, -.1160D-12, -.2063D-12, -.3668D-12, -.6522D-12, & + & -.1160D-11, -.2062D-11, -.3668D-11, -.6525D-11, -.1160D-10, & + & -.2064D-10, -.3672D-10, -.6530D-10, -.1162D-09, -.2069D-09, & + & -.3684D-09, -.6561D-09, -.1170D-08, -.2085D-08, -.3723D-08, & + & -.6657D-08, -.1192D-07, -.2137D-07, -.3838D-07, -.6900D-07, & + & -.1242D-06, -.2233D-06, -.3993D-06, -.7067D-06, -.1227D-05, & + & -.2066D-05, -.3329D-05, -.5057D-05, -.7154D-05, -.9369D-05, & + & -.1137D-04, -.1288D-04, -.1379D-04, -.1414D-04, -.1402D-04, & + & -.1358D-04, -.1296D-04, -.1228D-04, -.1162D-04, -.1103D-04, & + & -.1052D-04, -.1012D-04, -.9794D-05, -.9545D-05, -.9356D-05, & + & -.9215D-05, -.9111D-05, -.9034D-05, -.8980D-05, -.8938D-05, & + & -.8910D-05, -.8889D-05, -.8873D-05, -.8863D-05, -.8856D-05, & + & -.8851D-05, -.8847D-05, -.8844D-05, -.8841D-05, -.8840D-05, & + & -.8840D-05, -.8839D-05, -.8839D-05, -.8837D-05, -.8837D-05, & + & -.8837D-05/ + + data (calcpts(j, 2), j = 1,neta) /-.3027D-13, -.5384D-13, & + & -.9569D-13, -.1702D-12, -.3027D-12, -.5383D-12, -.9573D-12, & + & -.1703D-11, -.3027D-11, -.5384D-11, -.9577D-11, -.1703D-10, & + & -.3029D-10, -.5390D-10, -.9585D-10, -.1706D-09, -.3037D-09, & + & -.5406D-09, -.9630D-09, -.1717D-08, -.3060D-08, -.5465D-08, & + & -.9771D-08, -.1749D-07, -.3136D-07, -.5633D-07, -.1013D-06, & + & -.1823D-06, -.3277D-06, -.5860D-06, -.1037D-05, -.1801D-05, & + & -.3032D-05, -.4886D-05, -.7422D-05, -.1050D-04, -.1375D-04, & + & -.1668D-04, -.1890D-04, -.2024D-04, -.2075D-04, -.2058D-04, & + & -.1993D-04, -.1903D-04, -.1803D-04, -.1705D-04, -.1619D-04, & + & -.1545D-04, -.1485D-04, -.1438D-04, -.1401D-04, -.1373D-04, & + & -.1352D-04, -.1337D-04, -.1326D-04, -.1318D-04, -.1312D-04, & + & -.1308D-04, -.1305D-04, -.1303D-04, -.1301D-04, -.1300D-04, & + & -.1299D-04, -.1299D-04, -.1299D-04, -.1297D-04, -.1297D-04, & + & -.1297D-04, -.1297D-04, -.1297D-04, -.1297D-04, -.1297D-04, & + & -.1297D-04/ + + data (calcpts(j, 3), j = 1,neta) /-.4440D-13, -.7897D-13, & + & -.1404D-12, -.2497D-12, -.4441D-12, -.7896D-12, -.1404D-11, & + & -.2498D-11, -.4440D-11, -.7897D-11, -.1405D-10, -.2498D-10, & + & -.4444D-10, -.7907D-10, -.1406D-09, -.2502D-09, -.4455D-09, & + & -.7931D-09, -.1413D-08, -.2518D-08, -.4489D-08, -.8016D-08, & + & -.1433D-07, -.2565D-07, -.4600D-07, -.8263D-07, -.1486D-06, & + & -.2674D-06, -.4807D-06, -.8596D-06, -.1521D-05, -.2642D-05, & + & -.4448D-05, -.7166D-05, -.1089D-04, -.1540D-04, -.2017D-04, & + & -.2447D-04, -.2772D-04, -.2970D-04, -.3044D-04, -.3018D-04, & + & -.2924D-04, -.2791D-04, -.2643D-04, -.2500D-04, -.2373D-04, & + & -.2265D-04, -.2177D-04, -.2108D-04, -.2054D-04, -.2013D-04, & + & -.1984D-04, -.1961D-04, -.1945D-04, -.1932D-04, -.1923D-04, & + & -.1918D-04, -.1913D-04, -.1910D-04, -.1907D-04, -.1906D-04, & + & -.1905D-04, -.1903D-04, -.1903D-04, -.1903D-04, -.1902D-04, & + & -.1902D-04, -.1902D-04, -.1902D-04, -.1902D-04, -.1902D-04, & + & -.1902D-04/ + + data (calcpts(j, 4), j = 1,neta) /-.6515D-13, -.1159D-12, & + & -.2060D-12, -.3663D-12, -.6516D-12, -.1159D-11, -.2061D-11, & + & -.3665D-11, -.6515D-11, -.1159D-10, -.2061D-10, -.3666D-10, & + & -.6521D-10, -.1160D-09, -.2063D-09, -.3672D-09, -.6537D-09, & + & -.1164D-08, -.2073D-08, -.3695D-08, -.6587D-08, -.1176D-07, & + & -.2103D-07, -.3764D-07, -.6749D-07, -.1212D-06, -.2180D-06, & + & -.3924D-06, -.7053D-06, -.1261D-05, -.2232D-05, -.3876D-05, & + & -.6526D-05, -.1051D-04, -.1597D-04, -.2260D-04, -.2959D-04, & + & -.3590D-04, -.4068D-04, -.4358D-04, -.4466D-04, -.4429D-04, & + & -.4290D-04, -.4094D-04, -.3878D-04, -.3669D-04, -.3483D-04, & + & -.3323D-04, -.3195D-04, -.3094D-04, -.3014D-04, -.2955D-04, & + & -.2911D-04, -.2877D-04, -.2853D-04, -.2835D-04, -.2822D-04, & + & -.2813D-04, -.2807D-04, -.2803D-04, -.2799D-04, -.2796D-04, & + & -.2795D-04, -.2793D-04, -.2792D-04, -.2792D-04, -.2792D-04, & + & -.2791D-04, -.2791D-04, -.2791D-04, -.2791D-04, -.2791D-04, & + & -.2791D-04/ + + data (calcpts(j, 5), j = 1,neta) /-.9559D-13, -.1700D-12, & + & -.3022D-12, -.5375D-12, -.9561D-12, -.1700D-11, -.3023D-11, & + & -.5377D-11, -.9558D-11, -.1700D-10, -.3024D-10, -.5379D-10, & + & -.9567D-10, -.1702D-09, -.3027D-09, -.5387D-09, -.9591D-09, & + & -.1707D-08, -.3041D-08, -.5421D-08, -.9664D-08, -.1726D-07, & + & -.3085D-07, -.5523D-07, -.9902D-07, -.1779D-06, -.3198D-06, & + & -.5756D-06, -.1035D-05, -.1850D-05, -.3274D-05, -.5686D-05, & + & -.9572D-05, -.1542D-04, -.2343D-04, -.3315D-04, -.4341D-04, & + & -.5267D-04, -.5968D-04, -.6393D-04, -.6553D-04, -.6498D-04, & + & -.6295D-04, -.6007D-04, -.5691D-04, -.5385D-04, -.5111D-04, & + & -.4878D-04, -.4688D-04, -.4538D-04, -.4423D-04, -.4336D-04, & + & -.4271D-04, -.4222D-04, -.4187D-04, -.4160D-04, -.4142D-04, & + & -.4127D-04, -.4118D-04, -.4112D-04, -.4106D-04, -.4102D-04, & + & -.4100D-04, -.4098D-04, -.4097D-04, -.4097D-04, -.4096D-04, & + & -.4096D-04, -.4096D-04, -.4094D-04, -.4094D-04, -.4094D-04, & + & -.4094D-04/ + + data (calcpts(j, 6), j = 1,neta) /-.1402D-12, -.2493D-12, & + & -.4431D-12, -.7882D-12, -.1402D-11, -.2493D-11, -.4433D-11, & + & -.7885D-11, -.1402D-10, -.2493D-10, -.4435D-10, -.7887D-10, & + & -.1403D-09, -.2496D-09, -.4439D-09, -.7899D-09, -.1406D-08, & + & -.2504D-08, -.4459D-08, -.7949D-08, -.1417D-07, -.2530D-07, & + & -.4524D-07, -.8098D-07, -.1452D-06, -.2608D-06, -.4689D-06, & + & -.8439D-06, -.1517D-05, -.2713D-05, -.4800D-05, -.8335D-05, & + & -.1403D-04, -.2261D-04, -.3435D-04, -.4861D-04, -.6365D-04, & + & -.7724D-04, -.8752D-04, -.9375D-04, -.9609D-04, -.9529D-04, & + & -.9229D-04, -.8810D-04, -.8346D-04, -.7895D-04, -.7492D-04, & + & -.7150D-04, -.6872D-04, -.6653D-04, -.6483D-04, -.6355D-04, & + & -.6259D-04, -.6188D-04, -.6136D-04, -.6098D-04, -.6071D-04, & + & -.6051D-04, -.6037D-04, -.6027D-04, -.6020D-04, -.6015D-04, & + & -.6011D-04, -.6008D-04, -.6007D-04, -.6005D-04, -.6004D-04, & + & -.6002D-04, -.6003D-04, -.6003D-04, -.6003D-04, -.6003D-04, & + & -.6001D-04/ + + data (calcpts(j, 7), j = 1,neta) /-.2055D-12, -.3655D-12, & + & -.6496D-12, -.1155D-11, -.2055D-11, -.3654D-11, -.6498D-11, & + & -.1156D-10, -.2055D-10, -.3655D-10, -.6501D-10, -.1156D-09, & + & -.2056D-09, -.3659D-09, -.6506D-09, -.1158D-08, -.2062D-08, & + & -.3670D-08, -.6537D-08, -.1165D-07, -.2077D-07, -.3709D-07, & + & -.6632D-07, -.1187D-06, -.2128D-06, -.3823D-06, -.6872D-06, & + & -.1237D-05, -.2223D-05, -.3975D-05, -.7034D-05, -.1222D-04, & + & -.2056D-04, -.3313D-04, -.5034D-04, -.7123D-04, -.9329D-04, & + & -.1132D-03, -.1283D-03, -.1374D-03, -.1409D-03, -.1397D-03, & + & -.1353D-03, -.1291D-03, -.1223D-03, -.1157D-03, -.1098D-03, & + & -.1048D-03, -.1007D-03, -.9748D-04, -.9500D-04, -.9311D-04, & + & -.9171D-04, -.9068D-04, -.8991D-04, -.8936D-04, -.8895D-04, & + & -.8866D-04, -.8845D-04, -.8829D-04, -.8819D-04, -.8812D-04, & + & -.8807D-04, -.8803D-04, -.8800D-04, -.8797D-04, -.8796D-04, & + & -.8796D-04, -.8795D-04, -.8795D-04, -.8795D-04, -.8793D-04, & + & -.8793D-04/ + + data (calcpts(j, 8), j = 1,neta) /-.3011D-12, -.5355D-12, & + & -.9518D-12, -.1693D-11, -.3011D-11, -.5354D-11, -.9521D-11, & + & -.1694D-10, -.3010D-10, -.5355D-10, -.9526D-10, -.1694D-09, & + & -.3013D-09, -.5361D-09, -.9533D-09, -.1697D-08, -.3021D-08, & + & -.5377D-08, -.9578D-08, -.1707D-07, -.3044D-07, -.5435D-07, & + & -.9716D-07, -.1739D-06, -.3118D-06, -.5600D-06, -.1007D-05, & + & -.1812D-05, -.3256D-05, -.5822D-05, -.1030D-04, -.1789D-04, & + & -.3011D-04, -.4852D-04, -.7372D-04, -.1043D-03, -.1367D-03, & + & -.1658D-03, -.1879D-03, -.2013D-03, -.2064D-03, -.2046D-03, & + & -.1982D-03, -.1892D-03, -.1792D-03, -.1695D-03, -.1608D-03, & + & -.1535D-03, -.1475D-03, -.1428D-03, -.1391D-03, -.1364D-03, & + & -.1343D-03, -.1329D-03, -.1317D-03, -.1308D-03, -.1303D-03, & + & -.1298D-03, -.1295D-03, -.1292D-03, -.1291D-03, -.1290D-03, & + & -.1290D-03, -.1288D-03, -.1289D-03, -.1289D-03, -.1289D-03, & + & -.1289D-03, -.1289D-03, -.1289D-03, -.1289D-03, -.1289D-03, & + & -.1287D-03/ + + data (calcpts(j, 9), j = 1,neta) /-.4405D-12, -.7835D-12, & + & -.1393D-11, -.2477D-11, -.4406D-11, -.7834D-11, -.1393D-10, & + & -.2478D-10, -.4405D-10, -.7835D-10, -.1394D-09, -.2479D-09, & + & -.4409D-09, -.7844D-09, -.1395D-08, -.2483D-08, -.4420D-08, & + & -.7868D-08, -.1401D-07, -.2498D-07, -.4453D-07, -.7951D-07, & + & -.1422D-06, -.2544D-06, -.4561D-06, -.8192D-06, -.1473D-05, & + & -.2650D-05, -.4762D-05, -.8514D-05, -.1506D-04, -.2615D-04, & + & -.4403D-04, -.7095D-04, -.1078D-03, -.1526D-03, -.1999D-03, & + & -.2426D-03, -.2750D-03, -.2946D-03, -.3020D-03, -.2994D-03, & + & -.2900D-03, -.2767D-03, -.2621D-03, -.2479D-03, -.2351D-03, & + & -.2244D-03, -.2156D-03, -.2087D-03, -.2033D-03, -.1993D-03, & + & -.1963D-03, -.1940D-03, -.1924D-03, -.1912D-03, -.1903D-03, & + & -.1897D-03, -.1893D-03, -.1890D-03, -.1888D-03, -.1886D-03, & + & -.1885D-03, -.1884D-03, -.1884D-03, -.1882D-03, -.1882D-03, & + & -.1882D-03, -.1882D-03, -.1882D-03, -.1882D-03, -.1882D-03, & + & -.1882D-03/ + + data (calcpts(j,10), j = 1,neta) /-.6440D-12, -.1146D-11, & + & -.2036D-11, -.3621D-11, -.6442D-11, -.1145D-10, -.2037D-10, & + & -.3623D-10, -.6440D-10, -.1145D-09, -.2038D-09, -.3624D-09, & + & -.6446D-09, -.1147D-08, -.2039D-08, -.3629D-08, -.6461D-08, & + & -.1150D-07, -.2049D-07, -.3652D-07, -.6510D-07, -.1162D-06, & + & -.2078D-06, -.3719D-06, -.6666D-06, -.1197D-05, -.2152D-05, & + & -.3872D-05, -.6957D-05, -.1244D-04, -.2200D-04, -.3819D-04, & + & -.6430D-04, -.1036D-03, -.1575D-03, -.2229D-03, -.2921D-03, & + & -.3546D-03, -.4019D-03, -.4306D-03, -.4414D-03, -.4377D-03, & + & -.4239D-03, -.4045D-03, -.3831D-03, -.3622D-03, -.3436D-03, & + & -.3279D-03, -.3150D-03, -.3048D-03, -.2970D-03, -.2910D-03, & + & -.2866D-03, -.2834D-03, -.2810D-03, -.2792D-03, -.2779D-03, & + & -.2770D-03, -.2763D-03, -.2759D-03, -.2755D-03, -.2753D-03, & + & -.2751D-03, -.2750D-03, -.2750D-03, -.2749D-03, -.2749D-03, & + & -.2749D-03, -.2747D-03, -.2747D-03, -.2747D-03, -.2747D-03, & + & -.2747D-03/ + + data (calcpts(j,11), j = 1,neta) /-.9398D-12, -.1672D-11, & + & -.2971D-11, -.5285D-11, -.9400D-11, -.1671D-10, -.2972D-10, & + & -.5287D-10, -.9397D-10, -.1672D-09, -.2974D-09, -.5288D-09, & + & -.9406D-09, -.1674D-08, -.2976D-08, -.5296D-08, -.9429D-08, & + & -.1678D-07, -.2989D-07, -.5329D-07, -.9499D-07, -.1696D-06, & + & -.3032D-06, -.5425D-06, -.9724D-06, -.1746D-05, -.3138D-05, & + & -.5645D-05, -.1014D-04, -.1812D-04, -.3205D-04, -.5564D-04, & + & -.9365D-04, -.1509D-03, -.2294D-03, -.3249D-03, -.4258D-03, & + & -.5171D-03, -.5863D-03, -.6283D-03, -.6441D-03, -.6386D-03, & + & -.6184D-03, -.5901D-03, -.5586D-03, -.5282D-03, -.5009D-03, & + & -.4779D-03, -.4591D-03, -.4442D-03, -.4328D-03, -.4240D-03, & + & -.4177D-03, -.4128D-03, -.4092D-03, -.4067D-03, -.4049D-03, & + & -.4034D-03, -.4025D-03, -.4019D-03, -.4013D-03, -.4009D-03, & + & -.4008D-03, -.4005D-03, -.4004D-03, -.4004D-03, -.4003D-03, & + & -.4003D-03, -.4003D-03, -.4003D-03, -.4001D-03, -.4001D-03, & + & -.4001D-03/ + + data (calcpts(j,12), j = 1,neta) /-.1367D-11, -.2432D-11, & + & -.4323D-11, -.7688D-11, -.1368D-10, -.2432D-10, -.4324D-10, & + & -.7692D-10, -.1367D-09, -.2432D-09, -.4326D-09, -.7694D-09, & + & -.1368D-08, -.2435D-08, -.4329D-08, -.7705D-08, -.1372D-07, & + & -.2442D-07, -.4349D-07, -.7752D-07, -.1382D-06, -.2467D-06, & + & -.4409D-06, -.7889D-06, -.1414D-05, -.2539D-05, -.4561D-05, & + & -.8202D-05, -.1473D-04, -.2632D-04, -.4653D-04, -.8076D-04, & + & -.1359D-03, -.2191D-03, -.3331D-03, -.4719D-03, -.6188D-03, & + & -.7518D-03, -.8527D-03, -.9139D-03, -.9369D-03, -.9289D-03, & + & -.8994D-03, -.8579D-03, -.8121D-03, -.7676D-03, -.7278D-03, & + & -.6940D-03, -.6664D-03, -.6447D-03, -.6280D-03, -.6152D-03, & + & -.6057D-03, -.5987D-03, -.5935D-03, -.5898D-03, -.5871D-03, & + & -.5852D-03, -.5837D-03, -.5828D-03, -.5820D-03, -.5815D-03, & + & -.5812D-03, -.5810D-03, -.5807D-03, -.5806D-03, -.5806D-03, & + & -.5804D-03, -.5804D-03, -.5804D-03, -.5803D-03, -.5803D-03, & + & -.5803D-03/ + + data (calcpts(j,13), j = 1,neta) /-.1981D-11, -.3524D-11, & + & -.6264D-11, -.1114D-10, -.1982D-10, -.3524D-10, -.6266D-10, & + & -.1115D-09, -.1981D-09, -.3524D-09, -.6269D-09, -.1115D-08, & + & -.1983D-08, -.3528D-08, -.6273D-08, -.1116D-07, -.1988D-07, & + & -.3538D-07, -.6301D-07, -.1123D-06, -.2002D-06, -.3573D-06, & + & -.6386D-06, -.1142D-05, -.2047D-05, -.3674D-05, -.6599D-05, & + & -.1186D-04, -.2130D-04, -.3803D-04, -.6722D-04, -.1166D-03, & + & -.1963D-03, -.3164D-03, -.4812D-03, -.6821D-03, -.8951D-03, & + & -.1088D-02, -.1235D-02, -.1324D-02, -.1357D-02, -.1346D-02, & + & -.1303D-02, -.1242D-02, -.1175D-02, -.1110D-02, -.1052D-02, & + & -.1003D-02, -.9628D-03, -.9311D-03, -.9066D-03, -.8881D-03, & + & -.8742D-03, -.8640D-03, -.8564D-03, -.8509D-03, -.8471D-03, & + & -.8442D-03, -.8421D-03, -.8406D-03, -.8396D-03, -.8388D-03, & + & -.8382D-03, -.8378D-03, -.8376D-03, -.8374D-03, -.8373D-03, & + & -.8372D-03, -.8372D-03, -.8372D-03, -.8370D-03, -.8370D-03, & + & -.8370D-03/ + + data (calcpts(j,14), j = 1,neta) /-.1657D-11, -.2947D-11, & + & -.5239D-11, -.9317D-11, -.1657D-10, -.2947D-10, -.5241D-10, & + & -.9322D-10, -.1657D-09, -.2948D-09, -.5244D-09, -.9328D-09, & + & -.1659D-08, -.2953D-08, -.5253D-08, -.9353D-08, -.1666D-07, & + & -.2969D-07, -.5295D-07, -.9455D-07, -.1689D-06, -.3026D-06, & + & -.5433D-06, -.9779D-06, -.1766D-05, -.3201D-05, -.5821D-05, & + & -.1062D-04, -.1939D-04, -.3528D-04, -.6357D-04, -.1123D-03, & + & -.1920D-03, -.3125D-03, -.4764D-03, -.6703D-03, -.8629D-03, & + & -.1016D-02, -.1102D-02, -.1114D-02, -.1061D-02, -.9629D-03, & + & -.8376D-03, -.7028D-03, -.5715D-03, -.4530D-03, -.3513D-03, & + & -.2678D-03, -.2010D-03, -.1494D-03, -.1096D-03, -.8020D-04, & + & -.5869D-04, -.4239D-04, -.3005D-04, -.2184D-04, -.1487D-04, & + & -.1074D-04, -.7992D-05, -.5163D-05, -.3779D-05, -.2358D-05, & + & -.2412D-05, -.9490D-06, -.9740D-06, -.9911D-06, -.1003D-05, & + & -.1011D-05, -.1016D-05, -.1020D-05, -.1022D-05, -.1024D-05, & + & 0.4749D-06/ + + data (calcpts(j,15), j = 1,neta) /-.2383D-11, -.4239D-11, & + & -.7535D-11, -.1340D-10, -.2384D-10, -.4239D-10, -.7538D-10, & + & -.1341D-09, -.2383D-09, -.4240D-09, -.7543D-09, -.1342D-08, & + & -.2387D-08, -.4247D-08, -.7555D-08, -.1345D-07, -.2396D-07, & + & -.4269D-07, -.7612D-07, -.1359D-06, -.2428D-06, -.4347D-06, & + & -.7800D-06, -.1403D-05, -.2531D-05, -.4584D-05, -.8325D-05, & + & -.1517D-04, -.2765D-04, -.5023D-04, -.9038D-04, -.1595D-03, & + & -.2725D-03, -.4437D-03, -.6773D-03, -.9547D-03, -.1232D-02, & + & -.1454D-02, -.1580D-02, -.1600D-02, -.1527D-02, -.1387D-02, & + & -.1208D-02, -.1014D-02, -.8254D-03, -.6546D-03, -.5069D-03, & + & -.3863D-03, -.2900D-03, -.2157D-03, -.1589D-03, -.1161D-03, & + & -.8367D-04, -.6062D-04, -.4279D-04, -.3042D-04, -.2220D-04, & + & -.1523D-04, -.1109D-04, -.6831D-05, -.5498D-05, -.4112D-05, & + & -.2690D-05, -.1243D-05, -.1279D-05, 0.1969D-06, 0.1801D-06, & + & 0.1688D-06, 0.1610D-06, 0.1557D-06, 0.1521D-06, 0.1496D-06, & + & 0.1480D-06/ + + data (calcpts(j,16), j = 1,neta) /-.3399D-11, -.6046D-11, & + & -.1075D-10, -.1911D-10, -.3400D-10, -.6045D-10, -.1075D-09, & + & -.1912D-09, -.3399D-09, -.6046D-09, -.1076D-08, -.1913D-08, & + & -.3403D-08, -.6056D-08, -.1077D-07, -.1918D-07, -.3416D-07, & + & -.6085D-07, -.1085D-06, -.1936D-06, -.3457D-06, -.6187D-06, & + & -.1110D-05, -.1994D-05, -.3594D-05, -.6499D-05, -.1178D-04, & + & -.2142D-04, -.3897D-04, -.7064D-04, -.1268D-03, -.2235D-03, & + & -.3815D-03, -.6215D-03, -.9500D-03, -.1343D-02, -.1738D-02, & + & -.2058D-02, -.2244D-02, -.2278D-02, -.2180D-02, -.1984D-02, & + & -.1730D-02, -.1455D-02, -.1185D-02, -.9400D-03, -.7301D-03, & + & -.5566D-03, -.4177D-03, -.3106D-03, -.2286D-03, -.1670D-03, & + & -.1211D-03, -.8712D-04, -.6249D-04, -.4462D-04, -.3222D-04, & + & -.2247D-04, -.1549D-04, -.1134D-04, -.8576D-05, -.5738D-05, & + & -.4349D-05, -.2924D-05, -.1475D-05, -.1510D-05, -.3433D-07, & + & -.5058D-07, -.6164D-07, -.6919D-07, -.7433D-07, -.7783D-07, & + & -.8021D-07/ + + data (calcpts(j,17), j = 1,neta) /-.4787D-11, -.8515D-11, & + & -.1513D-10, -.2692D-10, -.4788D-10, -.8514D-10, -.1514D-09, & + & -.2693D-09, -.4787D-09, -.8515D-09, -.1515D-08, -.2694D-08, & + & -.4793D-08, -.8528D-08, -.1517D-07, -.2700D-07, -.4808D-07, & + & -.8564D-07, -.1526D-06, -.2723D-06, -.4860D-06, -.8692D-06, & + & -.1557D-05, -.2796D-05, -.5031D-05, -.9081D-05, -.1642D-04, & + & -.2978D-04, -.5401D-04, -.9761D-04, -.1747D-03, -.3072D-03, & + & -.5238D-03, -.8536D-03, -.1307D-02, -.1854D-02, -.2411D-02, & + & -.2869D-02, -.3142D-02, -.3202D-02, -.3074D-02, -.2805D-02, & + & -.2451D-02, -.2066D-02, -.1687D-02, -.1339D-02, -.1041D-02, & + & -.7941D-03, -.5972D-03, -.4441D-03, -.3274D-03, -.2390D-03, & + & -.1742D-03, -.1251D-03, -.8941D-04, -.6469D-04, -.4675D-04, & + & -.3281D-04, -.2303D-04, -.1752D-04, -.1186D-04, -.9089D-05, & + & -.6244D-05, -.4851D-05, -.3423D-05, -.1972D-05, -.2006D-05, & + & -.2029D-05, -.5445D-06, -.5551D-06, -.5624D-06, -.5673D-06, & + & -.5706D-06/ + + data (calcpts(j,18), j = 1,neta) /-.6623D-11, -.1178D-10, & + & -.2094D-10, -.3724D-10, -.6624D-10, -.1178D-09, -.2095D-09, & + & -.3726D-09, -.6622D-09, -.1178D-08, -.2096D-08, -.3727D-08, & + & -.6629D-08, -.1180D-07, -.2098D-07, -.3734D-07, -.6648D-07, & + & -.1184D-06, -.2109D-06, -.3761D-06, -.6709D-06, -.1199D-05, & + & -.2146D-05, -.3845D-05, -.6907D-05, -.1244D-04, -.2243D-04, & + & -.4053D-04, -.7321D-04, -.1317D-03, -.2350D-03, -.4118D-03, & + & -.7008D-03, -.1142D-02, -.1754D-02, -.2498D-02, -.3268D-02, & + & -.3914D-02, -.4313D-02, -.4420D-02, -.4261D-02, -.3903D-02, & + & -.3423D-02, -.2891D-02, -.2365D-02, -.1883D-02, -.1466D-02, & + & -.1120D-02, -.8425D-03, -.6260D-03, -.4613D-03, -.3363D-03, & + & -.2443D-03, -.1761D-03, -.1267D-03, -.9088D-04, -.6453D-04, & + & -.4650D-04, -.3250D-04, -.2268D-04, -.1715D-04, -.1147D-04, & + & -.8681D-05, -.5828D-05, -.4428D-05, -.2996D-05, -.1543D-05, & + & -.1574D-05, -.1596D-05, -.1106D-06, -.1206D-06, -.1274D-06, & + & -.1321D-06/ + + data (calcpts(j,19), j = 1,neta) /-.8945D-11, -.1591D-10, & + & -.2828D-10, -.5030D-10, -.8947D-10, -.1591D-09, -.2829D-09, & + & -.5032D-09, -.8944D-09, -.1591D-08, -.2830D-08, -.5033D-08, & + & -.8952D-08, -.1593D-07, -.2832D-07, -.5040D-07, -.8973D-07, & + & -.1597D-06, -.2845D-06, -.5070D-06, -.9037D-06, -.1613D-05, & + & -.2883D-05, -.5159D-05, -.9244D-05, -.1660D-04, -.2982D-04, & + & -.5365D-04, -.9645D-04, -.1727D-03, -.3063D-03, -.5346D-03, & + & -.9074D-03, -.1478D-02, -.2276D-02, -.3259D-02, -.4296D-02, & + & -.5189D-02, -.5766D-02, -.5952D-02, -.5774D-02, -.5317D-02, & + & -.4683D-02, -.3972D-02, -.3259D-02, -.2601D-02, -.2029D-02, & + & -.1552D-02, -.1170D-02, -.8699D-03, -.6406D-03, -.4682D-03, & + & -.3407D-03, -.2463D-03, -.1761D-03, -.1264D-03, -.9026D-04, & + & -.6374D-04, -.4560D-04, -.3302D-04, -.2314D-04, -.1607D-04, & + & -.1186D-04, -.7561D-05, -.6196D-05, -.3288D-05, -.3351D-05, & + & -.1894D-05, -.1923D-05, -.4426D-06, -.4561D-06, -.4653D-06, & + & -.4716D-06/ + + data (calcpts(j,20), j = 1,neta) /-.1170D-10, -.2082D-10, & + & -.3700D-10, -.6581D-10, -.1171D-09, -.2082D-09, -.3702D-09, & + & -.6584D-09, -.1170D-08, -.2082D-08, -.3703D-08, -.6585D-08, & + & -.1171D-07, -.2083D-07, -.3704D-07, -.6591D-07, -.1173D-06, & + & -.2088D-06, -.3717D-06, -.6620D-06, -.1179D-05, -.2102D-05, & + & -.3752D-05, -.6700D-05, -.1198D-04, -.2143D-04, -.3835D-04, & + & -.6864D-04, -.1227D-03, -.2182D-03, -.3847D-03, -.6677D-03, & + & -.1129D-02, -.1837D-02, -.2835D-02, -.4084D-02, -.5432D-02, & + & -.6633D-02, -.7450D-02, -.7765D-02, -.7596D-02, -.7044D-02, & + & -.6242D-02, -.5321D-02, -.4385D-02, -.3514D-02, -.2749D-02, & + & -.2108D-02, -.1592D-02, -.1186D-02, -.8758D-03, -.6405D-03, & + & -.4661D-03, -.3371D-03, -.2418D-03, -.1739D-03, -.1252D-03, & + & -.8880D-04, -.6357D-04, -.4528D-04, -.3260D-04, -.2266D-04, & + & -.1704D-04, -.1280D-04, -.8476D-05, -.7097D-05, -.4179D-05, & + & -.4235D-05, -.2773D-05, -.2799D-05, -.1316D-05, -.1328D-05, & + & -.1337D-05/ + + data (calcpts(j,21), j = 1,neta) /-.1470D-10, -.2615D-10, & + & -.4648D-10, -.8267D-10, -.1470D-09, -.2615D-09, -.4650D-09, & + & -.8270D-09, -.1470D-08, -.2615D-08, -.4651D-08, -.8270D-08, & + & -.1471D-07, -.2616D-07, -.4651D-07, -.8275D-07, -.1472D-06, & + & -.2620D-06, -.4661D-06, -.8298D-06, -.1477D-05, -.2630D-05, & + & -.4687D-05, -.8353D-05, -.1489D-04, -.2656D-04, -.4732D-04, & + & -.8427D-04, -.1497D-03, -.2644D-03, -.4628D-03, -.7976D-03, & + & -.1341D-02, -.2177D-02, -.3364D-02, -.4877D-02, -.6552D-02, & + & -.8101D-02, -.9219D-02, -.9729D-02, -.9619D-02, -.9002D-02, & + & -.8041D-02, -.6903D-02, -.5723D-02, -.4607D-02, -.3618D-02, & + & -.2783D-02, -.2107D-02, -.1572D-02, -.1161D-02, -.8494D-03, & + & -.6165D-03, -.4455D-03, -.3193D-03, -.2288D-03, -.1631D-03, & + & -.1154D-03, -.8159D-04, -.5760D-04, -.4064D-04, -.2784D-04, & + & -.1932D-04, -.1364D-04, -.9365D-05, -.5017D-05, -.3620D-05, & + & -.2190D-05, -.7378D-06, -.7705D-06, 0.7073D-06, 0.6922D-06, & + & 0.6819D-06/ + + data (calcpts(j,22), j = 1,neta) /-.1759D-10, -.3128D-10, & + & -.5560D-10, -.9889D-10, -.1759D-09, -.3128D-09, -.5562D-09, & + & -.9892D-09, -.1758D-08, -.3127D-08, -.5563D-08, -.9892D-08, & + & -.1759D-07, -.3129D-07, -.5562D-07, -.9894D-07, -.1760D-06, & + & -.3130D-06, -.5568D-06, -.9908D-06, -.1762D-05, -.3135D-05, & + & -.5579D-05, -.9925D-05, -.1765D-04, -.3139D-04, -.5570D-04, & + & -.9871D-04, -.1743D-03, -.3058D-03, -.5311D-03, -.9085D-03, & + & -.1518D-02, -.2454D-02, -.3791D-02, -.5520D-02, -.7489D-02, & + & -.9386D-02, -.1085D-01, -.1162D-01, -.1164D-01, -.1102D-01, & + & -.9949D-02, -.8618D-02, -.7203D-02, -.5839D-02, -.4611D-02, & + & -.3563D-02, -.2706D-02, -.2019D-02, -.1505D-02, -.1094D-02, & + & -.8054D-03, -.5835D-03, -.4158D-03, -.3041D-03, -.2199D-03, & + & -.1488D-03, -.1064D-03, -.7823D-04, -.4947D-04, -.3531D-04, & + & -.2088D-04, -.2127D-04, -.6535D-05, -.6716D-05, -.6839D-05, & + & -.6923D-05, -.6980D-05, -.7019D-05, -.7046D-05, -.7064D-05, & + & -.7077D-05/ + + data (calcpts(j,23), j = 1,neta) /-.1989D-10, -.3537D-10, & + & -.6287D-10, -.1118D-09, -.1989D-09, -.3536D-09, -.6289D-09, & + & -.1119D-08, -.1988D-08, -.3536D-08, -.6290D-08, -.1118D-07, & + & -.1989D-07, -.3537D-07, -.6287D-07, -.1118D-06, -.1989D-06, & + & -.3537D-06, -.6290D-06, -.1119D-05, -.1988D-05, -.3535D-05, & + & -.6285D-05, -.1116D-04, -.1982D-04, -.3515D-04, -.6218D-04, & + & -.1097D-03, -.1928D-03, -.3362D-03, -.5800D-03, -.9849D-03, & + & -.1634D-02, -.2628D-02, -.4050D-02, -.5913D-02, -.8084D-02, & + & -.1026D-01, -.1205D-01, -.1313D-01, -.1336D-01, -.1284D-01, & + & -.1174D-01, -.1028D-01, -.8684D-02, -.7102D-02, -.5651D-02, & + & -.4397D-02, -.3347D-02, -.2525D-02, -.1869D-02, -.1373D-02, & + & -.9974D-03, -.7178D-03, -.5217D-03, -.3812D-03, -.2677D-03, & + & -.1971D-03, -.1401D-03, -.9716D-04, -.6856D-04, -.5451D-04, & + & -.4015D-04, -.2559D-04, -.1090D-04, -.1110D-04, -.1124D-04, & + & -.1133D-04, -.1140D-04, 0.3557D-05, 0.3526D-05, 0.3506D-05, & + & 0.3492D-05/ + + data (calcpts(j,24), j = 1,neta) /-.2117D-10, -.3765D-10, & + & -.6691D-10, -.1190D-09, -.2117D-09, -.3764D-09, -.6693D-09, & + & -.1191D-08, -.2116D-08, -.3763D-08, -.6694D-08, -.1190D-07, & + & -.2117D-07, -.3765D-07, -.6691D-07, -.1190D-06, -.2116D-06, & + & -.3763D-06, -.6690D-06, -.1189D-05, -.2113D-05, -.3755D-05, & + & -.6671D-05, -.1184D-04, -.2099D-04, -.3716D-04, -.6559D-04, & + & -.1154D-03, -.2020D-03, -.3506D-03, -.6016D-03, -.1015D-02, & + & -.1674D-02, -.2677D-02, -.4111D-02, -.6001D-02, -.8245D-02, & + & -.1058D-01, -.1261D-01, -.1398D-01, -.1449D-01, -.1415D-01, & + & -.1313D-01, -.1167D-01, -.9981D-02, -.8257D-02, -.6636D-02, & + & -.5198D-02, -.3993D-02, -.3012D-02, -.2240D-02, -.1656D-02, & + & -.1208D-02, -.8696D-03, -.6294D-03, -.4595D-03, -.3314D-03, & + & -.2311D-03, -.1593D-03, -.1164D-03, -.8792D-04, -.5893D-04, & + & -.4462D-04, -.3009D-04, -.1541D-04, -.1563D-04, -.1578D-04, & + & -.8765D-06, -.9453D-06, -.9923D-06, -.1024D-05, -.1046D-05, & + & -.1061D-05/ + + data (calcpts(j,25), j = 1,neta) /-.2120D-10, -.3770D-10, & + & -.6701D-10, -.1192D-09, -.2120D-09, -.3770D-09, -.6703D-09, & + & -.1192D-08, -.2119D-08, -.3769D-08, -.6704D-08, -.1192D-07, & + & -.2120D-07, -.3770D-07, -.6700D-07, -.1192D-06, -.2119D-06, & + & -.3767D-06, -.6697D-06, -.1190D-05, -.2114D-05, -.3756D-05, & + & -.6670D-05, -.1183D-04, -.2096D-04, -.3706D-04, -.6531D-04, & + & -.1147D-03, -.2003D-03, -.3466D-03, -.5925D-03, -.9958D-03, & + & -.1634D-02, -.2600D-02, -.3976D-02, -.5792D-02, -.7973D-02, & + & -.1030D-01, -.1244D-01, -.1402D-01, -.1480D-01, -.1472D-01, & + & -.1390D-01, -.1256D-01, -.1091D-01, -.9150D-02, -.7443D-02, & + & -.5897D-02, -.4564D-02, -.3478D-02, -.2601D-02, -.1928D-02, & + & -.1405D-02, -.1021D-02, -.7362D-03, -.5363D-03, -.3782D-03, & + & -.2779D-03, -.1911D-03, -.1333D-03, -.8977D-04, -.7579D-04, & + & -.4648D-04, -.3195D-04, -.1727D-04, -.1749D-04, -.1763D-04, & + & -.2736D-05, -.2805D-05, -.2852D-05, -.2884D-05, -.2906D-05, & + & -.2921D-05/ + + data (calcpts(j,26), j = 1,neta) /-.2004D-10, -.3564D-10, & + & -.6335D-10, -.1127D-09, -.2004D-09, -.3564D-09, -.6337D-09, & + & -.1127D-08, -.2003D-08, -.3563D-08, -.6337D-08, -.1127D-07, & + & -.2004D-07, -.3564D-07, -.6333D-07, -.1126D-06, -.2003D-06, & + & -.3561D-06, -.6329D-06, -.1125D-05, -.1998D-05, -.3548D-05, & + & -.6299D-05, -.1117D-04, -.1978D-04, -.3495D-04, -.6155D-04, & + & -.1080D-03, -.1883D-03, -.3252D-03, -.5547D-03, -.9297D-03, & + & -.1520D-02, -.2411D-02, -.3674D-02, -.5339D-02, -.7347D-02, & + & -.9529D-02, -.1161D-01, -.1327D-01, -.1426D-01, -.1446D-01, & + & -.1392D-01, -.1280D-01, -.1132D-01, -.9654D-02, -.7973D-02, & + & -.6401D-02, -.5014D-02, -.3846D-02, -.2905D-02, -.2154D-02, & + & -.1584D-02, -.1155D-02, -.8390D-03, -.6086D-03, -.4351D-03, & + & -.3045D-03, -.2176D-03, -.1596D-03, -.1160D-03, -.7199D-04, & + & -.5764D-04, -.4309D-04, -.2839D-04, -.1359D-04, -.1374D-04, & + & -.1383D-04, 0.1103D-05, 0.1059D-05, 0.1029D-05, 0.1008D-05, & + & 0.9939D-06/ + + data (calcpts(j,27), j = 1,neta) /-.1799D-10, -.3199D-10, & + & -.5687D-10, -.1011D-09, -.1799D-09, -.3199D-09, -.5688D-09, & + & -.1012D-08, -.1798D-08, -.3198D-08, -.5689D-08, -.1011D-07, & + & -.1799D-07, -.3199D-07, -.5685D-07, -.1011D-06, -.1798D-06, & + & -.3196D-06, -.5680D-06, -.1010D-05, -.1793D-05, -.3184D-05, & + & -.5652D-05, -.1002D-04, -.1774D-04, -.3134D-04, -.5516D-04, & + & -.9672D-04, -.1685D-03, -.2908D-03, -.4954D-03, -.8290D-03, & + & -.1353D-02, -.2141D-02, -.3255D-02, -.4719D-02, -.6487D-02, & + & -.8424D-02, -.1032D-01, -.1192D-01, -.1301D-01, -.1344D-01, & + & -.1320D-01, -.1239D-01, -.1116D-01, -.9702D-02, -.8158D-02, & + & -.6655D-02, -.5287D-02, -.4105D-02, -.3126D-02, -.2348D-02, & + & -.1730D-02, -.1269D-02, -.9212D-03, -.6598D-03, -.4856D-03, & + & -.3396D-03, -.2373D-03, -.1792D-03, -.1204D-03, -.9128D-04, & + & -.6187D-04, -.4727D-04, -.3254D-04, -.1772D-04, -.1785D-04, & + & -.1794D-04, -.2994D-05, -.3034D-05, -.3061D-05, -.3079D-05, & + & -.3092D-05/ + + data (calcpts(j,28), j = 1,neta) /-.1544D-10, -.2746D-10, & + & -.4881D-10, -.8681D-10, -.1544D-09, -.2746D-09, -.4882D-09, & + & -.8684D-09, -.1543D-08, -.2745D-08, -.4883D-08, -.8681D-08, & + & -.1544D-07, -.2746D-07, -.4879D-07, -.8677D-07, -.1543D-06, & + & -.2743D-06, -.4875D-06, -.8665D-06, -.1539D-05, -.2733D-05, & + & -.4850D-05, -.8597D-05, -.1522D-04, -.2688D-04, -.4730D-04, & + & -.8292D-04, -.1444D-03, -.2491D-03, -.4241D-03, -.7091D-03, & + & -.1156D-02, -.1827D-02, -.2774D-02, -.4016D-02, -.5514D-02, & + & -.7162D-02, -.8795D-02, -.1023D-01, -.1131D-01, -.1188D-01, & + & -.1190D-01, -.1140D-01, -.1049D-01, -.9302D-02, -.7977D-02, & + & -.6632D-02, -.5359D-02, -.4220D-02, -.3253D-02, -.2462D-02, & + & -.1836D-02, -.1352D-02, -.9877D-03, -.7146D-03, -.5141D-03, & + & -.3720D-03, -.2693D-03, -.1809D-03, -.1370D-03, -.9274D-04, & + & -.6324D-04, -.4859D-04, -.3382D-04, -.1898D-04, -.1909D-04, & + & -.1916D-04, -.4212D-05, -.4247D-05, -.4270D-05, -.4286D-05, & + & -.4297D-05/ + + data (calcpts(j,29), j = 1,neta) /-.1277D-10, -.2271D-10, & + & -.4036D-10, -.7178D-10, -.1277D-09, -.2270D-09, -.4037D-09, & + & -.7180D-09, -.1276D-08, -.2270D-08, -.4037D-08, -.7178D-08, & + & -.1276D-07, -.2270D-07, -.4034D-07, -.7175D-07, -.1276D-06, & + & -.2268D-06, -.4031D-06, -.7165D-06, -.1272D-05, -.2259D-05, & + & -.4010D-05, -.7107D-05, -.1258D-04, -.2222D-04, -.3910D-04, & + & -.6853D-04, -.1193D-03, -.2058D-03, -.3503D-03, -.5854D-03, & + & -.9541D-03, -.1507D-02, -.2286D-02, -.3306D-02, -.4536D-02, & + & -.5889D-02, -.7241D-02, -.8461D-02, -.9428D-02, -.1004D-01, & + & -.1024D-01, -.1001D-01, -.9412D-02, -.8529D-02, -.7474D-02, & + & -.6343D-02, -.5227D-02, -.4190D-02, -.3279D-02, -.2512D-02, & + & -.1892D-02, -.1404D-02, -.1030D-02, -.7499D-03, -.5410D-03, & + & -.3879D-03, -.2773D-03, -.1976D-03, -.1400D-03, -.9860D-04, & + & -.6902D-04, -.4830D-04, -.3499D-04, -.2462D-04, -.1721D-04, & + & -.1127D-04, -.8316D-05, -.5345D-05, -.3864D-05, -.2377D-05, & + & -.8862D-06/ + + data (calcpts(j,30), j = 1,neta) /-.1024D-10, -.1821D-10, & + & -.3237D-10, -.5758D-10, -.1024D-09, -.1821D-09, -.3238D-09, & + & -.5760D-09, -.1024D-08, -.1821D-08, -.3239D-08, -.5758D-08, & + & -.1024D-07, -.1821D-07, -.3236D-07, -.5755D-07, -.1023D-06, & + & -.1819D-06, -.3234D-06, -.5747D-06, -.1020D-05, -.1812D-05, & + & -.3216D-05, -.5701D-05, -.1009D-04, -.1782D-04, -.3136D-04, & + & -.5496D-04, -.9570D-04, -.1650D-03, -.2808D-03, -.4693D-03, & + & -.7646D-03, -.1207D-02, -.1830D-02, -.2646D-02, -.3629D-02, & + & -.4710D-02, -.5794D-02, -.6785D-02, -.7601D-02, -.8176D-02, & + & -.8465D-02, -.8438D-02, -.8102D-02, -.7507D-02, -.6725D-02, & + & -.5836D-02, -.4914D-02, -.4020D-02, -.3202D-02, -.2493D-02, & + & -.1900D-02, -.1425D-02, -.1054D-02, -.7710D-03, -.5599D-03, & + & -.4031D-03, -.2892D-03, -.2062D-03, -.1470D-03, -.1040D-03, & + & -.7278D-04, -.5201D-04, -.3717D-04, -.2527D-04, -.1784D-04, & + & -.1189D-04, -.8925D-05, -.5948D-05, -.4463D-05, -.2974D-05, & + & -.1481D-05/ + + data (calcpts(j,31), j = 1,neta) /-.8016D-11, -.1426D-10, & + & -.2534D-10, -.4507D-10, -.8017D-10, -.1425D-09, -.2535D-09, & + & -.4509D-09, -.8013D-09, -.1425D-08, -.2535D-08, -.4507D-08, & + & -.8015D-08, -.1425D-07, -.2533D-07, -.4505D-07, -.8011D-07, & + & -.1424D-06, -.2531D-06, -.4499D-06, -.7988D-06, -.1419D-05, & + & -.2518D-05, -.4462D-05, -.7897D-05, -.1395D-04, -.2455D-04, & + & -.4302D-04, -.7490D-04, -.1291D-03, -.2198D-03, -.3672D-03, & + & -.5983D-03, -.9443D-03, -.1432D-02, -.2069D-02, -.2837D-02, & + & -.3682D-02, -.4530D-02, -.5310D-02, -.5966D-02, -.6459D-02, & + & -.6762D-02, -.6850D-02, -.6712D-02, -.6358D-02, -.5827D-02, & + & -.5174D-02, -.4456D-02, -.3729D-02, -.3033D-02, -.2404D-02, & + & -.1863D-02, -.1415D-02, -.1057D-02, -.7793D-03, -.5689D-03, & + & -.4116D-03, -.2959D-03, -.2112D-03, -.1502D-03, -.1071D-03, & + & -.7589D-04, -.5357D-04, -.3719D-04, -.2677D-04, -.1933D-04, & + & -.1336D-04, -.8891D-05, -.5909D-05, -.4421D-05, -.2929D-05, & + & -.2935D-05/ + + data (calcpts(j,32), j = 1,neta) /-.6153D-11, -.1094D-10, & + & -.1945D-10, -.3459D-10, -.6154D-10, -.1094D-09, -.1946D-09, & + & -.3461D-09, -.6151D-09, -.1094D-08, -.1946D-08, -.3460D-08, & + & -.6152D-08, -.1094D-07, -.1944D-07, -.3458D-07, -.6149D-07, & + & -.1093D-06, -.1943D-06, -.3453D-06, -.6131D-06, -.1089D-05, & + & -.1932D-05, -.3425D-05, -.6062D-05, -.1071D-04, -.1884D-04, & + & -.3302D-04, -.5749D-04, -.9912D-04, -.1687D-03, -.2818D-03, & + & -.4591D-03, -.7246D-03, -.1099D-02, -.1588D-02, -.2176D-02, & + & -.2824D-02, -.3475D-02, -.4075D-02, -.4586D-02, -.4984D-02, & + & -.5256D-02, -.5390D-02, -.5373D-02, -.5197D-02, -.4872D-02, & + & -.4428D-02, -.3905D-02, -.3344D-02, -.2783D-02, -.2254D-02, & + & -.1778D-02, -.1372D-02, -.1039D-02, -.7750D-03, -.5700D-03, & + & -.4138D-03, -.2993D-03, -.2144D-03, -.1533D-03, -.1086D-03, & + & -.7733D-04, -.5347D-04, -.3856D-04, -.2663D-04, -.1917D-04, & + & -.1320D-04, -.8719D-05, -.5733D-05, -.4242D-05, -.2749D-05, & + & -.1253D-05/ + + data (calcpts(j,33), j = 1,neta) /-.4651D-11, -.8273D-11, & + & -.1470D-10, -.2615D-10, -.4652D-10, -.8272D-10, -.1471D-09, & + & -.2616D-09, -.4650D-09, -.8270D-09, -.1471D-08, -.2616D-08, & + & -.4651D-08, -.8272D-08, -.1470D-07, -.2614D-07, -.4649D-07, & + & -.8263D-07, -.1469D-06, -.2611D-06, -.4635D-06, -.8232D-06, & + & -.1461D-05, -.2589D-05, -.4583D-05, -.8095D-05, -.1424D-04, & + & -.2496D-04, -.4346D-04, -.7493D-04, -.1275D-03, -.2130D-03, & + & -.3471D-03, -.5478D-03, -.8304D-03, -.1200D-02, -.1645D-02, & + & -.2134D-02, -.2626D-02, -.3081D-02, -.3469D-02, -.3778D-02, & + & -.4002D-02, -.4138D-02, -.4179D-02, -.4117D-02, -.3944D-02, & + & -.3669D-02, -.3314D-02, -.2906D-02, -.2477D-02, -.2054D-02, & + & -.1656D-02, -.1304D-02, -.1003D-02, -.7573D-03, -.5638D-03, & + & -.4133D-03, -.3015D-03, -.2165D-03, -.1553D-03, -.1105D-03, & + & -.7918D-04, -.5679D-04, -.4036D-04, -.2840D-04, -.1944D-04, & + & -.1496D-04, -.1047D-04, -.7485D-05, -.5992D-05, -.4496D-05, & + & -.3000D-05/ + + data (calcpts(j,34), j = 1,neta) /-.3472D-11, -.6176D-11, & + & -.1098D-10, -.1952D-10, -.3473D-10, -.6175D-10, -.1098D-09, & + & -.1953D-09, -.3471D-09, -.6173D-09, -.1098D-08, -.1952D-08, & + & -.3472D-08, -.6174D-08, -.1097D-07, -.1951D-07, -.3470D-07, & + & -.6168D-07, -.1096D-06, -.1949D-06, -.3460D-06, -.6145D-06, & + & -.1091D-05, -.1933D-05, -.3421D-05, -.6042D-05, -.1063D-04, & + & -.1863D-04, -.3244D-04, -.5593D-04, -.9517D-04, -.1590D-03, & + & -.2591D-03, -.4089D-03, -.6198D-03, -.8957D-03, -.1228D-02, & + & -.1593D-02, -.1960D-02, -.2299D-02, -.2591D-02, -.2824D-02, & + & -.2999D-02, -.3116D-02, -.3176D-02, -.3172D-02, -.3097D-02, & + & -.2946D-02, -.2724D-02, -.2448D-02, -.2138D-02, -.1816D-02, & + & -.1499D-02, -.1206D-02, -.9455D-03, -.7251D-03, -.5463D-03, & + & -.4060D-03, -.2971D-03, -.2164D-03, -.1552D-03, -.1118D-03, & + & -.7894D-04, -.5651D-04, -.4007D-04, -.2810D-04, -.2063D-04, & + & -.1464D-04, -.1015D-04, -.7162D-05, -.5667D-05, -.4171D-05, & + & -.2673D-05/ + + data (calcpts(j,35), j = 1,neta) /-.2566D-11, -.4564D-11, & + & -.8112D-11, -.1443D-10, -.2566D-10, -.4563D-10, -.8115D-10, & + & -.1443D-09, -.2565D-09, -.4563D-09, -.8115D-09, -.1443D-08, & + & -.2566D-08, -.4563D-08, -.8110D-08, -.1442D-07, -.2565D-07, & + & -.4559D-07, -.8103D-07, -.1440D-06, -.2557D-06, -.4541D-06, & + & -.8060D-06, -.1428D-05, -.2528D-05, -.4466D-05, -.7857D-05, & + & -.1377D-04, -.2398D-04, -.4134D-04, -.7034D-04, -.1175D-03, & + & -.1915D-03, -.3022D-03, -.4581D-03, -.6620D-03, -.9073D-03, & + & -.1177D-02, -.1448D-02, -.1699D-02, -.1915D-02, -.2088D-02, & + & -.2220D-02, -.2314D-02, -.2371D-02, -.2391D-02, -.2369D-02, & + & -.2298D-02, -.2174D-02, -.2002D-02, -.1791D-02, -.1559D-02, & + & -.1320D-02, -.1086D-02, -.8718D-03, -.6811D-03, -.5214D-03, & + & -.3915D-03, -.2898D-03, -.2121D-03, -.1538D-03, -.1104D-03, & + & -.7900D-04, -.5655D-04, -.4009D-04, -.2812D-04, -.1914D-04, & + & -.1315D-04, -.1016D-04, -.7162D-05, -.4166D-05, -.2669D-05, & + & -.2670D-05/ + + data (calcpts(j,36), j = 1,neta) /-.1882D-11, -.3347D-11, & + & -.5949D-11, -.1058D-10, -.1882D-10, -.3347D-10, -.5951D-10, & + & -.1058D-09, -.1881D-09, -.3346D-09, -.5951D-09, -.1058D-08, & + & -.1882D-08, -.3346D-08, -.5947D-08, -.1058D-07, -.1881D-07, & + & -.3343D-07, -.5942D-07, -.1056D-06, -.1875D-06, -.3330D-06, & + & -.5911D-06, -.1048D-05, -.1854D-05, -.3275D-05, -.5762D-05, & + & -.1010D-04, -.1758D-04, -.3032D-04, -.5158D-04, -.8619D-04, & + & -.1404D-03, -.2216D-03, -.3359D-03, -.4854D-03, -.6654D-03, & + & -.8633D-03, -.1062D-02, -.1246D-02, -.1404D-02, -.1532D-02, & + & -.1630D-02, -.1701D-02, -.1749D-02, -.1774D-02, -.1776D-02, & + & -.1749D-02, -.1688D-02, -.1590D-02, -.1459D-02, -.1301D-02, & + & -.1129D-02, -.9534D-03, -.7830D-03, -.6264D-03, -.4890D-03, & + & -.3735D-03, -.2808D-03, -.2075D-03, -.1506D-03, -.1102D-03, & + & -.7874D-04, -.5628D-04, -.3981D-04, -.2783D-04, -.2034D-04, & + & -.1435D-04, -.9859D-05, -.6863D-05, -.5366D-05, -.3868D-05, & + & -.2369D-05/ + + data (calcpts(j,37), j = 1,neta) /-.1371D-11, -.2439D-11, & + & -.4334D-11, -.7709D-11, -.1371D-10, -.2438D-10, -.4336D-10, & + & -.7711D-10, -.1371D-09, -.2438D-09, -.4336D-09, -.7709D-09, & + & -.1371D-08, -.2438D-08, -.4333D-08, -.7705D-08, -.1370D-07, & + & -.2436D-07, -.4329D-07, -.7695D-07, -.1366D-06, -.2426D-06, & + & -.4306D-06, -.7632D-06, -.1351D-05, -.2386D-05, -.4198D-05, & + & -.7357D-05, -.1281D-04, -.2209D-04, -.3758D-04, -.6279D-04, & + & -.1023D-03, -.1614D-03, -.2447D-03, -.3537D-03, -.4847D-03, & + & -.6290D-03, -.7738D-03, -.9079D-03, -.1023D-02, -.1116D-02, & + & -.1188D-02, -.1241D-02, -.1278D-02, -.1300D-02, -.1310D-02, & + & -.1304D-02, -.1279D-02, -.1230D-02, -.1155D-02, -.1056D-02, & + & -.9399D-03, -.8136D-03, -.6854D-03, -.5616D-03, -.4483D-03, & + & -.3493D-03, -.2664D-03, -.1995D-03, -.1473D-03, -.1075D-03, & + & -.7764D-04, -.5563D-04, -.3960D-04, -.2821D-04, -.1997D-04, & + & -.1398D-04, -.9931D-05, -.6934D-05, -.4836D-05, -.3337D-05, & + & -.2438D-05/ + + data (calcpts(j,38), j = 1,neta) /-.9934D-12, -.1767D-11, & + & -.3141D-11, -.5586D-11, -.9935D-11, -.1767D-10, -.3141D-10, & + & -.5587D-10, -.9931D-10, -.1766D-09, -.3142D-09, -.5586D-09, & + & -.9933D-09, -.1767D-08, -.3140D-08, -.5583D-08, -.9929D-08, & + & -.1765D-07, -.3137D-07, -.5575D-07, -.9899D-07, -.1758D-06, & + & -.3120D-06, -.5530D-06, -.9787D-06, -.1729D-05, -.3042D-05, & + & -.5331D-05, -.9282D-05, -.1600D-04, -.2723D-04, -.4550D-04, & + & -.7412D-04, -.1170D-03, -.1773D-03, -.2563D-03, -.3512D-03, & + & -.4557D-03, -.5607D-03, -.6578D-03, -.7414D-03, -.8089D-03, & + & -.8609D-03, -.8995D-03, -.9269D-03, -.9453D-03, -.9557D-03, & + & -.9577D-03, -.9496D-03, -.9282D-03, -.8901D-03, -.8338D-03, & + & -.7607D-03, -.6755D-03, -.5835D-03, -.4905D-03, -.4011D-03, & + & -.3196D-03, -.2487D-03, -.1892D-03, -.1416D-03, -.1043D-03, & + & -.7596D-04, -.5468D-04, -.3924D-04, -.2785D-04, -.1976D-04, & + & -.1391D-04, -.9717D-05, -.6869D-05, -.4771D-05, -.3272D-05, & + & -.2223D-05/ + + data (calcpts(j,39), j = 1,neta) /-.7169D-12, -.1275D-11, & + & -.2266D-11, -.4031D-11, -.7170D-11, -.1275D-10, -.2267D-10, & + & -.4032D-10, -.7167D-10, -.1275D-09, -.2267D-09, -.4031D-09, & + & -.7168D-09, -.1275D-08, -.2266D-08, -.4029D-08, -.7165D-08, & + & -.1274D-07, -.2264D-07, -.4023D-07, -.7144D-07, -.1269D-06, & + & -.2252D-06, -.3991D-06, -.7063D-06, -.1248D-05, -.2195D-05, & + & -.3847D-05, -.6698D-05, -.1155D-04, -.1965D-04, -.3283D-04, & + & -.5349D-04, -.8442D-04, -.1280D-03, -.1849D-03, -.2535D-03, & + & -.3289D-03, -.4046D-03, -.4747D-03, -.5350D-03, -.5838D-03, & + & -.6214D-03, -.6493D-03, -.6694D-03, -.6833D-03, -.6921D-03, & + & -.6963D-03, -.6953D-03, -.6874D-03, -.6703D-03, -.6414D-03, & + & -.5995D-03, -.5460D-03, -.4838D-03, -.4172D-03, -.3501D-03, & + & -.2859D-03, -.2275D-03, -.1767D-03, -.1343D-03, -.1003D-03, & + & -.7396D-04, -.5387D-04, -.3888D-04, -.2779D-04, -.1985D-04, & + & -.1415D-04, -.9951D-05, -.7103D-05, -.5004D-05, -.3504D-05, & + & -.2455D-05/ + + data (calcpts(j,40), j = 1,neta) /-.5152D-12, -.9164D-12, & + & -.1629D-11, -.2897D-11, -.5153D-11, -.9162D-11, -.1629D-10, & + & -.2898D-10, -.5150D-10, -.9160D-10, -.1629D-09, -.2897D-09, & + & -.5151D-09, -.9162D-09, -.1628D-08, -.2896D-08, -.5149D-08, & + & -.9153D-08, -.1627D-07, -.2892D-07, -.5134D-07, -.9118D-07, & + & -.1618D-06, -.2868D-06, -.5076D-06, -.8966D-06, -.1578D-05, & + & -.2765D-05, -.4814D-05, -.8300D-05, -.1412D-04, -.2360D-04, & + & -.3844D-04, -.6067D-04, -.9197D-04, -.1329D-03, -.1822D-03, & + & -.2364D-03, -.2908D-03, -.3412D-03, -.3845D-03, -.4195D-03, & + & -.4466D-03, -.4667D-03, -.4812D-03, -.4914D-03, -.4982D-03, & + & -.5023D-03, -.5036D-03, -.5016D-03, -.4949D-03, -.4816D-03, & + & -.4601D-03, -.4293D-03, -.3903D-03, -.3453D-03, -.2974D-03, & + & -.2490D-03, -.2031D-03, -.1614D-03, -.1251D-03, -.9502D-04, & + & -.7088D-04, -.5215D-04, -.3790D-04, -.2726D-04, -.1946D-04, & + & -.1392D-04, -.9867D-05, -.7018D-05, -.4919D-05, -.3420D-05, & + & -.2520D-05/ + + data (calcpts(j,41), j = 1,neta) /-.3691D-12, -.6564D-12, & + & -.1167D-11, -.2075D-11, -.3691D-11, -.6563D-11, -.1167D-10, & + & -.2076D-10, -.3689D-10, -.6562D-10, -.1167D-09, -.2075D-09, & + & -.3690D-09, -.6563D-09, -.1166D-08, -.2074D-08, -.3689D-08, & + & -.6557D-08, -.1165D-07, -.2071D-07, -.3678D-07, -.6531D-07, & + & -.1159D-06, -.2054D-06, -.3636D-06, -.6423D-06, -.1130D-05, & + & -.1980D-05, -.3448D-05, -.5945D-05, -.1012D-04, -.1690D-04, & + & -.2754D-04, -.4346D-04, -.6588D-04, -.9520D-04, -.1305D-03, & + & -.1693D-03, -.2083D-03, -.2444D-03, -.2754D-03, -.3005D-03, & + & -.3199D-03, -.3343D-03, -.3447D-03, -.3521D-03, -.3572D-03, & + & -.3605D-03, -.3622D-03, -.3623D-03, -.3602D-03, -.3548D-03, & + & -.3448D-03, -.3289D-03, -.3064D-03, -.2782D-03, -.2458D-03, & + & -.2112D-03, -.1768D-03, -.1440D-03, -.1142D-03, -.8838D-04, & + & -.6709D-04, -.5000D-04, -.3666D-04, -.2661D-04, -.1911D-04, & + & -.1372D-04, -.9668D-05, -.6819D-05, -.4869D-05, -.3370D-05, & + & -.2320D-05/ + + data (calcpts(j,42), j = 1,neta) /-.2637D-12, -.4690D-12, & + & -.8337D-12, -.1483D-11, -.2637D-11, -.4689D-11, -.8339D-11, & + & -.1483D-10, -.2636D-10, -.4689D-10, -.8340D-10, -.1483D-09, & + & -.2637D-09, -.4689D-09, -.8334D-09, -.1482D-08, -.2636D-08, & + & -.4685D-08, -.8327D-08, -.1480D-07, -.2628D-07, -.4667D-07, & + & -.8282D-07, -.1468D-06, -.2598D-06, -.4589D-06, -.8074D-06, & + & -.1415D-05, -.2464D-05, -.4248D-05, -.7228D-05, -.1208D-04, & + & -.1967D-04, -.3105D-04, -.4707D-04, -.6802D-04, -.9323D-04, & + & -.1210D-03, -.1488D-03, -.1746D-03, -.1968D-03, -.2147D-03, & + & -.2286D-03, -.2389D-03, -.2463D-03, -.2516D-03, -.2553D-03, & + & -.2578D-03, -.2593D-03, -.2600D-03, -.2596D-03, -.2577D-03, & + & -.2536D-03, -.2462D-03, -.2345D-03, -.2182D-03, -.1978D-03, & + & -.1746D-03, -.1499D-03, -.1253D-03, -.1018D-03, -.8068D-04, & + & -.6239D-04, -.4724D-04, -.3525D-04, -.2580D-04, -.1875D-04, & + & -.1350D-04, -.9603D-05, -.6754D-05, -.4804D-05, -.3455D-05, & + & -.2405D-05/ + + data (calcpts(j,43), j = 1,neta) /-.1880D-12, -.3343D-12, & + & -.5942D-12, -.1057D-11, -.1880D-11, -.3342D-11, -.5944D-11, & + & -.1057D-10, -.1879D-10, -.3342D-10, -.5944D-10, -.1057D-09, & + & -.1879D-09, -.3342D-09, -.5940D-09, -.1056D-08, -.1878D-08, & + & -.3339D-08, -.5935D-08, -.1055D-07, -.1873D-07, -.3326D-07, & + & -.5903D-07, -.1046D-06, -.1852D-06, -.3271D-06, -.5755D-06, & + & -.1009D-05, -.1756D-05, -.3028D-05, -.5152D-05, -.8608D-05, & + & -.1402D-04, -.2213D-04, -.3355D-04, -.4848D-04, -.6645D-04, & + & -.8622D-04, -.1061D-03, -.1245D-03, -.1403D-03, -.1530D-03, & + & -.1629D-03, -.1703D-03, -.1756D-03, -.1794D-03, -.1820D-03, & + & -.1838D-03, -.1850D-03, -.1857D-03, -.1859D-03, -.1854D-03, & + & -.1838D-03, -.1807D-03, -.1753D-03, -.1668D-03, -.1550D-03, & + & -.1404D-03, -.1238D-03, -.1061D-03, -.8858D-04, -.7196D-04, & + & -.5695D-04, -.4401D-04, -.3330D-04, -.2475D-04, -.1815D-04, & + & -.1320D-04, -.9453D-05, -.6753D-05, -.4804D-05, -.3304D-05, & + & -.2404D-05/ + + data (calcpts(j,44), j = 1,neta) /-.1337D-12, -.2377D-12, & + & -.4225D-12, -.7515D-12, -.1337D-11, -.2377D-11, -.4227D-11, & + & -.7518D-11, -.1336D-10, -.2376D-10, -.4227D-10, -.7516D-10, & + & -.1336D-09, -.2377D-09, -.4224D-09, -.7512D-09, -.1336D-08, & + & -.2374D-08, -.4220D-08, -.7501D-08, -.1332D-07, -.2365D-07, & + & -.4198D-07, -.7440D-07, -.1317D-06, -.2326D-06, -.4092D-06, & + & -.7172D-06, -.1249D-05, -.2153D-05, -.3664D-05, -.6121D-05, & + & -.9972D-05, -.1574D-04, -.2386D-04, -.3448D-04, -.4726D-04, & + & -.6132D-04, -.7544D-04, -.8851D-04, -.9975D-04, -.1088D-03, & + & -.1159D-03, -.1211D-03, -.1249D-03, -.1276D-03, -.1294D-03, & + & -.1307D-03, -.1316D-03, -.1322D-03, -.1325D-03, -.1324D-03, & + & -.1320D-03, -.1308D-03, -.1285D-03, -.1245D-03, -.1184D-03, & + & -.1099D-03, -.9945D-04, -.8755D-04, -.7500D-04, -.6253D-04, & + & -.5075D-04, -.4011D-04, -.3097D-04, -.2341D-04, -.1738D-04, & + & -.1273D-04, -.9203D-05, -.6594D-05, -.4704D-05, -.3324D-05, & + & -.2349D-05/ + + data (calcpts(j,45), j = 1,neta) /-.9491D-13, -.1688D-12, & + & -.3000D-12, -.5336D-12, -.9492D-12, -.1688D-11, -.3001D-11, & + & -.5338D-11, -.9488D-11, -.1687D-10, -.3001D-10, -.5337D-10, & + & -.9489D-10, -.1688D-09, -.2999D-09, -.5334D-09, -.9485D-09, & + & -.1686D-08, -.2997D-08, -.5326D-08, -.9457D-08, -.1680D-07, & + & -.2981D-07, -.5283D-07, -.9350D-07, -.1652D-06, -.2906D-06, & + & -.5093D-06, -.8867D-06, -.1529D-05, -.2601D-05, -.4347D-05, & + & -.7081D-05, -.1118D-04, -.1694D-04, -.2448D-04, -.3355D-04, & + & -.4354D-04, -.5356D-04, -.6285D-04, -.7083D-04, -.7728D-04, & + & -.8226D-04, -.8597D-04, -.8866D-04, -.9058D-04, -.9192D-04, & + & -.9285D-04, -.9349D-04, -.9391D-04, -.9416D-04, -.9426D-04, & + & -.9416D-04, -.9377D-04, -.9288D-04, -.9118D-04, -.8830D-04, & + & -.8390D-04, -.7785D-04, -.7036D-04, -.6189D-04, -.5297D-04, & + & -.4413D-04, -.3577D-04, -.2826D-04, -.2180D-04, -.1647D-04, & + & -.1223D-04, -.8957D-05, -.6482D-05, -.4652D-05, -.3317D-05, & + & -.2357D-05/ + + data (calcpts(j,46), j = 1,neta) /-.6725D-13, -.1196D-12, & + & -.2126D-12, -.3781D-12, -.6726D-12, -.1196D-11, -.2127D-11, & + & -.3782D-11, -.6723D-11, -.1196D-10, -.2127D-10, -.3781D-10, & + & -.6724D-10, -.1196D-09, -.2125D-09, -.3779D-09, -.6721D-09, & + & -.1195D-08, -.2123D-08, -.3774D-08, -.6701D-08, -.1190D-07, & + & -.2112D-07, -.3743D-07, -.6625D-07, -.1170D-06, -.2059D-06, & + & -.3609D-06, -.6283D-06, -.1083D-05, -.1843D-05, -.3080D-05, & + & -.5017D-05, -.7918D-05, -.1200D-04, -.1735D-04, -.2378D-04, & + & -.3085D-04, -.3795D-04, -.4453D-04, -.5019D-04, -.5476D-04, & + & -.5829D-04, -.6092D-04, -.6282D-04, -.6418D-04, -.6513D-04, & + & -.6579D-04, -.6625D-04, -.6655D-04, -.6675D-04, -.6686D-04, & + & -.6688D-04, -.6678D-04, -.6647D-04, -.6581D-04, -.6457D-04, & + & -.6250D-04, -.5934D-04, -.5502D-04, -.4969D-04, -.4366D-04, & + & -.3733D-04, -.3106D-04, -.2517D-04, -.1986D-04, -.1530D-04, & + & -.1155D-04, -.8567D-05, -.6258D-05, -.4533D-05, -.3243D-05, & + & -.2313D-05/ + + data (calcpts(j,47), j = 1,neta) /-.4757D-13, -.8461D-13, & + & -.1504D-12, -.2675D-12, -.4758D-12, -.8460D-12, -.1504D-11, & + & -.2676D-11, -.4756D-11, -.8458D-11, -.1504D-10, -.2675D-10, & + & -.4757D-10, -.8460D-10, -.1503D-09, -.2674D-09, -.4755D-09, & + & -.8451D-09, -.1502D-08, -.2670D-08, -.4740D-08, -.8419D-08, & + & -.1494D-07, -.2648D-07, -.4687D-07, -.8278D-07, -.1457D-06, & + & -.2553D-06, -.4445D-06, -.7663D-06, -.1304D-05, -.2179D-05, & + & -.3549D-05, -.5602D-05, -.8492D-05, -.1227D-04, -.1682D-04, & + & -.2182D-04, -.2685D-04, -.3150D-04, -.3550D-04, -.3874D-04, & + & -.4123D-04, -.4309D-04, -.4444D-04, -.4540D-04, -.4608D-04, & + & -.4654D-04, -.4687D-04, -.4709D-04, -.4723D-04, -.4733D-04, & + & -.4737D-04, -.4736D-04, -.4726D-04, -.4703D-04, -.4654D-04, & + & -.4565D-04, -.4416D-04, -.4190D-04, -.3882D-04, -.3503D-04, & + & -.3075D-04, -.2629D-04, -.2185D-04, -.1768D-04, -.1394D-04, & + & -.1073D-04, -.8092D-05, -.5992D-05, -.4372D-05, -.3157D-05, & + & -.2257D-05/ + + data (calcpts(j,48), j = 1,neta) /-.3361D-13, -.5979D-13, & + & -.1063D-12, -.1890D-12, -.3362D-12, -.5977D-12, -.1063D-11, & + & -.1891D-11, -.3360D-11, -.5976D-11, -.1063D-10, -.1890D-10, & + & -.3361D-10, -.5977D-10, -.1062D-09, -.1889D-09, -.3359D-09, & + & -.5971D-09, -.1061D-08, -.1886D-08, -.3349D-08, -.5948D-08, & + & -.1056D-07, -.1871D-07, -.3312D-07, -.5849D-07, -.1029D-06, & + & -.1804D-06, -.3141D-06, -.5415D-06, -.9213D-06, -.1539D-05, & + & -.2508D-05, -.3958D-05, -.6000D-05, -.8671D-05, -.1188D-04, & + & -.1542D-04, -.1897D-04, -.2226D-04, -.2509D-04, -.2737D-04, & + & -.2914D-04, -.3045D-04, -.3140D-04, -.3208D-04, -.3256D-04, & + & -.3289D-04, -.3311D-04, -.3327D-04, -.3338D-04, -.3345D-04, & + & -.3349D-04, -.3350D-04, -.3348D-04, -.3341D-04, -.3323D-04, & + & -.3288D-04, -.3224D-04, -.3117D-04, -.2956D-04, -.2737D-04, & + & -.2468D-04, -.2165D-04, -.1849D-04, -.1536D-04, -.1242D-04, & + & -.9778D-05, -.7528D-05, -.5668D-05, -.4198D-05, -.3058D-05, & + & -.2218D-05/ + + data (calcpts(j,49), j = 1,neta) /-.2372D-13, -.4218D-13, & + & -.7498D-13, -.1334D-12, -.2372D-12, -.4218D-12, -.7500D-12, & + & -.1334D-11, -.2371D-11, -.4217D-11, -.7501D-11, -.1334D-10, & + & -.2371D-10, -.4218D-10, -.7495D-10, -.1333D-09, -.2370D-09, & + & -.4213D-09, -.7489D-09, -.1331D-08, -.2363D-08, -.4197D-08, & + & -.7449D-08, -.1320D-07, -.2337D-07, -.4127D-07, -.7262D-07, & + & -.1273D-06, -.2216D-06, -.3821D-06, -.6501D-06, -.1086D-05, & + & -.1770D-05, -.2793D-05, -.4234D-05, -.6118D-05, -.8385D-05, & + & -.1088D-04, -.1339D-04, -.1571D-04, -.1770D-04, -.1931D-04, & + & -.2056D-04, -.2149D-04, -.2216D-04, -.2264D-04, -.2297D-04, & + & -.2320D-04, -.2337D-04, -.2348D-04, -.2355D-04, -.2360D-04, & + & -.2364D-04, -.2365D-04, -.2366D-04, -.2363D-04, -.2358D-04, & + & -.2345D-04, -.2319D-04, -.2273D-04, -.2197D-04, -.2083D-04, & + & -.1927D-04, -.1737D-04, -.1523D-04, -.1299D-04, -.1078D-04, & + & -.8717D-05, -.6857D-05, -.5267D-05, -.3962D-05, -.2942D-05, & + & -.2147D-05/ + + data (dlaeta(j), j = 1,neta) / & + & -6d0, -5.83333333d0, -5.66666667d0, -5.5d0, -5.33333333d0, & + & -5.16666667d0, -5d0, -4.83333333d0, -4.66666667d0, -4.5d0, & + & -4.33333333d0, -4.16666667d0, -4d0, -3.83333333d0, & + & -3.66666667d0, -3.5d0, -3.33333333d0, -3.16666667d0, -3d0, & + & -2.83333333d0, -2.66666667d0, -2.5d0, -2.33333333d0, & + & -2.16666667d0, -2d0, -1.83333333d0, -1.66666667d0, -1.5d0, & + & -1.33333333d0, -1.16666667d0, -1d0, -0.83333333d0, -0.66666667d0,& + & -0.5d0, -0.33333333d0, -0.16666667d0, 0d0, 0.16666667d0, & + & 0.33333333d0, 0.5d0, 0.66666667d0, 0.83333333d0, 1d0, & + & 1.16666667d0, 1.33333333d0, 1.5d0, 1.66666667d0, 1.83333333d0, & + & 2d0, 2.16666667d0, 2.33333333d0, 2.5d0, 2.66666667d0, & + & 2.83333333d0, 3d0, 3.16666667d0, 3.33333333d0, 3.5d0, & + & 3.66666667d0, 3.83333333d0, 4d0, 4.16666667d0, 4.33333333d0, & + & 4.5d0, 4.66666667d0, 4.83333333d0, 5d0, 5.16666667d0, & + & 5.33333333d0, 5.5d0, 5.66666667d0, 5.83333333d0, 6d0/ + + data (dlaxi(j), j = 1,nxi) / & + & -3d0, -2.83333333d0, -2.66666667d0, -2.5d0, -2.33333333d0, & + & -2.16666667d0, -2d0, -1.83333333d0, -1.66666667d0, -1.5d0, & + & -1.33333333d0, -1.16666667d0, -1d0, -0.83333333d0, -0.66666667d0,& + & -0.5d0, -0.33333333d0, -0.16666667d0, 0d0, 0.16666667d0, & + & 0.33333333d0, 0.5d0, 0.66666667d0, 0.83333333d0, 1d0, & + & 1.16666667d0, 1.33333333d0, 1.5d0, 1.66666667d0, 1.83333333d0, & + & 2d0, 2.16666667d0, 2.33333333d0, 2.5d0, 2.66666667d0, & + & 2.83333333d0, 3d0, 3.16666667d0, 3.33333333d0, 3.5d0, & + & 3.66666667d0, 3.83333333d0, 4d0, 4.16666667d0, 4.33333333d0, & + & 4.5d0, 4.66666667d0, 4.83333333d0, 5d0/ + + dleta = dlog10(eta) + dlxi = dlog10(xi) + if (dlxi .le. dlaxi(1)) dlxi = dlaxi(1) + if (dlxi .ge. dlaxi(nxi)) dlxi = dlaxi(nxi) + if (dleta .ge. dlaeta(neta)) dleta = dlaeta(neta) + if (dleta .le. dlaeta(1)) dleta = dlaeta(1) + call locate(dlaeta,neta, dleta, ieta) + call locate(dlaxi, nxi, dlxi, ixi) +! interpolating between the appropriate points + delxi = 1d0/6d0 + deleta = 1d0/6d0 +! lagrange 3-pt. + if (ixi .le. 2) ixi = 2 + if (ixi .ge. 48) ixi = 48 + if (ieta .le. 2) ieta = 2 + if (ieta .ge. 72) ieta = 72 + pxi = (dlxi - dlaxi(ixi))/delxi + f(-1) = pxi*(pxi-1d0)/2d0*calcpts(ieta-1,ixi-1) + & + & (1d0 - pxi**2)*calcpts(ieta-1,ixi) + & + & pxi*(pxi+1d0)/2d0*calcpts(ieta-1,ixi+1) + f(0) = pxi*(pxi-1d0)/2d0*calcpts(ieta,ixi-1) + & + & (1d0 - pxi**2)*calcpts(ieta,ixi) + & + & pxi*(pxi+1d0)/2d0*calcpts(ieta,ixi+1) + f(1) = pxi*(pxi-1d0)/2d0*calcpts(ieta+1,ixi-1) + & + & (1d0 - pxi**2)*calcpts(ieta+1,ixi) + & + & pxi*(pxi+1d0)/2d0*calcpts(ieta+1,ixi+1) + peta = (dleta - dlaeta(ieta))/deleta + h1_HLq = peta*(peta-1d0)/2d0*f(-1) + & + & (1d0 - peta**2)*f(0) + & + & peta*(peta+1d0)/2d0*f(1) +!MB + + peta*(peta+1d0)/2d0*f(1) + return + END + +! =========================================== + double precision function h1bar_HLq(eta,xi) +! =========================================== + +! eq (27) in PLB347 (1995) 143 - 151 for the transverse piece +! MSbar scheme +! This routine is called subcqhlbar in the original code. +! Called sqlbar in updated code (03/06/96). + + implicit none + integer neta, nxi + parameter (neta = 73, nxi = 49) + double precision calcpts(neta, nxi), dlaeta(neta), dlaxi(nxi) + double precision eta, xi, dleta, dlxi + double precision pxi, peta, f(-1:1), delxi, deleta + integer j, ieta, ixi + + data (calcpts(j, 1), j = 1,neta) /0.7071D-14, 0.1258D-13, & + & 0.2235D-13, 0.3975D-13, 0.7071D-13, 0.1257D-12, 0.2236D-12, & + & 0.3977D-12, 0.7068D-12, 0.1257D-11, 0.2236D-11, 0.3975D-11, & + & 0.7068D-11, 0.1257D-10, 0.2234D-10, 0.3972D-10, 0.7062D-10, & + & 0.1255D-09, 0.2229D-09, 0.3959D-09, 0.7023D-09, 0.1245D-08, & + & 0.2205D-08, 0.3896D-08, 0.6863D-08, 0.1204D-07, 0.2097D-07, & + & 0.3623D-07, 0.6178D-07, 0.1034D-06, 0.1688D-06, 0.2662D-06, & + & 0.4012D-06, 0.5725D-06, 0.7658D-06, 0.9555D-06, 0.1113D-05, & + & 0.1217D-05, 0.1255D-05, 0.1223D-05, 0.1129D-05, 0.9890D-06, & + & 0.8246D-06, 0.6585D-06, 0.5077D-06, 0.3804D-06, 0.2780D-06, & + & 0.2007D-06, 0.1423D-06, 0.1004D-06, 0.6907D-07, 0.4861D-07, & + & 0.3374D-07, 0.2298D-07, 0.1593D-07, 0.1030D-07, 0.8102D-08, & + & 0.5170D-08, 0.3239D-08, 0.2466D-08, 0.1462D-08, 0.1800D-08, & + & 0.5305D-09, 0.6874D-09, 0.7944D-09, 0.8672D-09, 0.9168D-09, & + & -.5494D-09, -.5264D-09, -.5107D-09, -.5000D-09, -.4927D-09, & + & -.4878D-09/ + + data (calcpts(j, 2), j = 1,neta) /0.1038D-13, 0.1846D-13, & + & 0.3281D-13, 0.5835D-13, 0.1038D-12, 0.1845D-12, 0.3282D-12, & + & 0.5837D-12, 0.1037D-11, 0.1845D-11, 0.3282D-11, 0.5835D-11, & + & 0.1037D-10, 0.1845D-10, 0.3279D-10, 0.5829D-10, 0.1036D-09, & + & 0.1842D-09, 0.3272D-09, 0.5811D-09, 0.1031D-08, 0.1828D-08, & + & 0.3237D-08, 0.5718D-08, 0.1007D-07, 0.1767D-07, 0.3078D-07, & + & 0.5317D-07, 0.9068D-07, 0.1518D-06, 0.2477D-06, 0.3907D-06, & + & 0.5888D-06, 0.8403D-06, 0.1124D-05, 0.1403D-05, 0.1635D-05, & + & 0.1788D-05, 0.1841D-05, 0.1796D-05, 0.1658D-05, 0.1451D-05, & + & 0.1210D-05, 0.9677D-06, 0.7471D-06, 0.5589D-06, 0.4104D-06, & + & 0.2951D-06, 0.2097D-06, 0.1473D-06, 0.1041D-06, 0.7141D-07, & + & 0.4950D-07, 0.3464D-07, 0.2390D-07, 0.1685D-07, 0.1272D-07, & + & 0.9026D-08, 0.6095D-08, 0.5663D-08, 0.3391D-08, 0.3887D-08, & + & 0.2724D-08, 0.2955D-08, 0.1612D-08, 0.1719D-08, 0.1791D-08, & + & 0.1841D-08, 0.1875D-08, 0.1898D-08, 0.1913D-08, 0.1924D-08, & + & 0.1931D-08/ + + data (calcpts(j, 3), j = 1,neta) /0.1522D-13, 0.2708D-13, & + & 0.4812D-13, 0.8559D-13, 0.1522D-12, 0.2707D-12, 0.4814D-12, & + & 0.8562D-12, 0.1522D-11, 0.2706D-11, 0.4814D-11, 0.8559D-11, & + & 0.1522D-10, 0.2706D-10, 0.4809D-10, 0.8551D-10, 0.1520D-09, & + & 0.2701D-09, 0.4799D-09, 0.8524D-09, 0.1512D-08, 0.2681D-08, & + & 0.4748D-08, 0.8388D-08, 0.1478D-07, 0.2592D-07, 0.4515D-07, & + & 0.7800D-07, 0.1330D-06, 0.2226D-06, 0.3633D-06, 0.5731D-06, & + & 0.8638D-06, 0.1233D-05, 0.1649D-05, 0.2058D-05, 0.2397D-05, & + & 0.2621D-05, 0.2701D-05, 0.2633D-05, 0.2429D-05, 0.2126D-05, & + & 0.1772D-05, 0.1416D-05, 0.1091D-05, 0.8163D-06, 0.5969D-06, & + & 0.4288D-06, 0.3029D-06, 0.2122D-06, 0.1470D-06, 0.1055D-06, & + & 0.6832D-07, 0.3893D-07, 0.3458D-07, 0.2684D-07, 0.1679D-07, & + & 0.5163D-08, 0.7463D-08, 0.9030D-08, -.4902D-08, -.4174D-08, & + & -.3679D-08, -.3341D-08, -.3111D-08, -.2954D-08, -.2847D-08, & + & -.2774D-08, -.2725D-08, -.2691D-08, -.2668D-08, -.2652D-08, & + & -.2642D-08/ + + data (calcpts(j, 4), j = 1,neta) /0.2234D-13, 0.3973D-13, & + & 0.7061D-13, 0.1256D-12, 0.2234D-12, 0.3972D-12, 0.7063D-12, & + & 0.1256D-11, 0.2233D-11, 0.3971D-11, 0.7063D-11, 0.1256D-10, & + & 0.2233D-10, 0.3971D-10, 0.7057D-10, 0.1255D-09, 0.2231D-09, & + & 0.3964D-09, 0.7042D-09, 0.1251D-08, 0.2219D-08, 0.3934D-08, & + & 0.6967D-08, 0.1231D-07, 0.2168D-07, 0.3803D-07, 0.6626D-07, & + & 0.1145D-06, 0.1952D-06, 0.3267D-06, 0.5332D-06, 0.8410D-06, & + & 0.1268D-05, 0.1809D-05, 0.2420D-05, 0.3020D-05, 0.3519D-05, & + & 0.3848D-05, 0.3965D-05, 0.3865D-05, 0.3568D-05, 0.3128D-05, & + & 0.2606D-05, 0.2084D-05, 0.1606D-05, 0.1202D-05, 0.8735D-06, & + & 0.6284D-06, 0.4504D-06, 0.3150D-06, 0.2217D-06, 0.1508D-06, & + & 0.1093D-06, 0.7222D-07, 0.4284D-07, 0.3850D-07, 0.1576D-07, & + & 0.2071D-07, 0.9091D-08, 0.1139D-07, -.2043D-08, -.9755D-09, & + & -.2487D-09, 0.2471D-09, 0.5849D-09, 0.8149D-09, 0.9716D-09, & + & 0.1078D-08, 0.1151D-08, 0.1201D-08, 0.1234D-08, 0.1257D-08, & + & 0.1273D-08/ + + data (calcpts(j, 5), j = 1,neta) /0.3277D-13, 0.5829D-13, & + & 0.1036D-12, 0.1843D-12, 0.3277D-12, 0.5827D-12, 0.1036D-11, & + & 0.1843D-11, 0.3276D-11, 0.5826D-11, 0.1036D-10, 0.1842D-10, & + & 0.3276D-10, 0.5826D-10, 0.1035D-09, 0.1841D-09, 0.3273D-09, & + & 0.5816D-09, 0.1033D-08, 0.1835D-08, 0.3255D-08, 0.5772D-08, & + & 0.1022D-07, 0.1806D-07, 0.3181D-07, 0.5580D-07, 0.9721D-07, & + & 0.1679D-06, 0.2864D-06, 0.4793D-06, 0.7823D-06, 0.1234D-05, & + & 0.1860D-05, 0.2655D-05, 0.3553D-05, 0.4433D-05, 0.5166D-05, & + & 0.5649D-05, 0.5822D-05, 0.5680D-05, 0.5241D-05, 0.4590D-05, & + & 0.3820D-05, 0.3061D-05, 0.2354D-05, 0.1770D-05, 0.1289D-05, & + & 0.9368D-06, 0.6648D-06, 0.4732D-06, 0.3234D-06, 0.2304D-06, & + & 0.1596D-06, 0.1032D-06, 0.8115D-07, 0.5179D-07, 0.3243D-07, & + & 0.2470D-07, 0.1466D-07, 0.1803D-07, 0.5327D-08, 0.6894D-08, & + & 0.7960D-08, 0.8687D-08, 0.9183D-08, 0.9520D-08, 0.9750D-08, & + & 0.9907D-08, 0.1001D-07, 0.1009D-07, 0.1014D-07, 0.1017D-07, & + & 0.1019D-07/ + + data (calcpts(j, 6), j = 1,neta) /0.4805D-13, 0.8547D-13, & + & 0.1519D-12, 0.2702D-12, 0.4806D-12, 0.8545D-12, 0.1519D-11, & + & 0.2703D-11, 0.4803D-11, 0.8543D-11, 0.1520D-10, 0.2702D-10, & + & 0.4804D-10, 0.8543D-10, 0.1518D-09, 0.2699D-09, 0.4799D-09, & + & 0.8528D-09, 0.1515D-08, 0.2691D-08, 0.4773D-08, 0.8463D-08, & + & 0.1499D-07, 0.2648D-07, 0.4664D-07, 0.8183D-07, 0.1425D-06, & + & 0.2462D-06, 0.4200D-06, 0.7029D-06, 0.1147D-05, 0.1810D-05, & + & 0.2729D-05, 0.3894D-05, 0.5212D-05, 0.6505D-05, 0.7579D-05, & + & 0.8289D-05, 0.8535D-05, 0.8330D-05, 0.7691D-05, 0.6728D-05, & + & 0.5606D-05, 0.4484D-05, 0.3460D-05, 0.2584D-05, 0.1900D-05, & + & 0.1368D-05, 0.9749D-06, 0.6750D-06, 0.4691D-06, 0.3348D-06, & + & 0.2270D-06, 0.1562D-06, 0.9983D-07, 0.7776D-07, 0.4838D-07, & + & 0.2904D-07, 0.2130D-07, 0.1124D-07, 0.1461D-07, 0.1912D-08, & + & 0.3475D-08, 0.4542D-08, 0.5269D-08, 0.5763D-08, 0.6101D-08, & + & 0.6330D-08, 0.6487D-08, 0.6593D-08, 0.6666D-08, 0.6716D-08, & + & 0.6749D-08/ + + data (calcpts(j, 7), j = 1,neta) /0.7043D-13, 0.1253D-12, & + & 0.2227D-12, 0.3960D-12, 0.7044D-12, 0.1253D-11, 0.2227D-11, & + & 0.3961D-11, 0.7041D-11, 0.1252D-10, 0.2227D-10, 0.3960D-10, & + & 0.7041D-10, 0.1252D-09, 0.2225D-09, 0.3957D-09, 0.7035D-09, & + & 0.1250D-08, 0.2221D-08, 0.3944D-08, 0.6996D-08, 0.1241D-07, & + & 0.2197D-07, 0.3881D-07, 0.6837D-07, 0.1199D-06, 0.2090D-06, & + & 0.3610D-06, 0.6156D-06, 0.1031D-05, 0.1682D-05, 0.2654D-05, & + & 0.4001D-05, 0.5712D-05, 0.7645D-05, 0.9542D-05, 0.1112D-04, & + & 0.1217D-04, 0.1253D-04, 0.1222D-04, 0.1128D-04, 0.9879D-05, & + & 0.8236D-05, 0.6579D-05, 0.5079D-05, 0.3800D-05, 0.2788D-05, & + & 0.1996D-05, 0.1425D-05, 0.1005D-05, 0.6910D-06, 0.4859D-06, & + & 0.3367D-06, 0.2289D-06, 0.1582D-06, 0.1018D-06, 0.7968D-07, & + & 0.5030D-07, 0.3095D-07, 0.2320D-07, 0.1314D-07, 0.1650D-07, & + & 0.3796D-08, 0.5360D-08, 0.6425D-08, 0.7150D-08, 0.7644D-08, & + & 0.7981D-08, 0.8210D-08, 0.8367D-08, -.6527D-08, -.6454D-08, & + & -.6405D-08/ + + data (calcpts(j, 8), j = 1,neta) /0.1032D-12, 0.1835D-12, & + & 0.3262D-12, 0.5802D-12, 0.1032D-11, 0.1835D-11, 0.3263D-11, & + & 0.5804D-11, 0.1032D-10, 0.1835D-10, 0.3263D-10, 0.5802D-10, & + & 0.1032D-09, 0.1835D-09, 0.3260D-09, 0.5797D-09, 0.1031D-08, & + & 0.1831D-08, 0.3253D-08, 0.5779D-08, 0.1025D-07, 0.1818D-07, & + & 0.3219D-07, 0.5687D-07, 0.1002D-06, 0.1757D-06, 0.3062D-06, & + & 0.5289D-06, 0.9021D-06, 0.1510D-05, 0.2465D-05, 0.3890D-05, & + & 0.5866D-05, 0.8377D-05, 0.1121D-04, 0.1400D-04, 0.1632D-04, & + & 0.1785D-04, 0.1840D-04, 0.1795D-04, 0.1656D-04, 0.1450D-04, & + & 0.1209D-04, 0.9673D-05, 0.7465D-05, 0.5587D-05, 0.4094D-05, & + & 0.2950D-05, 0.2092D-05, 0.1480D-05, 0.1031D-05, 0.7180D-06, & + & 0.4981D-06, 0.3489D-06, 0.2410D-06, 0.1703D-06, 0.1288D-06, & + & 0.9171D-07, 0.6230D-07, 0.4292D-07, 0.3516D-07, 0.2510D-07, & + & 0.2845D-07, 0.1574D-07, 0.1730D-07, 0.1837D-07, 0.1909D-07, & + & 0.1958D-07, 0.1992D-07, 0.2015D-07, 0.2031D-07, 0.2041D-07, & + & 0.2048D-07/ + + data (calcpts(j, 9), j = 1,neta) /0.1510D-12, 0.2685D-12, & + & 0.4773D-12, 0.8489D-12, 0.1510D-11, 0.2685D-11, 0.4774D-11, & + & 0.8491D-11, 0.1509D-10, 0.2684D-10, 0.4774D-10, 0.8488D-10, & + & 0.1509D-09, 0.2684D-09, 0.4770D-09, 0.8481D-09, 0.1508D-08, & + & 0.2679D-08, 0.4760D-08, 0.8454D-08, 0.1500D-07, 0.2659D-07, & + & 0.4709D-07, 0.8320D-07, 0.1466D-06, 0.2571D-06, 0.4480D-06, & + & 0.7740D-06, 0.1320D-05, 0.2210D-05, 0.3608D-05, 0.5695D-05, & + & 0.8591D-05, 0.1227D-04, 0.1643D-04, 0.2051D-04, 0.2392D-04, & + & 0.2616D-04, 0.2696D-04, 0.2628D-04, 0.2426D-04, 0.2123D-04, & + & 0.1770D-04, 0.1414D-04, 0.1090D-04, 0.8152D-05, 0.5971D-05, & + & 0.4277D-05, 0.3024D-05, 0.2126D-05, 0.1471D-05, 0.1008D-05, & + & 0.6944D-06, 0.4892D-06, 0.2948D-06, 0.2168D-06, 0.1159D-06, & + & 0.1494D-06, 0.2220D-07, 0.3774D-07, 0.4833D-07, 0.5555D-07, & + & 0.6046D-07, -.8619D-07, -.8390D-07, -.8235D-07, -.8129D-07, & + & -.8057D-07, -.8008D-07, -.7974D-07, -.7951D-07, -.7936D-07, & + & -.7925D-07/ + + data (calcpts(j,10), j = 1,neta) /0.2207D-12, 0.3925D-12, & + & 0.6976D-12, 0.1241D-11, 0.2207D-11, 0.3924D-11, 0.6978D-11, & + & 0.1241D-10, 0.2206D-10, 0.3923D-10, 0.6978D-10, 0.1241D-09, & + & 0.2206D-09, 0.3923D-09, 0.6972D-09, 0.1240D-08, 0.2204D-08, & + & 0.3916D-08, 0.6958D-08, 0.1236D-07, 0.2192D-07, 0.3887D-07, & + & 0.6884D-07, 0.1216D-06, 0.2143D-06, 0.3759D-06, 0.6549D-06, & + & 0.1132D-05, 0.1930D-05, 0.3232D-05, 0.5279D-05, 0.8334D-05, & + & 0.1257D-04, 0.1797D-04, 0.2406D-04, 0.3007D-04, 0.3508D-04, & + & 0.3837D-04, 0.3956D-04, 0.3857D-04, 0.3560D-04, 0.3117D-04, & + & 0.2598D-04, 0.2081D-04, 0.1595D-04, 0.1201D-04, 0.8833D-05, & + & 0.6355D-05, 0.4407D-05, 0.3191D-05, 0.2248D-05, 0.1534D-05, & + & 0.9652D-06, 0.7414D-06, 0.4458D-06, 0.4011D-06, 0.1728D-06, & + & 0.2217D-06, 0.1051D-06, 0.1278D-06, -.6740D-08, 0.3811D-08, & + & 0.1099D-07, 0.1589D-07, 0.1923D-07, 0.2150D-07, 0.2305D-07, & + & 0.2410D-07, 0.2482D-07, 0.2531D-07, 0.2564D-07, 0.2587D-07, & + & 0.2603D-07/ + + data (calcpts(j,11), j = 1,neta) /0.3220D-12, 0.5726D-12, & + & 0.1018D-11, 0.1810D-11, 0.3220D-11, 0.5725D-11, 0.1018D-10, & + & 0.1811D-10, 0.3218D-10, 0.5724D-10, 0.1018D-09, 0.1810D-09, & + & 0.3219D-09, 0.5724D-09, 0.1017D-08, 0.1809D-08, 0.3216D-08, & + & 0.5714D-08, 0.1015D-07, 0.1803D-07, 0.3198D-07, 0.5671D-07, & + & 0.1004D-06, 0.1775D-06, 0.3126D-06, 0.5485D-06, 0.9557D-06, & + & 0.1652D-05, 0.2818D-05, 0.4720D-05, 0.7710D-05, 0.1218D-04, & + & 0.1838D-04, 0.2628D-04, 0.3524D-04, 0.4405D-04, 0.5141D-04, & + & 0.5627D-04, 0.5802D-04, 0.5660D-04, 0.5232D-04, 0.4571D-04, & + & 0.3816D-04, 0.3050D-04, 0.2357D-04, 0.1761D-04, 0.1302D-04, & + & 0.9293D-05, 0.6683D-05, 0.4741D-05, 0.3224D-05, 0.2282D-05, & + & 0.1566D-05, 0.1146D-05, 0.7708D-06, 0.6244D-06, 0.4290D-06, & + & 0.3504D-06, 0.2491D-06, 0.1322D-06, 0.1548D-06, 0.1702D-06, & + & 0.3068D-07, 0.3783D-07, 0.4270D-07, 0.4601D-07, 0.4827D-07, & + & 0.4981D-07, 0.5086D-07, 0.5157D-07, 0.5206D-07, 0.5239D-07, & + & 0.5262D-07/ + + data (calcpts(j,12), j = 1,neta) /0.4683D-12, 0.8329D-12, & + & 0.1480D-11, 0.2633D-11, 0.4683D-11, 0.8327D-11, 0.1481D-10, & + & 0.2634D-10, 0.4681D-10, 0.8325D-10, 0.1481D-09, 0.2633D-09, & + & 0.4681D-09, 0.8325D-09, 0.1479D-08, 0.2630D-08, 0.4677D-08, & + & 0.8310D-08, 0.1476D-07, 0.2622D-07, 0.4652D-07, 0.8249D-07, & + & 0.1461D-06, 0.2581D-06, 0.4548D-06, 0.7980D-06, 0.1391D-05, & + & 0.2403D-05, 0.4102D-05, 0.6872D-05, 0.1123D-04, 0.1775D-04, & + & 0.2682D-04, 0.3838D-04, 0.5150D-04, 0.6445D-04, 0.7526D-04, & + & 0.8242D-04, 0.8503D-04, 0.8298D-04, 0.7661D-04, 0.6705D-04, & + & 0.5593D-04, 0.4469D-04, 0.3455D-04, 0.2585D-04, 0.1898D-04, & + & 0.1369D-04, 0.9675D-05, 0.6918D-05, 0.4820D-05, 0.3300D-05, & + & 0.2353D-05, 0.1633D-05, 0.1211D-05, 0.8341D-06, 0.5363D-06, & + & 0.4901D-06, 0.4109D-06, 0.3091D-06, 0.1919D-06, 0.2143D-06, & + & 0.2296D-06, 0.8995D-07, 0.9703D-07, 0.1018D-06, 0.1051D-06, & + & 0.1074D-06, 0.1089D-06, 0.1099D-06, 0.1106D-06, 0.1111D-06, & + & 0.1115D-06/ + + data (calcpts(j,13), j = 1,neta) /0.6783D-12, 0.1207D-11, & + & 0.2144D-11, 0.3814D-11, 0.6784D-11, 0.1206D-10, 0.2145D-10, & + & 0.3815D-10, 0.6781D-10, 0.1206D-09, 0.2145D-09, 0.3814D-09, & + & 0.6781D-09, 0.1206D-08, 0.2143D-08, 0.3811D-08, 0.6775D-08, & + & 0.1204D-07, 0.2139D-07, 0.3799D-07, 0.6739D-07, 0.1195D-06, & + & 0.2117D-06, 0.3740D-06, 0.6590D-06, 0.1156D-05, 0.2016D-05, & + & 0.3484D-05, 0.5948D-05, 0.9971D-05, 0.1631D-04, 0.2579D-04, & + & 0.3901D-04, 0.5590D-04, 0.7514D-04, 0.9416D-04, 0.1101D-03, & + & 0.1207D-03, 0.1245D-03, 0.1214D-03, 0.1122D-03, 0.9831D-04, & + & 0.8202D-04, 0.6564D-04, 0.5065D-04, 0.3808D-04, 0.2804D-04, & + & 0.2017D-04, 0.1443D-04, 0.1026D-04, 0.7188D-05, 0.5079D-05, & + & 0.3548D-05, 0.2593D-05, 0.1868D-05, 0.1441D-05, 0.1062D-05, & + & 0.7624D-06, 0.7149D-06, 0.4847D-06, 0.5323D-06, 0.4147D-06, & + & 0.4368D-06, 0.3018D-06, 0.3121D-06, 0.3191D-06, 0.3238D-06, & + & 0.3271D-06, 0.3293D-06, 0.3308D-06, 0.3318D-06, 0.3325D-06, & + & 0.3330D-06/ + + data (calcpts(j,14), j = 1,neta) /0.9761D-12, 0.1736D-11, & + & 0.3086D-11, 0.5488D-11, 0.9762D-11, 0.1736D-10, 0.3087D-10, & + & 0.5490D-10, 0.9758D-10, 0.1735D-09, 0.3087D-09, 0.5488D-09, & + & 0.9758D-09, 0.1735D-08, 0.3084D-08, 0.5483D-08, 0.9750D-08, & + & 0.1732D-07, 0.3078D-07, 0.5467D-07, 0.9698D-07, 0.1720D-06, & + & 0.3046D-06, 0.5383D-06, 0.9486D-06, 0.1665D-05, 0.2903D-05, & + & 0.5020D-05, 0.8573D-05, 0.1438D-04, 0.2354D-04, 0.3728D-04, & + & 0.5648D-04, 0.8107D-04, 0.1092D-03, 0.1371D-03, 0.1605D-03, & + & 0.1760D-03, 0.1816D-03, 0.1773D-03, 0.1637D-03, 0.1434D-03, & + & 0.1196D-03, 0.9570D-04, 0.7384D-04, 0.5544D-04, 0.4061D-04, & + & 0.2922D-04, 0.2087D-04, 0.1464D-04, 0.1027D-04, 0.7166D-05, & + & 0.5032D-05, 0.3483D-05, 0.2366D-05, 0.1631D-05, 0.1199D-05, & + & 0.8151D-06, 0.6626D-06, 0.4631D-06, 0.3815D-06, 0.2782D-06, & + & 0.1600D-06, 0.1816D-06, 0.1964D-06, 0.2064D-06, 0.2133D-06, & + & 0.6796D-07, 0.7114D-07, 0.7330D-07, 0.7478D-07, 0.7578D-07, & + & 0.7647D-07/ + + data (calcpts(j,15), j = 1,neta) /0.1392D-11, 0.2477D-11, & + & 0.4402D-11, 0.7829D-11, 0.1393D-10, 0.2476D-10, 0.4403D-10, & + & 0.7832D-10, 0.1392D-09, 0.2476D-09, 0.4403D-09, 0.7829D-09, & + & 0.1392D-08, 0.2476D-08, 0.4399D-08, 0.7822D-08, 0.1391D-07, & + & 0.2471D-07, 0.4391D-07, 0.7800D-07, 0.1384D-06, 0.2454D-06, & + & 0.4347D-06, 0.7682D-06, 0.1354D-05, 0.2377D-05, 0.4145D-05, & + & 0.7171D-05, 0.1226D-04, 0.2058D-04, 0.3373D-04, 0.5351D-04, & + & 0.8124D-04, 0.1169D-03, 0.1579D-03, 0.1988D-03, 0.2333D-03, & + & 0.2561D-03, 0.2645D-03, 0.2582D-03, 0.2385D-03, 0.2088D-03, & + & 0.1742D-03, 0.1394D-03, 0.1074D-03, 0.8048D-04, 0.5895D-04, & + & 0.4236D-04, 0.2994D-04, 0.2101D-04, 0.1453D-04, 0.9938D-05, & + & 0.6780D-05, 0.4608D-05, 0.3032D-05, 0.2046D-05, 0.1299D-05, & + & 0.8574D-06, 0.4678D-06, 0.3112D-06, 0.1088D-06, 0.2541D-07, & + & -.7929D-07, -.1984D-06, -.1773D-06, -.1630D-06, -.1532D-06, & + & -.2966D-06, -.2920D-06, -.2889D-06, -.2868D-06, -.2854D-06, & + & -.2844D-06/ + + data (calcpts(j,16), j = 1,neta) /0.1963D-11, 0.3491D-11, & + & 0.6205D-11, 0.1104D-10, 0.1963D-10, 0.3490D-10, 0.6206D-10, & + & 0.1104D-09, 0.1962D-09, 0.3489D-09, 0.6207D-09, 0.1104D-08, & + & 0.1962D-08, 0.3490D-08, 0.6201D-08, 0.1103D-07, 0.1960D-07, & + & 0.3484D-07, 0.6190D-07, 0.1099D-06, 0.1950D-06, 0.3459D-06, & + & 0.6129D-06, 0.1083D-05, 0.1910D-05, 0.3353D-05, 0.5851D-05, & + & 0.1013D-04, 0.1733D-04, 0.2913D-04, 0.4784D-04, 0.7607D-04, & + & 0.1158D-03, 0.1673D-03, 0.2269D-03, 0.2867D-03, 0.3375D-03, & + & 0.3716D-03, 0.3841D-03, 0.3753D-03, 0.3466D-03, 0.3039D-03, & + & 0.2537D-03, 0.2030D-03, 0.1565D-03, 0.1181D-03, 0.8594D-04, & + & 0.6177D-04, 0.4362D-04, 0.3032D-04, 0.2161D-04, 0.1543D-04, & + & 0.1088D-04, 0.6887D-05, 0.5260D-05, 0.3197D-05, 0.2334D-05, & + & 0.1270D-05, 0.1566D-05, 0.2684D-06, 0.4061D-06, 0.4999D-06, & + & 0.5638D-06, 0.6074D-06, 0.6370D-06, 0.6572D-06, -.8290D-06, & + & -.8196D-06, -.8132D-06, -.8089D-06, -.8059D-06, -.8039D-06, & + & -.8025D-06/ + + data (calcpts(j,17), j = 1,neta) /0.2719D-11, 0.4836D-11, & + & 0.8595D-11, 0.1529D-10, 0.2719D-10, 0.4835D-10, 0.8598D-10, & + & 0.1529D-09, 0.2718D-09, 0.4834D-09, 0.8598D-09, 0.1529D-08, & + & 0.2718D-08, 0.4834D-08, 0.8590D-08, 0.1527D-07, 0.2716D-07, & + & 0.4826D-07, 0.8575D-07, 0.1523D-06, 0.2702D-06, 0.4794D-06, & + & 0.8493D-06, 0.1502D-05, 0.2648D-05, 0.4652D-05, 0.8121D-05, & + & 0.1407D-04, 0.2410D-04, 0.4059D-04, 0.6682D-04, 0.1066D-03, & + & 0.1630D-03, 0.2366D-03, 0.3226D-03, 0.4099D-03, 0.4847D-03, & + & 0.5352D-03, 0.5545D-03, 0.5421D-03, 0.5006D-03, 0.4394D-03, & + & 0.3677D-03, 0.2939D-03, 0.2269D-03, 0.1708D-03, 0.1253D-03, & + & 0.9057D-04, 0.6407D-04, 0.4530D-04, 0.3153D-04, 0.2250D-04, & + & 0.1459D-04, 0.9875D-05, 0.7276D-05, 0.5574D-05, 0.3457D-05, & + & 0.2560D-05, 0.1471D-05, 0.1751D-05, 0.4418D-06, 0.5718D-06, & + & 0.6603D-06, 0.7206D-06, 0.7618D-06, 0.7898D-06, 0.8088D-06, & + & 0.8218D-06, 0.8307D-06, 0.8367D-06, 0.8408D-06, 0.8436D-06, & + & 0.8455D-06/ + + data (calcpts(j,18), j = 1,neta) /0.3677D-11, 0.6539D-11, & + & 0.1162D-10, 0.2067D-10, 0.3677D-10, 0.6538D-10, 0.1163D-09, & + & 0.2068D-09, 0.3675D-09, 0.6537D-09, 0.1163D-08, 0.2067D-08, & + & 0.3676D-08, 0.6537D-08, 0.1162D-07, 0.2066D-07, 0.3673D-07, & + & 0.6527D-07, 0.1160D-06, 0.2060D-06, 0.3655D-06, 0.6485D-06, & + & 0.1149D-05, 0.2032D-05, 0.3585D-05, 0.6301D-05, 0.1101D-04, & + & 0.1910D-04, 0.3277D-04, 0.5531D-04, 0.9132D-04, 0.1463D-03, & + & 0.2249D-03, 0.3286D-03, 0.4512D-03, 0.5776D-03, 0.6873D-03, & + & 0.7621D-03, 0.7917D-03, 0.7756D-03, 0.7173D-03, 0.6298D-03, & + & 0.5273D-03, 0.4235D-03, 0.3281D-03, 0.2463D-03, 0.1814D-03, & + & 0.1306D-03, 0.9257D-04, 0.6479D-04, 0.4509D-04, 0.3217D-04, & + & 0.2119D-04, 0.1446D-04, 0.9533D-05, 0.6787D-05, 0.4982D-05, & + & 0.2797D-05, 0.1853D-05, 0.2231D-05, 0.9891D-06, 0.1165D-05, & + & -.2155D-06, -.1339D-06, -.7834D-07, -.4048D-07, -.1468D-07, & + & 0.2897D-08, 0.1486D-07, 0.2302D-07, 0.2858D-07, 0.3237D-07, & + & 0.3495D-07/ + + data (calcpts(j,19), j = 1,neta) /0.4815D-11, 0.8565D-11, & + & 0.1522D-10, 0.2707D-10, 0.4816D-10, 0.8563D-10, 0.1523D-09, & + & 0.2708D-09, 0.4814D-09, 0.8561D-09, 0.1523D-08, 0.2707D-08, & + & 0.4814D-08, 0.8562D-08, 0.1521D-07, 0.2705D-07, 0.4811D-07, & + & 0.8549D-07, 0.1519D-06, 0.2699D-06, 0.4789D-06, 0.8497D-06, & + & 0.1506D-05, 0.2664D-05, 0.4702D-05, 0.8270D-05, 0.1446D-04, & + & 0.2512D-04, 0.4319D-04, 0.7311D-04, 0.1212D-03, 0.1951D-03, & + & 0.3020D-03, 0.4449D-03, 0.6166D-03, 0.7966D-03, 0.9558D-03, & + & 0.1067D-02, 0.1113D-02, 0.1092D-02, 0.1014D-02, 0.8925D-03, & + & 0.7478D-03, 0.6015D-03, 0.4664D-03, 0.3505D-03, 0.2583D-03, & + & 0.1857D-03, 0.1329D-03, 0.9248D-04, 0.6442D-04, 0.4501D-04, & + & 0.3124D-04, 0.2118D-04, 0.1405D-04, 0.1035D-04, 0.7411D-05, & + & 0.3979D-05, 0.3207D-05, 0.2202D-05, 0.1040D-05, 0.1270D-05, & + & 0.1427D-05, 0.3386D-07, 0.1067D-06, 0.1563D-06, 0.1901D-06, & + & 0.2131D-06, 0.2287D-06, 0.2394D-06, 0.2467D-06, 0.2517D-06, & + & 0.2551D-06/ + + data (calcpts(j,20), j = 1,neta) /0.6052D-11, 0.1076D-10, & + & 0.1913D-10, 0.3403D-10, 0.6052D-10, 0.1076D-09, 0.1914D-09, & + & 0.3404D-09, 0.6050D-09, 0.1076D-08, 0.1914D-08, 0.3403D-08, & + & 0.6050D-08, 0.1076D-07, 0.1912D-07, 0.3400D-07, 0.6046D-07, & + & 0.1075D-06, 0.1909D-06, 0.3393D-06, 0.6021D-06, 0.1068D-05, & + & 0.1894D-05, 0.3352D-05, 0.5918D-05, 0.1042D-04, 0.1824D-04, & + & 0.3174D-04, 0.5468D-04, 0.9285D-04, 0.1546D-03, 0.2504D-03, & + & 0.3906D-03, 0.5811D-03, 0.8145D-03, 0.1065D-02, 0.1291D-02, & + & 0.1454D-02, 0.1525D-02, 0.1504D-02, 0.1401D-02, 0.1236D-02, & + & 0.1041D-02, 0.8396D-03, 0.6525D-03, 0.4925D-03, 0.3638D-03, & + & 0.2628D-03, 0.1870D-03, 0.1314D-03, 0.9228D-04, 0.6359D-04, & + & 0.4418D-04, 0.3088D-04, 0.2162D-04, 0.1401D-04, 0.9972D-05, & + & 0.6814D-05, 0.4728D-05, 0.3851D-05, 0.2776D-05, 0.1565D-05, & + & 0.1762D-05, 0.3964D-06, 0.4879D-06, 0.5502D-06, 0.5927D-06, & + & 0.6216D-06, 0.6413D-06, 0.6548D-06, 0.6639D-06, 0.6702D-06, & + & 0.6744D-06/ + + data (calcpts(j,21), j = 1,neta) /0.7225D-11, 0.1285D-10, & + & 0.2284D-10, 0.4062D-10, 0.7226D-10, 0.1285D-09, 0.2285D-09, & + & 0.4064D-09, 0.7222D-09, 0.1285D-08, 0.2285D-08, 0.4062D-08, & + & 0.7223D-08, 0.1285D-07, 0.2283D-07, 0.4060D-07, 0.7219D-07, & + & 0.1283D-06, 0.2280D-06, 0.4051D-06, 0.7191D-06, 0.1276D-05, & + & 0.2263D-05, 0.4006D-05, 0.7078D-05, 0.1247D-04, 0.2186D-04, & + & 0.3809D-04, 0.6578D-04, 0.1121D-03, 0.1875D-03, 0.3057D-03, & + & 0.4809D-03, 0.7232D-03, 0.1027D-02, 0.1361D-02, 0.1674D-02, & + & 0.1907D-02, 0.2020D-02, 0.2003D-02, 0.1874D-02, 0.1664D-02, & + & 0.1407D-02, 0.1140D-02, 0.8905D-03, 0.6748D-03, 0.4981D-03, & + & 0.3607D-03, 0.2569D-03, 0.1812D-03, 0.1264D-03, 0.8829D-04, & + & 0.6015D-04, 0.4206D-04, 0.2761D-04, 0.1906D-04, 0.1240D-04, & + & 0.8007D-05, 0.6099D-05, 0.3843D-05, 0.2850D-05, 0.1695D-05, & + & 0.4300D-06, 0.5904D-06, 0.6997D-06, -.7260D-06, -.6753D-06, & + & -.6407D-06, -.6172D-06, -.6012D-06, -.5902D-06, -.5828D-06, & + & -.5777D-06/ + + data (calcpts(j,22), j = 1,neta) /0.8126D-11, 0.1445D-10, & + & 0.2569D-10, 0.4569D-10, 0.8127D-10, 0.1445D-09, 0.2570D-09, & + & 0.4570D-09, 0.8123D-09, 0.1445D-08, 0.2570D-08, 0.4569D-08, & + & 0.8124D-08, 0.1445D-07, 0.2568D-07, 0.4566D-07, 0.8120D-07, & + & 0.1443D-06, 0.2565D-06, 0.4558D-06, 0.8090D-06, 0.1436D-05, & + & 0.2547D-05, 0.4511D-05, 0.7973D-05, 0.1406D-04, 0.2467D-04, & + & 0.4306D-04, 0.7453D-04, 0.1274D-03, 0.2141D-03, 0.3512D-03, & + & 0.5574D-03, 0.8476D-03, 0.1220D-02, 0.1643D-02, 0.2054D-02, & + & 0.2375D-02, 0.2546D-02, 0.2550D-02, 0.2406D-02, 0.2151D-02, & + & 0.1834D-02, 0.1496D-02, 0.1177D-02, 0.8971D-03, 0.6657D-03, & + & 0.4847D-03, 0.3465D-03, 0.2451D-03, 0.1721D-03, 0.1195D-03, & + & 0.8221D-04, 0.5604D-04, 0.3922D-04, 0.2660D-04, 0.1874D-04, & + & 0.1304D-04, 0.8271D-05, 0.6108D-05, 0.3678D-05, 0.2566D-05, & + & 0.1330D-05, 0.1511D-05, 0.1337D-06, 0.2174D-06, 0.2744D-06, & + & 0.3133D-06, 0.3397D-06, 0.3577D-06, 0.3700D-06, 0.3784D-06, & + & 0.3841D-06/ + + data (calcpts(j,23), j = 1,neta) /0.8555D-11, 0.1522D-10, & + & 0.2705D-10, 0.4810D-10, 0.8556D-10, 0.1521D-09, 0.2705D-09, & + & 0.4812D-09, 0.8552D-09, 0.1521D-08, 0.2706D-08, 0.4810D-08, & + & 0.8554D-08, 0.1521D-07, 0.2704D-07, 0.4808D-07, 0.8549D-07, & + & 0.1520D-06, 0.2701D-06, 0.4799D-06, 0.8520D-06, 0.1513D-05, & + & 0.2684D-05, 0.4754D-05, 0.8406D-05, 0.1483D-04, 0.2605D-04, & + & 0.4552D-04, 0.7895D-04, 0.1353D-03, 0.2283D-03, 0.3768D-03, & + & 0.6026D-03, 0.9260D-03, 0.1351D-02, 0.1849D-02, 0.2353D-02, & + & 0.2770D-02, 0.3018D-02, 0.3064D-02, 0.2924D-02, 0.2640D-02, & + & 0.2273D-02, 0.1874D-02, 0.1488D-02, 0.1143D-02, 0.8549D-03, & + & 0.6257D-03, 0.4499D-03, 0.3189D-03, 0.2234D-03, 0.1552D-03, & + & 0.1080D-03, 0.7481D-04, 0.5080D-04, 0.3538D-04, 0.2466D-04, & + & 0.1606D-04, 0.1135D-04, 0.7732D-05, 0.5332D-05, 0.4241D-05, & + & 0.3019D-05, 0.1709D-05, 0.1838D-05, 0.4264D-06, 0.4864D-06, & + & 0.5273D-06, 0.5552D-06, 0.5742D-06, 0.5871D-06, 0.5959D-06, & + & 0.6019D-06/ + + data (calcpts(j,24), j = 1,neta) /0.8413D-11, 0.1496D-10, & + & 0.2660D-10, 0.4731D-10, 0.8414D-10, 0.1496D-09, 0.2660D-09, & + & 0.4732D-09, 0.8410D-09, 0.1496D-08, 0.2661D-08, 0.4731D-08, & + & 0.8412D-08, 0.1496D-07, 0.2659D-07, 0.4728D-07, 0.8408D-07, & + & 0.1494D-06, 0.2656D-06, 0.4721D-06, 0.8381D-06, 0.1488D-05, & + & 0.2640D-05, 0.4678D-05, 0.8275D-05, 0.1461D-04, 0.2567D-04, & + & 0.4492D-04, 0.7802D-04, 0.1340D-03, 0.2268D-03, 0.3760D-03, & + & 0.6052D-03, 0.9383D-03, 0.1385D-02, 0.1925D-02, 0.2495D-02, & + & 0.2996D-02, 0.3329D-02, 0.3440D-02, 0.3331D-02, 0.3050D-02, & + & 0.2661D-02, 0.2221D-02, 0.1785D-02, 0.1387D-02, 0.1048D-02, & + & 0.7719D-03, 0.5577D-03, 0.3976D-03, 0.2806D-03, 0.1956D-03, & + & 0.1362D-03, 0.9383D-04, 0.6522D-04, 0.4373D-04, 0.2997D-04, & + & 0.2133D-04, 0.1360D-04, 0.9969D-05, 0.6059D-05, 0.4962D-05, & + & 0.3735D-05, 0.2422D-05, 0.1049D-05, 0.1136D-05, 0.1195D-05, & + & -.2647D-06, -.2374D-06, -.2187D-06, -.2060D-06, -.1973D-06, & + & -.1914D-06/ + + data (calcpts(j,25), j = 1,neta) /0.7746D-11, 0.1378D-10, & + & 0.2449D-10, 0.4355D-10, 0.7747D-10, 0.1377D-09, 0.2449D-09, & + & 0.4357D-09, 0.7743D-09, 0.1377D-08, 0.2450D-08, 0.4355D-08, & + & 0.7745D-08, 0.1377D-07, 0.2448D-07, 0.4353D-07, 0.7741D-07, & + & 0.1376D-06, 0.2446D-06, 0.4347D-06, 0.7717D-06, 0.1370D-05, & + & 0.2432D-05, 0.4309D-05, 0.7624D-05, 0.1346D-04, 0.2367D-04, & + & 0.4144D-04, 0.7206D-04, 0.1240D-03, 0.2103D-03, 0.3497D-03, & + & 0.5656D-03, 0.8828D-03, 0.1316D-02, 0.1852D-02, 0.2441D-02, & + & 0.2990D-02, 0.3395D-02, 0.3583D-02, 0.3537D-02, 0.3295D-02, & + & 0.2920D-02, 0.2479D-02, 0.2022D-02, 0.1593D-02, 0.1219D-02, & + & 0.9078D-03, 0.6620D-03, 0.4748D-03, 0.3362D-03, 0.2362D-03, & + & 0.1638D-03, 0.1133D-03, 0.7819D-04, 0.5339D-04, 0.3641D-04, & + & 0.2462D-04, 0.1679D-04, 0.1159D-04, 0.7636D-05, 0.5006D-05, & + & 0.3758D-05, 0.2430D-05, 0.1047D-05, 0.1127D-05, 0.1181D-05, & + & 0.1218D-05, -.2567D-06, -.2395D-06, -.2278D-06, -.2198D-06, & + & -.2144D-06/ + + data (calcpts(j,26), j = 1,neta) /0.6715D-11, 0.1194D-10, & + & 0.2123D-10, 0.3775D-10, 0.6716D-10, 0.1194D-09, 0.2123D-09, & + & 0.3777D-09, 0.6712D-09, 0.1194D-08, 0.2124D-08, 0.3776D-08, & + & 0.6714D-08, 0.1194D-07, 0.2122D-07, 0.3774D-07, 0.6711D-07, & + & 0.1193D-06, 0.2120D-06, 0.3768D-06, 0.6690D-06, 0.1188D-05, & + & 0.2108D-05, 0.3737D-05, 0.6612D-05, 0.1168D-04, 0.2054D-04, & + & 0.3598D-04, 0.6259D-04, 0.1078D-03, 0.1831D-03, 0.3051D-03, & + & 0.4950D-03, 0.7763D-03, 0.1165D-02, 0.1656D-02, 0.2213D-02, & + & 0.2759D-02, 0.3201D-02, 0.3456D-02, 0.3490D-02, 0.3320D-02, & + & 0.3002D-02, 0.2595D-02, 0.2157D-02, 0.1730D-02, 0.1343D-02, & + & 0.1015D-02, 0.7487D-03, 0.5417D-03, 0.3862D-03, 0.2735D-03, & + & 0.1906D-03, 0.1314D-03, 0.9113D-04, 0.6284D-04, 0.4252D-04, & + & 0.2901D-04, 0.1952D-04, 0.1272D-04, 0.8687D-05, 0.6008D-05, & + & 0.4726D-05, 0.1876D-05, 0.1977D-05, 0.5462D-06, 0.5933D-06, & + & 0.6254D-06, 0.6473D-06, -.8378D-06, -.8277D-06, -.8207D-06, & + & -.8160D-06/ + + data (calcpts(j,27), j = 1,neta) /0.5527D-11, 0.9830D-11, & + & 0.1747D-10, 0.3108D-10, 0.5528D-10, 0.9829D-10, 0.1748D-09, & + & 0.3109D-09, 0.5525D-09, 0.9827D-09, 0.1748D-08, 0.3108D-08, & + & 0.5526D-08, 0.9828D-08, 0.1747D-07, 0.3106D-07, 0.5524D-07, & + & 0.9818D-07, 0.1745D-06, 0.3102D-06, 0.5507D-06, 0.9780D-06, & + & 0.1736D-05, 0.3076D-05, 0.5444D-05, 0.9614D-05, 0.1691D-04, & + & 0.2963D-04, 0.5158D-04, 0.8887D-04, 0.1511D-03, 0.2521D-03, & + & 0.4098D-03, 0.6445D-03, 0.9714D-03, 0.1391D-02, 0.1877D-02, & + & 0.2374D-02, 0.2806D-02, 0.3100D-02, 0.3208D-02, 0.3127D-02, & + & 0.2890D-02, 0.2554D-02, 0.2168D-02, 0.1775D-02, 0.1405D-02, & + & 0.1080D-02, 0.8101D-03, 0.5929D-03, 0.4277D-03, 0.3048D-03, & + & 0.2141D-03, 0.1493D-03, 0.1037D-03, 0.7180D-04, 0.4960D-04, & + & 0.3432D-04, 0.2316D-04, 0.1623D-04, 0.1211D-04, 0.7877D-05, & + & 0.5057D-05, 0.3680D-05, 0.2263D-05, 0.2320D-05, 0.2359D-05, & + & 0.8854D-06, 0.9034D-06, 0.9157D-06, 0.9240D-06, 0.9297D-06, & + & 0.9336D-06/ + + data (calcpts(j,28), j = 1,neta) /0.4356D-11, 0.7748D-11, & + & 0.1377D-10, 0.2449D-10, 0.4356D-10, 0.7746D-10, 0.1377D-09, & + & 0.2450D-09, 0.4354D-09, 0.7745D-09, 0.1378D-08, 0.2449D-08, & + & 0.4355D-08, 0.7746D-08, 0.1377D-07, 0.2448D-07, 0.4353D-07, & + & 0.7738D-07, 0.1375D-06, 0.2445D-06, 0.4340D-06, 0.7708D-06, & + & 0.1368D-05, 0.2425D-05, 0.4291D-05, 0.7579D-05, 0.1333D-04, & + & 0.2337D-04, 0.4067D-04, 0.7011D-04, 0.1192D-03, 0.1991D-03, & + & 0.3240D-03, 0.5104D-03, 0.7713D-03, 0.1109D-02, 0.1507D-02, & + & 0.1926D-02, 0.2310D-02, 0.2603D-02, 0.2758D-02, 0.2758D-02, & + & 0.2615D-02, 0.2366D-02, 0.2056D-02, 0.1721D-02, 0.1394D-02, & + & 0.1094D-02, 0.8339D-03, 0.6218D-03, 0.4527D-03, 0.3258D-03, & + & 0.2304D-03, 0.1613D-03, 0.1134D-03, 0.7795D-04, 0.5386D-04, & + & 0.3683D-04, 0.2549D-04, 0.1693D-04, 0.1274D-04, 0.8447D-05, & + & 0.5589D-05, 0.4186D-05, 0.2751D-05, 0.1296D-05, 0.1327D-05, & + & 0.1348D-05, 0.1362D-05, 0.1372D-05, -.1219D-06, -.1174D-06, & + & -.1143D-06/ + + data (calcpts(j,29), j = 1,neta) /0.3316D-11, 0.5897D-11, & + & 0.1048D-10, 0.1864D-10, 0.3316D-10, 0.5896D-10, 0.1048D-09, & + & 0.1865D-09, 0.3314D-09, 0.5895D-09, 0.1049D-08, 0.1864D-08, & + & 0.3315D-08, 0.5896D-08, 0.1048D-07, 0.1863D-07, 0.3314D-07, & + & 0.5890D-07, 0.1047D-06, 0.1861D-06, 0.3304D-06, 0.5867D-06, & + & 0.1041D-05, 0.1846D-05, 0.3266D-05, 0.5769D-05, 0.1015D-04, & + & 0.1779D-04, 0.3097D-04, 0.5339D-04, 0.9082D-04, 0.1517D-03, & + & 0.2470D-03, 0.3894D-03, 0.5895D-03, 0.8495D-03, 0.1159D-02, & + & 0.1491D-02, 0.1808D-02, 0.2068D-02, 0.2237D-02, 0.2292D-02, & + & 0.2232D-02, 0.2073D-02, 0.1847D-02, 0.1585D-02, 0.1314D-02, & + & 0.1055D-02, 0.8229D-03, 0.6239D-03, 0.4621D-03, 0.3359D-03, & + & 0.2403D-03, 0.1702D-03, 0.1186D-03, 0.8264D-04, 0.5672D-04, & + & 0.3945D-04, 0.2646D-04, 0.1780D-04, 0.1203D-04, 0.9188D-05, & + & 0.6296D-05, 0.3370D-05, 0.1920D-05, 0.1954D-05, 0.4774D-06, & + & 0.4932D-06, 0.5040D-06, 0.5114D-06, 0.5164D-06, 0.5198D-06, & + & 0.5221D-06/ + + data (calcpts(j,30), j = 1,neta) /0.2456D-11, 0.4369D-11, & + & 0.7765D-11, 0.1381D-10, 0.2457D-10, 0.4368D-10, 0.7767D-10, & + & 0.1381D-09, 0.2455D-09, 0.4367D-09, 0.7768D-09, 0.1381D-08, & + & 0.2456D-08, 0.4368D-08, 0.7762D-08, 0.1380D-07, 0.2455D-07, & + & 0.4363D-07, 0.7756D-07, 0.1378D-06, 0.2448D-06, 0.4347D-06, & + & 0.7714D-06, 0.1367D-05, 0.2420D-05, 0.4274D-05, 0.7520D-05, & + & 0.1318D-04, 0.2295D-04, 0.3956D-04, 0.6730D-04, 0.1124D-03, & + & 0.1831D-03, 0.2889D-03, 0.4376D-03, 0.6315D-03, 0.8634D-03, & + & 0.1115D-02, 0.1361D-02, 0.1574D-02, 0.1729D-02, 0.1809D-02, & + & 0.1807D-02, 0.1725D-02, 0.1579D-02, 0.1391D-02, 0.1183D-02, & + & 0.9743D-03, 0.7788D-03, 0.6043D-03, 0.4562D-03, 0.3371D-03, & + & 0.2448D-03, 0.1753D-03, 0.1230D-03, 0.8669D-04, 0.6049D-04, & + & 0.4154D-04, 0.2841D-04, 0.1966D-04, 0.1383D-04, 0.9450D-05, & + & 0.6530D-05, 0.3585D-05, 0.3622D-05, 0.2147D-05, 0.6646D-06, & + & 0.6763D-06, 0.6843D-06, 0.6898D-06, 0.6935D-06, 0.6960D-06, & + & 0.6977D-06/ + + data (calcpts(j,31), j = 1,neta) /0.1782D-11, 0.3169D-11, & + & 0.5632D-11, 0.1002D-10, 0.1782D-10, 0.3168D-10, 0.5634D-10, & + & 0.1002D-09, 0.1781D-09, 0.3168D-09, 0.5634D-09, 0.1002D-08, & + & 0.1781D-08, 0.3168D-08, 0.5630D-08, 0.1001D-07, 0.1781D-07, & + & 0.3165D-07, 0.5626D-07, 0.9999D-07, 0.1775D-06, 0.3153D-06, & + & 0.5596D-06, 0.9917D-06, 0.1755D-05, 0.3100D-05, 0.5455D-05, & + & 0.9560D-05, 0.1665D-04, 0.2870D-04, 0.4883D-04, 0.8158D-04, & + & 0.1329D-03, 0.2097D-03, 0.3177D-03, 0.4588D-03, 0.6281D-03, & + & 0.8132D-03, 0.9961D-03, 0.1159D-02, 0.1288D-02, 0.1369D-02, & + & 0.1397D-02, 0.1369D-02, 0.1288D-02, 0.1166D-02, 0.1019D-02, & + & 0.8616D-03, 0.7061D-03, 0.5616D-03, 0.4343D-03, 0.3274D-03, & + & 0.2414D-03, 0.1742D-03, 0.1245D-03, 0.8781D-04, 0.6139D-04, & + & 0.4228D-04, 0.2905D-04, 0.2024D-04, 0.1436D-04, 0.9946D-05, & + & 0.7004D-05, 0.4044D-05, 0.2570D-05, 0.2589D-05, 0.1101D-05, & + & 0.1110D-05, 0.1116D-05, 0.1120D-05, -.3777D-06, -.3759D-06, & + & -.3746D-06/ + + data (calcpts(j,32), j = 1,neta) /0.1272D-11, 0.2262D-11, & + & 0.4020D-11, 0.7150D-11, 0.1272D-10, 0.2261D-10, 0.4021D-10, & + & 0.7152D-10, 0.1271D-09, 0.2261D-09, 0.4021D-09, 0.7150D-09, & + & 0.1271D-08, 0.2261D-08, 0.4019D-08, 0.7146D-08, 0.1271D-07, & + & 0.2259D-07, 0.4015D-07, 0.7136D-07, 0.1267D-06, 0.2250D-06, & + & 0.3994D-06, 0.7078D-06, 0.1253D-05, 0.2213D-05, 0.3893D-05, & + & 0.6823D-05, 0.1188D-04, 0.2048D-04, 0.3485D-04, 0.5823D-04, & + & 0.9486D-04, 0.1497D-03, 0.2269D-03, 0.3278D-03, 0.4490D-03, & + & 0.5819D-03, 0.7143D-03, 0.8346D-03, 0.9331D-03, 0.1003D-02, & + & 0.1040D-02, 0.1042D-02, 0.1006D-02, 0.9370D-03, 0.8420D-03, & + & 0.7316D-03, 0.6159D-03, 0.5030D-03, 0.3989D-03, 0.3078D-03, & + & 0.2315D-03, 0.1704D-03, 0.1231D-03, 0.8770D-04, 0.6186D-04, & + & 0.4310D-04, 0.2994D-04, 0.2062D-04, 0.1411D-04, 0.9669D-05, & + & 0.6560D-05, 0.4488D-05, 0.3008D-05, 0.1971D-05, 0.1230D-05, & + & 0.7857D-06, 0.4899D-06, 0.3427D-06, 0.1946D-06, 0.4594D-07, & + & 0.4683D-07/ + + data (calcpts(j,33), j = 1,neta) /0.8970D-12, 0.1596D-11, & + & 0.2836D-11, 0.5044D-11, 0.8972D-11, 0.1595D-10, 0.2837D-10, & + & 0.5045D-10, 0.8967D-10, 0.1595D-09, 0.2837D-09, 0.5044D-09, & + & 0.8969D-09, 0.1595D-08, 0.2835D-08, 0.5041D-08, 0.8965D-08, & + & 0.1594D-07, 0.2832D-07, 0.5034D-07, 0.8939D-07, 0.1587D-06, & + & 0.2817D-06, 0.4993D-06, 0.8838D-06, 0.1561D-05, 0.2747D-05, & + & 0.4814D-05, 0.8381D-05, 0.1445D-04, 0.2459D-04, 0.4108D-04, & + & 0.6692D-04, 0.1056D-03, 0.1601D-03, 0.2313D-03, 0.3170D-03, & + & 0.4110D-03, 0.5051D-03, 0.5914D-03, 0.6637D-03, 0.7184D-03, & + & 0.7533D-03, 0.7669D-03, 0.7573D-03, 0.7242D-03, 0.6695D-03, & + & 0.5985D-03, 0.5181D-03, 0.4348D-03, 0.3544D-03, 0.2805D-03, & + & 0.2162D-03, 0.1625D-03, 0.1195D-03, 0.8643D-04, 0.6152D-04, & + & 0.4342D-04, 0.3035D-04, 0.2115D-04, 0.1461D-04, 0.1015D-04, & + & 0.7032D-05, 0.4801D-05, 0.3315D-05, 0.2424D-05, 0.1681D-05, & + & 0.1235D-05, 0.7878D-06, 0.6398D-06, 0.4911D-06, 0.3421D-06, & + & 0.3427D-06/ + + data (calcpts(j,34), j = 1,neta) /0.6268D-12, 0.1115D-11, & + & 0.1982D-11, 0.3525D-11, 0.6269D-11, 0.1115D-10, 0.1982D-10, & + & 0.3526D-10, 0.6266D-10, 0.1114D-09, 0.1982D-09, 0.3525D-09, & + & 0.6267D-09, 0.1115D-08, 0.1981D-08, 0.3523D-08, 0.6265D-08, & + & 0.1114D-07, 0.1979D-07, 0.3518D-07, 0.6246D-07, 0.1109D-06, & + & 0.1969D-06, 0.3489D-06, 0.6176D-06, 0.1091D-05, 0.1919D-05, & + & 0.3364D-05, 0.5857D-05, 0.1010D-04, 0.1718D-04, 0.2871D-04, & + & 0.4677D-04, 0.7381D-04, 0.1119D-03, 0.1617D-03, 0.2216D-03, & + & 0.2874D-03, 0.3534D-03, 0.4142D-03, 0.4658D-03, 0.5061D-03, & + & 0.5344D-03, 0.5501D-03, 0.5524D-03, 0.5402D-03, 0.5129D-03, & + & 0.4718D-03, 0.4202D-03, 0.3626D-03, 0.3038D-03, 0.2471D-03, & + & 0.1954D-03, 0.1503D-03, 0.1129D-03, 0.8290D-04, 0.5986D-04, & + & 0.4259D-04, 0.3009D-04, 0.2100D-04, 0.1460D-04, 0.1013D-04, & + & 0.6998D-05, 0.4762D-05, 0.3271D-05, 0.2228D-05, 0.1632D-05, & + & 0.1035D-05, 0.7373D-06, 0.5887D-06, 0.4396D-06, 0.2903D-06, & + & 0.1407D-06/ + + data (calcpts(j,35), j = 1,neta) /0.4350D-12, 0.7738D-12, & + & 0.1375D-11, 0.2446D-11, 0.4351D-11, 0.7736D-11, 0.1376D-10, & + & 0.2447D-10, 0.4349D-10, 0.7735D-10, 0.1376D-09, 0.2446D-09, & + & 0.4350D-09, 0.7736D-09, 0.1375D-08, 0.2445D-08, 0.4348D-08, & + & 0.7729D-08, 0.1374D-07, 0.2442D-07, 0.4335D-07, 0.7699D-07, & + & 0.1366D-06, 0.2422D-06, 0.4286D-06, 0.7571D-06, 0.1332D-05, & + & 0.2335D-05, 0.4065D-05, 0.7008D-05, 0.1192D-04, 0.1992D-04, & + & 0.3246D-04, 0.5123D-04, 0.7766D-04, 0.1122D-03, 0.1538D-03, & + & 0.1995D-03, 0.2454D-03, 0.2878D-03, 0.3240D-03, 0.3528D-03, & + & 0.3739D-03, 0.3876D-03, 0.3936D-03, 0.3915D-03, 0.3802D-03, & + & 0.3592D-03, 0.3292D-03, 0.2924D-03, 0.2519D-03, 0.2107D-03, & + & 0.1711D-03, 0.1351D-03, 0.1039D-03, 0.7790D-04, 0.5719D-04, & + & 0.4124D-04, 0.2931D-04, 0.2065D-04, 0.1438D-04, 0.1005D-04, & + & 0.6917D-05, 0.4677D-05, 0.3184D-05, 0.2138D-05, 0.1541D-05, & + & 0.9433D-06, 0.6447D-06, 0.4957D-06, 0.3463D-06, 0.1968D-06, & + & 0.4708D-07/ + + data (calcpts(j,36), j = 1,neta) /0.3005D-12, 0.5345D-12, & + & 0.9500D-12, 0.1690D-11, 0.3005D-11, 0.5344D-11, 0.9502D-11, & + & 0.1690D-10, 0.3004D-10, 0.5343D-10, 0.9503D-10, 0.1690D-09, & + & 0.3005D-09, 0.5344D-09, 0.9497D-09, 0.1689D-08, 0.3003D-08, & + & 0.5338D-08, 0.9488D-08, 0.1686D-07, 0.2994D-07, 0.5318D-07, & + & 0.9438D-07, 0.1673D-06, 0.2960D-06, 0.5229D-06, 0.9201D-06, & + & 0.1613D-05, 0.2808D-05, 0.4841D-05, 0.8237D-05, 0.1376D-04, & + & 0.2242D-04, 0.3538D-04, 0.5364D-04, 0.7751D-04, 0.1062D-03, & + & 0.1378D-03, 0.1696D-03, 0.1989D-03, 0.2240D-03, 0.2442D-03, & + & 0.2594D-03, 0.2699D-03, 0.2761D-03, 0.2777D-03, 0.2743D-03, & + & 0.2651D-03, 0.2496D-03, 0.2282D-03, 0.2023D-03, 0.1741D-03, & + & 0.1455D-03, 0.1180D-03, 0.9320D-04, 0.7159D-04, 0.5369D-04, & + & 0.3936D-04, 0.2845D-04, 0.2023D-04, 0.1425D-04, 0.9918D-05, & + & 0.6928D-05, 0.4684D-05, 0.3339D-05, 0.2292D-05, 0.1544D-05, & + & 0.1095D-05, 0.6464D-06, 0.4971D-06, 0.3476D-06, 0.1979D-06, & + & 0.1981D-06/ + + data (calcpts(j,37), j = 1,neta) /0.2068D-12, 0.3678D-12, & + & 0.6537D-12, 0.1163D-11, 0.2068D-11, 0.3677D-11, 0.6539D-11, & + & 0.1163D-10, 0.2067D-10, 0.3676D-10, 0.6539D-10, 0.1163D-09, & + & 0.2068D-09, 0.3677D-09, 0.6535D-09, 0.1162D-08, 0.2067D-08, & + & 0.3673D-08, 0.6529D-08, 0.1161D-07, 0.2061D-07, 0.3659D-07, & + & 0.6495D-07, 0.1151D-06, 0.2037D-06, 0.3598D-06, 0.6331D-06, & + & 0.1110D-05, 0.1932D-05, 0.3331D-05, 0.5668D-05, 0.9470D-05, & + & 0.1543D-04, 0.2435D-04, 0.3691D-04, 0.5334D-04, 0.7311D-04, & + & 0.9485D-04, 0.1167D-03, 0.1369D-03, 0.1542D-03, 0.1682D-03, & + & 0.1789D-03, 0.1865D-03, 0.1915D-03, 0.1940D-03, 0.1939D-03, & + & 0.1906D-03, 0.1836D-03, 0.1724D-03, 0.1573D-03, 0.1393D-03, & + & 0.1198D-03, 0.1000D-03, 0.8116D-04, 0.6403D-04, 0.4914D-04, & + & 0.3688D-04, 0.2701D-04, 0.1954D-04, 0.1385D-04, 0.9811D-05, & + & 0.6817D-05, 0.4722D-05, 0.3225D-05, 0.2177D-05, 0.1579D-05, & + & 0.9795D-06, 0.6802D-06, 0.5307D-06, 0.3810D-06, 0.2312D-06, & + & 0.8135D-07/ + + data (calcpts(j,38), j = 1,neta) /0.1419D-12, 0.2524D-12, & + & 0.4485D-12, 0.7978D-12, 0.1419D-11, 0.2523D-11, 0.4487D-11, & + & 0.7980D-11, 0.1418D-10, 0.2523D-10, 0.4487D-10, 0.7978D-10, & + & 0.1419D-09, 0.2523D-09, 0.4484D-09, 0.7974D-09, 0.1418D-08, & + & 0.2521D-08, 0.4480D-08, 0.7963D-08, 0.1414D-07, 0.2511D-07, & + & 0.4456D-07, 0.7898D-07, 0.1398D-06, 0.2469D-06, 0.4344D-06, & + & 0.7614D-06, 0.1326D-05, 0.2286D-05, 0.3889D-05, 0.6498D-05, & + & 0.1059D-04, 0.1671D-04, 0.2533D-04, 0.3660D-04, 0.5016D-04, & + & 0.6509D-04, 0.8007D-04, 0.9395D-04, 0.1059D-03, 0.1155D-03, & + & 0.1229D-03, 0.1283D-03, 0.1320D-03, 0.1343D-03, 0.1351D-03, & + & 0.1344D-03, 0.1316D-03, 0.1265D-03, 0.1186D-03, 0.1081D-03, & + & 0.9565D-04, 0.8217D-04, 0.6858D-04, 0.5562D-04, 0.4385D-04, & + & 0.3367D-04, 0.2521D-04, 0.1849D-04, 0.1333D-04, 0.9480D-05, & + & 0.6665D-05, 0.4643D-05, 0.3220D-05, 0.2216D-05, 0.1512D-05, & + & 0.1033D-05, 0.7036D-06, 0.2689D-06, 0.3141D-06, 0.2093D-06, & + & 0.1344D-06/ + + data (calcpts(j,39), j = 1,neta) /0.9721D-13, 0.1729D-12, & + & 0.3073D-12, 0.5466D-12, 0.9722D-12, 0.1729D-11, 0.3074D-11, & + & 0.5467D-11, 0.9717D-11, 0.1728D-10, 0.3074D-10, 0.5466D-10, & + & 0.9719D-10, 0.1729D-09, 0.3072D-09, 0.5463D-09, 0.9715D-09, & + & 0.1727D-08, 0.3069D-08, 0.5455D-08, 0.9686D-08, 0.1720D-07, & + & 0.3053D-07, 0.5411D-07, 0.9577D-07, 0.1692D-06, 0.2976D-06, & + & 0.5216D-06, 0.9082D-06, 0.1566D-05, 0.2664D-05, 0.4452D-05, & + & 0.7252D-05, 0.1145D-04, 0.1735D-04, 0.2507D-04, 0.3437D-04, & + & 0.4459D-04, 0.5486D-04, 0.6437D-04, 0.7254D-04, 0.7914D-04, & + & 0.8422D-04, 0.8797D-04, 0.9062D-04, 0.9238D-04, 0.9334D-04, & + & 0.9349D-04, 0.9267D-04, 0.9059D-04, 0.8691D-04, 0.8140D-04, & + & 0.7414D-04, 0.6557D-04, 0.5631D-04, 0.4698D-04, 0.3810D-04, & + & 0.3004D-04, 0.2306D-04, 0.1728D-04, 0.1268D-04, 0.9146D-05, & + & 0.6510D-05, 0.4592D-05, 0.3213D-05, 0.2224D-05, 0.1550D-05, & + & 0.1070D-05, 0.7407D-06, 0.5159D-06, 0.3511D-06, 0.2462D-06, & + & 0.1713D-06/ + + data (calcpts(j,40), j = 1,neta) /0.6647D-13, 0.1182D-12, & + & 0.2101D-12, 0.3737D-12, 0.6648D-12, 0.1182D-11, 0.2102D-11, & + & 0.3739D-11, 0.6645D-11, 0.1182D-10, 0.2102D-10, 0.3738D-10, & + & 0.6646D-10, 0.1182D-09, 0.2101D-09, 0.3736D-09, 0.6643D-09, & + & 0.1181D-08, 0.2099D-08, 0.3730D-08, 0.6624D-08, 0.1176D-07, & + & 0.2088D-07, 0.3700D-07, 0.6549D-07, 0.1157D-06, 0.2035D-06, & + & 0.3567D-06, 0.6210D-06, 0.1071D-05, 0.1822D-05, 0.3044D-05, & + & 0.4959D-05, 0.7827D-05, 0.1187D-04, 0.1715D-04, 0.2350D-04, & + & 0.3049D-04, 0.3751D-04, 0.4402D-04, 0.4960D-04, 0.5412D-04, & + & 0.5760D-04, 0.6019D-04, 0.6204D-04, 0.6331D-04, 0.6410D-04, & + & 0.6447D-04, 0.6436D-04, 0.6366D-04, 0.6213D-04, 0.5954D-04, & + & 0.5572D-04, 0.5072D-04, 0.4483D-04, 0.3849D-04, 0.3210D-04, & + & 0.2603D-04, 0.2052D-04, 0.1576D-04, 0.1180D-04, 0.8654D-05, & + & 0.6241D-05, 0.4442D-05, 0.3123D-05, 0.2179D-05, 0.1519D-05, & + & 0.1055D-05, 0.7248D-06, 0.5000D-06, 0.3351D-06, 0.2302D-06, & + & 0.1702D-06/ + + data (calcpts(j,41), j = 1,neta) /0.4540D-13, 0.8075D-13, & + & 0.1435D-12, 0.2553D-12, 0.4541D-12, 0.8074D-12, 0.1436D-11, & + & 0.2554D-11, 0.4539D-11, 0.8072D-11, 0.1436D-10, 0.2553D-10, & + & 0.4539D-10, 0.8074D-10, 0.1435D-09, 0.2552D-09, 0.4538D-09, & + & 0.8066D-09, 0.1434D-08, 0.2548D-08, 0.4524D-08, 0.8035D-08, & + & 0.1426D-07, 0.2527D-07, 0.4473D-07, 0.7901D-07, 0.1390D-06, & + & 0.2436D-06, 0.4242D-06, 0.7314D-06, 0.1244D-05, 0.2079D-05, & + & 0.3387D-05, 0.5346D-05, 0.8105D-05, 0.1171D-04, 0.1605D-04, & + & 0.2083D-04, 0.2562D-04, 0.3006D-04, 0.3388D-04, 0.3697D-04, & + & 0.3935D-04, 0.4112D-04, 0.4239D-04, 0.4329D-04, 0.4388D-04, & + & 0.4423D-04, 0.4434D-04, 0.4417D-04, 0.4362D-04, 0.4252D-04, & + & 0.4072D-04, 0.3808D-04, 0.3465D-04, 0.3062D-04, 0.2628D-04, & + & 0.2192D-04, 0.1777D-04, 0.1400D-04, 0.1074D-04, 0.8047D-05, & + & 0.5904D-05, 0.4255D-05, 0.3025D-05, 0.2126D-05, 0.1481D-05, & + & 0.1031D-05, 0.7015D-06, 0.4916D-06, 0.3266D-06, 0.2217D-06, & + & 0.1467D-06/ + + data (calcpts(j,42), j = 1,neta) /0.3100D-13, 0.5513D-13, & + & 0.9799D-13, 0.1743D-12, 0.3100D-12, 0.5512D-12, 0.9801D-12, & + & 0.1743D-11, 0.3098D-11, 0.5511D-11, 0.9802D-11, 0.1743D-10, & + & 0.3099D-10, 0.5512D-10, 0.9795D-10, 0.1742D-09, 0.3098D-09, & + & 0.5506D-09, 0.9787D-09, 0.1740D-08, 0.3089D-08, 0.5485D-08, & + & 0.9735D-08, 0.1725D-07, 0.3054D-07, 0.5394D-07, 0.9490D-07, & + & 0.1663D-06, 0.2896D-06, 0.4993D-06, 0.8496D-06, 0.1420D-05, & + & 0.2313D-05, 0.3650D-05, 0.5533D-05, 0.7995D-05, 0.1096D-04, & + & 0.1422D-04, 0.1749D-04, 0.2052D-04, 0.2313D-04, 0.2524D-04, & + & 0.2686D-04, 0.2807D-04, 0.2895D-04, 0.2957D-04, 0.2999D-04, & + & 0.3026D-04, 0.3040D-04, 0.3041D-04, 0.3025D-04, 0.2984D-04, & + & 0.2907D-04, 0.2782D-04, 0.2601D-04, 0.2366D-04, 0.2091D-04, & + & 0.1794D-04, 0.1497D-04, 0.1213D-04, 0.9555D-05, 0.7337D-05, & + & 0.5493D-05, 0.4024D-05, 0.2899D-05, 0.2059D-05, 0.1460D-05, & + & 0.1010D-05, 0.7099D-06, 0.4850D-06, 0.3350D-06, 0.2300D-06, & + & 0.1551D-06/ + + data (calcpts(j,43), j = 1,neta) /0.2115D-13, 0.3761D-13, & + & 0.6685D-13, 0.1189D-12, 0.2115D-12, 0.3761D-12, 0.6687D-12, & + & 0.1189D-11, 0.2114D-11, 0.3760D-11, 0.6688D-11, 0.1189D-10, & + & 0.2114D-10, 0.3760D-10, 0.6683D-10, 0.1188D-09, 0.2113D-09, & + & 0.3757D-09, 0.6677D-09, 0.1187D-08, 0.2107D-08, 0.3742D-08, & + & 0.6642D-08, 0.1177D-07, 0.2083D-07, 0.3680D-07, 0.6475D-07, & + & 0.1135D-06, 0.1976D-06, 0.3407D-06, 0.5796D-06, 0.9685D-06, & + & 0.1578D-05, 0.2490D-05, 0.3775D-05, 0.5455D-05, 0.7477D-05, & + & 0.9701D-05, 0.1193D-04, 0.1400D-04, 0.1578D-04, 0.1722D-04, & + & 0.1833D-04, 0.1916D-04, 0.1975D-04, 0.2018D-04, 0.2047D-04, & + & 0.2067D-04, 0.2079D-04, 0.2084D-04, 0.2082D-04, 0.2068D-04, & + & 0.2039D-04, 0.1985D-04, 0.1899D-04, 0.1775D-04, 0.1614D-04, & + & 0.1426D-04, 0.1224D-04, 0.1021D-04, 0.8272D-05, 0.6518D-05, & + & 0.5005D-05, 0.3746D-05, 0.2741D-05, 0.1976D-05, 0.1406D-05, & + & 0.9865D-06, 0.6866D-06, 0.4766D-06, 0.3267D-06, 0.2217D-06, & + & 0.1617D-06/ + + data (calcpts(j,44), j = 1,neta) /0.1442D-13, 0.2565D-13, & + & 0.4559D-13, 0.8108D-13, 0.1442D-12, 0.2564D-12, 0.4560D-12, & + & 0.8110D-12, 0.1441D-11, 0.2564D-11, 0.4560D-11, 0.8108D-11, & + & 0.1442D-10, 0.2564D-10, 0.4557D-10, 0.8104D-10, 0.1441D-09, & + & 0.2562D-09, 0.4553D-09, 0.8093D-09, 0.1437D-08, 0.2552D-08, & + & 0.4529D-08, 0.8027D-08, 0.1421D-07, 0.2509D-07, 0.4415D-07, & + & 0.7738D-07, 0.1347D-06, 0.2323D-06, 0.3952D-06, 0.6604D-06, & + & 0.1076D-05, 0.1698D-05, 0.2574D-05, 0.3720D-05, 0.5098D-05, & + & 0.6615D-05, 0.8138D-05, 0.9549D-05, 0.1076D-04, 0.1174D-04, & + & 0.1250D-04, 0.1306D-04, 0.1347D-04, 0.1376D-04, 0.1396D-04, & + & 0.1410D-04, 0.1419D-04, 0.1424D-04, 0.1426D-04, 0.1422D-04, & + & 0.1412D-04, 0.1391D-04, 0.1354D-04, 0.1295D-04, 0.1211D-04, & + & 0.1101D-04, 0.9725D-05, 0.8345D-05, 0.6957D-05, 0.5636D-05, & + & 0.4442D-05, 0.3407D-05, 0.2551D-05, 0.1870D-05, 0.1348D-05, & + & 0.9585D-06, 0.6736D-06, 0.4696D-06, 0.3241D-06, 0.2236D-06, & + & 0.1532D-06/ + + data (calcpts(j,45), j = 1,neta) /0.9834D-14, 0.1749D-13, & + & 0.3109D-13, 0.5530D-13, 0.9836D-13, 0.1749D-12, 0.3110D-12, & + & 0.5531D-12, 0.9831D-12, 0.1749D-11, 0.3110D-11, 0.5530D-11, & + & 0.9833D-11, 0.1749D-10, 0.3108D-10, 0.5527D-10, 0.9829D-10, & + & 0.1747D-09, 0.3105D-09, 0.5519D-09, 0.9800D-09, 0.1740D-08, & + & 0.3089D-08, 0.5474D-08, 0.9689D-08, 0.1711D-07, 0.3011D-07, & + & 0.5277D-07, 0.9189D-07, 0.1584D-06, 0.2696D-06, 0.4504D-06, & + & 0.7337D-06, 0.1158D-05, 0.1756D-05, 0.2537D-05, 0.3477D-05, & + & 0.4511D-05, 0.5550D-05, 0.6512D-05, 0.7339D-05, 0.8008D-05, & + & 0.8524D-05, 0.8909D-05, 0.9187D-05, 0.9385D-05, 0.9524D-05, & + & 0.9620D-05, 0.9684D-05, 0.9725D-05, 0.9746D-05, 0.9745D-05, & + & 0.9716D-05, 0.9642D-05, 0.9496D-05, 0.9241D-05, 0.8837D-05, & + & 0.8258D-05, 0.7509D-05, 0.6633D-05, 0.5691D-05, 0.4745D-05, & + & 0.3847D-05, 0.3031D-05, 0.2327D-05, 0.1743D-05, 0.1278D-05, & + & 0.9198D-06, 0.6558D-06, 0.4624D-06, 0.3229D-06, 0.2254D-06, & + & 0.1564D-06/ + + data (calcpts(j,46), j = 1,neta) /0.6703D-14, 0.1192D-13, & + & 0.2119D-13, 0.3769D-13, 0.6704D-13, 0.1192D-12, 0.2120D-12, & + & 0.3770D-12, 0.6701D-12, 0.1192D-11, 0.2120D-11, 0.3769D-11, & + & 0.6702D-11, 0.1192D-10, 0.2118D-10, 0.3767D-10, 0.6699D-10, & + & 0.1191D-09, 0.2116D-09, 0.3762D-09, 0.6679D-09, 0.1186D-08, & + & 0.2105D-08, 0.3731D-08, 0.6603D-08, 0.1166D-07, 0.2052D-07, & + & 0.3597D-07, 0.6263D-07, 0.1080D-06, 0.1837D-06, 0.3070D-06, & + & 0.5001D-06, 0.7893D-06, 0.1196D-05, 0.1729D-05, 0.2370D-05, & + & 0.3075D-05, 0.3783D-05, 0.4439D-05, 0.5002D-05, 0.5458D-05, & + & 0.5810D-05, 0.6072D-05, 0.6262D-05, 0.6397D-05, 0.6492D-05, & + & 0.6557D-05, 0.6602D-05, 0.6632D-05, 0.6650D-05, 0.6657D-05, & + & 0.6652D-05, 0.6629D-05, 0.6576D-05, 0.6475D-05, 0.6300D-05, & + & 0.6024D-05, 0.5629D-05, 0.5117D-05, 0.4519D-05, 0.3879D-05, & + & 0.3234D-05, 0.2621D-05, 0.2066D-05, 0.1585D-05, 0.1187D-05, & + & 0.8707D-06, 0.6277D-06, 0.4462D-06, 0.3143D-06, 0.2198D-06, & + & 0.1523D-06/ + + data (calcpts(j,47), j = 1,neta) /0.4567D-14, 0.8124D-14, & + & 0.1444D-13, 0.2568D-13, 0.4568D-13, 0.8122D-13, 0.1444D-12, & + & 0.2569D-12, 0.4566D-12, 0.8121D-12, 0.1444D-11, 0.2568D-11, & + & 0.4567D-11, 0.8122D-11, 0.1443D-10, 0.2567D-10, 0.4565D-10, & + & 0.8114D-10, 0.1442D-09, 0.2563D-09, 0.4551D-09, 0.8083D-09, & + & 0.1435D-08, 0.2542D-08, 0.4500D-08, 0.7948D-08, 0.1398D-07, & + & 0.2451D-07, 0.4267D-07, 0.7358D-07, 0.1252D-06, 0.2092D-06, & + & 0.3408D-06, 0.5378D-06, 0.8153D-06, 0.1178D-05, 0.1615D-05, & + & 0.2095D-05, 0.2578D-05, 0.3025D-05, 0.3409D-05, 0.3719D-05, & + & 0.3959D-05, 0.4138D-05, 0.4267D-05, 0.4359D-05, 0.4424D-05, & + & 0.4468D-05, 0.4499D-05, 0.4520D-05, 0.4534D-05, 0.4541D-05, & + & 0.4543D-05, 0.4537D-05, 0.4520D-05, 0.4483D-05, 0.4413D-05, & + & 0.4294D-05, 0.4105D-05, 0.3835D-05, 0.3487D-05, 0.3080D-05, & + & 0.2643D-05, 0.2203D-05, 0.1785D-05, 0.1407D-05, 0.1078D-05, & + & 0.8084D-06, 0.5924D-06, 0.4274D-06, 0.3029D-06, 0.2129D-06, & + & 0.1484D-06/ + + data (calcpts(j,48), j = 1,neta) /0.3113D-14, 0.5537D-14, & + & 0.9840D-14, 0.1750D-13, 0.3113D-13, 0.5535D-13, 0.9843D-13, & + & 0.1751D-12, 0.3112D-12, 0.5534D-12, 0.9844D-12, 0.1750D-11, & + & 0.3112D-11, 0.5535D-11, 0.9837D-11, 0.1749D-10, 0.3111D-10, & + & 0.5530D-10, 0.9829D-10, 0.1747D-09, 0.3102D-09, 0.5509D-09, & + & 0.9777D-09, 0.1733D-08, 0.3067D-08, 0.5417D-08, 0.9531D-08, & + & 0.1670D-07, 0.2908D-07, 0.5014D-07, 0.8532D-07, 0.1426D-06, & + & 0.2322D-06, 0.3665D-06, 0.5557D-06, 0.8030D-06, 0.1101D-05, & + & 0.1428D-05, 0.1757D-05, 0.2061D-05, 0.2323D-05, 0.2535D-05, & + & 0.2698D-05, 0.2820D-05, 0.2908D-05, 0.2971D-05, 0.3015D-05, & + & 0.3045D-05, 0.3067D-05, 0.3081D-05, 0.3091D-05, 0.3097D-05, & + & 0.3100D-05, 0.3099D-05, 0.3094D-05, 0.3082D-05, 0.3056D-05, & + & 0.3009D-05, 0.2927D-05, 0.2798D-05, 0.2614D-05, 0.2377D-05, & + & 0.2099D-05, 0.1801D-05, 0.1502D-05, 0.1217D-05, 0.9587D-06, & + & 0.7353D-06, 0.5508D-06, 0.4038D-06, 0.2913D-06, 0.2073D-06, & + & 0.1458D-06/ + + data (calcpts(j,49), j = 1,neta) /0.2121D-14, 0.3773D-14, & + & 0.6706D-14, 0.1193D-13, 0.2121D-13, 0.3772D-13, 0.6708D-13, & + & 0.1193D-12, 0.2120D-12, 0.3771D-12, 0.6708D-12, 0.1193D-11, & + & 0.2121D-11, 0.3772D-11, 0.6703D-11, 0.1192D-10, 0.2120D-10, & + & 0.3768D-10, 0.6698D-10, 0.1190D-09, 0.2114D-09, 0.3754D-09, & + & 0.6662D-09, 0.1181D-08, 0.2090D-08, 0.3691D-08, 0.6495D-08, & + & 0.1138D-07, 0.1982D-07, 0.3417D-07, 0.5814D-07, 0.9715D-07, & + & 0.1583D-06, 0.2498D-06, 0.3786D-06, 0.5472D-06, 0.7499D-06, & + & 0.9731D-06, 0.1197D-05, 0.1405D-05, 0.1583D-05, 0.1727D-05, & + & 0.1839D-05, 0.1921D-05, 0.1982D-05, 0.2024D-05, 0.2054D-05, & + & 0.2075D-05, 0.2090D-05, 0.2100D-05, 0.2106D-05, 0.2111D-05, & + & 0.2113D-05, 0.2114D-05, 0.2113D-05, 0.2110D-05, 0.2101D-05, & + & 0.2083D-05, 0.2050D-05, 0.1994D-05, 0.1907D-05, 0.1781D-05, & + & 0.1620D-05, 0.1430D-05, 0.1227D-05, 0.1023D-05, 0.8291D-06, & + & 0.6532D-06, 0.5011D-06, 0.3751D-06, 0.2746D-06, 0.1981D-06, & + & 0.1411D-06/ + + data (dlaeta(j), j = 1,neta) / & + & -6d0, -5.83333333d0, -5.66666667d0, -5.5d0, -5.33333333d0, & + & -5.16666667d0, -5d0, -4.83333333d0, -4.66666667d0, -4.5d0, & + & -4.33333333d0, -4.16666667d0, -4d0, -3.83333333d0, & + & -3.66666667d0, -3.5d0, -3.33333333d0, -3.16666667d0, -3d0, & + & -2.83333333d0, -2.66666667d0, -2.5d0, -2.33333333d0, & + & -2.16666667d0, -2d0, -1.83333333d0, -1.66666667d0, -1.5d0, & + & -1.33333333d0, -1.16666667d0, -1d0, -0.83333333d0, -0.66666667d0,& + & -0.5d0, -0.33333333d0, -0.16666667d0, 0d0, 0.16666667d0, & + & 0.33333333d0, 0.5d0, 0.66666667d0, 0.83333333d0, 1d0, & + & 1.16666667d0, 1.33333333d0, 1.5d0, 1.66666667d0, 1.83333333d0, & + & 2d0, 2.16666667d0, 2.33333333d0, 2.5d0, 2.66666667d0, & + & 2.83333333d0, 3d0, 3.16666667d0, 3.33333333d0, 3.5d0, & + & 3.66666667d0, 3.83333333d0, 4d0, 4.16666667d0, 4.33333333d0, & + & 4.5d0, 4.66666667d0, 4.83333333d0, 5d0, 5.16666667d0, & + & 5.33333333d0, 5.5d0, 5.66666667d0, 5.83333333d0, 6d0/ + + data (dlaxi(j), j = 1,nxi) / & + & -3d0, -2.83333333d0, -2.66666667d0, -2.5d0, -2.33333333d0, & + & -2.16666667d0, -2d0, -1.83333333d0, -1.66666667d0, -1.5d0, & + & -1.33333333d0, -1.16666667d0, -1d0, -0.83333333d0, -0.66666667d0,& + & -0.5d0, -0.33333333d0, -0.16666667d0, 0d0, 0.16666667d0, & + & 0.33333333d0, 0.5d0, 0.66666667d0, 0.83333333d0, 1d0, & + & 1.16666667d0, 1.33333333d0, 1.5d0, 1.66666667d0, 1.83333333d0, & + & 2d0, 2.16666667d0, 2.33333333d0, 2.5d0, 2.66666667d0, & + & 2.83333333d0, 3d0, 3.16666667d0, 3.33333333d0, 3.5d0, & + & 3.66666667d0, 3.83333333d0, 4d0, 4.16666667d0, 4.33333333d0, & + & 4.5d0, 4.66666667d0, 4.83333333d0, 5d0/ + + dleta = dlog10(eta) + dlxi = dlog10(xi) + if (dlxi .le. dlaxi(1)) dlxi = dlaxi(1) + if (dlxi .ge. dlaxi(nxi)) dlxi = dlaxi(nxi) + if (dleta .ge. dlaeta(neta)) dleta = dlaeta(neta) + if (dleta .le. dlaeta(1)) dleta = dlaeta(1) + call locate(dlaeta,neta, dleta, ieta) + call locate(dlaxi, nxi, dlxi, ixi) +! interpolating between the appropriate points + delxi = 1d0/6d0 + deleta = 1d0/6d0 +! lagrange 3-pt. + if (ixi .le. 2) ixi = 2 + if (ixi .ge. 48) ixi = 48 + if (ieta .le. 2) ieta = 2 + if (ieta .ge. 72) ieta = 72 + pxi = (dlxi - dlaxi(ixi))/delxi + f(-1) = pxi*(pxi-1d0)/2d0*calcpts(ieta-1,ixi-1) + & + & (1d0 - pxi**2)*calcpts(ieta-1,ixi) + & + & pxi*(pxi+1d0)/2d0*calcpts(ieta-1,ixi+1) + f(0) = pxi*(pxi-1d0)/2d0*calcpts(ieta,ixi-1) + & + & (1d0 - pxi**2)*calcpts(ieta,ixi) + & + & pxi*(pxi+1d0)/2d0*calcpts(ieta,ixi+1) + f(1) = pxi*(pxi-1d0)/2d0*calcpts(ieta+1,ixi-1) + & + & (1d0 - pxi**2)*calcpts(ieta+1,ixi) + & + & pxi*(pxi+1d0)/2d0*calcpts(ieta+1,ixi+1) + peta = (dleta - dlaeta(ieta))/deleta + h1bar_HLq = peta*(peta-1d0)/2d0*f(-1) + & + & (1d0 - peta**2)*f(0) + & + & peta*(peta+1d0)/2d0*f(1) +!MB + + peta*(peta+1d0)/2d0*f(1) + return + END + +! ========================================= + double precision function h1f_LLq(eta,xi) +! ========================================= + +! eq (28) in PLB347 (1995) 143 - 151 for the longitudinal piece +! This also takes into account the additional mass factorizations +! necessary from a low Q^2 photon coupling to the light quark. +! MSbar scheme +! This routine is called subd1lqf in the original code. +! Gives h1_LLq for Q2 < 1.5 GeV2 (use h1_LLq for Q2 > 1.5 GeV2). + + implicit none + integer neta, nxi + parameter (neta = 45, nxi = 15) + double precision calcpts(neta,nxi), aeta(neta), axi(nxi) + double precision eta, xi, huge, small + double precision t, u, y1, y2, y3, y4 + parameter (small = 1.d-8, huge = 1.d10) + integer j, ieta, ixi + + data (calcpts(j, 1), j=1,neta) /0.d0, -.4776D-09, -.6020D-08, & + & -.1815D-07, -.3618D-07, -.5922D-07, -.7236D-07, -.4052D-06, & + & -.5175D-06, -.9498D-07, 0.1024D-05, 0.1868D-05, 0.2083D-04, & + & 0.5522D-04, 0.9831D-04, 0.1448D-03, 0.1913D-03, 0.2357D-03, & + & 0.2769D-03, 0.3144D-03, 0.3480D-03, 0.5190D-03, 0.5396D-03, & + & 0.5166D-03, 0.4819D-03, 0.4467D-03, 0.4138D-03, 0.3843D-03, & + & 0.3581D-03, 0.3348D-03, 0.1415D-03, 0.8921D-04, 0.6507D-04, & + & 0.5126D-04, 0.4629D-04, 0.2359D-04, 0.1582D-04, 0.9541D-05, & + & 0.6834D-05, 0.5321D-05, 0.4785D-05, 0.9609D-06, 0.4809D-06, & + & 0.4800D-07, 0.d0/ +! + data (calcpts(j, 2), j=1,neta) /0.d0, -.3228D-09, -.4385D-08, & + & -.1380D-07, -.2816D-07, -.4656D-07, -.5691D-07, -.1957D-06, & + & 0.4271D-06, 0.2429D-05, 0.6145D-05, 0.8706D-05, 0.5987D-04, & + & 0.1485D-03, 0.2585D-03, 0.3771D-03, 0.4953D-03, 0.6087D-03, & + & 0.7136D-03, 0.8094D-03, 0.8954D-03, 0.1336D-02, 0.1391D-02, & + & 0.1332D-02, 0.1244D-02, 0.1153D-02, 0.1069D-02, 0.9933D-03, & + & 0.9254D-03, 0.8649D-03, 0.3657D-03, 0.2305D-03, 0.1682D-03, & + & 0.1325D-03, 0.1197D-03, 0.6099D-04, 0.4089D-04, 0.2469D-04, & + & 0.1765D-04, 0.1375D-04, 0.1239D-04, 0.2480D-05, 0.1242D-05, & + & 0.1244D-06, 0.d0/ +! + data (calcpts(j, 3), j=1,neta) /0.d0, -.7553D-10, -.9480D-09, & + & -.2635D-08, -.4464D-08, -.5487D-08, -.5352D-08, 0.3277D-06, & + & 0.2037D-05, 0.5960D-05, 0.1261D-04, 0.1707D-04, 0.1039D-03, & + & 0.2553D-03, 0.4464D-03, 0.6548D-03, 0.8652D-03, 0.1068D-02, & + & 0.1259D-02, 0.1434D-02, 0.1592D-02, 0.2423D-02, 0.2543D-02, & + & 0.2445D-02, 0.2289D-02, 0.2125D-02, 0.1971D-02, 0.1832D-02, & + & 0.1707D-02, 0.1598D-02, 0.6758D-03, 0.4258D-03, 0.3108D-03, & + & 0.2446D-03, 0.2209D-03, 0.1126D-03, 0.7551D-04, 0.4554D-04, & + & 0.3260D-04, 0.2538D-04, 0.2284D-04, 0.4588D-05, 0.2292D-05, & + & 0.2292D-06, 0.d0/ +! + data (calcpts(j, 4), j=1,neta) /0.d0, 0.1486D-11, 0.9642D-10, & + & 0.6003D-09, 0.1963D-08, 0.4715D-08, 0.6797D-08, 0.2807D-06, & + & 0.1468D-05, 0.4193D-05, 0.8945D-05, 0.1219D-04, 0.8137D-04, & + & 0.2145D-03, 0.3941D-03, 0.6006D-03, 0.8178D-03, 0.1034D-02, & + & 0.1243D-02, 0.1439D-02, 0.1620D-02, 0.2652D-02, 0.2861D-02, & + & 0.2787D-02, 0.2627D-02, 0.2448D-02, 0.2279D-02, 0.2121D-02, & + & 0.1980D-02, 0.1854D-02, 0.7854D-03, 0.4940D-03, 0.3602D-03, & + & 0.2834D-03, 0.2559D-03, 0.1302D-03, 0.8738D-04, 0.5263D-04, & + & 0.3765D-04, 0.2933D-04, 0.2638D-04, 0.5286D-05, 0.2649D-05, & + & 0.2645D-06, 0.d0/ +! + data (calcpts(j, 5), j=1,neta) /0.d0, 0.7637D-12, 0.3540D-10, & + & 0.2097D-09, 0.6749D-09, 0.1613D-08, 0.2322D-08, 0.9969D-07, & + & 0.5478D-06, 0.1638D-05, 0.3644D-05, 0.5064D-05, 0.3938D-04, & + & 0.1154D-03, 0.2295D-03, 0.3726D-03, 0.5337D-03, 0.7044D-03, & + & 0.8778D-03, 0.1048D-02, 0.1212D-02, 0.2309D-02, 0.2654D-02, & + & 0.2671D-02, 0.2570D-02, 0.2426D-02, 0.2276D-02, 0.2130D-02, & + & 0.1998D-02, 0.1876D-02, 0.8007D-03, 0.5025D-03, 0.3653D-03, & + & 0.2870D-03, 0.2591D-03, 0.1314D-03, 0.8796D-04, 0.5287D-04, & + & 0.3783D-04, 0.2940D-04, 0.2647D-04, 0.5306D-05, 0.2651D-05, & + & 0.2651D-06, 0.d0/ +! + data (calcpts(j, 6), j=1,neta) /0.d0, 0.3057D-12, 0.1420D-10, & + & 0.8435D-10, 0.2719D-09, 0.6511D-09, 0.9384D-09, 0.4110D-07, & + & 0.2302D-06, 0.7017D-06, 0.1588D-05, 0.2228D-05, 0.1869D-04, & + & 0.5837D-04, 0.1227D-03, 0.2088D-03, 0.3120D-03, 0.4274D-03, & + & 0.5504D-03, 0.6773D-03, 0.8046D-03, 0.1824D-02, 0.2286D-02, & + & 0.2424D-02, 0.2408D-02, 0.2325D-02, 0.2216D-02, 0.2100D-02, & + & 0.1985D-02, 0.1876D-02, 0.8223D-03, 0.5151D-03, 0.3734D-03, & + & 0.2925D-03, 0.2639D-03, 0.1329D-03, 0.8870D-04, 0.5322D-04, & + & 0.3800D-04, 0.2958D-04, 0.2661D-04, 0.5309D-05, 0.2655D-05, & + & 0.2652D-06, 0.d0/ +! + data (calcpts(j, 7), j=1,neta) /0.d0, 0.2418D-12, 0.1123D-10, & + & 0.6674D-10, 0.2154D-09, 0.5155D-09, 0.7433D-09, 0.3266D-07, & + & 0.1835D-06, 0.5605D-06, 0.1272D-05, 0.1787D-05, 0.1518D-04, & + & 0.4799D-04, 0.1020D-03, 0.1754D-03, 0.2644D-03, 0.3654D-03, & + & 0.4742D-03, 0.5879D-03, 0.7031D-03, 0.1673D-02, 0.2155D-02, & + & 0.2326D-02, 0.2337D-02, 0.2276D-02, 0.2183D-02, 0.2078D-02, & + & 0.1971D-02, 0.1869D-02, 0.8293D-03, 0.5196D-03, 0.3765D-03, & + & 0.2948D-03, 0.2657D-03, 0.1336D-03, 0.8898D-04, 0.5337D-04, & + & 0.3807D-04, 0.2961D-04, 0.2664D-04, 0.5312D-05, 0.2655D-05, & + & 0.2654D-06, 0.d0/ +! + data (calcpts(j, 8), j=1,neta) /0.d0, 0.1019D-12, 0.4742D-11, & + & 0.2817D-10, 0.9098D-10, 0.2179D-09, 0.3144D-09, 0.1390D-07, & + & 0.7859D-07, 0.2416D-06, 0.5520D-06, 0.7771D-06, 0.6819D-05, & + & 0.2222D-04, 0.4859D-04, 0.8589D-04, 0.1330D-03, 0.1882D-03, & + & 0.2503D-03, 0.3175D-03, 0.3882D-03, 0.1095D-02, 0.1577D-02, & + & 0.1835D-02, 0.1947D-02, 0.1976D-02, 0.1955D-02, 0.1908D-02, & + & 0.1847D-02, 0.1779D-02, 0.8622D-03, 0.5429D-03, 0.3925D-03, & + & 0.3067D-03, 0.2760D-03, 0.1374D-03, 0.9090D-04, 0.5416D-04, & + & 0.3855D-04, 0.2988D-04, 0.2687D-04, 0.5327D-05, 0.2658D-05, & + & 0.2655D-06, 0.d0/ +! + data (calcpts(j, 9), j=1,neta) /0.d0, 0.7647D-13, 0.3556D-11, & + & 0.2113D-10, 0.6827D-10, 0.1635D-09, 0.2358D-09, 0.1045D-07, & + & 0.5912D-07, 0.1821D-06, 0.4163D-06, 0.5868D-06, 0.5177D-05, & + & 0.1697D-04, 0.3735D-04, 0.6637D-04, 0.1034D-03, 0.1474D-03, & + & 0.1971D-03, 0.2514D-03, 0.3091D-03, 0.9150D-03, 0.1365D-02, & + & 0.1635D-02, 0.1773D-02, 0.1829D-02, 0.1836D-02, 0.1811D-02, & + & 0.1769D-02, 0.1716D-02, 0.8732D-03, 0.5532D-03, 0.4004D-03, & + & 0.3122D-03, 0.2813D-03, 0.1392D-03, 0.9206D-04, 0.5460D-04, & + & 0.3876D-04, 0.3009D-04, 0.2702D-04, 0.5337D-05, 0.2666D-05, & + & 0.2654D-06, 0.d0/ +! + data (calcpts(j,10), j=1,neta) /0.d0, 0.2420D-13, 0.1125D-11, & + & 0.6694D-11, 0.2160D-10, 0.5178D-10, 0.7469D-10, 0.3315D-08, & + & 0.1881D-07, 0.5808D-07, 0.1332D-06, 0.1879D-06, 0.1680D-05, & + & 0.5582D-05, 0.1245D-04, 0.2245D-04, 0.3549D-04, 0.5128D-04, & + & 0.6956D-04, 0.8996D-04, 0.1122D-03, 0.3801D-03, 0.6375D-03, & + & 0.8418D-03, 0.9927D-03, 0.1100D-02, 0.1172D-02, 0.1219D-02, & + & 0.1246D-02, 0.1259D-02, 0.8760D-03, 0.5937D-03, 0.4388D-03, & + & 0.3447D-03, 0.3107D-03, 0.1521D-03, 0.9921D-04, 0.5789D-04, & + & 0.4068D-04, 0.3131D-04, 0.2807D-04, 0.5393D-05, 0.2676D-05, & + & 0.2657D-06, 0.d0/ +! + data (calcpts(j,11), j=1,neta) /0.d0, 0.7649D-14, 0.3559D-12, & + & 0.2115D-11, 0.6834D-11, 0.1638D-10, 0.2363D-10, 0.1050D-08, & + & 0.5961D-08, 0.1842D-07, 0.4226D-07, 0.5963D-07, 0.5356D-06, & + & 0.1787D-05, 0.4008D-05, 0.7258D-05, 0.1153D-04, 0.1675D-04, & + & 0.2284D-04, 0.2971D-04, 0.3726D-04, 0.1337D-03, 0.2379D-03, & + & 0.3324D-03, 0.4140D-03, 0.4825D-03, 0.5399D-03, 0.5868D-03, & + & 0.6257D-03, 0.6576D-03, 0.7086D-03, 0.5671D-03, 0.4546D-03, & + & 0.3732D-03, 0.3411D-03, 0.1752D-03, 0.1142D-03, 0.6549D-04, & + & 0.4530D-04, 0.3443D-04, 0.3069D-04, 0.5568D-05, 0.2727D-05, & + & 0.2662D-06, 0.d0/ +! + data (calcpts(j,12), j=1,neta) /0.d0, 0.2418D-14, 0.1125D-12, & + & 0.6692D-12, 0.2161D-11, 0.5181D-11, 0.7473D-11, 0.3320D-09, & + & 0.1887D-08, 0.5829D-08, 0.1338D-07, 0.1889D-07, 0.1698D-06, & + & 0.5675D-06, 0.1274D-05, 0.2312D-05, 0.3679D-05, 0.5354D-05, & + & 0.7313D-05, 0.9531D-05, 0.1198D-04, 0.4386D-04, 0.7982D-04, & + & 0.1143D-03, 0.1456D-03, 0.1738D-03, 0.1991D-03, 0.2216D-03, & + & 0.2415D-03, 0.2595D-03, 0.3963D-03, 0.3921D-03, 0.3609D-03, & + & 0.3261D-03, 0.3095D-03, 0.1923D-03, 0.1333D-03, 0.7890D-04, & + & 0.5455D-04, 0.4114D-04, 0.3653D-04, 0.6024D-05, 0.2865D-05, & + & 0.2682D-06, 0.d0/ +! + data (calcpts(j,13), j=1,neta) /0.d0, 0.7684D-15, 0.3558D-13, & + & 0.2117D-12, 0.6833D-12, 0.1638D-11, 0.2362D-11, 0.1050D-09, & + & 0.5965D-09, 0.1844D-08, 0.4233D-08, 0.5975D-08, 0.5375D-07, & + & 0.1797D-06, 0.4038D-06, 0.7329D-06, 0.1166D-05, 0.1700D-05, & + & 0.2322D-05, 0.3029D-05, 0.3806D-05, 0.1403D-04, 0.2573D-04, & + & 0.3713D-04, 0.4772D-04, 0.5745D-04, 0.6639D-04, 0.7458D-04, & + & 0.8210D-04, 0.8896D-04, 0.1616D-03, 0.1850D-03, 0.1919D-03, & + & 0.1917D-03, 0.1901D-03, 0.1583D-03, 0.1280D-03, 0.8802D-04, & + & 0.6498D-04, 0.5058D-04, 0.4533D-04, 0.7158D-05, 0.3225D-05, & + & 0.2742D-06, 0.d0/ +! + data (calcpts(j,14), j=1,neta) /0.d0, 0.1468D-15, 0.7101D-14, & + & 0.4230D-13, 0.1367D-12, 0.3276D-12, 0.4727D-12, 0.2100D-10, & + & 0.1194D-09, 0.3687D-09, 0.8462D-09, 0.1195D-08, 0.1075D-07, & + & 0.3596D-07, 0.8079D-07, 0.1467D-06, 0.2335D-06, 0.3402D-06, & + & 0.4652D-06, 0.6066D-06, 0.7628D-06, 0.2819D-05, 0.5184D-05, & + & 0.7505D-05, 0.9676D-05, 0.1169D-04, 0.1356D-04, 0.1527D-04, & + & 0.1688D-04, 0.1836D-04, 0.3604D-04, 0.4455D-04, 0.4976D-04, & + & 0.5326D-04, 0.5457D-04, 0.6029D-04, 0.6027D-04, 0.5579D-04, & + & 0.5019D-04, 0.4495D-04, 0.4254D-04, 0.1047D-04, 0.4619D-05, & + & 0.3043D-06, 0.d0/ +! + data (calcpts(j,15), j=1,neta) /0.d0, 0.8083D-16, 0.3549D-14, & + & 0.2130D-13, 0.6840D-13, 0.1637D-12, 0.2361D-12, 0.1050D-10, & + & 0.5967D-10, 0.1844D-09, 0.4233D-09, 0.5976D-09, 0.5376D-08, & + & 0.1799D-07, 0.4040D-07, 0.7337D-07, 0.1168D-06, 0.1701D-06, & + & 0.2325D-06, 0.3033D-06, 0.3815D-06, 0.1410D-05, 0.2595D-05, & + & 0.3756D-05, 0.4847D-05, 0.5861D-05, 0.6792D-05, 0.7664D-05, & + & 0.8469D-05, 0.9219D-05, 0.1827D-04, 0.2285D-04, 0.2580D-04, & + & 0.2793D-04, 0.2877D-04, 0.3348D-04, 0.3515D-04, 0.3546D-04, & + & 0.3425D-04, 0.3258D-04, 0.3168D-04, 0.1158D-04, 0.5529D-05, & + & 0.3374D-06, 0.d0/ +! + data (aeta(j), j = 1,neta) /small, 0.1000d-02, 0.3000d-02, & + & 0.5000d-02, 0.7000d-02, 0.9000d-02, 0.1000d-01, 0.3000d-01, & + & 0.5000d-01, 0.7000d-01, 0.9000d-01, 0.1000d+00, 0.2000d+00, & + & 0.3000d+00, 0.4000d+00, 0.5000d+00, 0.6000d+00, 0.7000d+00, & + & 0.8000d+00, 0.9000d+00, 0.1000d+01, 0.2000d+01, 0.3000d+01, & + & 0.4000d+01, 0.5000d+01, 0.6000d+01, 0.7000d+01, 0.8000d+01, & + & 0.9000d+01, 0.1000d+02, 0.3000d+02, 0.5000d+02, 0.7000d+02, & + & 0.9000d+02, 0.1000d+03, 0.2000d+03, 0.3000d+03, 0.5000d+03, & + & 0.7000d+03, 0.9000d+03, 0.1000d+04, 0.5000d+04, 0.1000d+05, & + & 0.1000d+06, huge/ +! + data (axi(j), j = 1,nxi) /0.1000d-01, 0.3162d-01, 0.1000d+00, & + & 0.3162d+00, 0.1000d+01, 0.2500d+01, 0.3162d+01, 0.7500d+01, & + & 0.1000d+02, 0.3162d+02, 0.1000d+03, 0.3162d+03, 0.1000d+04, & + & 0.5000d+04, 0.1000d+05/ +! +! here we have to choose the array elements that will go into the +! interpolation. + call locate(aeta, neta, eta, ieta) + call locate(axi, nxi, xi, ixi) + if (ieta .le. 1) ieta = 1 + if (ieta .gt. (neta - 1)) ieta = neta - 1 + if (ixi .le. 1) ixi = 1 + if (ixi .gt. (nxi - 1)) ixi = nxi - 1 + y1 = calcpts(ieta,ixi) + y2 = calcpts(ieta+1,ixi) + y3 = calcpts(ieta+1,ixi+1) + y4 = calcpts(ieta,ixi+1) +! interpolating between the points + t = (eta - aeta(ieta))/(aeta(ieta + 1) - aeta(ieta)) + u = (xi - axi(ixi))/(axi(ixi + 1) - axi(ixi)) + h1f_LLq = (1.d0 - t)*(1.d0 - u)*y1 + t*(1.d0 - u)*y2 + & + & t*u*y3 + (1.d0 - t)*u*y4 + + return + END + +! ======================================== + double precision function h1_LLq(eta,xi) +! ======================================== + +! eq (28) in PLB347 (1995) 143 - 151 for the longitudinal piece +! MSbar scheme +! This routine is called subd1lq in the original code. +! Gives h1_LLq for Q2 > 1.5 GeV2 (use h1f_LLq for Q2 < 1.5 GeV2). +! Called sclql in updated code (03/06/96). + + implicit none + integer neta, nxi + parameter (neta = 73, nxi = 49) + double precision calcpts(neta, nxi), dlaeta(neta), dlaxi(nxi) + double precision eta, xi, dleta, dlxi + double precision pxi, peta, f(-1:1), delxi, deleta + integer j, ieta, ixi + + data (calcpts(j, 1), j = 1,neta) /0.2423D-19, 0.9273D-19, & + & 0.3548D-18, 0.1357D-17, 0.5186D-17, 0.1980D-16, 0.7542D-16, & + & 0.2866D-15, 0.1085D-14, 0.4089D-14, 0.1530D-13, 0.5665D-13, & + & 0.2072D-12, 0.7446D-12, 0.2620D-11, 0.8998D-11, 0.3005D-10, & + & 0.9740D-10, 0.3063D-09, 0.9353D-09, 0.2775D-08, 0.8042D-08, & + & 0.2279D-07, 0.6327D-07, 0.1727D-06, 0.4629D-06, 0.1221D-05, & + & 0.3162D-05, 0.8022D-05, 0.1983D-04, 0.4740D-04, 0.1084D-03, & + & 0.2341D-03, 0.4692D-03, 0.8571D-03, 0.1404D-02, 0.2035D-02, & + & 0.2598D-02, 0.2933D-02, 0.2958D-02, 0.2711D-02, 0.2297D-02, & + & 0.1833D-02, 0.1397D-02, 0.1031D-02, 0.7420D-03, 0.5253D-03, & + & 0.3675D-03, 0.2550D-03, 0.1760D-03, 0.1209D-03, 0.8283D-04, & + & 0.5665D-04, 0.3870D-04, 0.2642D-04, 0.1803D-04, 0.1229D-04, & + & 0.8378D-05, 0.5710D-05, 0.3891D-05, 0.2652D-05, 0.1806D-05, & + & 0.1231D-05, 0.8387D-06, 0.5715D-06, 0.3893D-06, 0.2652D-06, & + & 0.1808D-06, 0.1231D-06, 0.8388D-07, 0.5715D-07, 0.3894D-07, & + & 0.2652D-07/ + + data (calcpts(j, 2), j = 1,neta) /0.1652D-19, 0.6323D-19, & + & 0.2421D-18, 0.9263D-18, 0.3541D-17, 0.1354D-16, 0.5166D-16, & + & 0.1968D-15, 0.7482D-15, 0.2834D-14, 0.1067D-13, 0.3993D-13, & + & 0.1479D-12, 0.5406D-12, 0.1944D-11, 0.6840D-11, 0.2347D-10, & + & 0.7839D-10, 0.2540D-09, 0.7985D-09, 0.2433D-08, 0.7222D-08, & + & 0.2090D-07, 0.5907D-07, 0.1635D-06, 0.4438D-06, 0.1182D-05, & + & 0.3085D-05, 0.7875D-05, 0.1956D-04, 0.4694D-04, 0.1077D-03, & + & 0.2329D-03, 0.4676D-03, 0.8553D-03, 0.1402D-02, 0.2034D-02, & + & 0.2598D-02, 0.2933D-02, 0.2958D-02, 0.2711D-02, 0.2297D-02, & + & 0.1833D-02, 0.1397D-02, 0.1031D-02, 0.7420D-03, 0.5253D-03, & + & 0.3675D-03, 0.2550D-03, 0.1760D-03, 0.1209D-03, 0.8283D-04, & + & 0.5665D-04, 0.3871D-04, 0.2642D-04, 0.1803D-04, 0.1229D-04, & + & 0.8378D-05, 0.5710D-05, 0.3891D-05, 0.2652D-05, 0.1806D-05, & + & 0.1231D-05, 0.8387D-06, 0.5715D-06, 0.3893D-06, 0.2652D-06, & + & 0.1808D-06, 0.1231D-06, 0.8388D-07, 0.5715D-07, 0.3894D-07, & + & 0.2652D-07/ + + data (calcpts(j, 3), j = 1,neta) /0.1125D-19, 0.4310D-19, & + & 0.1650D-18, 0.6318D-18, 0.2418D-17, 0.9246D-17, 0.3534D-16, & + & 0.1349D-15, 0.5139D-15, 0.1953D-14, 0.7395D-14, 0.2786D-13, & + & 0.1042D-12, 0.3859D-12, 0.1411D-11, 0.5072D-11, 0.1785D-10, & + & 0.6126D-10, 0.2045D-09, 0.6621D-09, 0.2081D-08, 0.6333D-08, & + & 0.1876D-07, 0.5418D-07, 0.1527D-06, 0.4206D-06, 0.1134D-05, & + & 0.2988D-05, 0.7687D-05, 0.1922D-04, 0.4632D-04, 0.1066D-03, & + & 0.2314D-03, 0.4655D-03, 0.8527D-03, 0.1399D-02, 0.2031D-02, & + & 0.2597D-02, 0.2931D-02, 0.2958D-02, 0.2711D-02, 0.2298D-02, & + & 0.1833D-02, 0.1398D-02, 0.1031D-02, 0.7420D-03, 0.5253D-03, & + & 0.3675D-03, 0.2550D-03, 0.1760D-03, 0.1209D-03, 0.8283D-04, & + & 0.5665D-04, 0.3871D-04, 0.2642D-04, 0.1803D-04, 0.1229D-04, & + & 0.8378D-05, 0.5710D-05, 0.3891D-05, 0.2652D-05, 0.1806D-05, & + & 0.1231D-05, 0.8387D-06, 0.5715D-06, 0.3893D-06, 0.2652D-06, & + & 0.1808D-06, 0.1231D-06, 0.8388D-07, 0.5715D-07, 0.3894D-07, & + & 0.2652D-07/ + + data (calcpts(j, 4), j = 1,neta) /0.7668D-20, 0.2937D-19, & + & 0.1125D-18, 0.4308D-18, 0.1648D-17, 0.6311D-17, 0.2413D-16, & + & 0.9224D-16, 0.3521D-15, 0.1341D-14, 0.5097D-14, 0.1931D-13, & + & 0.7272D-13, 0.2720D-12, 0.1007D-11, 0.3683D-11, 0.1323D-10, & + & 0.4656D-10, 0.1597D-09, 0.5330D-09, 0.1725D-08, 0.5406D-08, & + & 0.1646D-07, 0.4866D-07, 0.1400D-06, 0.3927D-06, 0.1074D-05, & + & 0.2866D-05, 0.7448D-05, 0.1877D-04, 0.4551D-04, 0.1053D-03, & + & 0.2294D-03, 0.4626D-03, 0.8493D-03, 0.1396D-02, 0.2028D-02, & + & 0.2595D-02, 0.2931D-02, 0.2957D-02, 0.2711D-02, 0.2298D-02, & + & 0.1833D-02, 0.1398D-02, 0.1031D-02, 0.7422D-03, 0.5255D-03, & + & 0.3675D-03, 0.2550D-03, 0.1760D-03, 0.1209D-03, 0.8283D-04, & + & 0.5665D-04, 0.3871D-04, 0.2642D-04, 0.1803D-04, 0.1229D-04, & + & 0.8378D-05, 0.5710D-05, 0.3891D-05, 0.2652D-05, 0.1806D-05, & + & 0.1231D-05, 0.8387D-06, 0.5715D-06, 0.3893D-06, 0.2652D-06, & + & 0.1808D-06, 0.1231D-06, 0.8388D-07, 0.5715D-07, 0.3894D-07, & + & 0.2652D-07/ + + data (calcpts(j, 5), j = 1,neta) /0.5226D-20, 0.2001D-19, & + & 0.7668D-19, 0.2937D-18, 0.1124D-17, 0.4305D-17, 0.1647D-16, & + & 0.6300D-16, 0.2408D-15, 0.9189D-15, 0.3501D-14, 0.1330D-13, & + & 0.5038D-13, 0.1897D-12, 0.7098D-12, 0.2630D-11, 0.9607D-11, & + & 0.3452D-10, 0.1214D-09, 0.4164D-09, 0.1388D-08, 0.4484D-08, & + & 0.1405D-07, 0.4267D-07, 0.1258D-06, 0.3603D-06, 0.1004D-05, & + & 0.2718D-05, 0.7148D-05, 0.1818D-04, 0.4446D-04, 0.1035D-03, & + & 0.2265D-03, 0.4587D-03, 0.8447D-03, 0.1391D-02, 0.2025D-02, & + & 0.2592D-02, 0.2930D-02, 0.2957D-02, 0.2711D-02, 0.2298D-02, & + & 0.1833D-02, 0.1398D-02, 0.1031D-02, 0.7422D-03, 0.5255D-03, & + & 0.3675D-03, 0.2550D-03, 0.1760D-03, 0.1209D-03, 0.8283D-04, & + & 0.5665D-04, 0.3871D-04, 0.2642D-04, 0.1803D-04, 0.1229D-04, & + & 0.8378D-05, 0.5710D-05, 0.3891D-05, 0.2652D-05, 0.1806D-05, & + & 0.1231D-05, 0.8387D-06, 0.5715D-06, 0.3893D-06, 0.2652D-06, & + & 0.1808D-06, 0.1231D-06, 0.8388D-07, 0.5715D-07, 0.3894D-07, & + & 0.2652D-07/ + + data (calcpts(j, 6), j = 1,neta) /0.3561D-20, 0.1364D-19, & + & 0.5224D-19, 0.2001D-18, 0.7665D-18, 0.2936D-17, 0.1124D-16, & + & 0.4299D-16, 0.1644D-15, 0.6284D-15, 0.2399D-14, 0.9138D-14, & + & 0.3473D-13, 0.1315D-12, 0.4953D-12, 0.1853D-11, 0.6860D-11, & + & 0.2506D-10, 0.9003D-10, 0.3165D-09, 0.1085D-08, 0.3609D-08, & + & 0.1165D-07, 0.3644D-07, 0.1103D-06, 0.3237D-06, 0.9210D-06, & + & 0.2540D-05, 0.6779D-05, 0.1746D-04, 0.4312D-04, 0.1012D-03, & + & 0.2229D-03, 0.4536D-03, 0.8383D-03, 0.1385D-02, 0.2019D-02, & + & 0.2587D-02, 0.2927D-02, 0.2957D-02, 0.2711D-02, 0.2298D-02, & + & 0.1835D-02, 0.1398D-02, 0.1031D-02, 0.7424D-03, 0.5255D-03, & + & 0.3677D-03, 0.2550D-03, 0.1760D-03, 0.1209D-03, 0.8284D-04, & + & 0.5665D-04, 0.3871D-04, 0.2642D-04, 0.1803D-04, 0.1229D-04, & + & 0.8378D-05, 0.5710D-05, 0.3891D-05, 0.2652D-05, 0.1806D-05, & + & 0.1231D-05, 0.8387D-06, 0.5715D-06, 0.3893D-06, 0.2652D-06, & + & 0.1808D-06, 0.1231D-06, 0.8388D-07, 0.5715D-07, 0.3894D-07, & + & 0.2652D-07/ + + data (calcpts(j, 7), j = 1,neta) /0.2426D-20, 0.9294D-20, & + & 0.3561D-19, 0.1364D-18, 0.5224D-18, 0.2001D-17, 0.7662D-17, & + & 0.2933D-16, 0.1122D-15, 0.4293D-15, 0.1640D-14, 0.6260D-14, & + & 0.2385D-13, 0.9065D-13, 0.3432D-12, 0.1293D-11, 0.4833D-11, & + & 0.1790D-10, 0.6537D-10, 0.2348D-09, 0.8247D-09, 0.2820D-08, & + & 0.9381D-08, 0.3023D-07, 0.9423D-07, 0.2841D-06, 0.8278D-06, & + & 0.2331D-05, 0.6338D-05, 0.1658D-04, 0.4145D-04, 0.9827D-04, & + & 0.2182D-03, 0.4468D-03, 0.8298D-03, 0.1376D-02, 0.2012D-02, & + & 0.2583D-02, 0.2925D-02, 0.2955D-02, 0.2711D-02, 0.2298D-02, & + & 0.1835D-02, 0.1398D-02, 0.1031D-02, 0.7425D-03, 0.5256D-03, & + & 0.3677D-03, 0.2550D-03, 0.1760D-03, 0.1209D-03, 0.8284D-04, & + & 0.5667D-04, 0.3871D-04, 0.2642D-04, 0.1803D-04, 0.1229D-04, & + & 0.8378D-05, 0.5710D-05, 0.3891D-05, 0.2652D-05, 0.1806D-05, & + & 0.1231D-05, 0.8387D-06, 0.5715D-06, 0.3893D-06, 0.2652D-06, & + & 0.1808D-06, 0.1231D-06, 0.8388D-07, 0.5715D-07, 0.3894D-07, & + & 0.2652D-07/ + + data (calcpts(j, 8), j = 1,neta) /0.1653D-20, 0.6333D-20, & + & 0.2425D-19, 0.9294D-19, 0.3559D-18, 0.1364D-17, 0.5223D-17, & + & 0.2000D-16, 0.7656D-16, 0.2930D-15, 0.1120D-14, 0.4281D-14, & + & 0.1634D-13, 0.6225D-13, 0.2366D-12, 0.8955D-12, 0.3373D-11, & + & 0.1261D-10, 0.4666D-10, 0.1704D-09, 0.6116D-09, 0.2147D-08, & + & 0.7331D-08, 0.2433D-07, 0.7818D-07, 0.2427D-06, 0.7266D-06, & + & 0.2097D-05, 0.5823D-05, 0.1551D-04, 0.3938D-04, 0.9454D-04, & + & 0.2121D-03, 0.4378D-03, 0.8186D-03, 0.1363D-02, 0.2001D-02, & + & 0.2576D-02, 0.2921D-02, 0.2953D-02, 0.2711D-02, 0.2299D-02, & + & 0.1835D-02, 0.1399D-02, 0.1032D-02, 0.7426D-03, 0.5256D-03, & + & 0.3677D-03, 0.2550D-03, 0.1760D-03, 0.1209D-03, 0.8284D-04, & + & 0.5667D-04, 0.3871D-04, 0.2642D-04, 0.1803D-04, 0.1229D-04, & + & 0.8378D-05, 0.5710D-05, 0.3891D-05, 0.2652D-05, 0.1806D-05, & + & 0.1231D-05, 0.8387D-06, 0.5715D-06, 0.3893D-06, 0.2652D-06, & + & 0.1808D-06, 0.1231D-06, 0.8388D-07, 0.5715D-07, 0.3894D-07, & + & 0.2652D-07/ + + data (calcpts(j, 9), j = 1,neta) /0.1126D-20, 0.4314D-20, & + & 0.1653D-19, 0.6333D-19, 0.2426D-18, 0.9293D-18, 0.3560D-17, & + & 0.1363D-16, 0.5220D-16, 0.1998D-15, 0.7647D-15, 0.2925D-14, & + & 0.1117D-13, 0.4264D-13, 0.1625D-12, 0.6173D-12, 0.2337D-11, & + & 0.8799D-11, 0.3289D-10, 0.1217D-09, 0.4440D-09, 0.1591D-08, & + & 0.5573D-08, 0.1902D-07, 0.6296D-07, 0.2013D-06, 0.6208D-06, & + & 0.1842D-05, 0.5241D-05, 0.1426D-04, 0.3689D-04, 0.8996D-04, & + & 0.2045D-03, 0.4264D-03, 0.8037D-03, 0.1347D-02, 0.1986D-02, & + & 0.2565D-02, 0.2915D-02, 0.2952D-02, 0.2711D-02, 0.2301D-02, & + & 0.1836D-02, 0.1400D-02, 0.1032D-02, 0.7430D-03, 0.5257D-03, & + & 0.3678D-03, 0.2552D-03, 0.1760D-03, 0.1209D-03, 0.8284D-04, & + & 0.5667D-04, 0.3871D-04, 0.2642D-04, 0.1803D-04, 0.1229D-04, & + & 0.8378D-05, 0.5710D-05, 0.3891D-05, 0.2652D-05, 0.1806D-05, & + & 0.1231D-05, 0.8387D-06, 0.5715D-06, 0.3893D-06, 0.2652D-06, & + & 0.1808D-06, 0.1231D-06, 0.8388D-07, 0.5715D-07, 0.3894D-07, & + & 0.2652D-07/ + + data (calcpts(j,10), j = 1,neta) /0.7672D-21, 0.2940D-20, & + & 0.1126D-19, 0.4314D-19, 0.1653D-18, 0.6333D-18, 0.2425D-17, & + & 0.9291D-17, 0.3558D-16, 0.1363D-15, 0.5216D-15, 0.1996D-14, & + & 0.7634D-14, 0.2916D-13, 0.1113D-12, 0.4239D-12, 0.1611D-11, & + & 0.6096D-11, 0.2295D-10, 0.8574D-10, 0.3171D-09, 0.1156D-08, & + & 0.4133D-08, 0.1446D-07, 0.4922D-07, 0.1622D-06, 0.5154D-06, & + & 0.1575D-05, 0.4605D-05, 0.1285D-04, 0.3396D-04, 0.8439D-04, & + & 0.1948D-03, 0.4119D-03, 0.7844D-03, 0.1326D-02, 0.1966D-02, & + & 0.2550D-02, 0.2907D-02, 0.2949D-02, 0.2712D-02, 0.2301D-02, & + & 0.1837D-02, 0.1401D-02, 0.1033D-02, 0.7432D-03, 0.5261D-03, & + & 0.3678D-03, 0.2552D-03, 0.1760D-03, 0.1209D-03, 0.8286D-04, & + & 0.5667D-04, 0.3871D-04, 0.2643D-04, 0.1803D-04, 0.1229D-04, & + & 0.8378D-05, 0.5710D-05, 0.3891D-05, 0.2652D-05, 0.1806D-05, & + & 0.1231D-05, 0.8387D-06, 0.5715D-06, 0.3893D-06, 0.2652D-06, & + & 0.1808D-06, 0.1231D-06, 0.8388D-07, 0.5715D-07, 0.3894D-07, & + & 0.2652D-07/ + + data (calcpts(j,11), j = 1,neta) /0.5227D-21, 0.2003D-20, & + & 0.7672D-20, 0.2940D-19, 0.1126D-18, 0.4314D-18, 0.1653D-17, & + & 0.6332D-17, 0.2426D-16, 0.9288D-16, 0.3557D-15, 0.1362D-14, & + & 0.5209D-14, 0.1992D-13, 0.7612D-13, 0.2904D-12, 0.1106D-11, & + & 0.4202D-11, 0.1590D-10, 0.5984D-10, 0.2234D-09, 0.8253D-09, & + & 0.3000D-08, 0.1072D-07, 0.3741D-07, 0.1268D-06, 0.4154D-06, & + & 0.1308D-05, 0.3941D-05, 0.1130D-04, 0.3065D-04, 0.7785D-04, & + & 0.1832D-03, 0.3936D-03, 0.7596D-03, 0.1297D-02, 0.1939D-02, & + & 0.2531D-02, 0.2897D-02, 0.2946D-02, 0.2711D-02, 0.2302D-02, & + & 0.1839D-02, 0.1402D-02, 0.1033D-02, 0.7437D-03, 0.5263D-03, & + & 0.3680D-03, 0.2553D-03, 0.1761D-03, 0.1209D-03, 0.8288D-04, & + & 0.5669D-04, 0.3871D-04, 0.2643D-04, 0.1803D-04, 0.1229D-04, & + & 0.8378D-05, 0.5710D-05, 0.3891D-05, 0.2652D-05, 0.1806D-05, & + & 0.1231D-05, 0.8387D-06, 0.5715D-06, 0.3893D-06, 0.2652D-06, & + & 0.1808D-06, 0.1231D-06, 0.8388D-07, 0.5715D-07, 0.3894D-07, & + & 0.2652D-07/ + + data (calcpts(j,12), j = 1,neta) /0.3561D-21, 0.1365D-20, & + & 0.5227D-20, 0.2003D-19, 0.7674D-19, 0.2940D-18, 0.1126D-17, & + & 0.4314D-17, 0.1653D-16, 0.6330D-16, 0.2424D-15, 0.9283D-15, & + & 0.3554D-14, 0.1360D-13, 0.5199D-13, 0.1986D-12, 0.7580D-12, & + & 0.2886D-11, 0.1096D-10, 0.4146D-10, 0.1559D-09, 0.5817D-09, & + & 0.2145D-08, 0.7786D-08, 0.2775D-07, 0.9642D-07, 0.3247D-06, & + & 0.1054D-05, 0.3276D-05, 0.9683D-05, 0.2700D-04, 0.7040D-04, & + & 0.1695D-03, 0.3712D-03, 0.7283D-03, 0.1260D-02, 0.1905D-02, & + & 0.2504D-02, 0.2880D-02, 0.2938D-02, 0.2711D-02, 0.2306D-02, & + & 0.1841D-02, 0.1404D-02, 0.1035D-02, 0.7445D-03, 0.5267D-03, & + & 0.3683D-03, 0.2553D-03, 0.1761D-03, 0.1210D-03, 0.8289D-04, & + & 0.5669D-04, 0.3871D-04, 0.2643D-04, 0.1803D-04, 0.1229D-04, & + & 0.8379D-05, 0.5710D-05, 0.3891D-05, 0.2652D-05, 0.1806D-05, & + & 0.1231D-05, 0.8387D-06, 0.5715D-06, 0.3894D-06, 0.2652D-06, & + & 0.1808D-06, 0.1231D-06, 0.8388D-07, 0.5715D-07, 0.3894D-07, & + & 0.2652D-07/ + + data (calcpts(j,13), j = 1,neta) /0.2427D-21, 0.9296D-21, & + & 0.3561D-20, 0.1365D-19, 0.5227D-19, 0.2003D-18, 0.7674D-18, & + & 0.2940D-17, 0.1126D-16, 0.4314D-16, 0.1653D-15, 0.6329D-15, & + & 0.2423D-14, 0.9275D-14, 0.3549D-13, 0.1357D-12, 0.5183D-12, & + & 0.1977D-11, 0.7527D-11, 0.2858D-10, 0.1080D-09, 0.4059D-09, & + & 0.1512D-08, 0.5560D-08, 0.2016D-07, 0.7152D-07, 0.2471D-06, & + & 0.8250D-06, 0.2643D-05, 0.8058D-05, 0.2318D-04, 0.6216D-04, & + & 0.1536D-03, 0.3445D-03, 0.6896D-03, 0.1214D-02, 0.1858D-02, & + & 0.2466D-02, 0.2858D-02, 0.2930D-02, 0.2709D-02, 0.2307D-02, & + & 0.1844D-02, 0.1406D-02, 0.1036D-02, 0.7453D-03, 0.5273D-03, & + & 0.3686D-03, 0.2556D-03, 0.1763D-03, 0.1210D-03, 0.8291D-04, & + & 0.5670D-04, 0.3873D-04, 0.2643D-04, 0.1803D-04, 0.1229D-04, & + & 0.8379D-05, 0.5710D-05, 0.3891D-05, 0.2652D-05, 0.1807D-05, & + & 0.1231D-05, 0.8388D-06, 0.5715D-06, 0.3894D-06, 0.2652D-06, & + & 0.1808D-06, 0.1231D-06, 0.8388D-07, 0.5715D-07, 0.3894D-07, & + & 0.2652D-07/ + + data (calcpts(j,14), j = 1,neta) /0.1653D-21, 0.6333D-21, & + & 0.2427D-20, 0.9297D-20, 0.3562D-19, 0.1365D-18, 0.5229D-18, & + & 0.2003D-17, 0.7674D-17, 0.2940D-16, 0.1126D-15, 0.4313D-15, & + & 0.1651D-14, 0.6324D-14, 0.2421D-13, 0.9261D-13, 0.3540D-12, & + & 0.1352D-11, 0.5157D-11, 0.1962D-10, 0.7446D-10, 0.2813D-09, & + & 0.1055D-08, 0.3918D-08, 0.1439D-07, 0.5196D-07, 0.1833D-06, & + & 0.6278D-06, 0.2070D-05, 0.6507D-05, 0.1932D-04, 0.5346D-04, & + & 0.1361D-03, 0.3135D-03, 0.6428D-03, 0.1155D-02, 0.1797D-02, & + & 0.2417D-02, 0.2826D-02, 0.2916D-02, 0.2706D-02, 0.2309D-02, & + & 0.1847D-02, 0.1409D-02, 0.1038D-02, 0.7467D-03, 0.5280D-03, & + & 0.3690D-03, 0.2558D-03, 0.1763D-03, 0.1211D-03, 0.8293D-04, & + & 0.5672D-04, 0.3873D-04, 0.2643D-04, 0.1803D-04, 0.1229D-04, & + & 0.8379D-05, 0.5710D-05, 0.3891D-05, 0.2652D-05, 0.1807D-05, & + & 0.1231D-05, 0.8388D-06, 0.5715D-06, 0.3894D-06, 0.2652D-06, & + & 0.1808D-06, 0.1231D-06, 0.8388D-07, 0.5715D-07, 0.3894D-07, & + & 0.2652D-07/ + + data (calcpts(j,15), j = 1,neta) /0.1127D-21, 0.4316D-21, & + & 0.1653D-20, 0.6334D-20, 0.2427D-19, 0.9297D-19, 0.3562D-18, & + & 0.1365D-17, 0.5229D-17, 0.2003D-16, 0.7673D-16, 0.2938D-15, & + & 0.1126D-14, 0.4311D-14, 0.1650D-13, 0.6317D-13, 0.2416D-12, & + & 0.9237D-12, 0.3526D-11, 0.1344D-10, 0.5113D-10, 0.1938D-09, & + & 0.7313D-09, 0.2735D-08, 0.1014D-07, 0.3710D-07, 0.1332D-06, & + & 0.4659D-06, 0.1575D-05, 0.5100D-05, 0.1562D-04, 0.4467D-04, & + & 0.1174D-03, 0.2789D-03, 0.5880D-03, 0.1083D-02, 0.1721D-02, & + & 0.2352D-02, 0.2782D-02, 0.2895D-02, 0.2702D-02, 0.2311D-02, & + & 0.1851D-02, 0.1413D-02, 0.1041D-02, 0.7485D-03, 0.5291D-03, & + & 0.3696D-03, 0.2561D-03, 0.1764D-03, 0.1212D-03, 0.8298D-04, & + & 0.5673D-04, 0.3875D-04, 0.2645D-04, 0.1803D-04, 0.1229D-04, & + & 0.8381D-05, 0.5710D-05, 0.3891D-05, 0.2652D-05, 0.1807D-05, & + & 0.1231D-05, 0.8388D-06, 0.5715D-06, 0.3894D-06, 0.2652D-06, & + & 0.1808D-06, 0.1231D-06, 0.8388D-07, 0.5715D-07, 0.3894D-07, & + & 0.2652D-07/ + + data (calcpts(j,16), j = 1,neta) /0.7679D-22, 0.2940D-21, & + & 0.1126D-20, 0.4316D-20, 0.1653D-19, 0.6334D-19, 0.2427D-18, & + & 0.9299D-18, 0.3563D-17, 0.1365D-16, 0.5229D-16, 0.2002D-15, & + & 0.7671D-15, 0.2939D-14, 0.1125D-13, 0.4307D-13, 0.1649D-12, & + & 0.6305D-12, 0.2409D-11, 0.9195D-11, 0.3504D-10, 0.1331D-09, & + & 0.5040D-09, 0.1898D-08, 0.7077D-08, 0.2615D-07, 0.9512D-07, & + & 0.3386D-06, 0.1170D-05, 0.3886D-05, 0.1226D-04, 0.3621D-04, & + & 0.9842D-04, 0.2416D-03, 0.5259D-03, 0.9966D-03, 0.1623D-02, & + & 0.2265D-02, 0.2724D-02, 0.2865D-02, 0.2693D-02, 0.2313D-02, & + & 0.1857D-02, 0.1418D-02, 0.1045D-02, 0.7509D-03, 0.5304D-03, & + & 0.3703D-03, 0.2565D-03, 0.1767D-03, 0.1213D-03, 0.8304D-04, & + & 0.5676D-04, 0.3876D-04, 0.2645D-04, 0.1803D-04, 0.1230D-04, & + & 0.8381D-05, 0.5712D-05, 0.3893D-05, 0.2652D-05, 0.1807D-05, & + & 0.1231D-05, 0.8388D-06, 0.5715D-06, 0.3894D-06, 0.2652D-06, & + & 0.1808D-06, 0.1231D-06, 0.8388D-07, 0.5715D-07, 0.3894D-07, & + & 0.2652D-07/ + + data (calcpts(j,17), j = 1,neta) /0.5235D-22, 0.2003D-21, & + & 0.7672D-21, 0.2940D-20, 0.1127D-19, 0.4316D-19, 0.1653D-18, & + & 0.6334D-18, 0.2427D-17, 0.9299D-17, 0.3562D-16, 0.1365D-15, & + & 0.5228D-15, 0.2003D-14, 0.7668D-14, 0.2936D-13, 0.1124D-12, & + & 0.4301D-12, 0.1644D-11, 0.6281D-11, 0.2396D-10, 0.9120D-10, & + & 0.3462D-09, 0.1308D-08, 0.4904D-08, 0.1826D-07, 0.6705D-07, & + & 0.2418D-06, 0.8505D-06, 0.2888D-05, 0.9354D-05, 0.2847D-04, & + & 0.8001D-04, 0.2034D-03, 0.4584D-03, 0.8976D-03, 0.1506D-02, & + & 0.2155D-02, 0.2643D-02, 0.2820D-02, 0.2678D-02, 0.2315D-02, & + & 0.1863D-02, 0.1424D-02, 0.1050D-02, 0.7542D-03, 0.5324D-03, & + & 0.3714D-03, 0.2571D-03, 0.1770D-03, 0.1215D-03, 0.8313D-04, & + & 0.5680D-04, 0.3878D-04, 0.2646D-04, 0.1805D-04, 0.1230D-04, & + & 0.8382D-05, 0.5712D-05, 0.3893D-05, 0.2652D-05, 0.1807D-05, & + & 0.1231D-05, 0.8388D-06, 0.5715D-06, 0.3894D-06, 0.2652D-06, & + & 0.1808D-06, 0.1231D-06, 0.8388D-07, 0.5715D-07, 0.3894D-07, & + & 0.2652D-07/ + + data (calcpts(j,18), j = 1,neta) /0.3573D-22, 0.1365D-21, & + & 0.5227D-21, 0.2003D-20, 0.7674D-20, 0.2940D-19, 0.1127D-18, & + & 0.4316D-18, 0.1653D-17, 0.6334D-17, 0.2427D-16, 0.9298D-16, & + & 0.3563D-15, 0.1364D-14, 0.5226D-14, 0.2001D-13, 0.7662D-13, & + & 0.2933D-12, 0.1122D-11, 0.4287D-11, 0.1637D-10, 0.6237D-10, & + & 0.2372D-09, 0.8985D-09, 0.3381D-08, 0.1265D-07, 0.4680D-07, & + & 0.1706D-06, 0.6078D-06, 0.2100D-05, 0.6957D-05, 0.2177D-04, & + & 0.6311D-04, 0.1661D-03, 0.3881D-03, 0.7881D-03, 0.1368D-02, & + & 0.2018D-02, 0.2537D-02, 0.2759D-02, 0.2652D-02, 0.2311D-02, & + & 0.1869D-02, 0.1432D-02, 0.1056D-02, 0.7584D-03, 0.5351D-03, & + & 0.3729D-03, 0.2580D-03, 0.1775D-03, 0.1217D-03, 0.8325D-04, & + & 0.5687D-04, 0.3882D-04, 0.2647D-04, 0.1805D-04, 0.1230D-04, & + & 0.8384D-05, 0.5714D-05, 0.3893D-05, 0.2652D-05, 0.1807D-05, & + & 0.1231D-05, 0.8388D-06, 0.5715D-06, 0.3894D-06, 0.2652D-06, & + & 0.1808D-06, 0.1231D-06, 0.8388D-07, 0.5715D-07, 0.3894D-07, & + & 0.2652D-07/ + + data (calcpts(j,19), j = 1,neta) /0.2443D-22, 0.9299D-22, & + & 0.3561D-21, 0.1365D-20, 0.5229D-20, 0.2003D-19, 0.7675D-19, & + & 0.2940D-18, 0.1127D-17, 0.4317D-17, 0.1653D-16, 0.6334D-16, & + & 0.2427D-15, 0.9297D-15, 0.3561D-14, 0.1364D-13, 0.5222D-13, & + & 0.1998D-12, 0.7647D-12, 0.2923D-11, 0.1117D-10, 0.4260D-10, & + & 0.1622D-09, 0.6156D-09, 0.2322D-08, 0.8717D-08, 0.3243D-07, & + & 0.1190D-06, 0.4286D-06, 0.1502D-05, 0.5064D-05, 0.1621D-04, & + & 0.4834D-04, 0.1315D-03, 0.3186D-03, 0.6722D-03, 0.1212D-02, & + & 0.1851D-02, 0.2399D-02, 0.2670D-02, 0.2613D-02, 0.2304D-02, & + & 0.1875D-02, 0.1442D-02, 0.1064D-02, 0.7641D-03, 0.5385D-03, & + & 0.3750D-03, 0.2591D-03, 0.1781D-03, 0.1220D-03, 0.8342D-04, & + & 0.5695D-04, 0.3885D-04, 0.2649D-04, 0.1806D-04, 0.1231D-04, & + & 0.8387D-05, 0.5715D-05, 0.3894D-05, 0.2652D-05, 0.1807D-05, & + & 0.1231D-05, 0.8388D-06, 0.5715D-06, 0.3894D-06, 0.2652D-06, & + & 0.1808D-06, 0.1231D-06, 0.8388D-07, 0.5715D-07, 0.3894D-07, & + & 0.2652D-07/ + + data (calcpts(j,20), j = 1,neta) /0.1677D-22, 0.6337D-22, & + & 0.2424D-21, 0.9296D-21, 0.3563D-20, 0.1365D-19, 0.5229D-19, & + & 0.2004D-18, 0.7676D-18, 0.2940D-17, 0.1127D-16, 0.4316D-16, & + & 0.1653D-15, 0.6335D-15, 0.2427D-14, 0.9293D-14, 0.3558D-13, & + & 0.1362D-12, 0.5213D-12, 0.1993D-11, 0.7619D-11, 0.2909D-10, & + & 0.1108D-09, 0.4211D-09, 0.1593D-08, 0.5987D-08, 0.2235D-07, & + & 0.8247D-07, 0.2991D-06, 0.1059D-05, 0.3622D-05, 0.1181D-04, & + & 0.3608D-04, 0.1011D-03, 0.2535D-03, 0.5559D-03, 0.1044D-02, & + & 0.1658D-02, 0.2224D-02, 0.2552D-02, 0.2553D-02, 0.2286D-02, & + & 0.1880D-02, 0.1452D-02, 0.1074D-02, 0.7713D-03, 0.5433D-03, & + & 0.3778D-03, 0.2607D-03, 0.1790D-03, 0.1225D-03, 0.8365D-04, & + & 0.5708D-04, 0.3893D-04, 0.2652D-04, 0.1808D-04, 0.1231D-04, & + & 0.8391D-05, 0.5717D-05, 0.3894D-05, 0.2654D-05, 0.1807D-05, & + & 0.1231D-05, 0.8390D-06, 0.5715D-06, 0.3894D-06, 0.2652D-06, & + & 0.1808D-06, 0.1231D-06, 0.8388D-07, 0.5715D-07, 0.3894D-07, & + & 0.2652D-07/ + + data (calcpts(j,21), j = 1,neta) /0.1158D-22, 0.4320D-22, & + & 0.1650D-21, 0.6332D-21, 0.2427D-20, 0.9297D-20, 0.3562D-19, & + & 0.1365D-18, 0.5229D-18, 0.2004D-17, 0.7676D-17, 0.2940D-16, & + & 0.1127D-15, 0.4316D-15, 0.1653D-14, 0.6331D-14, 0.2424D-13, & + & 0.9284D-13, 0.3553D-12, 0.1359D-11, 0.5195D-11, 0.1983D-10, & + & 0.7562D-10, 0.2876D-09, 0.1090D-08, 0.4103D-08, 0.1536D-07, & + & 0.5686D-07, 0.2073D-06, 0.7396D-06, 0.2556D-05, 0.8457D-05, & + & 0.2634D-04, 0.7564D-04, 0.1958D-03, 0.4452D-03, 0.8708D-03, & + & 0.1443D-02, 0.2016D-02, 0.2396D-02, 0.2466D-02, 0.2254D-02, & + & 0.1880D-02, 0.1463D-02, 0.1086D-02, 0.7806D-03, 0.5493D-03, & + & 0.3816D-03, 0.2628D-03, 0.1801D-03, 0.1231D-03, 0.8399D-04, & + & 0.5725D-04, 0.3900D-04, 0.2657D-04, 0.1811D-04, 0.1233D-04, & + & 0.8396D-05, 0.5720D-05, 0.3896D-05, 0.2654D-05, 0.1807D-05, & + & 0.1231D-05, 0.8390D-06, 0.5715D-06, 0.3894D-06, 0.2654D-06, & + & 0.1808D-06, 0.1231D-06, 0.8388D-07, 0.5715D-07, 0.3894D-07, & + & 0.2652D-07/ + + data (calcpts(j,22), j = 1,neta) /0.8067D-23, 0.2946D-22, & + & 0.1123D-21, 0.4311D-21, 0.1654D-20, 0.6333D-20, 0.2427D-19, & + & 0.9298D-19, 0.3562D-18, 0.1365D-17, 0.5229D-17, 0.2004D-16, & + & 0.7676D-16, 0.2940D-15, 0.1126D-14, 0.4314D-14, 0.1652D-13, & + & 0.6326D-13, 0.2421D-12, 0.9263D-12, 0.3542D-11, 0.1353D-10, & + & 0.5158D-10, 0.1962D-09, 0.7445D-09, 0.2805D-08, 0.1052D-07, & + & 0.3906D-07, 0.1430D-06, 0.5127D-06, 0.1785D-05, 0.5972D-05, & + & 0.1887D-04, 0.5534D-04, 0.1470D-03, 0.3458D-03, 0.7032D-03, & + & 0.1217D-02, 0.1777D-02, 0.2201D-02, 0.2345D-02, 0.2201D-02, & + & 0.1869D-02, 0.1472D-02, 0.1099D-02, 0.7918D-03, 0.5573D-03, & + & 0.3864D-03, 0.2657D-03, 0.1818D-03, 0.1240D-03, 0.8445D-04, & + & 0.5750D-04, 0.3914D-04, 0.2664D-04, 0.1814D-04, 0.1234D-04, & + & 0.8405D-05, 0.5722D-05, 0.3897D-05, 0.2655D-05, 0.1807D-05, & + & 0.1232D-05, 0.8391D-06, 0.5717D-06, 0.3894D-06, 0.2654D-06, & + & 0.1808D-06, 0.1231D-06, 0.8388D-07, 0.5715D-07, 0.3894D-07, & + & 0.2652D-07/ + + data (calcpts(j,23), j = 1,neta) /0.5685D-23, 0.2010D-22, & + & 0.7636D-22, 0.2936D-21, 0.1128D-20, 0.4314D-20, 0.1654D-19, & + & 0.6336D-19, 0.2427D-18, 0.9300D-18, 0.3563D-17, 0.1365D-16, & + & 0.5229D-16, 0.2004D-15, 0.7674D-15, 0.2940D-14, 0.1126D-13, & + & 0.4310D-13, 0.1650D-12, 0.6312D-12, 0.2414D-11, 0.9221D-11, & + & 0.3517D-10, 0.1339D-09, 0.5081D-09, 0.1920D-08, 0.7194D-08, & + & 0.2676D-07, 0.9820D-07, 0.3536D-06, 0.1238D-05, 0.4173D-05, & + & 0.1334D-04, 0.3972D-04, 0.1079D-03, 0.2610D-03, 0.5501D-03, & + & 0.9924D-03, 0.1517D-02, 0.1965D-02, 0.2182D-02, 0.2118D-02, & + & 0.1844D-02, 0.1476D-02, 0.1113D-02, 0.8052D-03, 0.5671D-03, & + & 0.3929D-03, 0.2696D-03, 0.1839D-03, 0.1252D-03, 0.8508D-04, & + & 0.5783D-04, 0.3930D-04, 0.2672D-04, 0.1818D-04, 0.1236D-04, & + & 0.8415D-05, 0.5729D-05, 0.3900D-05, 0.2657D-05, 0.1809D-05, & + & 0.1232D-05, 0.8393D-06, 0.5717D-06, 0.3894D-06, 0.2654D-06, & + & 0.1808D-06, 0.1231D-06, 0.8390D-07, 0.5715D-07, 0.3894D-07, & + & 0.2652D-07/ + + data (calcpts(j,24), j = 1,neta) /0.4040D-23, 0.1371D-22, & + & 0.5190D-22, 0.1998D-21, 0.7686D-21, 0.2938D-20, 0.1127D-19, & + & 0.4317D-19, 0.1655D-18, 0.6336D-18, 0.2427D-17, 0.9300D-17, & + & 0.3562D-16, 0.1365D-15, 0.5229D-15, 0.2003D-14, 0.7670D-14, & + & 0.2937D-13, 0.1124D-12, 0.4302D-12, 0.1646D-11, 0.6284D-11, & + & 0.2397D-10, 0.9129D-10, 0.3467D-09, 0.1310D-08, 0.4914D-08, & + & 0.1830D-07, 0.6728D-07, 0.2428D-06, 0.8538D-06, 0.2894D-05, & + & 0.9329D-05, 0.2811D-04, 0.7761D-04, 0.1922D-03, 0.4178D-03, & + & 0.7832D-03, 0.1251D-02, 0.1699D-02, 0.1977D-02, 0.1998D-02, & + & 0.1796D-02, 0.1471D-02, 0.1125D-02, 0.8201D-03, 0.5792D-03, & + & 0.4010D-03, 0.2745D-03, 0.1869D-03, 0.1268D-03, 0.8597D-04, & + & 0.5829D-04, 0.3954D-04, 0.2685D-04, 0.1824D-04, 0.1240D-04, & + & 0.8430D-05, 0.5736D-05, 0.3905D-05, 0.2658D-05, 0.1811D-05, & + & 0.1233D-05, 0.8394D-06, 0.5718D-06, 0.3895D-06, 0.2654D-06, & + & 0.1808D-06, 0.1231D-06, 0.8390D-07, 0.5715D-07, 0.3894D-07, & + & 0.2652D-07/ + + data (calcpts(j,25), j = 1,neta) /0.2879D-23, 0.9354D-23, & + & 0.3524D-22, 0.1360D-21, 0.5241D-21, 0.2003D-20, 0.7677D-20, & + & 0.2942D-19, 0.1127D-18, 0.4317D-18, 0.1653D-17, 0.6336D-17, & + & 0.2427D-16, 0.9298D-16, 0.3563D-15, 0.1364D-14, 0.5226D-14, & + & 0.2001D-13, 0.7659D-13, 0.2931D-12, 0.1121D-11, 0.4282D-11, & + & 0.1634D-10, 0.6224D-10, 0.2364D-09, 0.8938D-09, 0.3354D-08, & + & 0.1250D-07, 0.4602D-07, 0.1664D-06, 0.5867D-06, 0.1997D-05, & + & 0.6473D-05, 0.1968D-04, 0.5502D-04, 0.1387D-03, 0.3092D-03, & + & 0.5991D-03, 0.9977D-03, 0.1421D-02, 0.1734D-02, 0.1836D-02, & + & 0.1718D-02, 0.1449D-02, 0.1132D-02, 0.8349D-03, 0.5929D-03, & + & 0.4111D-03, 0.2811D-03, 0.1906D-03, 0.1290D-03, 0.8716D-04, & + & 0.5892D-04, 0.3987D-04, 0.2702D-04, 0.1833D-04, 0.1244D-04, & + & 0.8453D-05, 0.5748D-05, 0.3909D-05, 0.2661D-05, 0.1811D-05, & + & 0.1233D-05, 0.8398D-06, 0.5719D-06, 0.3895D-06, 0.2654D-06, & + & 0.1808D-06, 0.1232D-06, 0.8390D-07, 0.5715D-07, 0.3894D-07, & + & 0.2652D-07/ + + data (calcpts(j,26), j = 1,neta) /0.2059D-23, 0.6393D-23, & + & 0.2394D-22, 0.9253D-22, 0.3573D-21, 0.1364D-20, 0.5231D-20, & + & 0.2004D-19, 0.7677D-19, 0.2940D-18, 0.1127D-17, 0.4317D-17, & + & 0.1653D-16, 0.6336D-16, 0.2427D-15, 0.9296D-15, 0.3560D-14, & + & 0.1363D-13, 0.5218D-13, 0.1997D-12, 0.7637D-12, 0.2918D-11, & + & 0.1114D-10, 0.4242D-10, 0.1611D-09, 0.6094D-09, 0.2289D-08, & + & 0.8532D-08, 0.3144D-07, 0.1138D-06, 0.4020D-06, 0.1372D-05, & + & 0.4467D-05, 0.1366D-04, 0.3855D-04, 0.9854D-04, 0.2239D-03, & + & 0.4461D-03, 0.7699D-03, 0.1146D-02, 0.1469D-02, 0.1635D-02, & + & 0.1601D-02, 0.1404D-02, 0.1127D-02, 0.8472D-03, 0.6080D-03, & + & 0.4232D-03, 0.2892D-03, 0.1958D-03, 0.1319D-03, 0.8879D-04, & + & 0.5981D-04, 0.4033D-04, 0.2726D-04, 0.1845D-04, 0.1250D-04, & + & 0.8484D-05, 0.5763D-05, 0.3918D-05, 0.2664D-05, 0.1814D-05, & + & 0.1234D-05, 0.8403D-06, 0.5721D-06, 0.3897D-06, 0.2654D-06, & + & 0.1808D-06, 0.1232D-06, 0.8390D-07, 0.5715D-07, 0.3894D-07, & + & 0.2654D-07/ + + data (calcpts(j,27), j = 1,neta) /0.1454D-23, 0.4358D-23, & + & 0.1624D-22, 0.6296D-22, 0.2436D-21, 0.9289D-21, 0.3564D-20, & + & 0.1365D-19, 0.5230D-19, 0.2004D-18, 0.7676D-18, 0.2941D-17, & + & 0.1127D-16, 0.4316D-16, 0.1653D-15, 0.6333D-15, 0.2426D-14, & + & 0.9288D-14, 0.3555D-13, 0.1361D-12, 0.5203D-12, 0.1989D-11, & + & 0.7587D-11, 0.2891D-10, 0.1098D-09, 0.4155D-09, 0.1563D-08, & + & 0.5820D-08, 0.2145D-07, 0.7775D-07, 0.2750D-06, 0.9402D-06, & + & 0.3071D-05, 0.9431D-05, 0.2679D-04, 0.6917D-04, 0.1596D-03, & + & 0.3246D-03, 0.5772D-03, 0.8927D-03, 0.1199D-02, 0.1404D-02, & + & 0.1446D-02, 0.1327D-02, 0.1105D-02, 0.8527D-03, 0.6221D-03, & + & 0.4365D-03, 0.2991D-03, 0.2022D-03, 0.1357D-03, 0.9096D-04, & + & 0.6099D-04, 0.4098D-04, 0.2759D-04, 0.1862D-04, 0.1259D-04, & + & 0.8529D-05, 0.5785D-05, 0.3929D-05, 0.2670D-05, 0.1816D-05, & + & 0.1235D-05, 0.8409D-06, 0.5726D-06, 0.3899D-06, 0.2655D-06, & + & 0.1809D-06, 0.1232D-06, 0.8391D-07, 0.5717D-07, 0.3894D-07, & + & 0.2654D-07/ + + data (calcpts(j,28), j = 1,neta) /0.1025D-23, 0.2973D-23, & + & 0.1104D-22, 0.4286D-22, 0.1661D-21, 0.6328D-21, 0.2428D-20, & + & 0.9300D-20, 0.3564D-19, 0.1365D-18, 0.5229D-18, 0.2004D-17, & + & 0.7676D-17, 0.2940D-16, 0.1127D-15, 0.4316D-15, 0.1653D-14, & + & 0.6329D-14, 0.2422D-13, 0.9270D-13, 0.3545D-12, 0.1355D-11, & + & 0.5171D-11, 0.1970D-10, 0.7482D-10, 0.2832D-09, 0.1066D-08, & + & 0.3969D-08, 0.1464D-07, 0.5307D-07, 0.1878D-06, 0.6432D-06, & + & 0.2105D-05, 0.6485D-05, 0.1851D-04, 0.4812D-04, 0.1122D-03, & + & 0.2321D-03, 0.4224D-03, 0.6744D-03, 0.9441D-03, 0.1161D-02, & + & 0.1259D-02, 0.1215D-02, 0.1058D-02, 0.8457D-03, 0.6321D-03, & + & 0.4501D-03, 0.3105D-03, 0.2100D-03, 0.1406D-03, 0.9384D-04, & + & 0.6260D-04, 0.4185D-04, 0.2805D-04, 0.1886D-04, 0.1271D-04, & + & 0.8592D-05, 0.5817D-05, 0.3945D-05, 0.2677D-05, 0.1820D-05, & + & 0.1237D-05, 0.8418D-06, 0.5730D-06, 0.3900D-06, 0.2657D-06, & + & 0.1809D-06, 0.1232D-06, 0.8393D-07, 0.5717D-07, 0.3894D-07, & + & 0.2654D-07/ + + data (calcpts(j,29), j = 1,neta) /0.7223D-24, 0.2028D-23, & + & 0.7517D-23, 0.2915D-22, 0.1131D-21, 0.4311D-21, 0.1654D-20, & + & 0.6336D-20, 0.2427D-19, 0.9300D-19, 0.3562D-18, 0.1365D-17, & + & 0.5229D-17, 0.2004D-16, 0.7674D-16, 0.2940D-15, 0.1126D-14, & + & 0.4311D-14, 0.1650D-13, 0.6315D-13, 0.2415D-12, 0.9230D-12, & + & 0.3522D-11, 0.1342D-10, 0.5098D-10, 0.1931D-09, 0.7263D-09, & + & 0.2706D-08, 0.9980D-08, 0.3620D-07, 0.1282D-06, 0.4393D-06, & + & 0.1440D-05, 0.4445D-05, 0.1273D-04, 0.3327D-04, 0.7820D-04, & + & 0.1637D-03, 0.3032D-03, 0.4965D-03, 0.7194D-03, 0.9237D-03, & + & 0.1054D-02, 0.1073D-02, 0.9827D-03, 0.8201D-03, 0.6337D-03, & + & 0.4617D-03, 0.3225D-03, 0.2193D-03, 0.1468D-03, 0.9754D-04, & + & 0.6474D-04, 0.4302D-04, 0.2868D-04, 0.1919D-04, 0.1288D-04, & + & 0.8679D-05, 0.5861D-05, 0.3966D-05, 0.2689D-05, 0.1825D-05, & + & 0.1240D-05, 0.8432D-06, 0.5736D-06, 0.3904D-06, 0.2658D-06, & + & 0.1809D-06, 0.1232D-06, 0.8394D-07, 0.5718D-07, 0.3896D-07, & + & 0.2654D-07/ + + data (calcpts(j,30), j = 1,neta) /0.4949D-24, 0.1383D-23, & + & 0.5113D-23, 0.1989D-22, 0.7709D-22, 0.2936D-21, 0.1127D-20, & + & 0.4317D-20, 0.1654D-19, 0.6336D-19, 0.2427D-18, 0.9300D-18, & + & 0.3563D-17, 0.1365D-16, 0.5229D-16, 0.2002D-15, 0.7671D-15, & + & 0.2937D-14, 0.1124D-13, 0.4304D-13, 0.1646D-12, 0.6288D-12, & + & 0.2400D-11, 0.9144D-11, 0.3474D-10, 0.1315D-09, 0.4950D-09, & + & 0.1848D-08, 0.6803D-08, 0.2469D-07, 0.8746D-07, 0.2998D-06, & + & 0.9835D-06, 0.3042D-05, 0.8730D-05, 0.2289D-04, 0.5411D-04, & + & 0.1142D-03, 0.2144D-03, 0.3581D-03, 0.5332D-03, 0.7101D-03, & + & 0.8477D-03, 0.9087D-03, 0.8783D-03, 0.7709D-03, 0.6216D-03, & + & 0.4676D-03, 0.3336D-03, 0.2294D-03, 0.1541D-03, 0.1022D-03, & + & 0.6752D-04, 0.4460D-04, 0.2954D-04, 0.1965D-04, 0.1312D-04, & + & 0.8800D-05, 0.5924D-05, 0.3998D-05, 0.2705D-05, 0.1833D-05, & + & 0.1244D-05, 0.8451D-06, 0.5745D-06, 0.3909D-06, 0.2660D-06, & + & 0.1810D-06, 0.1233D-06, 0.8397D-07, 0.5719D-07, 0.3896D-07, & + & 0.2654D-07/ + + data (calcpts(j,31), j = 1,neta) /0.3417D-24, 0.9340D-24, & + & 0.3495D-23, 0.1351D-22, 0.5253D-22, 0.2000D-21, 0.7671D-21, & + & 0.2941D-20, 0.1127D-19, 0.4317D-19, 0.1653D-18, 0.6336D-18, & + & 0.2427D-17, 0.9299D-17, 0.3562D-16, 0.1365D-15, 0.5226D-15, & + & 0.2001D-14, 0.7661D-14, 0.2931D-13, 0.1121D-12, 0.4284D-12, & + & 0.1635D-11, 0.6229D-11, 0.2367D-10, 0.8960D-10, 0.3372D-09, & + & 0.1259D-08, 0.4636D-08, 0.1683D-07, 0.5964D-07, 0.2046D-06, & + & 0.6714D-06, 0.2079D-05, 0.5975D-05, 0.1570D-04, 0.3726D-04, & + & 0.7914D-04, 0.1500D-03, 0.2541D-03, 0.3864D-03, 0.5300D-03, & + & 0.6575D-03, 0.7388D-03, 0.7529D-03, 0.6975D-03, 0.5913D-03, & + & 0.4636D-03, 0.3410D-03, 0.2391D-03, 0.1622D-03, 0.1079D-03, & + & 0.7103D-04, 0.4665D-04, 0.3069D-04, 0.2026D-04, 0.1345D-04, & + & 0.8972D-05, 0.6011D-05, 0.4043D-05, 0.2727D-05, 0.1844D-05, & + & 0.1250D-05, 0.8478D-06, 0.5759D-06, 0.3915D-06, 0.2662D-06, & + & 0.1812D-06, 0.1234D-06, 0.8400D-07, 0.5721D-07, 0.3897D-07, & + & 0.2654D-07/ + + data (calcpts(j,32), j = 1,neta) /0.2423D-24, 0.6489D-24, & + & 0.2356D-23, 0.9243D-23, 0.3575D-22, 0.1364D-21, 0.5237D-21, & + & 0.2004D-20, 0.7677D-20, 0.2942D-19, 0.1127D-18, 0.4317D-18, & + & 0.1653D-17, 0.6336D-17, 0.2427D-16, 0.9295D-16, 0.3561D-15, & + & 0.1363D-14, 0.5218D-14, 0.1998D-13, 0.7638D-13, 0.2919D-12, & + & 0.1114D-11, 0.4245D-11, 0.1613D-10, 0.6105D-10, 0.2298D-09, & + & 0.8580D-09, 0.3159D-08, 0.1147D-07, 0.4065D-07, 0.1395D-06, & + & 0.4581D-06, 0.1419D-05, 0.4083D-05, 0.1075D-04, 0.2558D-04, & + & 0.5456D-04, 0.1041D-03, 0.1782D-03, 0.2751D-03, 0.3859D-03, & + & 0.4940D-03, 0.5780D-03, 0.6183D-03, 0.6045D-03, 0.5411D-03, & + & 0.4456D-03, 0.3414D-03, 0.2466D-03, 0.1704D-03, 0.1143D-03, & + & 0.7532D-04, 0.4927D-04, 0.3219D-04, 0.2110D-04, 0.1390D-04, & + & 0.9206D-05, 0.6132D-05, 0.4104D-05, 0.2759D-05, 0.1860D-05, & + & 0.1257D-05, 0.8517D-06, 0.5778D-06, 0.3924D-06, 0.2667D-06, & + & 0.1815D-06, 0.1235D-06, 0.8406D-07, 0.5723D-07, 0.3897D-07, & + & 0.2655D-07/ + + data (calcpts(j,33), j = 1,neta) /0.1613D-24, 0.4423D-24, & + & 0.1620D-23, 0.6268D-23, 0.2436D-22, 0.9282D-22, 0.3569D-21, & + & 0.1365D-20, 0.5231D-20, 0.2004D-19, 0.7675D-19, 0.2941D-18, & + & 0.1127D-17, 0.4316D-17, 0.1653D-16, 0.6333D-16, 0.2426D-15, & + & 0.9288D-15, 0.3557D-14, 0.1361D-13, 0.5204D-13, 0.1989D-12, & + & 0.7590D-12, 0.2892D-11, 0.1099D-10, 0.4159D-10, 0.1566D-09, & + & 0.5847D-09, 0.2155D-08, 0.7815D-08, 0.2770D-07, 0.9510D-07, & + & 0.3123D-06, 0.9679D-06, 0.2787D-05, 0.7349D-05, 0.1752D-04, & + & 0.3747D-04, 0.7182D-04, 0.1238D-03, 0.1935D-03, 0.2760D-03, & + & 0.3617D-03, 0.4372D-03, 0.4877D-03, 0.5012D-03, 0.4735D-03, & + & 0.4121D-03, 0.3317D-03, 0.2492D-03, 0.1771D-03, 0.1208D-03, & + & 0.8025D-04, 0.5250D-04, 0.3414D-04, 0.2220D-04, 0.1450D-04, & + & 0.9528D-05, 0.6300D-05, 0.4191D-05, 0.2802D-05, 0.1883D-05, & + & 0.1268D-05, 0.8571D-06, 0.5805D-06, 0.3938D-06, 0.2674D-06, & + & 0.1818D-06, 0.1236D-06, 0.8413D-07, 0.5727D-07, 0.3900D-07, & + & 0.2655D-07/ + + data (calcpts(j,34), j = 1,neta) /0.1105D-24, 0.3016D-24, & + & 0.1082D-23, 0.4271D-23, 0.1659D-22, 0.6324D-22, 0.2432D-21, & + & 0.9297D-21, 0.3563D-20, 0.1365D-19, 0.5229D-19, 0.2004D-18, & + & 0.7676D-18, 0.2940D-17, 0.1127D-16, 0.4316D-16, 0.1653D-15, & + & 0.6329D-15, 0.2423D-14, 0.9270D-14, 0.3546D-13, 0.1355D-12, & + & 0.5172D-12, 0.1970D-11, 0.7487D-11, 0.2834D-10, 0.1067D-09, & + & 0.3984D-09, 0.1470D-08, 0.5325D-08, 0.1889D-07, 0.6482D-07, & + & 0.2130D-06, 0.6602D-06, 0.1902D-05, 0.5018D-05, 0.1198D-04, & + & 0.2567D-04, 0.4937D-04, 0.8555D-04, 0.1347D-03, 0.1946D-03, & + & 0.2595D-03, 0.3218D-03, 0.3714D-03, 0.3984D-03, 0.3962D-03, & + & 0.3642D-03, 0.3095D-03, 0.2442D-03, 0.1805D-03, 0.1266D-03, & + & 0.8544D-04, 0.5625D-04, 0.3654D-04, 0.2363D-04, 0.1530D-04, & + & 0.9963D-05, 0.6531D-05, 0.4309D-05, 0.2863D-05, 0.1913D-05, & + & 0.1284D-05, 0.8649D-06, 0.5844D-06, 0.3957D-06, 0.2683D-06, & + & 0.1823D-06, 0.1239D-06, 0.8424D-07, 0.5732D-07, 0.3902D-07, & + & 0.2657D-07/ + + data (calcpts(j,35), j = 1,neta) /0.8031D-25, 0.2055D-24, & + & 0.7368D-24, 0.2908D-23, 0.1125D-22, 0.4308D-22, 0.1656D-21, & + & 0.6338D-21, 0.2427D-20, 0.9300D-20, 0.3562D-19, 0.1365D-18, & + & 0.5229D-18, 0.2004D-17, 0.7674D-17, 0.2940D-16, 0.1126D-15, & + & 0.4311D-15, 0.1650D-14, 0.6316D-14, 0.2415D-13, 0.9231D-13, & + & 0.3524D-12, 0.1342D-11, 0.5100D-11, 0.1931D-10, 0.7267D-10, & + & 0.2714D-09, 0.1002D-08, 0.3629D-08, 0.1287D-07, 0.4418D-07, & + & 0.1451D-06, 0.4500D-06, 0.1297D-05, 0.3424D-05, 0.8178D-05, & + & 0.1755D-04, 0.3384D-04, 0.5884D-04, 0.9319D-04, 0.1357D-03, & + & 0.1835D-03, 0.2317D-03, 0.2747D-03, 0.3053D-03, 0.3172D-03, & + & 0.3071D-03, 0.2759D-03, 0.2299D-03, 0.1784D-03, 0.1301D-03, & + & 0.9017D-04, 0.6026D-04, 0.3936D-04, 0.2540D-04, 0.1635D-04, & + & 0.1054D-04, 0.6843D-05, 0.4475D-05, 0.2949D-05, 0.1956D-05, & + & 0.1306D-05, 0.8760D-06, 0.5898D-06, 0.3984D-06, 0.2697D-06, & + & 0.1828D-06, 0.1242D-06, 0.8441D-07, 0.5740D-07, 0.3906D-07, & + & 0.2658D-07/ + + data (calcpts(j,36), j = 1,neta) /0.5171D-25, 0.1239D-24, & + & 0.5018D-24, 0.1958D-23, 0.7728D-23, 0.2945D-22, 0.1128D-21, & + & 0.4314D-21, 0.1654D-20, 0.6336D-20, 0.2427D-19, 0.9300D-19, & + & 0.3562D-18, 0.1365D-17, 0.5229D-17, 0.2003D-16, 0.7671D-16, & + & 0.2937D-15, 0.1124D-14, 0.4303D-14, 0.1646D-13, 0.6290D-13, & + & 0.2400D-12, 0.9146D-12, 0.3475D-11, 0.1316D-10, 0.4951D-10, & + & 0.1850D-09, 0.6825D-09, 0.2474D-08, 0.8768D-08, 0.3011D-07, & + & 0.9891D-07, 0.3068D-06, 0.8843D-06, 0.2336D-05, 0.5582D-05, & + & 0.1199D-04, 0.2314D-04, 0.4037D-04, 0.6416D-04, 0.9402D-04, & + & 0.1283D-03, 0.1643D-03, 0.1986D-03, 0.2268D-03, 0.2444D-03, & + & 0.2475D-03, 0.2343D-03, 0.2065D-03, 0.1694D-03, 0.1295D-03, & + & 0.9328D-04, 0.6401D-04, 0.4241D-04, 0.2750D-04, 0.1764D-04, & + & 0.1130D-04, 0.7261D-05, 0.4700D-05, 0.3066D-05, 0.2018D-05, & + & 0.1337D-05, 0.8915D-06, 0.5976D-06, 0.4023D-06, 0.2717D-06, & + & 0.1839D-06, 0.1246D-06, 0.8462D-07, 0.5751D-07, 0.3910D-07, & + & 0.2661D-07/ + + data (calcpts(j,37), j = 1,neta) /0.3531D-25, 0.9543D-25, & + & 0.3418D-24, 0.1334D-23, 0.5265D-23, 0.1999D-22, 0.7687D-22, & + & 0.2940D-21, 0.1127D-20, 0.4317D-20, 0.1654D-19, 0.6336D-19, & + & 0.2427D-18, 0.9299D-18, 0.3563D-17, 0.1365D-16, 0.5226D-16, & + & 0.2001D-15, 0.7660D-15, 0.2931D-14, 0.1121D-13, 0.4284D-13, & + & 0.1635D-12, 0.6231D-12, 0.2367D-11, 0.8963D-11, 0.3374D-10, & + & 0.1260D-09, 0.4650D-09, 0.1688D-08, 0.5974D-08, 0.2051D-07, & + & 0.6740D-07, 0.2090D-06, 0.6027D-06, 0.1592D-05, 0.3807D-05, & + & 0.8184D-05, 0.1581D-04, 0.2762D-04, 0.4402D-04, 0.6478D-04, & + & 0.8898D-04, 0.1151D-03, 0.1411D-03, 0.1646D-03, 0.1824D-03, & + & 0.1917D-03, 0.1901D-03, 0.1766D-03, 0.1532D-03, 0.1238D-03, & + & 0.9359D-04, 0.6668D-04, 0.4533D-04, 0.2980D-04, 0.1920D-04, & + & 0.1225D-04, 0.7807D-05, 0.5000D-05, 0.3227D-05, 0.2100D-05, & + & 0.1380D-05, 0.9132D-06, 0.6085D-06, 0.4077D-06, 0.2744D-06, & + & 0.1851D-06, 0.1253D-06, 0.8495D-07, 0.5766D-07, 0.3918D-07, & + & 0.2664D-07/ + + data (calcpts(j,38), j = 1,neta) /0.2861D-25, 0.5749D-25, & + & 0.2328D-24, 0.9369D-24, 0.3558D-23, 0.1362D-22, 0.5230D-22, & + & 0.2003D-21, 0.7674D-21, 0.2940D-20, 0.1127D-19, 0.4317D-19, & + & 0.1653D-18, 0.6336D-18, 0.2427D-17, 0.9296D-17, 0.3561D-16, & + & 0.1363D-15, 0.5220D-15, 0.1998D-14, 0.7639D-14, 0.2919D-13, & + & 0.1114D-12, 0.4245D-12, 0.1613D-11, 0.6107D-11, 0.2298D-10, & + & 0.8583D-10, 0.3168D-09, 0.1150D-08, 0.4071D-08, 0.1398D-07, & + & 0.4592D-07, 0.1424D-06, 0.4107D-06, 0.1085D-05, 0.2595D-05, & + & 0.5583D-05, 0.1080D-04, 0.1887D-04, 0.3015D-04, 0.4449D-04, & + & 0.6138D-04, 0.7995D-04, 0.9905D-04, 0.1172D-03, 0.1327D-03, & + & 0.1436D-03, 0.1479D-03, 0.1440D-03, 0.1318D-03, 0.1127D-03, & + & 0.9003D-04, 0.6732D-04, 0.4752D-04, 0.3204D-04, 0.2091D-04, & + & 0.1339D-04, 0.8498D-05, 0.5394D-05, 0.3443D-05, 0.2216D-05, & + & 0.1439D-05, 0.9437D-06, 0.6239D-06, 0.4154D-06, 0.2781D-06, & + & 0.1870D-06, 0.1262D-06, 0.8540D-07, 0.5789D-07, 0.3930D-07, & + & 0.2670D-07/ + + data (calcpts(j,39), j = 1,neta) /0.1952D-25, 0.4561D-25, & + & 0.1587D-24, 0.6522D-24, 0.2424D-23, 0.9308D-23, 0.3564D-22, & + & 0.1364D-21, 0.5231D-21, 0.2004D-20, 0.7676D-20, 0.2942D-19, & + & 0.1127D-18, 0.4316D-18, 0.1653D-17, 0.6333D-17, 0.2426D-16, & + & 0.9288D-16, 0.3557D-15, 0.1361D-14, 0.5205D-14, 0.1989D-13, & + & 0.7590D-13, 0.2892D-12, 0.1099D-11, 0.4160D-11, 0.1566D-10, & + & 0.5849D-10, 0.2158D-09, 0.7836D-09, 0.2774D-08, 0.9522D-08, & + & 0.3129D-07, 0.9705D-07, 0.2799D-06, 0.7395D-06, 0.1769D-05, & + & 0.3807D-05, 0.7365D-05, 0.1289D-04, 0.2061D-04, 0.3048D-04, & + & 0.4218D-04, 0.5520D-04, 0.6888D-04, 0.8240D-04, 0.9478D-04, & + & 0.1048D-03, 0.1112D-03, 0.1125D-03, 0.1080D-03, 0.9752D-04, & + & 0.8245D-04, 0.6516D-04, 0.4827D-04, 0.3378D-04, 0.2261D-04, & + & 0.1466D-04, 0.9330D-05, 0.5894D-05, 0.3724D-05, 0.2369D-05, & + & 0.1521D-05, 0.9858D-06, 0.6455D-06, 0.4263D-06, 0.2835D-06, & + & 0.1898D-06, 0.1276D-06, 0.8605D-07, 0.5822D-07, 0.3945D-07, & + & 0.2677D-07/ + + data (calcpts(j,40), j = 1,neta) /0.7491D-26, 0.2667D-25, & + & 0.1178D-24, 0.4443D-24, 0.1649D-23, 0.6341D-23, 0.2426D-22, & + & 0.9296D-22, 0.3564D-21, 0.1365D-20, 0.5229D-20, 0.2004D-19, & + & 0.7675D-19, 0.2940D-18, 0.1127D-17, 0.4316D-17, 0.1653D-16, & + & 0.6329D-16, 0.2423D-15, 0.9270D-15, 0.3546D-14, 0.1355D-13, & + & 0.5172D-13, 0.1971D-12, 0.7486D-12, 0.2834D-11, 0.1067D-10, & + & 0.3984D-10, 0.1471D-09, 0.5338D-09, 0.1893D-08, 0.6488D-08, & + & 0.2132D-07, 0.6614D-07, 0.1907D-06, 0.5040D-06, 0.1206D-05, & + & 0.2595D-05, 0.5022D-05, 0.8793D-05, 0.1407D-04, 0.2083D-04, & + & 0.2891D-04, 0.3795D-04, 0.4760D-04, 0.5738D-04, 0.6674D-04, & + & 0.7500D-04, 0.8136D-04, 0.8488D-04, 0.8471D-04, 0.8025D-04, & + & 0.7167D-04, 0.6000D-04, 0.4698D-04, 0.3450D-04, 0.2397D-04, & + & 0.1593D-04, 0.1026D-04, 0.6498D-05, 0.4085D-05, 0.2571D-05, & + & 0.1631D-05, 0.1044D-05, 0.6753D-06, 0.4414D-06, 0.2912D-06, & + & 0.1935D-06, 0.1295D-06, 0.8699D-07, 0.5866D-07, 0.3968D-07, & + & 0.2688D-07/ + + data (calcpts(j,41), j = 1,neta) /0.5321D-26, 0.2247D-25, & + & 0.7351D-25, 0.2945D-24, 0.1133D-23, 0.4324D-23, 0.1653D-22, & + & 0.6333D-22, 0.2427D-21, 0.9299D-21, 0.3563D-20, 0.1365D-19, & + & 0.5229D-19, 0.2004D-18, 0.7674D-18, 0.2940D-17, 0.1126D-16, & + & 0.4311D-16, 0.1650D-15, 0.6317D-15, 0.2415D-14, 0.9231D-14, & + & 0.3524D-13, 0.1342D-12, 0.5102D-12, 0.1931D-11, 0.7269D-11, & + & 0.2715D-10, 0.1002D-09, 0.3638D-09, 0.1290D-08, 0.4421D-08, & + & 0.1452D-07, 0.4506D-07, 0.1299D-06, 0.3434D-06, 0.8217D-06, & + & 0.1769D-05, 0.3423D-05, 0.5997D-05, 0.9603D-05, 0.1423D-04, & + & 0.1977D-04, 0.2602D-04, 0.3274D-04, 0.3969D-04, 0.4653D-04, & + & 0.5289D-04, 0.5832D-04, 0.6227D-04, 0.6408D-04, 0.6318D-04, & + & 0.5922D-04, 0.5238D-04, 0.4346D-04, 0.3375D-04, 0.2460D-04, & + & 0.1697D-04, 0.1121D-04, 0.7182D-05, 0.4523D-05, 0.2831D-05, & + & 0.1774D-05, 0.1122D-05, 0.7163D-06, 0.4626D-06, 0.3020D-06, & + & 0.1989D-06, 0.1321D-06, 0.8830D-07, 0.5931D-07, 0.3999D-07, & + & 0.2705D-07/ + + data (calcpts(j,42), j = 1,neta) /0.1749D-26, 0.1238D-25, & + & 0.4942D-25, 0.1999D-24, 0.7656D-24, 0.2949D-23, 0.1128D-22, & + & 0.4317D-22, 0.1655D-21, 0.6336D-21, 0.2427D-20, 0.9300D-20, & + & 0.3562D-19, 0.1365D-18, 0.5229D-18, 0.2003D-17, 0.7671D-17, & + & 0.2937D-16, 0.1124D-15, 0.4303D-15, 0.1646D-14, 0.6290D-14, & + & 0.2400D-13, 0.9146D-13, 0.3476D-12, 0.1315D-11, 0.4952D-11, & + & 0.1850D-10, 0.6827D-10, 0.2478D-09, 0.8790D-09, 0.3012D-08, & + & 0.9895D-08, 0.3069D-07, 0.8855D-07, 0.2340D-06, 0.5598D-06, & + & 0.1205D-05, 0.2334D-05, 0.4088D-05, 0.6549D-05, 0.9714D-05, & + & 0.1351D-04, 0.1780D-04, 0.2246D-04, 0.2732D-04, 0.3221D-04, & + & 0.3692D-04, 0.4119D-04, 0.4472D-04, 0.4710D-04, 0.4792D-04, & + & 0.4677D-04, 0.4344D-04, 0.3810D-04, 0.3135D-04, 0.2418D-04, & + & 0.1751D-04, 0.1200D-04, 0.7878D-05, 0.5021D-05, 0.3147D-05, & + & 0.1961D-05, 0.1225D-05, 0.7718D-06, 0.4916D-06, 0.3168D-06, & + & 0.2066D-06, 0.1359D-06, 0.9018D-07, 0.6024D-07, 0.4046D-07, & + & 0.2727D-07/ + + data (calcpts(j,43), j = 1,neta) /0.2703D-26, 0.8444D-26, & + & 0.3725D-25, 0.1405D-24, 0.5220D-24, 0.2006D-23, 0.7684D-23, & + & 0.2938D-22, 0.1127D-21, 0.4316D-21, 0.1654D-20, 0.6336D-20, & + & 0.2427D-19, 0.9298D-19, 0.3562D-18, 0.1365D-17, 0.5226D-17, & + & 0.2001D-16, 0.7661D-16, 0.2931D-15, 0.1121D-14, 0.4284D-14, & + & 0.1635D-13, 0.6231D-13, 0.2367D-12, 0.8963D-12, 0.3373D-11, & + & 0.1260D-10, 0.4650D-10, 0.1689D-09, 0.5988D-09, 0.2055D-08, & + & 0.6742D-08, 0.2091D-07, 0.6033D-07, 0.1595D-06, 0.3815D-06, & + & 0.8212D-06, 0.1590D-05, 0.2787D-05, 0.4466D-05, 0.6626D-05, & + & 0.9219D-05, 0.1217D-04, 0.1538D-04, 0.1875D-04, 0.2219D-04, & + & 0.2556D-04, 0.2877D-04, 0.3160D-04, 0.3387D-04, 0.3530D-04, & + & 0.3555D-04, 0.3439D-04, 0.3168D-04, 0.2759D-04, 0.2254D-04, & + & 0.1727D-04, 0.1243D-04, 0.8470D-05, 0.5531D-05, 0.3507D-05, & + & 0.2188D-05, 0.1358D-05, 0.8454D-06, 0.5310D-06, 0.3373D-06, & + & 0.2171D-06, 0.1412D-06, 0.9284D-07, 0.6156D-07, 0.4110D-07, & + & 0.2759D-07/ + + data (calcpts(j,44), j = 1,neta) /0.1634D-26, 0.5751D-26, & + & 0.2562D-25, 0.9281D-25, 0.3562D-24, 0.1366D-23, 0.5227D-23, & + & 0.2003D-22, 0.7679D-22, 0.2940D-21, 0.1127D-20, 0.4317D-20, & + & 0.1654D-19, 0.6336D-19, 0.2427D-18, 0.9295D-18, 0.3561D-17, & + & 0.1363D-16, 0.5220D-16, 0.1998D-15, 0.7640D-15, 0.2919D-14, & + & 0.1114D-13, 0.4245D-13, 0.1612D-12, 0.6107D-12, 0.2298D-11, & + & 0.8583D-11, 0.3168D-10, 0.1150D-09, 0.4080D-09, 0.1401D-08, & + & 0.4593D-08, 0.1425D-07, 0.4110D-07, 0.1086D-06, 0.2599D-06, & + & 0.5595D-06, 0.1084D-05, 0.1899D-05, 0.3044D-05, 0.4518D-05, & + & 0.6290D-05, 0.8306D-05, 0.1051D-04, 0.1283D-04, 0.1523D-04, & + & 0.1763D-04, 0.1994D-04, 0.2209D-04, 0.2397D-04, 0.2541D-04, & + & 0.2622D-04, 0.2621D-04, 0.2516D-04, 0.2301D-04, 0.1991D-04, & + & 0.1617D-04, 0.1231D-04, 0.8811D-05, 0.5972D-05, 0.3881D-05, & + & 0.2448D-05, 0.1521D-05, 0.9401D-06, 0.5832D-06, 0.3652D-06, & + & 0.2314D-06, 0.1486D-06, 0.9657D-07, 0.6342D-07, 0.4202D-07, & + & 0.2804D-07/ + + data (calcpts(j,45), j = 1,neta) /0.1110D-26, 0.4410D-26, & + & 0.1734D-25, 0.6595D-25, 0.2443D-24, 0.9300D-24, 0.3569D-23, & + & 0.1366D-22, 0.5229D-22, 0.2005D-21, 0.7677D-21, 0.2941D-20, & + & 0.1127D-19, 0.4317D-19, 0.1653D-18, 0.6333D-18, 0.2425D-17, & + & 0.9288D-17, 0.3557D-16, 0.1361D-15, 0.5205D-15, 0.1989D-14, & + & 0.7590D-14, 0.2892D-13, 0.1099D-12, 0.4160D-12, 0.1566D-11, & + & 0.5849D-11, 0.2159D-10, 0.7838D-10, 0.2780D-09, 0.9544D-09, & + & 0.3129D-08, 0.9708D-08, 0.2801D-07, 0.7400D-07, 0.1771D-06, & + & 0.3813D-06, 0.7383D-06, 0.1294D-05, 0.2075D-05, 0.3080D-05, & + & 0.4289D-05, 0.5666D-05, 0.7174D-05, 0.8773D-05, 0.1043D-04, & + & 0.1210D-04, 0.1375D-04, 0.1533D-04, 0.1677D-04, 0.1800D-04, & + & 0.1892D-04, 0.1935D-04, 0.1920D-04, 0.1831D-04, 0.1665D-04, & + & 0.1431D-04, 0.1157D-04, 0.8758D-05, 0.6236D-05, 0.4206D-05, & + & 0.2719D-05, 0.1709D-05, 0.1056D-05, 0.6505D-06, 0.4023D-06, & + & 0.2513D-06, 0.1588D-06, 0.1018D-06, 0.6605D-07, 0.4332D-07, & + & 0.2868D-07/ + + data (calcpts(j,46), j = 1,neta) /0.9015D-27, 0.2622D-26, & + & 0.1135D-25, 0.4299D-25, 0.1673D-24, 0.6300D-24, 0.2432D-23, & + & 0.9301D-23, 0.3562D-22, 0.1364D-21, 0.5229D-21, 0.2004D-20, & + & 0.7676D-20, 0.2940D-19, 0.1127D-18, 0.4316D-18, 0.1653D-17, & + & 0.6329D-17, 0.2423D-16, 0.9270D-16, 0.3546D-15, 0.1355D-14, & + & 0.5172D-14, 0.1971D-13, 0.7487D-13, 0.2834D-12, 0.1067D-11, & + & 0.3984D-11, 0.1471D-10, 0.5340D-10, 0.1893D-09, 0.6503D-09, & + & 0.2135D-08, 0.6613D-08, 0.1908D-07, 0.5042D-07, 0.1207D-06, & + & 0.2598D-06, 0.5031D-06, 0.8817D-06, 0.1414D-05, 0.2098D-05, & + & 0.2924D-05, 0.3864D-05, 0.4895D-05, 0.5991D-05, 0.7128D-05, & + & 0.8286D-05, 0.9442D-05, 0.1057D-04, 0.1164D-04, 0.1260D-04, & + & 0.1341D-04, 0.1397D-04, 0.1420D-04, 0.1400D-04, 0.1327D-04, & + & 0.1200D-04, 0.1027D-04, 0.8253D-05, 0.6219D-05, 0.4407D-05, & + & 0.2958D-05, 0.1904D-05, 0.1191D-05, 0.7338D-06, 0.4501D-06, & + & 0.2775D-06, 0.1728D-06, 0.1090D-06, 0.6971D-07, 0.4516D-07, & + & 0.2959D-07/ + + data (calcpts(j,47), j = 1,neta) /0.6257D-27, 0.1967D-26, & + & 0.7812D-26, 0.2892D-25, 0.1132D-24, 0.4352D-24, 0.1650D-23, & + & 0.6303D-23, 0.2431D-22, 0.9296D-22, 0.3559D-21, 0.1364D-20, & + & 0.5231D-20, 0.2004D-19, 0.7675D-19, 0.2940D-18, 0.1126D-17, & + & 0.4311D-17, 0.1650D-16, 0.6316D-16, 0.2415D-15, 0.9231D-15, & + & 0.3524D-14, 0.1342D-13, 0.5101D-13, 0.1930D-12, 0.7269D-12, & + & 0.2715D-11, 0.1002D-10, 0.3638D-10, 0.1290D-09, 0.4430D-09, & + & 0.1456D-08, 0.4506D-08, 0.1300D-07, 0.3435D-07, 0.8220D-07, & + & 0.1770D-06, 0.3428D-06, 0.6008D-06, 0.9632D-06, 0.1430D-05, & + & 0.1992D-05, 0.2634D-05, 0.3337D-05, 0.4088D-05, 0.4869D-05, & + & 0.5667D-05, 0.6470D-05, 0.7263D-05, 0.8031D-05, 0.8751D-05, & + & 0.9393D-05, 0.9915D-05, 0.1026D-04, 0.1037D-04, 0.1016D-04, & + & 0.9585D-05, 0.8626D-05, 0.7344D-05, 0.5877D-05, 0.4409D-05, & + & 0.3110D-05, 0.2079D-05, 0.1332D-05, 0.8301D-06, 0.5094D-06, & + & 0.3114D-06, 0.1912D-06, 0.1188D-06, 0.7476D-07, 0.4773D-07, & + & 0.3089D-07/ + + data (calcpts(j,48), j = 1,neta) /0.1929D-27, 0.1065D-26, & + & 0.5550D-26, 0.2037D-25, 0.7890D-25, 0.2965D-24, 0.1121D-23, & + & 0.4320D-23, 0.1657D-22, 0.6348D-22, 0.2428D-21, 0.9311D-21, & + & 0.3563D-20, 0.1364D-19, 0.5229D-19, 0.2003D-18, 0.7671D-18, & + & 0.2937D-17, 0.1124D-16, 0.4303D-16, 0.1646D-15, 0.6290D-15, & + & 0.2400D-14, 0.9146D-14, 0.3475D-13, 0.1316D-12, 0.4952D-12, & + & 0.1850D-11, 0.6827D-11, 0.2478D-10, 0.8790D-10, 0.3018D-09, & + & 0.9918D-09, 0.3071D-08, 0.8855D-08, 0.2340D-07, 0.5601D-07, & + & 0.1206D-06, 0.2335D-06, 0.4093D-06, 0.6563D-06, 0.9747D-06, & + & 0.1358D-05, 0.1796D-05, 0.2276D-05, 0.2789D-05, 0.3322D-05, & + & 0.3870D-05, 0.4424D-05, 0.4977D-05, 0.5518D-05, 0.6041D-05, & + & 0.6524D-05, 0.6949D-05, 0.7287D-05, 0.7499D-05, 0.7535D-05, & + & 0.7349D-05, 0.6900D-05, 0.6183D-05, 0.5241D-05, 0.4176D-05, & + & 0.3120D-05, 0.2192D-05, 0.1459D-05, 0.9318D-06, 0.5783D-06, & + & 0.3536D-06, 0.2154D-06, 0.1319D-06, 0.8168D-07, 0.5130D-07, & + & 0.3269D-07/ + + data (calcpts(j,49), j = 1,neta) /0.1342D-27, 0.7954D-27, & + & 0.3825D-26, 0.1374D-25, 0.5324D-25, 0.2004D-24, 0.7458D-24, & + & 0.2908D-23, 0.1111D-22, 0.4303D-22, 0.1656D-21, 0.6326D-21, & + & 0.2435D-20, 0.9320D-20, 0.3557D-19, 0.1364D-18, 0.5224D-18, & + & 0.2001D-17, 0.7657D-17, 0.2933D-16, 0.1121D-15, 0.4284D-15, & + & 0.1635D-14, 0.6231D-14, 0.2367D-13, 0.8962D-13, 0.3373D-12, & + & 0.1260D-11, 0.4650D-11, 0.1689D-10, 0.5988D-10, 0.2057D-09, & + & 0.6758D-09, 0.2094D-08, 0.6033D-08, 0.1595D-07, 0.3816D-07, & + & 0.8215D-07, 0.1592D-06, 0.2789D-06, 0.4472D-06, 0.6641D-06, & + & 0.9252D-06, 0.1224D-05, 0.1551D-05, 0.1901D-05, 0.2267D-05, & + & 0.2642D-05, 0.3023D-05, 0.3403D-05, 0.3783D-05, 0.4152D-05, & + & 0.4505D-05, 0.4829D-05, 0.5111D-05, 0.5328D-05, 0.5454D-05, & + & 0.5454D-05, 0.5297D-05, 0.4953D-05, 0.4421D-05, 0.3732D-05, & + & 0.2963D-05, 0.2205D-05, 0.1544D-05, 0.1024D-05, 0.6512D-06, & + & 0.4026D-06, 0.2453D-06, 0.1489D-06, 0.9093D-07, 0.5616D-07, & + & 0.3519D-07/ + + data (dlaeta(j), j = 1,neta) / & + & -6d0, -5.83333333d0, -5.66666667d0, -5.5d0, -5.33333333d0, & + & -5.16666667d0, -5d0, -4.83333333d0, -4.66666667d0, -4.5d0, & + & -4.33333333d0, -4.16666667d0, -4d0, -3.83333333d0, & + & -3.66666667d0, -3.5d0, -3.33333333d0, -3.16666667d0, -3d0, & + & -2.83333333d0, -2.66666667d0, -2.5d0, -2.33333333d0, & + & -2.16666667d0, -2d0, -1.83333333d0, -1.66666667d0, -1.5d0, & + & -1.33333333d0, -1.16666667d0, -1d0, -0.83333333d0, -0.66666667d0,& + & -0.5d0, -0.33333333d0, -0.16666667d0, 0d0, 0.16666667d0, & + & 0.33333333d0, 0.5d0, 0.66666667d0, 0.83333333d0, 1d0, & + & 1.16666667d0, 1.33333333d0, 1.5d0, 1.66666667d0, 1.83333333d0, & + & 2d0, 2.16666667d0, 2.33333333d0, 2.5d0, 2.66666667d0, & + & 2.83333333d0, 3d0, 3.16666667d0, 3.33333333d0, 3.5d0, & + & 3.66666667d0, 3.83333333d0, 4d0, 4.16666667d0, 4.33333333d0, & + & 4.5d0, 4.66666667d0, 4.83333333d0, 5d0, 5.16666667d0, & + & 5.33333333d0, 5.5d0, 5.66666667d0, 5.83333333d0, 6d0/ + + data (dlaxi(j), j = 1,nxi) / & + & -3d0, -2.83333333d0, -2.66666667d0, -2.5d0, -2.33333333d0, & + & -2.16666667d0, -2d0, -1.83333333d0, -1.66666667d0, -1.5d0, & + & -1.33333333d0, -1.16666667d0, -1d0, -0.83333333d0, -0.66666667d0,& + & -0.5d0, -0.33333333d0, -0.16666667d0, 0d0, 0.16666667d0, & + & 0.33333333d0, 0.5d0, 0.66666667d0, 0.83333333d0, 1d0, & + & 1.16666667d0, 1.33333333d0, 1.5d0, 1.66666667d0, 1.83333333d0, & + & 2d0, 2.16666667d0, 2.33333333d0, 2.5d0, 2.66666667d0, & + & 2.83333333d0, 3d0, 3.16666667d0, 3.33333333d0, 3.5d0, & + & 3.66666667d0, 3.83333333d0, 4d0, 4.16666667d0, 4.33333333d0, & + & 4.5d0, 4.66666667d0, 4.83333333d0, 5d0/ + + dleta = dlog10(eta) + dlxi = dlog10(xi) + if (dlxi .le. dlaxi(1)) dlxi = dlaxi(1) + if (dlxi .ge. dlaxi(nxi)) dlxi = dlaxi(nxi) + if (dleta .ge. dlaeta(neta)) dleta = dlaeta(neta) + if (dleta .le. dlaeta(1)) dleta = dlaeta(1) + call locate(dlaeta,neta, dleta, ieta) + call locate(dlaxi, nxi, dlxi, ixi) +! interpolating between the appropriate points + delxi = 1d0/6d0 + deleta = 1d0/6d0 +! lagrange 3-pt. + if (ixi .le. 2) ixi = 2 + if (ixi .ge. 48) ixi = 48 + if (ieta .le. 2) ieta = 2 + if (ieta .ge. 72) ieta = 72 + pxi = (dlxi - dlaxi(ixi))/delxi + f(-1) = pxi*(pxi-1d0)/2d0*calcpts(ieta-1,ixi-1) + & + & (1d0 - pxi**2)*calcpts(ieta-1,ixi) + & + & pxi*(pxi+1d0)/2d0*calcpts(ieta-1,ixi+1) + f(0) = pxi*(pxi-1d0)/2d0*calcpts(ieta,ixi-1) + & + & (1d0 - pxi**2)*calcpts(ieta,ixi) + & + & pxi*(pxi+1d0)/2d0*calcpts(ieta,ixi+1) + f(1) = pxi*(pxi-1d0)/2d0*calcpts(ieta+1,ixi-1) + & + & (1d0 - pxi**2)*calcpts(ieta+1,ixi) + & + & pxi*(pxi+1d0)/2d0*calcpts(ieta+1,ixi+1) + peta = (dleta - dlaeta(ieta))/deleta + h1_LLq = peta*(peta-1d0)/2d0*f(-1) + & + & (1d0 - peta**2)*f(0) + & + & peta*(peta+1d0)/2d0*f(1) +!MB + + peta*(peta+1d0)/2d0*f(1) + return + END + + +!DECK ID>, QCUTIL. + +!DECK ID>, QNMACRO. + +! ================================================== + SUBROUTINE QNMACRO(lun,name,isym,xx,yy,ee,np,text) +! ================================================== + + implicit double precision (A-H,O-Z) + + character*(*) name + character*(*) text + dimension xx(*), yy(*), ee(*) + dimension luns(50) + + data nluns,luns /0,50*0/ + + nn = max(np,0) + lseen = 0 + do i = 1,nluns + if(luns(i).eq.lun) lseen = 1 + enddo + + if(lseen.eq.0) then + + nluns = min(nluns+1,50) + luns(nluns) = lun + + write(lun,*) ' ' + write(lun,'(''*'',60(''-''))') + write(lun,*) ' macro qnplot' + write(lun,'(''*'',60(''-''))') + write(lun,'(''* 1=opt 2=sym 3=xmin 4=xmax'', & + & '' 5=ymin 6=ymax 7=size 8=npt'')') + write(lun,'(''*'',60(''-''))') + write(lun,*) ' ' + write(lun,*) ' if [1].eq.h then' + write(lun,'('' mess 1=opt 2=sym 3=xmin 4=xmax'', & + & '' 5=ymin 6=ymax 7=size 8=npt'')') + write(lun,*) ' goto klaar' + write(lun,*) ' elseif [1].eq.s then' + write(lun,*) ' if [8].le.0 goto klaar' + write(lun,*) ' elseif [8].eq.0 then' + write(lun,*) ' goto klaar' + write(lun,*) ' else' + write(lun,*) ' null [3] [4] [5] [6]' + write(lun,*) ' if [8].lt.0 goto klaar' + write(lun,*) ' endif' + write(lun,*) ' if [2].lt.20 then' + write(lun,*) ' set dmod abs([2])' + write(lun,*) ' if [2].gt.0 then' + write(lun,*) ' graph [8] xx yy C' + write(lun,*) ' endif' + write(lun,*) ' if [2].lt.0 then' + write(lun,*) ' sigma up=yy+ey' + write(lun,*) ' sigma dn=yy-ey' + write(lun,*) ' graph [8] xx up C' + write(lun,*) ' graph [8] xx dn C' + write(lun,*) ' endif' + write(lun,*) ' else' + write(lun,*) ' set dmod 1' + write(lun,*) ' hplot/errors xx yy ex ey [8] [2] [7]' + write(lun,*) ' endif' + write(lun,*) ' ' + write(lun,*) ' klaar:' + write(lun,*) ' ' + write(lun,*) ' return' + + endif + + if(nn.le.0) then + + xmin = 0. + xmax = 0. + ymin = 0. + ymax = 0. + + else + + xmin = xx(1) + xmax = xx(1) + ymin = yy(1) + ymax = yy(1) + do i = 2,nn + xmin = min(xmin,xx(i)) + xmax = max(xmax,xx(i)) + ymin = min(ymin,yy(i)) + ymax = max(ymax,yy(i)) + enddo + + dx = xmax-xmin + xmin = xmin-0.1*dx + xmax = xmax+0.1*dx + + dy = ymax-ymin + ymin = ymin-0.1*dy + ymax = ymax+0.1*dy + + endif + + write(lun,*) ' ' + write(lun,'(''*'',60(''-''))') + if(isym.lt.10) then + write(lun,'('' macro '',A,'' 1=n 2='',I1,'' _'')') name,isym + elseif(isym.lt.100) then + write(lun,'('' macro '',A,'' 1=n 2='',I2,'' _'')') name,isym + else + write(lun,'('' macro '',A,'' 1=n 2='',I3,'' _'')') name,isym + endif + if(nn.lt.10) then + write(lun,'('' 3='',E9.3,'' 4='',E9.3, & + & '' 5='',E9.3,'' 6='',E9.3,'' 7=0.28 8='',I1)') & + & xmin,xmax,ymin,ymax,nn + elseif(nn.lt.100) then + write(lun,'('' 3='',E9.3,'' 4='',E9.3, & + & '' 5='',E9.3,'' 6='',E9.3,'' 7=0.28 8='',I2)') & + & xmin,xmax,ymin,ymax,nn + elseif(nn.lt.1000) then + write(lun,'('' 3='',E9.3,'' 4='',E9.3, & + & '' 5='',E9.3,'' 6='',E9.3,'' 7=0.28 8='',I3)') & + & xmin,xmax,ymin,ymax,nn + else + write(lun,'('' 3='',E9.3,'' 4='',E9.3, & + & '' 5='',E9.3,'' 6='',E9.3,'' 7=0.28 8='',I4)') & + & xmin,xmax,ymin,ymax,nn + endif + write(lun,'(''*'',60(''-''))') +! write(lun,*) ' ' + write(lun,'(''* '',A)') text + + if(nn.le.0) goto 500 + + write(lun,*) ' ' + if(nn.le.9) then + write(lun,'('' ve/cr xx('',I1,'') r _'')') nn + elseif(nn.le.99) then + write(lun,'('' ve/cr xx('',I2,'') r _'')') nn + elseif(nn.le.999) then + write(lun,'('' ve/cr xx('',I3,'') r _'')') nn + elseif(nn.le.9999) then + write(lun,'('' ve/cr xx('',I4,'') r _'')') nn + endif + do i1 = 1,nn,6 + i2 = i1+5 + if(i2.lt.nn) then + write(lun,'(6E12.4,'' _'')') (xx(i),i=i1,i2) + else + write(lun,'(6E12.4 )') (xx(i),i=i1,nn) + endif + enddo + +! write(lun,*) ' ' + if(nn.le.9) then + write(lun,'('' ve/cr ex('',I1,'') r '',I1, & + & ''*0'')') nn,nn + elseif(nn.le.99) then + write(lun,'('' ve/cr ex('',I2,'') r '',I2, & + & ''*0'')') nn,nn + elseif(nn.le.999) then + write(lun,'('' ve/cr ex('',I3,'') r '',I3, & + & ''*0'')') nn,nn + elseif(nn.le.9999) then + write(lun,'('' ve/cr ex('',I4,'') r '',I4, & + & ''*0'')') nn,nn + endif + +! write(lun,*) ' ' + if(nn.le.9) then + write(lun,'('' ve/cr yy('',I1,'') r _'')') nn + elseif(nn.le.99) then + write(lun,'('' ve/cr yy('',I2,'') r _'')') nn + elseif(nn.le.999) then + write(lun,'('' ve/cr yy('',I3,'') r _'')') nn + elseif(nn.le.9999) then + write(lun,'('' ve/cr yy('',I4,'') r _'')') nn + endif + do i1 = 1,nn,6 + i2 = i1+5 + if(i2.lt.nn) then + write(lun,'(6E12.4,'' _'')') (yy(i),i=i1,i2) + else + write(lun,'(6E12.4 )') (yy(i),i=i1,nn) + endif + enddo + +! write(lun,*) ' ' + if(nn.le.9) then + write(lun,'('' ve/cr ey('',I1,'') r _'')') nn + elseif(nn.le.99) then + write(lun,'('' ve/cr ey('',I2,'') r _'')') nn + elseif(nn.le.999) then + write(lun,'('' ve/cr ey('',I3,'') r _'')') nn + elseif(nn.le.9999) then + write(lun,'('' ve/cr ey('',I4,'') r _'')') nn + endif + do i1 = 1,nn,6 + i2 = i1+5 + if(i2.lt.nn) then + write(lun,'(6E12.4,'' _'')') (ee(i),i=i1,i2) + else + write(lun,'(6E12.4 )') (ee(i),i=i1,nn) + endif + enddo + + 500 continue + + write(lun,*) ' ' + write(lun,*) ' exec qnplot [1] [2] [3] [4] [5] [6] [7] [8]' + write(lun,*) ' ' + write(lun,*) 'return' + + + return + END + +!DECK ID>, QNSORT. + +! ================================= + SUBROUTINE QNSORT(ARRAY,NIN,NOUT) +! ================================= + +!-- Interface routine to CERN library FLPSOR. +!-- Sorts NIN (< 5000) elements of ARRAY in ascending +!-- order into itself. Identical elements are removed +!-- so that NOUT might be < NIN. In this case the elements +!-- NOUT+1, ..., NIN are set to zero on output. +!-- Note: ARRAY is internally copied to the single precision +!-- array XXX which is copied back again to ARRAY on output. +!-- The double precision thus gets lost. + + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + REAL XXX + + DIMENSION ARRAY(*) + DIMENSION XXX(5000) + + IF(NIN.LE.1) THEN + NOUT = MAX(NIN,0) + RETURN + ENDIF + IF(NIN.GT.5000) THEN + IERR = 1 + GOTO 500 + ENDIF + + DO I = 1,NIN + XXX(I) = ARRAY(I) + ENDDO + + CALL FLPSOR_LHA(XXX,NIN) + + NOUT = 1 + DO I = 2,NIN + IF(XXX(I).GT.XXX(I-1)) THEN + NOUT = NOUT + 1 + XXX(NOUT) = XXX(I) + ENDIF + ENDDO + + DO I = 1,NOUT + ARRAY(I) = XXX(I) + ENDDO + + DO I = NOUT+1,NIN + ARRAY(I) = 0. + ENDDO + + RETURN + + 500 CONTINUE + + WRITE(6,'(/'' ------------------------------------'')') + WRITE(6,'( '' QCDNUM error in s/r QNSORT ---> STOP'')') + WRITE(6,'( '' ------------------------------------'')') + WRITE(6,'( '' Input ARRAY(1) :'',E12.5)') ARRAY(1) + WRITE(6,'( '' NN :'',I12 )') NIN + WRITE(6,'(/'' NN should be .le. 5000'')') + STOP + + END + +!DECK ID>, QNUCPY. + +! ======================== + SUBROUTINE QNUCPY(A,B,N) +! ======================== + + DOUBLE PRECISION A,B + DIMENSION A(*),B(*) + + DO 10 I=1,N + B(I) = A(I) + 10 END DO + + RETURN + END + +!DECK ID>, QNVFIL. + +! ======================== + SUBROUTINE QNVFIL(A,N,V) +! ======================== + + DOUBLE PRECISION A,V + DIMENSION A(*) + + DO 10 I=1,N + A(I) = V + 10 END DO + + RETURN + END +! +!DECK ID>, QNVNUL. + +! ====================== + SUBROUTINE QNVNUL(A,N) +! ====================== + + DOUBLE PRECISION A + DIMENSION A(*) + + DO 10 I=1,N + A(I) = 0. + 10 END DO + + RETURN + END + +!DECK ID>, QNINUL. + +! ======================= + SUBROUTINE QNINUL(IA,N) +! ======================= + + DIMENSION IA(*) + + DO 10 I=1,N + IA(I) = 0 + 10 END DO + + RETURN + END + +!DECK ID>, QNTRUE. + +! ======================= + SUBROUTINE QNTRUE(LA,N) +! ======================= + + LOGICAL LA + DIMENSION LA(*) + + DO 10 I=1,N + LA(I) = .TRUE. + 10 END DO + + RETURN + END + +!DECK ID>, QNFALS. + +! ======================= + SUBROUTINE QNFALS(LA,N) +! ======================= + + LOGICAL LA + DIMENSION LA(*) + + DO 10 I=1,N + LA(I) = .FALSE. + 10 END DO + + RETURN + END + +!DECK ID>, QNVMAX. + +! ==================================== + DOUBLE PRECISION FUNCTION QNVMAX(A,N) +! ==================================== + DOUBLE PRECISION A + DIMENSION A(*) + + QNVMAX = A(1) + IF(N.LE.1) RETURN + DO 10 I=2,N + QNVMAX = MAX(A(I),QNVMAX) + 10 END DO + + RETURN + END + +!DECK ID>, MXDFZE. + +! ==================== + FUNCTION MXDFZE(A,N) +! ==================== + + DOUBLE PRECISION A,V + DIMENSION A(*) + + IF(N.LE.1) THEN + MXDFZE = 1 + ELSE + V = A(1) + DO 10 I=2,N + V = MAX(A(I),V) + 10 CONTINUE + DO 20 I=1,N + IF(A(I).EQ.V) MXDFZE = I + 20 CONTINUE + ENDIF + + RETURN + END + +!DECK ID>, CURRENT_TIME. + +! =============================== + INTEGER FUNCTION CURRENT_TIME() +! =============================== + + COMMON/QCSHIT/T1,T2 + CHARACTER*8 T1,T2 + INTEGER ITIME,D(2),T(2) + + EQUIVALENCE (T1,D) + EQUIVALENCE (T2,T) + + CALL DATIMH_LHA(D,T) + CALL CONV_TIME(T2,ITIME) + + CURRENT_TIME = ITIME + RETURN + END + +!DECK ID>, ELAPSED_TIME. + +! ================================= + INTEGER FUNCTION ELAPSED_TIME(OT) +! ================================= + + EXTERNAL CURRENT_TIME + INTEGER OT,CT,CURRENT_TIME,IHRO,IMINO,ISECO + INTEGER IHRP,IMINP,ISECP,EHR,EMI,ESE + + CT = CURRENT_TIME() + + IHRO = OT/10000 + IMINO = (OT-(IHRO*10000))/100 + ISECO = (OT-(IHRO*10000)-(IMINO*100)) + + IHRP = CT/10000 + IMINP = (CT-(IHRP*10000))/100 + ISECP = (CT-(IHRP*10000)-(IMINP*100)) + + EHR = IHRP-IHRO + IF (EHR.LT.0) EHR = EHR + 24 + EMI = IMINP - IMINO + ESE = ISECP - ISECO + + ELAPSED_TIME = 60*60*EHR + 60*EMI + ESE + RETURN + END + +!DECK ID>, CONV_TIME. + +! ================================ + SUBROUTINE CONV_TIME(TIME,ITIME) +! ================================ + + CHARACTER*8 TIME + INTEGER ITIME,IHRS,IMINS,ISECS + + CALL CONV_LHA(TIME(1:2),IHRS) + CALL CONV_LHA(TIME(4:5),IMINS) + CALL CONV_LHA(TIME(7:8),ISECS) + + ITIME = 10000*IHRS+100*IMINS+ISECS + RETURN + END + +!DECK ID>, CONV. + +! ============================ + SUBROUTINE CONV_LHA(ICHAR,ITIME) +! ============================ +! + CHARACTER*2 ICHAR + CHARACTER*1 IT(0:9) + INTEGER ITIME,I,ITEN,IUNI +! + DATA IT /'0','1','2','3','4','5','6','7','8','9' / + ITEN = 0 + IUNI = 0 + DO I = 0,9 + IF (ICHAR(1:1).EQ.IT(I)) ITEN = I + IF (ICHAR(2:2).EQ.IT(I)) IUNI = I + ENDDO + ITIME = 10*ITEN + IUNI + RETURN + END diff --git a/LHAPDF/lhapdf-5.9.1/src/QCDparams.f b/LHAPDF/lhapdf-5.9.1/src/QCDparams.f new file mode 100644 index 00000000000..ac63416d282 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/QCDparams.f @@ -0,0 +1,137 @@ +! -*- F90 -*- + + +subroutine GetLam4(mem,lam4) + implicit none + integer mem,nset + double precision lam4,lam5 + nset = 1 + call GetLam4M(nset,mem,lam4) + return + + entry GetLam5(mem,lam5) + nset = 1 + call GetLam5M(nset,mem,lam5) + return +end subroutine GetLam4 + + +subroutine GetXmin(mem,xmin) + implicit none + integer mem,nset + double precision xmin,xmax,q2min,q2max + nset = 1 + call GetXminM(nset,mem,xmin) + return + + entry GetXmax(mem,xmax) + nset = 1 + call GetXmaxM(nset,mem,xmax) + return + + entry GetQ2min(mem,q2min) + nset = 1 + call GetQ2minM(nset,mem,q2min) + return + + entry GetQ2max(mem,q2max) + nset = 1 + call GetQ2maxM(nset,mem,q2max) + return + + entry GetMinMax(mem,xmin,xmax,q2min,q2max) + nset = 1 + call GetMinMaxM(nset,mem,xmin,xmax,q2min,q2max) + return +end subroutine GetXmin + + +subroutine initQCDparams(nset) + implicit double precision(a-h,o-z) + include 'parmsetup.inc' + double precision parmQCD(nmxset,0:noemax,2),lam4,lam5 + integer nset + ! integer iset,imem + ! common/SET/iset,imem + save + read(1,*)nmem,nrep + if(nrep.eq.0) then + do i=0,nmem + read(1,*) (parmQCD(nset,i,j),j=1,2) + enddo + else + read(1,*) (parmQCD(nset,0,j),j=1,2) + do i=1,nmem + do j=1,2 + parmQCD(nset,i,j)=parmQCD(nset,0,j) + enddo + enddo + endif + return + + entry GetLam4M(nset,mem,lam4) + lam4 = parmQCD(nset,mem,1) + return + + entry GetLam5M(nset,mem,lam5) + lam5 = parmQCD(nset,mem,2) + return +end subroutine initQCDparams + + +subroutine initMinMax(nset) + implicit double precision(a-h,o-z) + include 'parmsetup.inc' + double precision parmXmin(nmxset,0:noemax),xmin + double precision parmXmax(nmxset,0:noemax),xmax + double precision parmQ2min(nmxset,0:noemax),q2min + double precision parmQ2max(nmxset,0:noemax),q2max + integer nset + save + read(1,*)nmem,nrep + if(nrep.eq.0) then + do i=0,nmem + read(1,*) & + parmXmin(nset,i),& + parmXmax(nset,i),& + parmQ2min(nset,i),& + parmQ2max(nset,i) + enddo + else + read(1,*) & + parmXmin(nset,0),& + parmXmax(nset,0),& + parmQ2min(nset,0),& + parmQ2max(nset,0) + do i=1,nmem + parmXmin(nset,i) = parmXmin(nset,0) + parmXmax(nset,i) = parmXmax(nset,0) + parmQ2min(nset,i) = parmQ2min(nset,0) + parmQ2max(nset,i) = parmQ2max(nset,0) + enddo + endif + return + + entry GetXminM(nset,mem,xmin) + xmin = parmXmin(nset,mem) + return + + entry GetXmaxM(nset,mem,xmax) + xmax = parmXmax(nset,mem) + return + + entry GetQ2minM(nset,mem,q2min) + q2min = parmQ2min(nset,mem) + return + + entry GetQ2maxM(nset,mem,q2max) + q2max = parmQ2max(nset,mem) + return + + entry GetMinMaxM(nset,mem,xmin,xmax,q2min,q2max) + xmin = parmXmin(nset,mem) + xmax = parmXmax(nset,mem) + q2min = parmQ2min(nset,mem) + q2max = parmQ2max(nset,mem) + return +end subroutine initMinMax diff --git a/LHAPDF/lhapdf-5.9.1/src/Smrst-lite.f b/LHAPDF/lhapdf-5.9.1/src/Smrst-lite.f new file mode 100644 index 00000000000..84c6a75fe1d --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/Smrst-lite.f @@ -0,0 +1,239 @@ +! -*- F90 -*- + + subroutine jeppe1(imem,nx,my,xx,yy,ff,cc) + implicit real*8(a-h,o-z) + parameter(nnx=49,mmy=37,nhess=0) + dimension xx(nx),yy(my),ff(nnx,mmy), & + &ff1(nnx,mmy),ff2(nnx,mmy), & + &ff12(nnx,mmy),yy0(4),yy1(4),yy2(4),yy12(4),z(16),wt(16,16), & + &cl(16),cc(0:nhess,nx,my,4,4),iwt(16,16) + + data iwt/1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, & + & 0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0, & + & -3,0,0,3,0,0,0,0,-2,0,0,-1,0,0,0,0, & + & 2,0,0,-2,0,0,0,0,1,0,0,1,0,0,0,0, & + & 0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0, & + & 0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0, & + & 0,0,0,0,-3,0,0,3,0,0,0,0,-2,0,0,-1, & + & 0,0,0,0,2,0,0,-2,0,0,0,0,1,0,0,1, & + & -3,3,0,0,-2,-1,0,0,0,0,0,0,0,0,0,0, & + & 0,0,0,0,0,0,0,0,-3,3,0,0,-2,-1,0,0, & + & 9,-9,9,-9,6,3,-3,-6,6,-6,-3,3,4,2,1,2, & + & -6,6,-6,6,-4,-2,2,4,-3,3,3,-3,-2,-1,-1,-2, & + & 2,-2,0,0,1,1,0,0,0,0,0,0,0,0,0,0, & + & 0,0,0,0,0,0,0,0,2,-2,0,0,1,1,0,0, & + & -6,6,-6,6,-3,-3,3,3,-4,4,2,-2,-2,-2,-1,-1, & + & 4,-4,4,-4,2,2,-2,-2,2,-2,-2,2,1,1,1,1/ + + + do 42 m=1,my + dx=xx(2)-xx(1) + ff1(1,m)=(ff(2,m)-ff(1,m))/dx + dx=xx(nx)-xx(nx-1) + ff1(nx,m)=(ff(nx,m)-ff(nx-1,m))/dx + do 41 n=2,nx-1 + ff1(n,m)=polderiv(xx(n-1),xx(n),xx(n+1),ff(n-1,m),ff(n,m), & + &ff(n+1,m)) + 41 continue + 42 continue + + do 44 n=1,nx + dy=yy(2)-yy(1) + ff2(n,1)=(ff(n,2)-ff(n,1))/dy + dy=yy(my)-yy(my-1) + ff2(n,my)=(ff(n,my)-ff(n,my-1))/dy + do 43 m=2,my-1 + ff2(n,m)=polderiv(yy(m-1),yy(m),yy(m+1),ff(n,m-1),ff(n,m), & + &ff(n,m+1)) + 43 continue + 44 continue + + do 46 m=1,my + dx=xx(2)-xx(1) + ff12(1,m)=(ff2(2,m)-ff2(1,m))/dx + dx=xx(nx)-xx(nx-1) + ff12(nx,m)=(ff2(nx,m)-ff2(nx-1,m))/dx + do 45 n=2,nx-1 + ff12(n,m)=polderiv(xx(n-1),xx(n),xx(n+1),ff2(n-1,m),ff2(n,m), & + &ff2(n+1,m)) + 45 continue + 46 continue + + do 53 n=1,nx-1 + do 52 m=1,my-1 + d1=xx(n+1)-xx(n) + d2=yy(m+1)-yy(m) + d1d2=d1*d2 + + yy0(1)=ff(n,m) + yy0(2)=ff(n+1,m) + yy0(3)=ff(n+1,m+1) + yy0(4)=ff(n,m+1) + + yy1(1)=ff1(n,m) + yy1(2)=ff1(n+1,m) + yy1(3)=ff1(n+1,m+1) + yy1(4)=ff1(n,m+1) + + yy2(1)=ff2(n,m) + yy2(2)=ff2(n+1,m) + yy2(3)=ff2(n+1,m+1) + yy2(4)=ff2(n,m+1) + + yy12(1)=ff12(n,m) + yy12(2)=ff12(n+1,m) + yy12(3)=ff12(n+1,m+1) + yy12(4)=ff12(n,m+1) + + do 47 k=1,4 + z(k)=yy0(k) + z(k+4)=yy1(k)*d1 + z(k+8)=yy2(k)*d2 + z(k+12)=yy12(k)*d1d2 + 47 continue + + do 49 l=1,16 + xxd=0. + do 48 k=1,16 + xxd=xxd+iwt(k,l)*z(k) + 48 continue + cl(l)=xxd + 49 continue + l=0 + do 51 k=1,4 + do 50 j=1,4 + l=l+1 + cc(imem,n,m,k,j)=cl(l) + 50 continue + 51 continue + 52 continue + 53 continue + return + END + + subroutine jeppe2(i,x,y,nx,my,xx,yy,cc,z) +!-- G.W. 02/07/2007 Allow extrapolation to small x and large q. + implicit real*8(a-h,o-z) + parameter(nhess=0) + dimension xx(nx),yy(my),cc(0:nhess,nx,my,4,4) + + n=locx(xx,nx,x) + m=locx(yy,my,y) + + if (n.gt.0.and.n.lt.nx.and.m.gt.0.and.m.lt.my) then +!-- Do usual interpolation. + t=(x-xx(n))/(xx(n+1)-xx(n)) + u=(y-yy(m))/(yy(m+1)-yy(m)) + z=0.d0 + do l=4,1,-1 + z=t*z+((cc(i,n,m,l,4)*u+cc(i,n,m,l,3))*u & + & +cc(i,n,m,l,2))*u+cc(i,n,m,l,1) + enddo + + else if (n.eq.0.and.m.gt.0.and.m.lt.my) then +!-- Extrapolate to small x. + call jeppe3(i,xx(1),y,nx,my,xx,yy,cc,f0) + call jeppe3(i,xx(2),y,nx,my,xx,yy,cc,f1) + if (f0.gt.0.d0.and.f1.gt.0.d0) then + z = exp(log(f0)+(log(f1)-log(f0))/(xx(2)-xx(1))*(x-xx(1))) + else + z = f0+(f1-f0)/(xx(2)-xx(1))*(x-xx(1)) + end if + + else if (n.gt.0.and.m.eq.my) then +!-- Extrapolate to large q. + call jeppe3(i,x,yy(my),nx,my,xx,yy,cc,f0) + call jeppe3(i,x,yy(my-1),nx,my,xx,yy,cc,f1) + if (f0.gt.0.d0.and.f1.gt.0.d0) then + z = exp(log(f0)+(log(f0)-log(f1))/(yy(my)-yy(my-1))* & + & (y-yy(my))) + else + z = f0+(f0-f1)/(yy(my)-yy(my-1))*(y-yy(my)) + end if + + else if (n.eq.0.and.m.eq.my) then +!-- Extrapolate to small x AND large q. + call jeppe3(i,xx(1),yy(my),nx,my,xx,yy,cc,f0) + call jeppe3(i,xx(1),yy(my-1),nx,my,xx,yy,cc,f1) + if (f0.gt.0.d0.and.f1.gt.0.d0) then + z0 = exp(log(f0)+(log(f0)-log(f1))/(yy(my)-yy(my-1))* & + & (y-yy(my))) + else + z0 = f0+(f0-f1)/(yy(my)-yy(my-1))*(y-yy(my)) + end if + call jeppe3(i,xx(2),yy(my),nx,my,xx,yy,cc,f0) + call jeppe3(i,xx(2),yy(my-1),nx,my,xx,yy,cc,f1) + if (f0.gt.0.d0.and.f1.gt.0.d0) then + z1 = exp(log(f0)+(log(f0)-log(f1))/(yy(my)-yy(my-1))* & + & (y-yy(my))) + else + z1 = f0+(f0-f1)/(yy(my)-yy(my-1))*(y-yy(my)) + end if + if (z0.gt.0.d0.and.z1.gt.0.d0) then + z = exp(log(z0)+(log(z1)-log(z0))/(xx(2)-xx(1))*(x-xx(1))) + else + z = z0+(z1-z0)/(xx(2)-xx(1))*(x-xx(1)) + end if + + else +!-- Set parton distribution to zero otherwise. + z = 0.d0 + + end if + + return + END + +!-- G.W. 02/07/2007 Copy of the original jeppe2, +!-- only used for extrapolation. + subroutine jeppe3(i,x,y,nx,my,xx,yy,cc,z) + implicit real*8(a-h,o-z) + parameter(nhess=0) + dimension xx(nx),yy(my),cc(0:nhess,nx,my,4,4) + n=locx(xx,nx,x) + m=locx(yy,my,y) + t=(x-xx(n))/(xx(n+1)-xx(n)) + u=(y-yy(m))/(yy(m+1)-yy(m)) + z=0.d0 + do l=4,1,-1 + z=t*z+((cc(i,n,m,l,4)*u+cc(i,n,m,l,3))*u & + & +cc(i,n,m,l,2))*u+cc(i,n,m,l,1) + enddo + return + END + + integer function locx(xx,nx,x) + implicit real*8(a-h,o-z) + dimension xx(nx) +!$$$ if(x.le.xx(1)) then + ! G.W. 02/07/2007 + if(x.eq.xx(1)) then + locx=1 + return + endif +!$$$ if(x.ge.xx(nx)) then + ! G.W. 02/07/2007 + if(x.eq.xx(nx)) then + locx=nx-1 + return + endif + ju=nx+1 + jl=0 + 1 if((ju-jl).le.1) goto 2 + jm=(ju+jl)/2 + if(x.ge.xx(jm)) then + jl=jm + else + ju=jm + endif + goto 1 + 2 locx=jl + return + END + + real*8 function polderiv(x1,x2,x3,y1,y2,y3) + implicit real*8(a-h,o-z) + polderiv=(x3*x3*(y1-y2)-2.0*x2*(x3*(y1-y2)+x1* & + &(y2-y3))+x2*x2*(y1-y3)+x1*x1*(y2-y3))/((x1-x2)*(x1-x3)*(x2-x3)) + return + END diff --git a/LHAPDF/lhapdf-5.9.1/src/Smrst.f b/LHAPDF/lhapdf-5.9.1/src/Smrst.f new file mode 100644 index 00000000000..e2be0d40f37 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/Smrst.f @@ -0,0 +1,239 @@ +! -*- F90 -*- + + subroutine jeppe1(imem,nx,my,xx,yy,ff,cc) + implicit real*8(a-h,o-z) + parameter(nnx=49,mmy=37,nhess=30) + dimension xx(nx),yy(my),ff(nnx,mmy), & + &ff1(nnx,mmy),ff2(nnx,mmy), & + &ff12(nnx,mmy),yy0(4),yy1(4),yy2(4),yy12(4),z(16),wt(16,16), & + &cl(16),cc(0:nhess,nx,my,4,4),iwt(16,16) + + data iwt/1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, & + & 0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0, & + & -3,0,0,3,0,0,0,0,-2,0,0,-1,0,0,0,0, & + & 2,0,0,-2,0,0,0,0,1,0,0,1,0,0,0,0, & + & 0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0, & + & 0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0, & + & 0,0,0,0,-3,0,0,3,0,0,0,0,-2,0,0,-1, & + & 0,0,0,0,2,0,0,-2,0,0,0,0,1,0,0,1, & + & -3,3,0,0,-2,-1,0,0,0,0,0,0,0,0,0,0, & + & 0,0,0,0,0,0,0,0,-3,3,0,0,-2,-1,0,0, & + & 9,-9,9,-9,6,3,-3,-6,6,-6,-3,3,4,2,1,2, & + & -6,6,-6,6,-4,-2,2,4,-3,3,3,-3,-2,-1,-1,-2, & + & 2,-2,0,0,1,1,0,0,0,0,0,0,0,0,0,0, & + & 0,0,0,0,0,0,0,0,2,-2,0,0,1,1,0,0, & + & -6,6,-6,6,-3,-3,3,3,-4,4,2,-2,-2,-2,-1,-1, & + & 4,-4,4,-4,2,2,-2,-2,2,-2,-2,2,1,1,1,1/ + + + do 42 m=1,my + dx=xx(2)-xx(1) + ff1(1,m)=(ff(2,m)-ff(1,m))/dx + dx=xx(nx)-xx(nx-1) + ff1(nx,m)=(ff(nx,m)-ff(nx-1,m))/dx + do 41 n=2,nx-1 + ff1(n,m)=polderiv(xx(n-1),xx(n),xx(n+1),ff(n-1,m),ff(n,m), & + &ff(n+1,m)) + 41 continue + 42 continue + + do 44 n=1,nx + dy=yy(2)-yy(1) + ff2(n,1)=(ff(n,2)-ff(n,1))/dy + dy=yy(my)-yy(my-1) + ff2(n,my)=(ff(n,my)-ff(n,my-1))/dy + do 43 m=2,my-1 + ff2(n,m)=polderiv(yy(m-1),yy(m),yy(m+1),ff(n,m-1),ff(n,m), & + &ff(n,m+1)) + 43 continue + 44 continue + + do 46 m=1,my + dx=xx(2)-xx(1) + ff12(1,m)=(ff2(2,m)-ff2(1,m))/dx + dx=xx(nx)-xx(nx-1) + ff12(nx,m)=(ff2(nx,m)-ff2(nx-1,m))/dx + do 45 n=2,nx-1 + ff12(n,m)=polderiv(xx(n-1),xx(n),xx(n+1),ff2(n-1,m),ff2(n,m), & + &ff2(n+1,m)) + 45 continue + 46 continue + + do 53 n=1,nx-1 + do 52 m=1,my-1 + d1=xx(n+1)-xx(n) + d2=yy(m+1)-yy(m) + d1d2=d1*d2 + + yy0(1)=ff(n,m) + yy0(2)=ff(n+1,m) + yy0(3)=ff(n+1,m+1) + yy0(4)=ff(n,m+1) + + yy1(1)=ff1(n,m) + yy1(2)=ff1(n+1,m) + yy1(3)=ff1(n+1,m+1) + yy1(4)=ff1(n,m+1) + + yy2(1)=ff2(n,m) + yy2(2)=ff2(n+1,m) + yy2(3)=ff2(n+1,m+1) + yy2(4)=ff2(n,m+1) + + yy12(1)=ff12(n,m) + yy12(2)=ff12(n+1,m) + yy12(3)=ff12(n+1,m+1) + yy12(4)=ff12(n,m+1) + + do 47 k=1,4 + z(k)=yy0(k) + z(k+4)=yy1(k)*d1 + z(k+8)=yy2(k)*d2 + z(k+12)=yy12(k)*d1d2 + 47 continue + + do 49 l=1,16 + xxd=0. + do 48 k=1,16 + xxd=xxd+iwt(k,l)*z(k) + 48 continue + cl(l)=xxd + 49 continue + l=0 + do 51 k=1,4 + do 50 j=1,4 + l=l+1 + cc(imem,n,m,k,j)=cl(l) + 50 continue + 51 continue + 52 continue + 53 continue + return + END + + subroutine jeppe2(i,x,y,nx,my,xx,yy,cc,z) +!-- G.W. 02/07/2007 Allow extrapolation to small x and large q. + implicit real*8(a-h,o-z) + parameter(nhess=30) + dimension xx(nx),yy(my),cc(0:nhess,nx,my,4,4) + + n=locx(xx,nx,x) + m=locx(yy,my,y) + + if (n.gt.0.and.n.lt.nx.and.m.gt.0.and.m.lt.my) then +!-- Do usual interpolation. + t=(x-xx(n))/(xx(n+1)-xx(n)) + u=(y-yy(m))/(yy(m+1)-yy(m)) + z=0.d0 + do l=4,1,-1 + z=t*z+((cc(i,n,m,l,4)*u+cc(i,n,m,l,3))*u & + & +cc(i,n,m,l,2))*u+cc(i,n,m,l,1) + enddo + + else if (n.eq.0.and.m.gt.0.and.m.lt.my) then +!-- Extrapolate to small x. + call jeppe3(i,xx(1),y,nx,my,xx,yy,cc,f0) + call jeppe3(i,xx(2),y,nx,my,xx,yy,cc,f1) + if (f0.gt.0.d0.and.f1.gt.0.d0) then + z = exp(log(f0)+(log(f1)-log(f0))/(xx(2)-xx(1))*(x-xx(1))) + else + z = f0+(f1-f0)/(xx(2)-xx(1))*(x-xx(1)) + end if + + else if (n.gt.0.and.m.eq.my) then +!-- Extrapolate to large q. + call jeppe3(i,x,yy(my),nx,my,xx,yy,cc,f0) + call jeppe3(i,x,yy(my-1),nx,my,xx,yy,cc,f1) + if (f0.gt.0.d0.and.f1.gt.0.d0) then + z = exp(log(f0)+(log(f0)-log(f1))/(yy(my)-yy(my-1))* & + & (y-yy(my))) + else + z = f0+(f0-f1)/(yy(my)-yy(my-1))*(y-yy(my)) + end if + + else if (n.eq.0.and.m.eq.my) then +!-- Extrapolate to small x AND large q. + call jeppe3(i,xx(1),yy(my),nx,my,xx,yy,cc,f0) + call jeppe3(i,xx(1),yy(my-1),nx,my,xx,yy,cc,f1) + if (f0.gt.0.d0.and.f1.gt.0.d0) then + z0 = exp(log(f0)+(log(f0)-log(f1))/(yy(my)-yy(my-1))* & + & (y-yy(my))) + else + z0 = f0+(f0-f1)/(yy(my)-yy(my-1))*(y-yy(my)) + end if + call jeppe3(i,xx(2),yy(my),nx,my,xx,yy,cc,f0) + call jeppe3(i,xx(2),yy(my-1),nx,my,xx,yy,cc,f1) + if (f0.gt.0.d0.and.f1.gt.0.d0) then + z1 = exp(log(f0)+(log(f0)-log(f1))/(yy(my)-yy(my-1))* & + & (y-yy(my))) + else + z1 = f0+(f0-f1)/(yy(my)-yy(my-1))*(y-yy(my)) + end if + if (z0.gt.0.d0.and.z1.gt.0.d0) then + z = exp(log(z0)+(log(z1)-log(z0))/(xx(2)-xx(1))*(x-xx(1))) + else + z = z0+(z1-z0)/(xx(2)-xx(1))*(x-xx(1)) + end if + + else +!-- Set parton distribution to zero otherwise. + z = 0.d0 + + end if + + return + END + +!-- G.W. 02/07/2007 Copy of the original jeppe2, +!-- only used for extrapolation. + subroutine jeppe3(i,x,y,nx,my,xx,yy,cc,z) + implicit real*8(a-h,o-z) + parameter(nhess=30) + dimension xx(nx),yy(my),cc(0:nhess,nx,my,4,4) + n=locx(xx,nx,x) + m=locx(yy,my,y) + t=(x-xx(n))/(xx(n+1)-xx(n)) + u=(y-yy(m))/(yy(m+1)-yy(m)) + z=0.d0 + do l=4,1,-1 + z=t*z+((cc(i,n,m,l,4)*u+cc(i,n,m,l,3))*u & + & +cc(i,n,m,l,2))*u+cc(i,n,m,l,1) + enddo + return + END + + integer function locx(xx,nx,x) + implicit real*8(a-h,o-z) + dimension xx(nx) +!$$$ if(x.le.xx(1)) then + ! G.W. 02/07/2007 + if(x.eq.xx(1)) then + locx=1 + return + endif +!$$$ if(x.ge.xx(nx)) then + ! G.W. 02/07/2007 + if(x.eq.xx(nx)) then + locx=nx-1 + return + endif + ju=nx+1 + jl=0 + 1 if((ju-jl).le.1) goto 2 + jm=(ju+jl)/2 + if(x.ge.xx(jm)) then + jl=jm + else + ju=jm + endif + goto 1 + 2 locx=jl + return + END + + real*8 function polderiv(x1,x2,x3,y1,y2,y3) + implicit real*8(a-h,o-z) + polderiv=(x3*x3*(y1-y2)-2.0*x2*(x3*(y1-y2)+x1* & + &(y2-y3))+x2*x2*(y1-y3)+x1*x1*(y2-y3))/((x1-x2)*(x1-x3)*(x2-x3)) + return + END diff --git a/LHAPDF/lhapdf-5.9.1/src/Sqcdnum.f b/LHAPDF/lhapdf-5.9.1/src/Sqcdnum.f new file mode 100644 index 00000000000..f5c75f8c6de --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/Sqcdnum.f @@ -0,0 +1,585 @@ +! -*- F90 -*- + + +! $Log$ +! Revision 1.3 2005/12/02 14:50:54 whalley +! Changes for new CTEQ code/AB sets +! +! Revision 1.2 2005/10/18 10:34:52 whalley +! small changes from cdf/d0 comments - renamubg conflicting name +! adding pftopdg, etc. +! +! Revision 1.1.1.1 2005/05/06 14:54:44 whalley +! Initial CVS import of the LHAPDF code and data sets +! +! Revision 1.1.1.1 1996/04/01 15:02:05 mclareni +! Mathlib gen +! +! + FUNCTION DDILOG_LHA(X) + implicit real*8 (a-h,o-z) + DIMENSION C(0:19) + PARAMETER (Z1 = 1d0, HF = Z1/2d0) + PARAMETER (PI = 3.14159265358979324D0) + PARAMETER (PI3 = PI**2/3, PI6 = PI**2/6, PI12 = PI**2/12) + + DATA C( 0) / 0.42996693560813697D0/ + DATA C( 1) / 0.40975987533077105D0/ + DATA C( 2) /-0.01858843665014592D0/ + DATA C( 3) / 0.00145751084062268D0/ + DATA C( 4) /-0.00014304184442340D0/ + DATA C( 5) / 0.00001588415541880D0/ + DATA C( 6) /-0.00000190784959387D0/ + DATA C( 7) / 0.00000024195180854D0/ + DATA C( 8) /-0.00000003193341274D0/ + DATA C( 9) / 0.00000000434545063D0/ + DATA C(10) /-0.00000000060578480D0/ + DATA C(11) / 0.00000000008612098D0/ + DATA C(12) /-0.00000000001244332D0/ + DATA C(13) / 0.00000000000182256D0/ + DATA C(14) /-0.00000000000027007D0/ + DATA C(15) / 0.00000000000004042D0/ + DATA C(16) /-0.00000000000000610D0/ + DATA C(17) / 0.00000000000000093D0/ + DATA C(18) /-0.00000000000000014D0/ + DATA C(19) /+0.00000000000000002D0/ + + IF(X .EQ. 1d0) THEN + H=PI6 + ELSEIF(X .EQ. -1d0) THEN + H=-PI12 + ELSE + T=-X + IF(T .LE. -2d0) THEN + Y=-1/(1d0+T) + S=1d0 + A=-PI3+HF*(LOG(-T)**2-LOG(1d0+1d0/T)**2) + ELSEIF(T .LT. -1d0) THEN + Y=-1d0-T + S=-1d0 + A=LOG(-T) + A=-PI6+A*(A+LOG(1d0+1d0/T)) + ELSE IF(T .LE. -HF) THEN + Y=-(1d0+T)/T + S=1d0 + A=LOG(-T) + A=-PI6+A*(-HF*A+LOG(1d0+T)) + ELSE IF(T .LT. 0) THEN + Y=-T/(1d0+T) + S=-1d0 + A=HF*LOG(1d0+T)**2 + ELSE IF(T .LE. 1d0) THEN + Y=T + S=1d0 + A=0d0 + ELSE + Y=1d0/T + S=-1d0 + A=PI6+HF*LOG(T)**2 + ENDIF + H=Y+Y-1 + ALFA=H+H + B1=0 + B2=0 + DO 1 I = 19,0,-1 + B0=C(I)+ALFA*B1-B2 + B2=B1 + 1 B1=B0 + H=-(S*(B0-H*B2)+A) + ENDIF + DDILOG_LHA=H + RETURN + END +! +! $Id: Sqcdnum.f 443 2009-02-10 15:39:06Z buckley $ +! +! $Log$ +! Revision 1.3 2005/12/02 14:50:54 whalley +! Changes for new CTEQ code/AB sets +! +! Revision 1.2 2005/10/18 10:34:52 whalley +! small changes from cdf/d0 comments - renamubg conflicting name +! adding pftopdg, etc. +! +! Revision 1.1.1.1 2005/05/06 14:54:44 whalley +! Initial CVS import of the LHAPDF code and data sets +! +! Revision 1.1.1.1 1996/04/01 15:02:13 mclareni +! Mathlib gen +! +! + FUNCTION DGAUSS_LHA(F,A,B,EPS) + + implicit real*8 (a-h,o-z) + CHARACTER NAME*(*) + PARAMETER (NAME = 'DGAUSS_LHA') + DIMENSION W(12),X(12) + PARAMETER (Z1 = 1d0, HF = Z1/2d0, CST = 5d0*Z1/1000d0) + DATA X & + & /0.96028985649753623168356086856947D0, & + & 0.79666647741362673959155393647583D0, & + & 0.52553240991632898581773904918925D0, & + & 0.18343464249564980493947614236018D0, & + & 0.98940093499164993259615417345033D0, & + & 0.94457502307323257607798841553461D0, & + & 0.86563120238783174388046789771239D0, & + & 0.75540440835500303389510119484744D0, & + & 0.61787624440264374844667176404879D0, & + & 0.45801677765722738634241944298358D0, & + & 0.28160355077925891323046050146050D0, & + & 0.95012509837637440185319335424958D-1/ + + DATA W & + & /0.10122853629037625915253135430996D0, & + & 0.22238103445337447054435599442624D0, & + & 0.31370664587788728733796220198660D0, & + & 0.36268378337836198296515044927720D0, & + & 0.27152459411754094851780572456018D-1, & + & 0.62253523938647892862843836994378D-1, & + & 0.95158511682492784809925107602246D-1, & + & 0.12462897125553387205247628219202D0, & + & 0.14959598881657673208150173054748D0, & + & 0.16915651939500253818931207903036D0, & + & 0.18260341504492358886676366796922D0, & + & 0.18945061045506849628539672320828D0/ + + H=0 + IF(B .EQ. A) GOTO 99 + CONST=CST/ABS(B-A) + BB=A + 1 AA=BB + BB=B + 2 C1=HF*(BB+AA) + C2=HF*(BB-AA) + S8=0 + DO 3 I = 1,4 + U=C2*X(I) + 3 S8=S8+W(I)*(F(C1+U)+F(C1-U)) + S16=0 + DO 4 I = 5,12 + U=C2*X(I) + 4 S16=S16+W(I)*(F(C1+U)+F(C1-U)) + S16=C2*S16 + IF(ABS(S16-C2*S8) .LE. EPS*(1+ABS(S16))) THEN + H=H+S16 + IF(BB .NE. B) GOTO 1 + ELSE + BB=C1 + IF(1+CONST*ABS(C2) .NE. 1) GOTO 2 + H=0 + write(*,*) NAME,'D103.1','TOO HIGH ACCURACY REQUIRED' + GOTO 99 + END IF + 99 DGAUSS_LHA=H + RETURN + END + + SUBROUTINE VZERO_LHA (A,N) +! +! CERN PROGLIB# F121 VZERO .VERSION KERNFOR 4.40 940929 +! ORIG. 01/07/71, modif. 24/05/87 to set integer zero +! modif. 25/05/94 to depend on QINTZERO +! + DIMENSION A(*) + IF (N.LE.0) RETURN + DO 9 I= 1,N + 9 A(I)= 0d0 + RETURN + END + +! +! $Id: Sqcdnum.f 443 2009-02-10 15:39:06Z buckley $ +! +! $Log$ +! Revision 1.3 2005/12/02 14:50:54 whalley +! Changes for new CTEQ code/AB sets +! +! Revision 1.2 2005/10/18 10:34:52 whalley +! small changes from cdf/d0 comments - renamubg conflicting name +! adding pftopdg, etc. +! +! Revision 1.1.1.1 2005/05/06 14:54:44 whalley +! Initial CVS import of the LHAPDF code and data sets +! +! Revision 1.1.1.1 1996/02/15 17:49:49 mclareni +! Kernlib +! +! + FUNCTION LENOCC_LHA (CHV) +! +! CERN PROGLIB# M507 LENOCC .VERSION KERNFOR 4.21 890323 +! ORIG. March 85, A.Petrilli, re-write 21/02/89, JZ +! +!- Find last non-blank character in CHV + + CHARACTER CHV*(*) + + N = LEN(CHV) + + DO 17 JJ= N,1,-1 + IF (CHV(JJ:JJ).NE.' ') GOTO 99 + 17 END DO + JJ = 0 + + 99 LENOCC_LHA = JJ + RETURN + END +! +! $Id: Sqcdnum.f 443 2009-02-10 15:39:06Z buckley $ +! +! $Log$ +! Revision 1.3 2005/12/02 14:50:54 whalley +! Changes for new CTEQ code/AB sets +! +! Revision 1.2 2005/10/18 10:34:52 whalley +! small changes from cdf/d0 comments - renamubg conflicting name +! adding pftopdg, etc. +! +! Revision 1.1.1.1 2005/05/06 14:54:44 whalley +! Initial CVS import of the LHAPDF code and data sets +! +! Revision 1.1.1.1 1996/02/15 17:49:43 mclareni +! Kernlib +! +! + SUBROUTINE CLTOU_LHA (CHV) +! +! CERN PROGLIB# M432 CLTOU .VERSION KERNFOR 4.21 890323 +! ORIG. 11/02/86 A. PETRILLI +! NEW 9/02/89 JZ, for speed +! +!- Convert character string CHV from lower to upper case. + + CHARACTER CHV*(*) + DO 19 JJ=1,LEN(CHV) + J = ICHAR(CHV(JJ:JJ)) + IF (J.LT.97) EXIT + IF (J.GE.123) EXIT + CHV(JJ:JJ) = CHAR(J-32) + 19 END DO + END +! + SUBROUTINE TIMEX_LHA (T) +! +! CERN PROGLIB# Z007 TIMEX DUMMY .VERSION KERNFOR 4.05 821202 +! +!- DUMMY FOR NON-ESSENTIAL ROUTINE STILL MISSING ON YOUR MACHINE + + T = 9. + RETURN + END +! +! $Id: Sqcdnum.f 443 2009-02-10 15:39:06Z buckley $ +! +! $Log$ +! Revision 1.3 2005/12/02 14:50:54 whalley +! Changes for new CTEQ code/AB sets +! +! Revision 1.2 2005/10/18 10:34:52 whalley +! small changes from cdf/d0 comments - renamubg conflicting name +! adding pftopdg, etc. +! +! Revision 1.1.1.1 2005/05/06 14:54:44 whalley +! Initial CVS import of the LHAPDF code and data sets +! +! Revision 1.1.1.1 1996/02/15 17:49:44 mclareni +! Kernlib +! +! + SUBROUTINE FLPSOR_LHA(A,N) +! +! CERN PROGLIB# M103 FLPSOR .VERSION KERNFOR 3.15 820113 +! ORIG. 29/04/78 +! +! SORT THE ONE-DIMENSIONAL FLOATING POINT ARRAY A(1),...,A(N) BY +! INCREASING VALUES +! +!- PROGRAM M103 TAKEN FROM CERN PROGRAM LIBRARY, 29-APR-78 +! + DIMENSION A(N) + COMMON /SLATE/ LT(20),RT(20) + INTEGER R,RT +! + LEVEL=1 + LT(1)=1 + RT(1)=N + 10 L=LT(LEVEL) + R=RT(LEVEL) + LEVEL=LEVEL-1 + 20 IF(R.GT.L) GOTO 200 + IF(LEVEL.LE.0) THEN + GOTO 50 + ELSE + GOTO 10 + ENDIF +! +! SUBDIVIDE THE INTERVAL L,R +! L : LOWER LIMIT OF THE INTERVAL (INPUT) +! R : UPPER LIMIT OF THE INTERVAL (INPUT) +! J : UPPER LIMIT OF LOWER SUB-INTERVAL (OUTPUT) +! I : LOWER LIMIT OF UPPER SUB-INTERVAL (OUTPUT) +! + 200 I=L + J=R + M=(L+R)/2 + X=A(M) + 220 IF(A(I).GE.X) GOTO 230 + I=I+1 + GOTO 220 + 230 IF(A(J).LE.X) GOTO 231 + J=J-1 + GOTO 230 +! + 231 IF(I.GT.J) GOTO 232 + W=A(I) + A(I)=A(J) + A(J)=W + I=I+1 + J=J-1 + IF(I.LE.J) GOTO 220 +! + 232 LEVEL=LEVEL+1 + IF((R-I).GE.(J-L)) GOTO 30 + LT(LEVEL)=L + RT(LEVEL)=J + L=I + GOTO 20 + 30 LT(LEVEL)=I + RT(LEVEL)=R + R=J + GOTO 20 + 50 RETURN + END + + SUBROUTINE DATIMH_LHA (ND,NT) +! +! CERN PROGLIB# Z007 DATIMH DUMMY .VERSION KERNFOR 4.03 821008 +! +!- DUMMY FOR NON-ESSENTIAL ROUTINE STILL MISSING ON YOUR MACHINE + + DIMENSION ND(9), NT(9) +! DIMENSION M(8) + + do i=1,9 + ND(i)=0 + NT(i)=0 + enddo +! CALL UBLOW (8H29/09/79,M,8) +! CALL UBUNCH (M,ND,8) +! CALL UBLOW (8H12.00.00,M,8) +! CALL UBUNCH (M,NT,8) + RETURN + END +!*********************************************************************** +! these next added from CERNLIB to allow some photon and pion sets to wo +! nothing to do with QCDNUM mrw 9/12/2004 +!*********************************************************************** +!* +! $Id: Sqcdnum.f 443 2009-02-10 15:39:06Z buckley $ +! +! $Log$ +! Revision 1.3 2005/12/02 14:50:54 whalley +! Changes for new CTEQ code/AB sets +! +! Revision 1.2 2005/10/18 10:34:52 whalley +! small changes from cdf/d0 comments - renamubg conflicting name +! adding pftopdg, etc. +! +! Revision 1.1.1.1 2005/05/06 14:54:44 whalley +! Initial CVS import of the LHAPDF code and data sets +! +! Revision 1.1.1.1 1996/02/15 17:48:17 mclareni +! Kernlib +! +! + DOUBLE PRECISION FUNCTION DGAMMA_LHA(X) + LOGICAL MFLAG,RFLAG + REAL SX + DOUBLE PRECISION X,U,F,ZERO,ONE,THREE,FOUR,PI + DOUBLE PRECISION C(0:24),H,ALFA,B0,B1,B2 + DATA ZERO /0.0D0/, ONE /1.0D0/, THREE /3.0D0/, FOUR /4.0D0/ +!#if defined(CERNLIB_NUMHIPRE) +! DATA NC /24/ +! DATA PI /3.14159 26535 89793 23846 26433 83D0/ +! DATA C( 0) /3.65738 77250 83382 43849 88068 39D0/ +! DATA C( 1) /1.95754 34566 61268 26928 33742 26D0/ +! DATA C( 2) / .33829 71138 26160 38915 58510 73D0/ +! DATA C( 3) / .04208 95127 65575 49198 51083 97D0/ +! DATA C( 4) / .00428 76504 82129 08770 04289 08D0/ +! DATA C( 5) / .00036 52121 69294 61767 02198 22D0/ +! DATA C( 6) / .00002 74006 42226 42200 27170 66D0/ +! DATA C( 7) / .00000 18124 02333 65124 44603 05D0/ +! DATA C( 8) / .00000 01096 57758 65997 06993 06D0/ +! DATA C( 9) / .00000 00059 87184 04552 00046 95D0/ +! DATA C(10) / .00000 00003 07690 80535 24777 71D0/ +! DATA C(11) / .00000 00000 14317 93029 61915 76D0/ +! DATA C(12) / .00000 00000 00651 08773 34803 70D0/ +! DATA C(13) / .00000 00000 00025 95849 89822 28D0/ +! DATA C(14) / .00000 00000 00001 10789 38922 59D0/ +! DATA C(15) / .00000 00000 00000 03547 43620 17D0/ +! DATA C(16) / .00000 00000 00000 00168 86075 04D0/ +! DATA C(17) / .00000 00000 00000 00002 73543 58D0/ +! DATA C(18) / .00000 00000 00000 00000 30297 74D0/ +! DATA C(19) /-.00000 00000 00000 00000 00571 22D0/ +! DATA C(20) / .00000 00000 00000 00000 00090 77D0/ +! DATA C(21) /-.00000 00000 00000 00000 00005 05D0/ +! DATA C(22) / .00000 00000 00000 00000 00000 41D0/ +! DATA C(23) /-.00000 00000 00000 00000 00000 03D0/ +! DATA C(24) / .00000 00000 00000 00000 00000 01D0/ +!#endif +!#if defined(CERNLIB_NUMLOPRE) + DATA NC /15/ + DATA PI /3.14159265358979324D0/ + DATA C( 0) /3.65738772508338244D0/ + DATA C( 1) /1.95754345666126827D0/ + DATA C( 2) / .33829711382616039D0/ + DATA C( 3) / .04208951276557549D0/ + DATA C( 4) / .00428765048212909D0/ + DATA C( 5) / .00036521216929462D0/ + DATA C( 6) / .00002740064222642D0/ + DATA C( 7) / .00000181240233365D0/ + DATA C( 8) / .00000010965775866D0/ + DATA C( 9) / .00000000598718405D0/ + DATA C(10) / .00000000030769081D0/ + DATA C(11) / .00000000001431793D0/ + DATA C(12) / .00000000000065109D0/ + DATA C(13) / .00000000000002596D0/ + DATA C(14) / .00000000000000111D0/ + DATA C(15) / .00000000000000004D0/ +!#endif + U=X + IF(X .LE. ZERO) THEN + IF(X .EQ. INT(X)) THEN + CALL KERMTR_LHA('C305.1',LGFILE,MFLAG,RFLAG) + IF(MFLAG) THEN + SX=X + IF(LGFILE .EQ. 0) THEN + WRITE(*,100) SX + ELSE + WRITE(LGFILE,100) SX + END IF + END IF + IF(.NOT.RFLAG) CALL ABEND_LHA + DGAMMA_LHA=ZERO + RETURN + ELSE + U=ONE-U + END IF + END IF + F=ONE + IF(U .LT. THREE) THEN + DO 1 I = 1,INT(FOUR-U) + F=F/U + 1 U=U+ONE + ELSE + DO 2 I = 1,INT(U-THREE) + U=U-ONE + 2 F=F*U + END IF + U=U-THREE + H=U+U-ONE + ALFA=H+H + B1=ZERO + B2=ZERO + DO 3 I = NC,0,-1 + B0=C(I)+ALFA*B1-B2 + B2=B1 + 3 B1=B0 + U=F*(B0-H*B2) + IF(X .LT. ZERO) U=PI/(SIN(PI*X)*U) + DGAMMA_LHA=U + RETURN + 100 FORMAT(1X,'DGAMMA ... ARGUMENT IS NON-POSITIVE INTEGER = ',E15.1) + END +!======================================================================= + SUBROUTINE KERSET_LHA(ERCODE,LGFILE,LIMITM,LIMITR) + PARAMETER(KOUNTE = 28) + CHARACTER*6 ERCODE, CODE(KOUNTE) + LOGICAL MFLAG, RFLAG + INTEGER KNTM(KOUNTE), KNTR(KOUNTE) + DATA LOGF / 0 / + DATA CODE(1), KNTM(1), KNTR(1) / 'C204.1', 100, 100 / + DATA CODE(2), KNTM(2), KNTR(2) / 'C204.2', 100, 100 / + DATA CODE(3), KNTM(3), KNTR(3) / 'C204.3', 100, 100 / + DATA CODE(4), KNTM(4), KNTR(4) / 'C205.1', 100, 100 / + DATA CODE(5), KNTM(5), KNTR(5) / 'C205.2', 100, 100 / + DATA CODE(6), KNTM(6), KNTR(6) / 'C205.3', 100, 100 / + DATA CODE(7), KNTM(7), KNTR(7) / 'C305.1', 100, 100 / + DATA CODE(8), KNTM(8), KNTR(8) / 'C308.1', 100, 100 / + DATA CODE(9), KNTM(9), KNTR(9) / 'C312.1', 100, 100 / + DATA CODE(10),KNTM(10),KNTR(10) / 'C313.1', 100, 100 / + DATA CODE(11),KNTM(11),KNTR(11) / 'C336.1', 100, 100 / + DATA CODE(12),KNTM(12),KNTR(12) / 'C337.1', 100, 100 / + DATA CODE(13),KNTM(13),KNTR(13) / 'C341.1', 100, 100 / + DATA CODE(14),KNTM(14),KNTR(14) / 'D103.1', 100, 100 / + DATA CODE(15),KNTM(15),KNTR(15) / 'D106.1', 100, 100 / + DATA CODE(16),KNTM(16),KNTR(16) / 'D209.1', 100, 100 / + DATA CODE(17),KNTM(17),KNTR(17) / 'D509.1', 100, 100 / + DATA CODE(18),KNTM(18),KNTR(18) / 'E100.1', 100, 100 / + DATA CODE(19),KNTM(19),KNTR(19) / 'E104.1', 100, 100 / + DATA CODE(20),KNTM(20),KNTR(20) / 'E105.1', 100, 100 / + DATA CODE(21),KNTM(21),KNTR(21) / 'E208.1', 100, 100 / + DATA CODE(22),KNTM(22),KNTR(22) / 'E208.2', 100, 100 / + DATA CODE(23),KNTM(23),KNTR(23) / 'F010.1', 100, 0 / + DATA CODE(24),KNTM(24),KNTR(24) / 'F011.1', 100, 0 / + DATA CODE(25),KNTM(25),KNTR(25) / 'F012.1', 100, 0 / + DATA CODE(26),KNTM(26),KNTR(26) / 'F406.1', 100, 0 / + DATA CODE(27),KNTM(27),KNTR(27) / 'G100.1', 100, 100 / + DATA CODE(28),KNTM(28),KNTR(28) / 'G100.2', 100, 100 / + LOGF = LGFILE + IF(ERCODE .EQ. ' ') THEN + L = 0 + ELSE + DO 10 L = 1, 6 + IF(ERCODE(1:L) .EQ. ERCODE) GOTO 12 + 10 CONTINUE + 12 CONTINUE + ENDIF + DO 14 I = 1, KOUNTE + IF(L .EQ. 0) GOTO 13 + IF(CODE(I)(1:L) .NE. ERCODE(1:L)) GOTO 14 + 13 KNTM(I) = LIMITM + KNTR(I) = LIMITR + 14 CONTINUE + RETURN + ENTRY KERMTR_LHA(ERCODE,LOG,MFLAG,RFLAG) + LOG = LOGF + DO 20 I = 1, KOUNTE + IF(ERCODE .EQ. CODE(I)) GOTO 21 + 20 CONTINUE + WRITE(*,1000) ERCODE + CALL ABEND_LHA + RETURN + 21 RFLAG = KNTR(I) .GE. 1 + IF(RFLAG .AND. (KNTR(I) .LT. 100)) KNTR(I) = KNTR(I) - 1 + MFLAG = KNTM(I) .GE. 1 + IF(MFLAG .AND. (KNTM(I) .LT. 100)) KNTM(I) = KNTM(I) - 1 + IF(.NOT. RFLAG) THEN + IF(LOGF .LT. 1) THEN + WRITE(*,1001) CODE(I) + ELSE + WRITE(LOGF,1001) CODE(I) + ENDIF + ENDIF + IF(MFLAG .AND. RFLAG) THEN + IF(LOGF .LT. 1) THEN + WRITE(*,1002) CODE(I) + ELSE + WRITE(LOGF,1002) CODE(I) + ENDIF + ENDIF + RETURN + 1000 FORMAT(' KERNLIB LIBRARY ERROR. ' / & + & ' ERROR CODE ',A6,' NOT RECOGNIZED BY KERMTR', & + & ' ERROR MONITOR. RUN ABORTED.') + 1001 FORMAT(/' ***** RUN TERMINATED BY CERN LIBRARY ERROR ', & + & 'CONDITION ',A6) + 1002 FORMAT(/' ***** CERN LIBRARY ERROR CONDITION ',A6) + END +!======================================================================= + SUBROUTINE ABEND_LHA +! +! CERN PROGLIB# Z035 ABEND .VERSION KERNVAX 1.10 811126 + + STOP '*** ABEND ***' + END diff --git a/LHAPDF/lhapdf-5.9.1/src/Szeus.f b/LHAPDF/lhapdf-5.9.1/src/Szeus.f new file mode 100644 index 00000000000..8d73f9c83de --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/Szeus.f @@ -0,0 +1,14 @@ +!----------------------------------------------------------------------- + SUBROUTINE DVZERO (A,N) +! +! CERN PROGLIB# F121 VZERO .VERSION KERNFOR 4.40 940929 +! ORIG. 01/07/71, modif. 24/05/87 to set integer zero +! modif. 25/05/94 to depend on QINTZERO +! + implicit real*8 (a-h,o-z) + DIMENSION A(*) + IF (N.LE.0) RETURN + DO 9 I= 1,N + 9 A(I)= 0d0 + RETURN + END diff --git a/LHAPDF/lhapdf-5.9.1/src/alphas.f b/LHAPDF/lhapdf-5.9.1/src/alphas.f new file mode 100644 index 00000000000..a88113ea6f2 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/alphas.f @@ -0,0 +1,975 @@ +! -*- F90 -*- + + +double precision function alphasPDF(Q) + implicit none + integer nset + double precision Q,a + call getnset(nset) + call evolveAs(nset,Q,a) + alphasPDF=a + return +end function alphasPDF + + +double precision function alphasPDFM(nset,Q) + implicit none + integer nset + double precision Q,a + call evolveAs(nset,Q,a) + alphasPDFM=a + return +end function alphasPDFM + + +subroutine GetQmass(nnf,mass) + implicit none + double precision mass + integer nnf,order,nset + nset = 1 + call GetQmassM(nset,nnf,mass) + return + entry GetOrderAs(order) + nset = 1 + call GetOrderAsM(nset,order) + return +end subroutine GetQmass + + +subroutine evolveAs(nset,Q,alphas) + implicit none + include 'parmsetup.inc' + integer iset,imem + common/SET/iset,imem + integer nset + character*16 s1,s2,s3 + double precision Q,alphas,alfas0,scale0 + double precision Q0(nmxset) + double precision AlfasQ(nmxset) + double precision b0,b1,b2,L,As,mass + double precision CtLhALPI,CtLhAlphaNew,CtLhALPInew,CtLhalgluino + parameter (b0=1.2202,b1=0.4897,b2=0.1913) + integer n!,k + integer order + integer EvlOrd(nmxset) + integer parm(nmxset) + integer Etype(nmxset) + integer Method(nmxset) + integer nnf,naf + double precision cmass(nmxset),bmass(nmxset),tmass(nmxset) + common/masses_LHA/cmass,bmass,tmass + save EvlOrd,parm,Etype,alfasQ,Q0,Method + + call setnset(nset) + + if (method(nset).eq.0) then + if ((Etype(nset).eq.1).or.(Etype(nset).eq.2)) then + L=log(Q/Q0(nset)) + As=alfasQ(nset) + if (Etype(nset).eq.2) call GetParmPDF(nset,parm(nset),As) + if (EvlOrd(nset).eq.0) L=b0*L + if (EvlOrd(nset).eq.1) L=(b0+As*b1)*L + if (EvlOrd(nset).eq.2) L=(b0+As*b1+As**2*b2)*L -0.5*As**2*b0*b1/2d0*L**2 + alphas=As/(1.0+As*L) + endif + endif + if (method(nset).eq.1) then + call alfasevolve(nset,alphas,Q) + elseif (method(nset).eq.2) then + call alphamrs(5,alphas,Q) + elseif (method(nset).eq.3) then + if(Etype(nset).eq.1) alphas = 3.1415926535898d0*CtLhALPI(Q) + if(Etype(nset).eq.2) alphas = 3.1415926535898d0*CtLhALPInew(Q) + elseif (method(nset).eq.4) then + alphas = CtLhAlphaNew(Q) + elseif (method(nset).eq.5) then + call alphamrs(3,alphas,Q) + elseif (method(nset).eq.6) then + call alphamrs(4,alphas,Q) + elseif (method(nset).eq.7) then + call alphacteq5f34(3,alphas,Q) + elseif (method(nset).eq.8) then + call alphacteq5f34(4,alphas,Q) + elseif (method(nset).eq.9) then + alphas = CtLhalgluino(Q) + elseif (method(nset).eq.10) then + call alphacteq4(alphas,Q) + endif + return + + entry GetQmassM(nset,nnf,mass) + n=abs(nnf) + mass=0d0 + if (n.eq.4) mass=cmass(nset) + if (n.eq.5) mass=bmass(nset) + if (n.eq.6) mass=tmass(nset) + return + + entry GetNactive(naf,q) + ! compute nnfn = number of active flavors at scale qin. + n = 3 + if(q .ge. cmass(nset)) n = 4 + if(q .ge. bmass(nset)) n = n + 1 + if(q .ge. tmass(nset)) n = n + 1 + naf = n + return + + entry GetAlfas(nset,alfas0,scale0) + scale0=Q0(nset) + alfas0=alfasQ(nset) + if (Etype(nset).eq.2) call GetParmPDF(nset,parm(nset),alfas0) + return + + entry GetOrderAsM(nset,order) + order=EvlOrd(nset) + return + + entry InitAlphasPDF(nset) + Etype(nset)=-1 + EvlOrd(nset)=-1 + read(1,*) s1,s2,s3 + if (index(s2,'lo').eq.1) EvlOrd(nset)=0 + if (index(s2,'nlo').eq.1) EvlOrd(nset)=1 + if (index(s2,'nnlo').eq.1) EvlOrd(nset)=2 + if (EvlOrd(nset).lt.0) then + write(*,*) 'File description error:' + write(*,*) 'Unknown alpha_s evolution order ',s2 + stop + endif + if (index(s1,'Fixed').eq.1) then + Etype(nset)=1 + parm(nset)=-1 + read(1,*) alfasQ(nset),Q0(nset),cmass(nset),bmass(nset),tmass(nset) + endif + if (index(s1,'Variable').eq.1) then + Etype(nset)=2 + alfasQ(nset)=0d0 + read(1,*) parm(nset),Q0(nset),cmass(nset),bmass(nset),tmass(nset) + endif + if (Etype(nset).lt.0) then + write(*,*) 'File description error:' + write(*,*) 'Unknown alpha_s evolution method ',s1 + stop + endif + Method(nset)=-1 + if (index(s3,'Internal').eq.1) Method(nset)=0 + if (index(s3,'EvolCode').eq.1) Method(nset)=1 + if (index(s3,'MRSTalfa').eq.1) Method(nset)=2 + if (index(s3,'CTEQalfa').eq.1) Method(nset)=3 + if (index(s3,'CTEQABalfa').eq.1) Method(nset)=4 + if (index(s3,'MRST3alfa').eq.1) Method(nset)=5 + if (index(s3,'MRST4alfa').eq.1) Method(nset)=6 + if (index(s3,'CTEQ5F3alfa').eq.1) Method(nset)=7 + if (index(s3,'CTEQ5F4alfa').eq.1) Method(nset)=8 + if (index(s3,'CTEQ6LGalfa').eq.1) Method(nset)=9 + if (index(s3,'CTEQ4alfa').eq.1) Method(nset)=10 + if (index(s3,'CT12alfa').eq.1) Method(nset)=1 + if (Method(nset).lt.0) then + write(*,*) 'File description error:' + write(*,*) 'Unknown alpha_s method ',s3 + stop + endif + return +end subroutine evolveAs + + +subroutine alphamrs(nflav,alpha,Q) + IMPLICIT double precision (a-h,o-z) + include 'parmsetup.inc' + common/SET/iset,imem + common/masses_LHA/cmass(nmxset),bmass(nmxset),tmass(nmxset) + dimension parms(31) + DATA PI/3.14159/ + DATA TOL/.0005/ + data memold/-1/ + integer nset + save alambda,memold + call getnset(nset) + + ! Find alambda corresponding to alphas given in first parameter + call getnmem(nset,imem) + call listPDF(nset,imem,parms) + alphas = parms(1) + memold=imem + qz2=8315. + qz = dsqrt(qz2) + alambda = 0.3000 + astep = 0.010 + tol2 = 0.0000001 + idir = +1 +10 continue + alambda = alambda + idir*astep + call mrslambda(nflav,alpha,qz,alambda) + + if(idir*(alphas-alpha).gt.0.0) then + goto 20 + else + astep = 0.5*astep + idir = -1*idir + goto 20 + endif +20 continue + if(abs(alpha-alphas).gt.tol2) goto 10 + ! alambda found -- save it !!!! + ! next call mrslambda to get alphas at q with the correct alambda + call mrslambda(nflav,alpha,q,alambda) + RETURN +END subroutine alphamrs + + +subroutine rgras(alpha,Q2) + IMPLICIT double precision (a-h,o-z) + !double precision mc,mb,mt + include 'parmsetup.inc' + character*16 name(nmxset) + integer nmem(nmxset),ndef(nmxset),mem + common/NAME/name,nmem,ndef,mem + q=dsqrt(q2) + call getnset(nset) + nflav=5 + if(name(nset).eq.'QCDNUM_MRST3') nflav=3 + if(name(nset).eq.'QCDNUM_MRST4') nflav=4 + call alphamrs(nflav,alpha,Q) + return +end subroutine rgras + + +! new vewrsion of mrslambda 13/5/2004 - includes lo, nlo, and nnlo with flags +subroutine mrslambda(nflav,alpha,Q,alambda) + IMPLICIT DOUBLE PRECISION(A-H,O-Z) + DATA PI/3.14159/ + DATA TOL/.0005/ + ! The value of Lambda required corresponds to nflav=4 + ! iord=0 gives leading order, iord=1 gives NLO, iord=2 gives NNLO + qsdt=8.18 !! This is the value of 4m_c^2 + qsct=74.0 !! This is the value of 4m_b^2 + al2=alambda*alambda + q2=q*q + t=dlog(q2/al2) + + ! CHECK: explicitly initialising ALFQC{3,4,5} (by AB) + ALFQC3 = 0 + ALFQC4 = 0 + ALFQC5 = 0 + + call getnset(nset) + call GetOrderAsM(nset,iord) + ITH=0 + TT=T + qsdtt=qsdt/4. + qsctt=qsct/4. + AL=ALAMBDA + AL2=AL*AL + FLAV=4. + if(nflav.eq.3) flav=3. + QS=AL2*dEXP(T) + + if(qs.lt.0.5d0) then !! running stops below 0.5 + qs=0.5d0 + t=dlog(qs/al2) + tt=t + endif + + IF(QS.gt.QSCTT.and.nflav.gt.4) GOTO 12 + IF(QS.lt.QSDTT.and.nflav.gt.3) GOTO 312 +11 CONTINUE + B0=11-2.*FLAV/3. + X1=4.*PI/B0 + IF(IORD.eq.0) then + ALPHA=X1/T + ELSE + if(iord.gt.1) then + alpha=qwikalf(t,iord,flav) + goto 51 + endif + B1=102.-38.*FLAV/3. + X2=B1/B0**2 + AS2=X1/T*(1.-X2*dLOG(T)/T) +5 AS=AS2 + F=-T+X1/AS-X2*dLOG(X1/AS+X2) + FP=-X1/AS**2*(1.-X2/(X1/AS+X2)) + AS2=AS-F/FP + DEL=ABS(F/FP/AS) + IF((DEL-TOL).GT.0.) goto 5 + ALPHA=AS2 +51 continue + ENDIF + IF(ITH.EQ.0) RETURN + GOTO (13,14,15) ITH + ! GOTO 5 +12 ITH=1 + T=dLOG(QSCTT/AL2) + GOTO 11 +13 ALFQC4=ALPHA + FLAV=5. + ITH=2 + + GOTO 11 +14 ALFQC5=ALPHA + ITH=3 + T=TT + GOTO 11 +15 ALFQS5=ALPHA + ALFINV=1./ALFQS5+1./ALFQC4-1./ALFQC5 + ALPHA=1./ALFINV + RETURN + +311 CONTINUE + B0=11-2.*FLAV/3. + X1=4.*PI/B0 + IF(IORD.eq.0) then + ALPHA=X1/T + + ELSE + if(iord.gt.1) then + alpha=qwikalf(t,iord,flav) + goto 351 + endif + B1=102.-38.*FLAV/3. + X2=B1/B0**2 + AS2=X1/T*(1.-X2*dLOG(T)/T) +35 AS=AS2 + F=-T+X1/AS-X2*dLOG(X1/AS+X2) + FP=-X1/AS**2*(1.-X2/(X1/AS+X2)) + AS2=AS-F/FP + DEL=ABS(F/FP/AS) + IF((DEL-TOL).GT.0.) goto 35 + ALPHA=AS2 + +351 continue + endif + IF(ITH.EQ.0) RETURN + GOTO (313,314,315) ITH +312 ITH=1 + T=dLOG(QSDTT/AL2) + GOTO 311 +313 ALFQC4=ALPHA + FLAV=3. + ITH=2 + GOTO 311 +314 ALFQC3=ALPHA + ITH=3 + T=TT + GOTO 311 +315 ALFQS3=ALPHA + ALFINV=1./ALFQS3+1./ALFQC4-1./ALFQC3 + ALPHA=1./ALFINV + RETURN +END subroutine mrslambda + + +double precision function qwikalf(t,iord,flav) + implicit double precision(a-h,o-z) + dimension z3(6),z4(6),z5(6),zz3(6),zz4(6),zz5(6) + data z3/ -.161667E+01,0.954244E+01,0.768623E+01,0.101523E+00,-.360127E-02,0.457867E-04/ + data z4/ -.172239E+01,0.831185E+01,0.721463E+01,0.835531E-01,-.285436E-02,0.349129E-04/ + data z5/ -.872190E+00,0.572816E+01,0.716119E+01,0.195884E-01,-.300199E-03,0.151741E-05/ + data zz3/-.155611E+02,0.168406E+02,0.603014E+01,0.257682E+00,-.970217E-02,0.127628E-03/ + data zz4/-.106762E+02,0.118497E+02,0.664964E+01,0.112996E+00,-.317551E-02,0.302434E-04/ + data zz5/-.531860E+01,0.708503E+01,0.698352E+01,0.274170E-01,-.426894E-03,0.217591E-05/ + + data pi/3.14159/ + nfm2=flav-2. + x=dsqrt(t) + x2=x*x + x3=x*x2 + x4=x*x3 + x5=x*x4 + goto (1,2) iord +1 goto (3,4,5) nfm2 +3 y=z3(1)+z3(2)*x+z3(3)*x2+z3(4)*x3+z3(5)*x4+z3(6)*x5 + goto 10 +4 y=z4(1)+z4(2)*x+z4(3)*x2+z4(4)*x3+z4(5)*x4+z4(6)*x5 + goto 10 +5 y=z5(1)+z5(2)*x+z5(3)*x2+z5(4)*x3+z5(5)*x4+z5(6)*x5 + goto 10 +2 goto (6,7,8) nfm2 +6 y=zz3(1)+zz3(2)*x+zz3(3)*x2+zz3(4)*x3+zz3(5)*x4+zz3(6)*x5 + goto 10 +7 y=zz4(1)+zz4(2)*x+zz4(3)*x2+zz4(4)*x3+zz4(5)*x4+zz4(6)*x5 + goto 10 +8 y=zz5(1)+zz5(2)*x+zz5(3)*x2+zz5(4)*x3+zz5(5)*x4+zz5(6)*x5 + goto 10 +10 qwikalf=4.*pi/y + return +end function qwikalf + + +!===================================================================== +! alphas routine from PDFLIB +! D OUBLE PRECISION FUNCTION ALPHAS2(SCALE,qcdl5) +subroutine aspdflib(alphas2,SCALE,iord,qcdl5) + implicit double precision (a-h,o-z) + double precision NF + DATA XMC/1.43D0/,XMB/4.30D0/,XMT/100.D0/ + DATA ZEROD/0.D0/,PONED/0.001D0/,ONED/1.D0/,TWOD/2.D0/ + + LO = 1 + if(iord.ne.0) LO = 2 + + TMAS = 180.0d0 + + ALPHAS2 = ZEROD + 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 + + Q = SCALE + XLQ = TWOD * LOG( Q/QCDL5 ) + XLLQ = LOG( XLQ ) + + ! 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 + 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(*,*) 'Error in Alphas2' + STOP + ENDIF + ALPHAS2 = ALF + RETURN +END subroutine aspdflib + + +! ======================================================================== +SUBROUTINE CtLhAlphaNewSET(MC,MB,MT,Q0,ALPHA0,IORDER,IMODE) + ! call to set quark masses for alpha_s, and choose lambda or its + ! equivalent to make alpha_s take the value alpha0 at scale Q0. + IMPLICIT NONE + include 'parmsetup.inc' + DOUBLE PRECISION MC, MB, MT, Q0, ALPHA0 + INTEGER IORDER, IMODE + + DOUBLE PRECISION UDSCBT, QQ0, AALPHA0 + INTEGER IIORDER, IIMODE + COMMON /QMASSES/ UDSCBT(6), IIMODE, IIORDER + COMMON /ALSCALE/ QQ0(nmxset), AALPHA0(nmxset) + integer iset + double precision Adummy(nmxset) + integer Nfl(nmxset), Idummy(nmxset) + common / QCDtable / Adummy, Nfl, Idummy + + call getnset(iset) + + if((imode .lt. 1) .or. (imode .gt. 3)) then + print *,'CtLhAlphaNewSET: fatal imode=',imode + stop + endif + + IIMODE = IMODE + QQ0(iset) = Q0 + AALPHA0(iset) = ALPHA0 + IIORDER = IORDER + + UDSCBT(1) = .005D0 + UDSCBT(2) = .010D0 + UDSCBT(3) = .300D0 + UDSCBT(4) = MC + UDSCBT(5) = MB + UDSCBT(6) = MT + + ! set artificial quark masses, if necessary, in alpha_s to enforce + ! the requested maximum number of flavors... + if(Nfl(iset) .le. 5) UDSCBT(6) = 6.d99 + if(Nfl(iset) .le. 4) UDSCBT(5) = 5.d99 + if(Nfl(iset) .le. 3) UDSCBT(4) = 4.d99 + if(Nfl(iset) .le. 2) UDSCBT(3) = 3.d99 + if(Nfl(iset) .le. 1) UDSCBT(2) = 2.d99 + if(Nfl(iset) .le. 0) UDSCBT(1) = 1.d99 + + RETURN +END SUBROUTINE CtLhAlphaNewSET + + +FUNCTION CtLhAlphaNew(Q) + IMPLICIT NONE + DOUBLE PRECISION CtLhAlphaNew, Q + DOUBLE PRECISION Q2, CtLhQALPHAS, UDSCBT + integer nf,ier + INTEGER IIMODE, IIORDER + COMMON /QMASSES/ UDSCBT(6), IIMODE, IIORDER + if ((iimode .ge. 1) .and. (iimode .le. 3)) then + Q2=Q*Q + nf=6 + if (Q2.lt. UDSCBT(6)**2) nf=5 + if (Q2.lt. UDSCBT(5)**2) nf=4 + if (Q2.lt. UDSCBT(4)**2) nf=3 + if (Q2.lt. UDSCBT(3)**2) nf=2 + if (Q2.lt. UDSCBT(2)**2) nf=1 + if (Q2.lt. UDSCBT(1)**2) nf=0 + + ! external maximum number of flavors -- typically, nfmax=5 so + ! top quark is not a parton even at large Q... + CtLhAlphaNew=CtLhQALPHAS(Q2,nf,ier) + if(ier .ne. 0) then + print *,'warning in CtLhAlphaNew, Q=',Q,' nf=',nf,' ier=',ier,' CtLhAlphaNew=',CtLhAlphaNew + endif + else + print *,'CtLhAlphaNew: undefined mode=',iimode + stop + endif + + return +end FUNCTION CtLhAlphaNew + + +FUNCTION CtLhQALPHAS(QQ2,NF,IERR) + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + include 'parmsetup.inc' + COMMON /ALSCALE/ Q0(nmxset), ALPHA0(nmxset) + COMMON /QMASSES/ UDSCBT(6), IIMODE, IIORDER + + call getnset(iset) + + Q02 = Q0(iset)**2 + ALP0 = ALPHA0(iset) + IOR = IIORDER + + NFFF = NF + CtLhQALPHAS = CtLhA0TOA1(QQ2,Q02,ALP0,IOR,NFFF,IERR) + + RETURN +END FUNCTION CtLhQALPHAS + + +FUNCTION CtLhA0TOA1(QSU,QS0,AS0,IORD,NFF,IERR) + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + COMMON /QMASSES/ UDSCBT(6), IIMODE, IIORDER + QS1 = QSU + QMU0 = SQRT(QS0) + QMU1 = SQRT(QS1) + + ! CHECK: explicit initialisation of NF{0,1} (by AB) + NF0 = 0 + NF1 = 0 + DO I = 1, 6 + IF(QMU0.GE.UDSCBT(I)) NF0 = I + IF(QMU1.GE.UDSCBT(I)) NF1 = I + ENDDO + + IF(NF1.LT.NF0) THEN + IST = -1 + JST = 0 + ELSE + IST = 1 + JST = 1 + ENDIF + + ALFA0 = AS0 + Q00 = QS0 + + IERR = 0 + DO NF = NF0,NF1,IST + IF(NF.NE.NF1) THEN + Q21 = UDSCBT(NF+JST)**2 + ELSE + Q21 = QS1 + ENDIF + IMODE = IIMODE + ALFA1 = CtLhALPHAR(Q21,Q00,ALFA0,NF,IORD,IMODE,JERR) + IERR = IERR + JERR!IERR is sum of all errors + ALFA0 = ALFA1 + Q00 = Q21 + END DO + + CtLhA0TOA1 = ALFA0 + NFF = NF1 + + RETURN +END FUNCTION CtLhA0TOA1 + + +FUNCTION CtLhALPHAR(QSQ,QS0,AS0,NF,IORD,IMODE,IERR) + ! calculate ALPHAS FROM RGE GIVEN AS0 AT QS0. + ! + ! IORD=1: LEADING ORDER DEFINED BY + ! Q*d(alpha)/d(Q) = c1*alpha**2 + ! + ! IORD=2,IMODE=1: QCD NUM CHOICE DEFINED BY + ! Q*d(alpha)/d(Q) = c1*alpha**2 + c2*alpha**3 + ! + ! IORD=2,IMODE=2: AD HOC ALTERNATIVE DEFINED BY + ! Q*d(alpha)/d(Q) = c1*alpha**2 / (1 - (c2/c1)*alpha) + ! + ! IORD=2,IMODE=3: TRADITIONAL CTEQ CHOICE DEFINED BY + ! ALPHA = c3*(1 - c4*log(L)/L)/L, WHERE L=log((Q/lambda)**2) + ! + ! c1 = -beta0/(2*pi) where beta0 = 11. - (2./3.)*nf + ! c2 = -beta1/(8*pi**2) where beta1 = 102. - (38./3.)*nf + ! + ! c3 = -2/c1 + ! c4 = -2*c2/c1**2 + ! + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + + DATA PI / 3.14159265358979d0 / + + BET0 = 11.d0 -(2*NF)/3.d0 + BET1 = 102.d0 - (38*NF)/3.d0 + B0 = BET0/(4.d0*PI) + B1 = BET1/(4.d0*PI*BET0) + IERR = 0 + + TERM0 = 1.d0/AS0+B0*LOG(QSQ/QS0) + IF (TERM0.LE.0.) THEN + CtLhALPHAR = 100. + IERR = 1 + PRINT *,'CtLhALPHAR WARNING: RETURN 100.' + RETURN + ENDIF + ALFA0 = 1.d0/TERM0 + + ! ORDER=1 IS LEADING ORDER, WHICH IS SAME FOR ALL IMODE. + IF (IORD.EQ.1) THEN + CtLhALPHAR = ALFA0 + RETURN + ELSEIF(IORD.NE.2) THEN + PRINT *,'FATAL ERROR: UNDEFINED ORDER IN CtLhALPHAR' + STOP + ENDIF + + + ! QCD NUM CHOICE: Q*d(alpha)/d(Q) = c1*alpha**2 + c2*alpha**3 + IF(IMODE .EQ. 1) THEN + + ! use Newton's method to solve the equation, instead of the + ! simple iterative method used in qcdnum (jcp 9/01) + DO ITER = 1, 20 + ARG = (1.d0/ALFA0+B1)/(1.d0/AS0+B1) + IF(ARG.LE.0.) THEN + CtLhALPHAR = 10. + IERR = 1 + PRINT *,'CtLhALPHAR WARNING: RETURN 10.' + RETURN + ENDIF + + TERM = TERM0 + B1*LOG(ARG) - 1.d0/ALFA0 + ALFA1 = ALFA0/(1.d0 + ALFA0*(1.d0 + B1*ALFA0)*TERM) + + IF(ABS(ALFA1-ALFA0).LT.1.E-12) GOTO 20 + ALFA0 = ALFA1 + ENDDO + + CtLhALPHAR = 10. + IERR = 1 + RETURN + +20 CONTINUE + CtLhALPHAR = ALFA1 + RETURN + + ! AD HOC ALTERNATIVE: Q*d(alpha)/d(Q) = c1*alpha**2 / (1 - (c2/c1)*alpha) + ELSEIF(IMODE .EQ. 2) THEN + + ! first get a good starting point, to be sure Newton's method doesn't go + ! to the wrong root. + BEST = 9.d99 + ! CHECK: adding explicit initialisation of ALBST (by AB) + ALBST = ALFA0 + DO ITRY = 0, 20 + IF(ITRY.NE.0) ALFA0 = (1./B1)*(ITRY-0.5D0)/20.D0 + F = -1.d0/ALFA0 + TERM0 - B1*LOG(ALFA0/AS0) + IF(ABS(F) .LT. BEST) THEN + BEST = ABS(F) + ALBST = ALFA0 + ENDIF + ENDDO + + ALFA0 = ALBST + DO ITER=1, 20 + F = -1.d0/ALFA0 + TERM0 - B1*LOG(ALFA0/AS0) + ALFA1 = ALFA0/(1.d0 + ALFA0*F/(1.d0 - B1*ALFA0)) + IF(ABS(ALFA1-ALFA0) .LT. 1.E-12) GOTO 30 + ALFA0 = ALFA1 + ENDDO + + CtLhALPHAR = 10. + IERR = 1 + RETURN + +30 CONTINUE + CtLhALPHAR = ALFA1 + RETURN + + ! TRADITIONAL CTEQ CHOICE: ALPHA = c3*(1 - c4*log(L)/L)/L, WHERE L=log((Q/lambda)**2) + ELSEIF(IMODE .EQ. 3) THEN + + Z = -LOG(B0*AS0) + TMP = BET1/BET0**2 + + DO ITER = 1, 20 + F = EXP(Z) - (1.D0 - TMP*Z*EXP(-Z))/(B0*AS0) + FPRI = EXP(Z) + TMP*(1.D0-Z)*EXP(-Z)/(B0*AS0) + ZNEW = Z - F/FPRI + IF(ABS(Z-ZNEW) .LT. 1.E-10) GOTO 40 + Z = ZNEW + ENDDO + + CtLhALPHAR = 10. + IERR = 1 + RETURN + +40 CONTINUE + XLAMSQ = QS0 * EXP(-EXP(ZNEW)) + + XL = LOG(QSQ/XLAMSQ) + + ! return a fixed value if no solution... + IF (XL .LE. 0.D0) THEN + CtLhALPHAR = 10.D0 + IERR = 1 + RETURN + ENDIF + + CtLhALPHAR = (1.d0 - TMP*LOG(XL)/XL)/(B0*XL) + + ! place a cutoff if comes out very large... + if (CtLhALPHAR .gt. 10.d0) then + CtLhALPHAR = 10.d0 + IERR = 1 + endif + + RETURN + + ELSE + PRINT *,'FATAL UNDEFINED IMODE=',IMODE + STOP + ENDIF + + RETURN +END FUNCTION CtLhALPHAR + + +FUNCTION CtLhALPInew (AMU) + ! Returns effective g**2/(4pi**2) = alpha/pi. + IMPLICIT DOUBLE PRECISION (A-H, O-Z) + data pi / 3.14159265358979d0 / + q = amu + alpha = CtLhAlphaNew(q) + CtLhalpinew = alpha/pi + RETURN +END FUNCTION CtLhALPInew + + +subroutine CTEQ6NewAlpha(nset,mem) + IMPLICIT DOUBLE PRECISION (A-H, O-Z) + include 'parmsetup.inc' + common / QCDtable / Alambda(nmxset), Nfl(nmxset), Iorder(nmxset) + dimension parms(2) + q0 = 91.188d0 + call listPDF(nset,mem,parms) + alpha0 = parms(1) + ximode = parms(2) + imode = int(ximode) + iiorder = iorder(nset) + + ! ********************************************************** + ! the input data file should probably specify a very large + ! value for xmt, because we never allow top quark as a parton + ! in the PDF fitting, so there are never more than 5 active + ! flavors. Presume it is most consistent therefore to + ! also keep top quark loop out of running of alpha. + ! ********************************************************** + + call GetQmassM(nset,4,cmass) + call GetQmassM(nset,5,bmass) + call GetQmassM(nset,6,tmass) + call CtLhAlphaNewSET(cmass,bmass,tmass,Q0,ALPHA0,IIORDER,IMODE) + RETURN +END subroutine CTEQ6NewAlpha + + +subroutine getnset(nset) + integer iset,nset + save iset + nset = iset + return + + entry setnset(nset) + iset = nset + return +end subroutine getnset + + +subroutine getnmem(nset,nmem) + include 'parmsetup.inc' + integer nmem,nset,member(nmxset) + save member + nmem = member(nset) + return + + entry setnmem(nset,nmem) + member(nset) = nmem + return +end subroutine getnmem + + +subroutine alphacteq5f34(nflav,alphas,q) + IMPLICIT DOUBLE PRECISION (A-H, O-Z) + parameter(pi=3.14159265358979323846d0) + + alphas = pi*CtLhALPI34(nflav,q) + return +end subroutine alphacteq5f34 + + +FUNCTION CtLhALPI34 (nflav,AMU) + IMPLICIT DOUBLE PRECISION (A-H, O-Z) + COMMON / LhCtCWZPRM / ALAM(0:9), AMHAT(0:9), AMN, NHQ + COMMON / LhCtQCDPAR_LHA / AL, NF, NORDER, SET + LOGICAL SET + PARAMETER (D0 = 0.D0, D1 = 1.D0, BIG = 1.0D15) + DATA IW1, IW2 / 2*0 / + IF(.NOT.SET) CALL CtLhLAMCWZ + NEFF = LhCtNFL(AMU) + + if(neff.gt.nflav) neff=nflav + + ALM = ALAM(NEFF) + if(neff.eq.3) alm = 0.395 + if(neff.eq.4) alm = 0.309 + CtLhALPI34 = CtLhALPQCD (NORDER, NEFF, AMU/ALM, IRT) + IF (IRT .EQ. 1) THEN + CALL CtLhWARNR (IW1, 'AMU < ALAM in CtLhALPI34', 'AMU', AMU,ALM, BIG, 1) + ELSEIF (IRT .EQ. 2) THEN + CALL CtLhWARNR(IW2,'CtLhALPI34 > 3; Be aware!','CtLhALPI34',CtLhALPI34, D0, D1, 0) + ENDIF + RETURN +END FUNCTION CtLhALPI34 + +subroutine alphacteq4(alphas,q) + IMPLICIT DOUBLE PRECISION (A-H, O-Z) + parameter(pi=3.14159265358979323846d0) + + alphas = pi*CtLhALPI4(q) + return +end subroutine alphacteq4 + +FUNCTION CtLhALPI4 (AMU) + IMPLICIT DOUBLE PRECISION (A-H, O-Z) + COMMON / LhCtCWZPRM / ALAM(0:9), AMHAT(0:9), AMN, NHQ + COMMON / LhCtQCDPAR_LHA / AL, NF, NORDER, SET + LOGICAL SET + PARAMETER (D0 = 0.D0, D1 = 1.D0, BIG = 1.0D15) + DATA IW1, IW2 / 2*0 / + IF(.NOT.SET) CALL CtLhLAMCWZ + NEFF = LhCtNFL(AMU) + +! ALM = ALAM(NEFF) + call getnset(nset) + call getnmem(nset,nmem) + call getLam5M(nset,nmem,alm) + call getOrderPDFM(nset,norderm) + norderm=norderm+1 + CtLhALPI4 = CtLhALPQCD (NORDERM, NEFF, AMU/ALM, IRT) + IF (IRT .EQ. 1) THEN + CALL CtLhWARNR (IW1, 'AMU < ALAM in CtLhALPI4', 'AMU', AMU,ALM, BIG, 1) + ELSEIF (IRT .EQ. 2) THEN + CALL CtLhWARNR(IW2,'CtLhALPI34 > 3; Be aware!','CtLhALPI4',CtLhALPI4, D0, D1, 0) + ENDIF + RETURN +END FUNCTION CtLhALPI4 + + +function CtLhalgluino(Q) + ! 51 mg=50 GeV WITH TOP MASS OF 174 + ! 52 mg=15 GeV + ! 53 mg=25 GeV + ! 54 mg=35 GeV + ! 55 mg=50 GeV + ! 56 mg=90 GeV + ! 57 mg=100 GeV + ! 58 mg=200 GeV + ! 59 mg=inf GeV + + IMPLICIT DOUBLE PRECISION (A-H, O-Z) + Parameter (nsets=8) + Dimension xmass(6), gArray(nsets), nfArray(nsets) + Dimension xlamStrange(nsets),xlamCharm(nsets),xlamBottom(nsets),xlamGluino(nsets),xlamTop(nsets) + data iorder /2/ + Data xmass / 0.0, 0.0, 0.5d0, 1.3d0, 4.5d0, 174.0d0/ + Data gArray / 15.0d0, 25.0d0, 35.0d0, 50.0d0, 90.0d0, 100.0d0, 200.0d0, 1.0d99/ !*** Last value = Infinity + Data xlamStrange / 0.240257, 0.272782, 0.296194, 0.322873, 0.371374, 0.372537, 0.372537, 0.372537/ + Data xlamCharm / 0.197153, 0.227834, 0.250338, 0.276386, 0.324772, 0.325947, 0.325947, 0.325947/ + Data xlamBottom / 0.128981, 0.151553, 0.168364, 0.188074, 0.225349, 0.226264, 0.226264, 0.226264/ + Data xlamGluino / 0.005, 0.005, 0.005, 0.005, 0.005, 0.00480354, 0.00355387, 0.0/ + + Data xlamTop / 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/ + Data nfArray /5,5,5,5,5,5,5,5/ + + ! 3456789012345678901234567890123456789012345678901234567890123456789012 + + zmass=91.2 + + pi=4.0d0*atan(1.0d0) + + call getnset(iset) + call getnmem(iset,imem) + + nfMax=nfArray(imem) + nf=3 + if(Q.ge.xmass(4)) nf=4 + if(Q.ge.xmass(5)) nf=5 + if(Q.ge.xmass(6)) nf=6 !*** Top for Iset=51 only + if(nf.gt.nfMax) nf=nfMax + + gmass=gArray(imem+1) + ng=0 + if(Q.ge.gmass) ng=1 + + xlam = xlamStrange(imem+1) + if(Q.ge.xmass(4)) xlam = xlamCharm(imem+1) + if(Q.ge.xmass(5)) xlam = xlamBottom(imem+1) + if(Q.ge.gmass ) xlam = xlamGluino(imem+1) + + if((Q.ge.xmass(6)).and.(nfMax.ge.6)) xlam = xlamTop(imem+1) + + nsquark=0 + b0=11. - 2./3.*nf - 2.*ng- 1./6.*nsquark + b1=102.-38./3.*nf-48.*ng-11./3.*nsquark+13./3.*ng*nsquark + if(iorder.eq.1) b1=0 + + xlog=Log(Q**2/xlam**2) + + tmp= 4.*pi*( 1./(b0*xlog) - b1*Log(xlog)/(b0**3*xlog**2)) + + CtLhalgluino=tmp + Return +End function CtLhalgluino diff --git a/LHAPDF/lhapdf-5.9.1/src/binreloc.c b/LHAPDF/lhapdf-5.9.1/src/binreloc.c new file mode 100644 index 00000000000..cb93194e37b --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/binreloc.c @@ -0,0 +1,793 @@ +/* + * BinReloc - a library for creating relocatable executables + * Written by: Hongli Lai + * http://autopackage.org/ + * + * This source code is public domain. You can relicense this code + * under whatever license you want. + * + * See http://autopackage.org/docs/binreloc/ for + * more information and how to use this. + */ + +#ifndef __BINRELOC_C__ +#define __BINRELOC_C__ + +#ifdef ENABLE_BINRELOC + #include + #include + #include +#endif /* ENABLE_BINRELOC */ +#include +#include +#include +#include +#include "binreloc.h" + +#ifdef __cplusplus +extern "C" { +#endif /* __cplusplus */ + +extern char* strdup(const char*); + +/** @internal + * Find the canonical filename of the executable. Returns the filename + * (which must be freed) or NULL on error. If the parameter 'error' is + * not NULL, the error code will be stored there, if an error occured. + */ +static char * +_br_find_exe (BrInitError *error) +{ +#ifndef ENABLE_BINRELOC + if (error) + *error = BR_INIT_ERROR_DISABLED; + return NULL; +#else + char *path, *path2, *line, *result; + size_t buf_size; + ssize_t size; + struct stat stat_buf; + FILE *f; + + /* Read from /proc/self/exe (symlink) */ + if (sizeof (path) > SSIZE_MAX) + buf_size = SSIZE_MAX - 1; + else + buf_size = PATH_MAX - 1; + path = (char *) malloc (buf_size); + if (path == NULL) { + /* Cannot allocate memory. */ + if (error) + *error = BR_INIT_ERROR_NOMEM; + return NULL; + } + path2 = (char *) malloc (buf_size); + if (path2 == NULL) { + /* Cannot allocate memory. */ + if (error) + *error = BR_INIT_ERROR_NOMEM; + free (path); + return NULL; + } + + strncpy (path2, "/proc/self/exe", buf_size - 1); + + while (1) { + int i; + + size = readlink (path2, path, buf_size - 1); + if (size == -1) { + /* Error. */ + free (path2); + break; + } + + /* readlink() success. */ + path[size] = '\0'; + + /* Check whether the symlink's target is also a symlink. + * We want to get the final target. */ + i = stat (path, &stat_buf); + if (i == -1) { + /* Error. */ + free (path2); + break; + } + + /* stat() success. */ + if (!S_ISLNK (stat_buf.st_mode)) { + /* path is not a symlink. Done. */ + free (path2); + return path; + } + + /* path is a symlink. Continue loop and resolve this. */ + strncpy (path, path2, buf_size - 1); + } + + + /* readlink() or stat() failed; this can happen when the program is + * running in Valgrind 2.2. Read from /proc/self/maps as fallback. */ + + buf_size = PATH_MAX + 128; + line = (char *) realloc (path, buf_size); + if (line == NULL) { + /* Cannot allocate memory. */ + free (path); + if (error) + *error = BR_INIT_ERROR_NOMEM; + return NULL; + } + + f = fopen ("/proc/self/maps", "r"); + if (f == NULL) { + free (line); + if (error) + *error = BR_INIT_ERROR_OPEN_MAPS; + return NULL; + } + + /* The first entry should be the executable name. */ + result = fgets (line, (int) buf_size, f); + if (result == NULL) { + fclose (f); + free (line); + if (error) + *error = BR_INIT_ERROR_READ_MAPS; + return NULL; + } + + /* Get rid of newline character. */ + buf_size = strlen (line); + if (buf_size <= 0) { + /* Huh? An empty string? */ + fclose (f); + free (line); + if (error) + *error = BR_INIT_ERROR_INVALID_MAPS; + return NULL; + } + if (line[buf_size - 1] == 10) + line[buf_size - 1] = 0; + + /* Extract the filename; it is always an absolute path. */ + path = strchr (line, '/'); + + /* Sanity check. */ + if (strstr (line, " r-xp ") == NULL || path == NULL) { + fclose (f); + free (line); + if (error) + *error = BR_INIT_ERROR_INVALID_MAPS; + return NULL; + } + + char* oldpath = path; + path = strdup (oldpath); + free (oldpath); + free (line); + fclose (f); + return path; +#endif /* ENABLE_BINRELOC */ +} + + +/** @internal + * Find the canonical filename of the executable which owns symbol. + * Returns a filename which must be freed, or NULL on error. + */ +static char * +_br_find_exe_for_symbol (const void *symbol, BrInitError *error) +{ +#ifndef ENABLE_BINRELOC + if (error) + *error = BR_INIT_ERROR_DISABLED; + return (char *) NULL; +#else + #define SIZE PATH_MAX + 100 + FILE *f; + size_t address_string_len; + char *address_string, line[SIZE], *found; + + if (symbol == NULL) + return (char *) NULL; + + f = fopen ("/proc/self/maps", "r"); + if (f == NULL) + return (char *) NULL; + + address_string_len = 4; + address_string = (char *) malloc (address_string_len); + /* Handle OOM (Tracker issue #35) */ + if (!address_string) + { + if (error) + *error = BR_INIT_ERROR_NOMEM; + return (char *) NULL; + } + found = (char *) NULL; + + while (!feof (f)) { + char *start_addr, *end_addr, *end_addr_end, *file; + void *start_addr_p, *end_addr_p; + size_t len; + + if (fgets (line, SIZE, f) == NULL) + break; + + /* Sanity check. */ + if (strstr (line, " r-xp ") == NULL || strchr (line, '/') == NULL) + continue; + + /* Parse line. */ + start_addr = line; + end_addr = strchr (line, '-'); + file = strchr (line, '/'); + + /* More sanity check. */ + if (!(file > end_addr && end_addr != NULL && end_addr[0] == '-')) + continue; + + end_addr[0] = '\0'; + end_addr++; + end_addr_end = strchr (end_addr, ' '); + if (end_addr_end == NULL) + continue; + + end_addr_end[0] = '\0'; + len = strlen (file); + if (len == 0) + continue; + if (file[len - 1] == '\n') + file[len - 1] = '\0'; + + /* Get rid of "(deleted)" from the filename. */ + len = strlen (file); + if (len > 10 && strcmp (file + len - 10, " (deleted)") == 0) + file[len - 10] = '\0'; + + /* I don't know whether this can happen but better safe than sorry. */ + len = strlen (start_addr); + if (len != strlen (end_addr)) + continue; + + + /* Transform the addresses into a string in the form of 0xdeadbeef, + * then transform that into a pointer. */ + if (address_string_len < len + 3) { + address_string_len = len + 3; + address_string = (char *) realloc (address_string, address_string_len); + /* Handle OOM (Tracker issue #35) */ + if (!address_string) + { + if (error) + *error = BR_INIT_ERROR_NOMEM; + return (char *) NULL; + } + } + + memcpy (address_string, "0x", 2); + memcpy (address_string + 2, start_addr, len); + address_string[2 + len] = '\0'; + sscanf (address_string, "%p", &start_addr_p); + + memcpy (address_string, "0x", 2); + memcpy (address_string + 2, end_addr, len); + address_string[2 + len] = '\0'; + sscanf (address_string, "%p", &end_addr_p); + + + if (symbol >= start_addr_p && symbol < end_addr_p) { + found = file; + break; + } + } + + free (address_string); + fclose (f); + + if (found == NULL) + return (char *) NULL; + else + return strdup (found); +#endif /* ENABLE_BINRELOC */ +} + + +#ifndef BINRELOC_RUNNING_DOXYGEN + #undef NULL + #define NULL ((char *) 0) /* typecasted as char* for C++ type safeness */ +#endif + +static char *exe = (char *) NULL; + + +/** Initialize the BinReloc library (for applications). + * + * This function must be called before using any other BinReloc functions. + * It attempts to locate the application's canonical filename. + * + * @note If you want to use BinReloc for a library, then you should call + * br_init_lib() instead. + * @note Initialization failure is not fatal. BinReloc functions will just + * fallback to the supplied default path. + * + * @param error If BinReloc failed to initialize, then the error code will + * be stored in this variable. Set to NULL if you want to + * ignore this. See #BrInitError for a list of error codes. + * + * @returns 1 on success, 0 if BinReloc failed to initialize. + */ +int +br_init (BrInitError *error) +{ + exe = _br_find_exe (error); + return exe != NULL; +} + + +/** Initialize the BinReloc library (for libraries). + * + * This function must be called before using any other BinReloc functions. + * It attempts to locate the calling library's canonical filename. + * + * @note The BinReloc source code MUST be included in your library, or this + * function won't work correctly. + * @note Initialization failure is not fatal. BinReloc functions will just + * fallback to the supplied default path. + * + * @param error If BinReloc failed to initialize, then the error code will + * be stored in this variable. Set to NULL if you want to + * ignore this. See #BrInitError for a list of error codes. + * + * @returns 1 on success, 0 if a filename cannot be found. + */ +int +br_init_lib (BrInitError *error) +{ + exe = _br_find_exe_for_symbol ((const void *) "", error); + return exe != NULL; +} + + +/** Find the canonical filename of the current application. + * + * @param default_exe A default filename which will be used as fallback. + * @returns A string containing the application's canonical filename, + * which must be freed when no longer necessary. If BinReloc is + * not initialized, or if br_init() failed, then a copy of + * default_exe will be returned. If default_exe is NULL, then + * NULL will be returned. + */ +char * +br_find_exe (const char *default_exe) +{ + if (exe == (char *) NULL) { + /* BinReloc is not initialized. */ + if (default_exe != (const char *) NULL) + return strdup (default_exe); + else + return (char *) NULL; + } + return strdup (exe); +} + + +/** Locate the directory in which the current application is installed. + * + * The prefix is generated by the following pseudo-code evaluation: + * \code + * dirname(exename) + * \endcode + * + * @param default_dir A default directory which will used as fallback. + * @return A string containing the directory, which must be freed when no + * longer necessary. If BinReloc is not initialized, or if the + * initialization function failed, then a copy of default_dir + * will be returned. If default_dir is NULL, then NULL will be + * returned. + */ +char * +br_find_exe_dir (const char *default_dir) +{ + if (exe == NULL) { + /* BinReloc not initialized. */ + if (default_dir != NULL) + return strdup (default_dir); + else + return NULL; + } + + return br_dirname (exe); +} + + +/** Locate the prefix in which the current application is installed. + * + * The prefix is generated by the following pseudo-code evaluation: + * \code + * dirname(dirname(exename)) + * \endcode + * + * @param default_prefix A default prefix which will used as fallback. + * @return A string containing the prefix, which must be freed when no + * longer necessary. If BinReloc is not initialized, or if + * the initialization function failed, then a copy of default_prefix + * will be returned. If default_prefix is NULL, then NULL will be returned. + */ +char * +br_find_prefix (const char *default_prefix) +{ + char *dir1, *dir2; + + if (exe == (char *) NULL) { + /* BinReloc not initialized. */ + if (default_prefix != (const char *) NULL) + return strdup (default_prefix); + else + return (char *) NULL; + } + + dir1 = br_dirname (exe); + dir2 = br_dirname (dir1); + free (dir1); + return dir2; +} + + +/** Locate the application's binary folder. + * + * The path is generated by the following pseudo-code evaluation: + * \code + * prefix + "/bin" + * \endcode + * + * @param default_bin_dir A default path which will used as fallback. + * @return A string containing the bin folder's path, which must be freed when + * no longer necessary. If BinReloc is not initialized, or if + * the initialization function failed, then a copy of default_bin_dir will + * be returned. If default_bin_dir is NULL, then NULL will be returned. + */ +char * +br_find_bin_dir (const char *default_bin_dir) +{ + char *prefix, *dir; + + prefix = br_find_prefix ((const char *) NULL); + if (prefix == (char *) NULL) { + /* BinReloc not initialized. */ + if (default_bin_dir != (const char *) NULL) + return strdup (default_bin_dir); + else + return (char *) NULL; + } + + dir = br_build_path (prefix, "bin"); + free (prefix); + return dir; +} + + +/** Locate the application's superuser binary folder. + * + * The path is generated by the following pseudo-code evaluation: + * \code + * prefix + "/sbin" + * \endcode + * + * @param default_sbin_dir A default path which will used as fallback. + * @return A string containing the sbin folder's path, which must be freed when + * no longer necessary. If BinReloc is not initialized, or if the + * initialization function failed, then a copy of default_sbin_dir will + * be returned. If default_bin_dir is NULL, then NULL will be returned. + */ +char * +br_find_sbin_dir (const char *default_sbin_dir) +{ + char *prefix, *dir; + + prefix = br_find_prefix ((const char *) NULL); + if (prefix == (char *) NULL) { + /* BinReloc not initialized. */ + if (default_sbin_dir != (const char *) NULL) + return strdup (default_sbin_dir); + else + return (char *) NULL; + } + + dir = br_build_path (prefix, "sbin"); + free (prefix); + return dir; +} + + +/** Locate the application's data folder. + * + * The path is generated by the following pseudo-code evaluation: + * \code + * prefix + "/share" + * \endcode + * + * @param default_data_dir A default path which will used as fallback. + * @return A string containing the data folder's path, which must be freed when + * no longer necessary. If BinReloc is not initialized, or if the + * initialization function failed, then a copy of default_data_dir + * will be returned. If default_data_dir is NULL, then NULL will be + * returned. + */ +char * +br_find_data_dir (const char *default_data_dir) +{ + char *prefix, *dir; + + prefix = br_find_prefix ((const char *) NULL); + if (prefix == (char *) NULL) { + /* BinReloc not initialized. */ + if (default_data_dir != (const char *) NULL) + return strdup (default_data_dir); + else + return (char *) NULL; + } + + dir = br_build_path (prefix, "share"); + free (prefix); + return dir; +} + + +/** Locate the application's localization folder. + * + * The path is generated by the following pseudo-code evaluation: + * \code + * prefix + "/share/locale" + * \endcode + * + * @param default_locale_dir A default path which will used as fallback. + * @return A string containing the localization folder's path, which must be freed when + * no longer necessary. If BinReloc is not initialized, or if the + * initialization function failed, then a copy of default_locale_dir will be returned. + * If default_locale_dir is NULL, then NULL will be returned. + */ +char * +br_find_locale_dir (const char *default_locale_dir) +{ + char *data_dir, *dir; + + data_dir = br_find_data_dir ((const char *) NULL); + if (data_dir == (char *) NULL) { + /* BinReloc not initialized. */ + if (default_locale_dir != (const char *) NULL) + return strdup (default_locale_dir); + else + return (char *) NULL; + } + + dir = br_build_path (data_dir, "locale"); + free (data_dir); + return dir; +} + + +/** Locate the application's library folder. + * + * The path is generated by the following pseudo-code evaluation: + * \code + * prefix + "/lib" + * \endcode + * + * @param default_lib_dir A default path which will used as fallback. + * @return A string containing the library folder's path, which must be freed when + * no longer necessary. If BinReloc is not initialized, or if the initialization + * function failed, then a copy of default_lib_dir will be returned. + * If default_lib_dir is NULL, then NULL will be returned. + */ +char * +br_find_lib_dir (const char *default_lib_dir) +{ + char *prefix, *dir; + + prefix = br_find_prefix ((const char *) NULL); + if (prefix == (char *) NULL) { + /* BinReloc not initialized. */ + if (default_lib_dir != (const char *) NULL) + return strdup (default_lib_dir); + else + return (char *) NULL; + } + + dir = br_build_path (prefix, "lib"); + free (prefix); + return dir; +} + + +/** Locate the application's libexec folder. + * + * The path is generated by the following pseudo-code evaluation: + * \code + * prefix + "/libexec" + * \endcode + * + * @param default_libexec_dir A default path which will used as fallback. + * @return A string containing the libexec folder's path, which must be freed when + * no longer necessary. If BinReloc is not initialized, or if the initialization + * function failed, then a copy of default_libexec_dir will be returned. + * If default_libexec_dir is NULL, then NULL will be returned. + */ +char * +br_find_libexec_dir (const char *default_libexec_dir) +{ + char *prefix, *dir; + + prefix = br_find_prefix ((const char *) NULL); + if (prefix == (char *) NULL) { + /* BinReloc not initialized. */ + if (default_libexec_dir != (const char *) NULL) + return strdup (default_libexec_dir); + else + return (char *) NULL; + } + + dir = br_build_path (prefix, "libexec"); + free (prefix); + return dir; +} + + +/** Locate the application's configuration files folder. + * + * The path is generated by the following pseudo-code evaluation: + * \code + * prefix + "/etc" + * \endcode + * + * @param default_etc_dir A default path which will used as fallback. + * @return A string containing the etc folder's path, which must be freed when + * no longer necessary. If BinReloc is not initialized, or if the initialization + * function failed, then a copy of default_etc_dir will be returned. + * If default_etc_dir is NULL, then NULL will be returned. + */ +char * +br_find_etc_dir (const char *default_etc_dir) +{ + char *prefix, *dir; + + prefix = br_find_prefix ((const char *) NULL); + if (prefix == (char *) NULL) { + /* BinReloc not initialized. */ + if (default_etc_dir != (const char *) NULL) + return strdup (default_etc_dir); + else + return (char *) NULL; + } + + dir = br_build_path (prefix, "etc"); + free (prefix); + return dir; +} + + +/*********************** + * Utility functions + ***********************/ + +/** Concatenate str1 and str2 to a newly allocated string. + * + * @param str1 A string. + * @param str2 Another string. + * @returns A newly-allocated string. This string should be freed when no longer needed. + */ +char * +br_strcat (const char *str1, const char *str2) +{ + char *result; + size_t len1, len2; + + if (str1 == NULL) + str1 = ""; + if (str2 == NULL) + str2 = ""; + + len1 = strlen (str1); + len2 = strlen (str2); + + result = (char *) malloc (len1 + len2 + 1); + /* Handle OOM (Tracker issue #35) */ + if (result) + { + memcpy (result, str1, len1); + memcpy (result + len1, str2, len2); + result[len1 + len2] = '\0'; + } + return result; +} + + +char * +br_build_path (const char *dir, const char *file) +{ + char *dir2, *result; + size_t len; + int must_free = 0; + + len = strlen (dir); + if (len > 0 && dir[len - 1] != '/') { + dir2 = br_strcat (dir, "/"); + must_free = 1; + } else + dir2 = (char *) dir; + + result = br_strcat (dir2, file); + if (must_free) + free (dir2); + return result; +} + + +/* Emulates glibc's strndup() */ +static char * +br_strndup (const char *str, size_t size) +{ + char *result = (char *) NULL; + size_t len; + + if (str == (const char *) NULL) + return (char *) NULL; + + len = strlen (str); + if (len == 0) + return strdup (""); + if (size > len) + size = len; + + result = (char *) malloc (len + 1); + /* Handle OOM (Tracker issue #35) */ + if (result) + { + memcpy (result, str, size); + result[size] = '\0'; + } + return result; +} + + +/** Extracts the directory component of a path. + * + * Similar to g_dirname() or the dirname commandline application. + * + * Example: + * \code + * br_dirname ("/usr/local/foobar"); --> Returns: "/usr/local" + * \endcode + * + * @param path A path. + * @returns A directory name. This string should be freed when no longer needed. + */ +char * +br_dirname (const char *path) +{ + char *end, *result; + + if (path == (const char *) NULL) + return (char *) NULL; + + end = strrchr (path, '/'); + if (end == (const char *) NULL) + return strdup ("."); + + while (end > path && *end == '/') + end--; + result = br_strndup (path, end - path + 1); + if (result[0] == 0) { + free (result); + return strdup ("/"); + } else + return result; +} + + +#ifdef __cplusplus +} +#endif /* __cplusplus */ + +#endif /* __BINRELOC_C__ */ diff --git a/LHAPDF/lhapdf-5.9.1/src/binreloc.cxx b/LHAPDF/lhapdf-5.9.1/src/binreloc.cxx new file mode 100644 index 00000000000..2c4c22d5c78 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/binreloc.cxx @@ -0,0 +1,793 @@ +/* + * BinReloc - a library for creating relocatable executables + * Written by: Hongli Lai + * http://autopackage.org/ + * + * This source code is public domain. You can relicense this code + * under whatever license you want. + * + * See http://autopackage.org/docs/binreloc/ for + * more information and how to use this. + */ + +#ifndef __BINRELOC_C__ +#define __BINRELOC_C__ + +#ifdef ENABLE_BINRELOC + #include + #include + #include +#endif /* ENABLE_BINRELOC */ +#include +#include +#include +#include +#include "binreloc.h" + +#ifdef __cplusplus +extern "C" { +#endif /* __cplusplus */ + + + +/** @internal + * Find the canonical filename of the executable. Returns the filename + * (which must be freed) or NULL on error. If the parameter 'error' is + * not NULL, the error code will be stored there, if an error occured. + */ +static char * +_br_find_exe (BrInitError *error) +{ +#ifndef ENABLE_BINRELOC + if (error) + *error = BR_INIT_ERROR_DISABLED; + return NULL; +#else + char *path, *path2, *line, *result; + size_t buf_size; + ssize_t size; + struct stat stat_buf; + FILE *f; + + /* Read from /proc/self/exe (symlink) */ + if (sizeof (path) > SSIZE_MAX) + buf_size = SSIZE_MAX - 1; + else + buf_size = PATH_MAX - 1; + path = (char *) malloc (buf_size); + if (path == NULL) { + /* Cannot allocate memory. */ + if (error) + *error = BR_INIT_ERROR_NOMEM; + return NULL; + } + path2 = (char *) malloc (buf_size); + if (path2 == NULL) { + /* Cannot allocate memory. */ + if (error) + *error = BR_INIT_ERROR_NOMEM; + free (path); + return NULL; + } + + strncpy (path2, "/proc/self/exe", buf_size - 1); + + while (1) { + int i; + + size = readlink (path2, path, buf_size - 1); + if (size == -1) { + /* Error. */ + free (path2); + break; + } + + /* readlink() success. */ + path[size] = '\0'; + + /* Check whether the symlink's target is also a symlink. + * We want to get the final target. */ + i = stat (path, &stat_buf); + if (i == -1) { + /* Error. */ + free (path2); + break; + } + + /* stat() success. */ + if (!S_ISLNK (stat_buf.st_mode)) { + /* path is not a symlink. Done. */ + free (path2); + return path; + } + + /* path is a symlink. Continue loop and resolve this. */ + strncpy (path, path2, buf_size - 1); + } + + + /* readlink() or stat() failed; this can happen when the program is + * running in Valgrind 2.2. Read from /proc/self/maps as fallback. */ + + buf_size = PATH_MAX + 128; + line = (char *) realloc (path, buf_size); + if (line == NULL) { + /* Cannot allocate memory. */ + free (path); + if (error) + *error = BR_INIT_ERROR_NOMEM; + return NULL; + } + + f = fopen ("/proc/self/maps", "r"); + if (f == NULL) { + free (line); + if (error) + *error = BR_INIT_ERROR_OPEN_MAPS; + return NULL; + } + + /* The first entry should be the executable name. */ + result = fgets (line, (int) buf_size, f); + if (result == NULL) { + fclose (f); + free (line); + if (error) + *error = BR_INIT_ERROR_READ_MAPS; + return NULL; + } + + /* Get rid of newline character. */ + buf_size = strlen (line); + if (buf_size <= 0) { + /* Huh? An empty string? */ + fclose (f); + free (line); + if (error) + *error = BR_INIT_ERROR_INVALID_MAPS; + return NULL; + } + if (line[buf_size - 1] == 10) + line[buf_size - 1] = 0; + + /* Extract the filename; it is always an absolute path. */ + path = strchr (line, '/'); + + /* Sanity check. */ + if (strstr (line, " r-xp ") == NULL || path == NULL) { + fclose (f); + free (line); + if (error) + *error = BR_INIT_ERROR_INVALID_MAPS; + return NULL; + } + + char* oldpath = path; + path = strdup (oldpath); + free (oldpath); + free (line); + fclose (f); + return path; +#endif /* ENABLE_BINRELOC */ +} + + +/** @internal + * Find the canonical filename of the executable which owns symbol. + * Returns a filename which must be freed, or NULL on error. + */ +static char * +_br_find_exe_for_symbol (const void *symbol, BrInitError *error) +{ +#ifndef ENABLE_BINRELOC + if (error) + *error = BR_INIT_ERROR_DISABLED; + return (char *) NULL; +#else + #define SIZE PATH_MAX + 100 + FILE *f; + size_t address_string_len; + char *address_string, line[SIZE], *found; + + if (symbol == NULL) + return (char *) NULL; + + f = fopen ("/proc/self/maps", "r"); + if (f == NULL) + return (char *) NULL; + + address_string_len = 4; + address_string = (char *) malloc (address_string_len); + /* Handle OOM (Tracker issue #35) */ + if (!address_string) + { + if (error) + *error = BR_INIT_ERROR_NOMEM; + return (char *) NULL; + } + found = (char *) NULL; + + while (!feof (f)) { + char *start_addr, *end_addr, *end_addr_end, *file; + void *start_addr_p, *end_addr_p; + size_t len; + + if (fgets (line, SIZE, f) == NULL) + break; + + /* Sanity check. */ + if (strstr (line, " r-xp ") == NULL || strchr (line, '/') == NULL) + continue; + + /* Parse line. */ + start_addr = line; + end_addr = strchr (line, '-'); + file = strchr (line, '/'); + + /* More sanity check. */ + if (!(file > end_addr && end_addr != NULL && end_addr[0] == '-')) + continue; + + end_addr[0] = '\0'; + end_addr++; + end_addr_end = strchr (end_addr, ' '); + if (end_addr_end == NULL) + continue; + + end_addr_end[0] = '\0'; + len = strlen (file); + if (len == 0) + continue; + if (file[len - 1] == '\n') + file[len - 1] = '\0'; + + /* Get rid of "(deleted)" from the filename. */ + len = strlen (file); + if (len > 10 && strcmp (file + len - 10, " (deleted)") == 0) + file[len - 10] = '\0'; + + /* I don't know whether this can happen but better safe than sorry. */ + len = strlen (start_addr); + if (len != strlen (end_addr)) + continue; + + + /* Transform the addresses into a string in the form of 0xdeadbeef, + * then transform that into a pointer. */ + if (address_string_len < len + 3) { + address_string_len = len + 3; + address_string = (char *) realloc (address_string, address_string_len); + /* Handle OOM (Tracker issue #35) */ + if (!address_string) + { + if (error) + *error = BR_INIT_ERROR_NOMEM; + return (char *) NULL; + } + } + + memcpy (address_string, "0x", 2); + memcpy (address_string + 2, start_addr, len); + address_string[2 + len] = '\0'; + sscanf (address_string, "%p", &start_addr_p); + + memcpy (address_string, "0x", 2); + memcpy (address_string + 2, end_addr, len); + address_string[2 + len] = '\0'; + sscanf (address_string, "%p", &end_addr_p); + + + if (symbol >= start_addr_p && symbol < end_addr_p) { + found = file; + break; + } + } + + free (address_string); + fclose (f); + + if (found == NULL) + return (char *) NULL; + else + return strdup (found); +#endif /* ENABLE_BINRELOC */ +} + + +#ifndef BINRELOC_RUNNING_DOXYGEN + #undef NULL + #define NULL ((char *) 0) /* typecasted as char* for C++ type safeness */ +#endif + +static char *exe = (char *) NULL; + + +/** Initialize the BinReloc library (for applications). + * + * This function must be called before using any other BinReloc functions. + * It attempts to locate the application's canonical filename. + * + * @note If you want to use BinReloc for a library, then you should call + * br_init_lib() instead. + * @note Initialization failure is not fatal. BinReloc functions will just + * fallback to the supplied default path. + * + * @param error If BinReloc failed to initialize, then the error code will + * be stored in this variable. Set to NULL if you want to + * ignore this. See #BrInitError for a list of error codes. + * + * @returns 1 on success, 0 if BinReloc failed to initialize. + */ +int +br_init (BrInitError *error) +{ + exe = _br_find_exe (error); + return exe != NULL; +} + + +/** Initialize the BinReloc library (for libraries). + * + * This function must be called before using any other BinReloc functions. + * It attempts to locate the calling library's canonical filename. + * + * @note The BinReloc source code MUST be included in your library, or this + * function won't work correctly. + * @note Initialization failure is not fatal. BinReloc functions will just + * fallback to the supplied default path. + * + * @param error If BinReloc failed to initialize, then the error code will + * be stored in this variable. Set to NULL if you want to + * ignore this. See #BrInitError for a list of error codes. + * + * @returns 1 on success, 0 if a filename cannot be found. + */ +int +br_init_lib (BrInitError *error) +{ + exe = _br_find_exe_for_symbol ((const void *) "", error); + return exe != NULL; +} + + +/** Find the canonical filename of the current application. + * + * @param default_exe A default filename which will be used as fallback. + * @returns A string containing the application's canonical filename, + * which must be freed when no longer necessary. If BinReloc is + * not initialized, or if br_init() failed, then a copy of + * default_exe will be returned. If default_exe is NULL, then + * NULL will be returned. + */ +char * +br_find_exe (const char *default_exe) +{ + if (exe == (char *) NULL) { + /* BinReloc is not initialized. */ + if (default_exe != (const char *) NULL) + return strdup (default_exe); + else + return (char *) NULL; + } + return strdup (exe); +} + + +/** Locate the directory in which the current application is installed. + * + * The prefix is generated by the following pseudo-code evaluation: + * \code + * dirname(exename) + * \endcode + * + * @param default_dir A default directory which will used as fallback. + * @return A string containing the directory, which must be freed when no + * longer necessary. If BinReloc is not initialized, or if the + * initialization function failed, then a copy of default_dir + * will be returned. If default_dir is NULL, then NULL will be + * returned. + */ +char * +br_find_exe_dir (const char *default_dir) +{ + if (exe == NULL) { + /* BinReloc not initialized. */ + if (default_dir != NULL) + return strdup (default_dir); + else + return NULL; + } + + return br_dirname (exe); +} + + +/** Locate the prefix in which the current application is installed. + * + * The prefix is generated by the following pseudo-code evaluation: + * \code + * dirname(dirname(exename)) + * \endcode + * + * @param default_prefix A default prefix which will used as fallback. + * @return A string containing the prefix, which must be freed when no + * longer necessary. If BinReloc is not initialized, or if + * the initialization function failed, then a copy of default_prefix + * will be returned. If default_prefix is NULL, then NULL will be returned. + */ +char * +br_find_prefix (const char *default_prefix) +{ + char *dir1, *dir2; + + if (exe == (char *) NULL) { + /* BinReloc not initialized. */ + if (default_prefix != (const char *) NULL) + return strdup (default_prefix); + else + return (char *) NULL; + } + + dir1 = br_dirname (exe); + dir2 = br_dirname (dir1); + free (dir1); + return dir2; +} + + +/** Locate the application's binary folder. + * + * The path is generated by the following pseudo-code evaluation: + * \code + * prefix + "/bin" + * \endcode + * + * @param default_bin_dir A default path which will used as fallback. + * @return A string containing the bin folder's path, which must be freed when + * no longer necessary. If BinReloc is not initialized, or if + * the initialization function failed, then a copy of default_bin_dir will + * be returned. If default_bin_dir is NULL, then NULL will be returned. + */ +char * +br_find_bin_dir (const char *default_bin_dir) +{ + char *prefix, *dir; + + prefix = br_find_prefix ((const char *) NULL); + if (prefix == (char *) NULL) { + /* BinReloc not initialized. */ + if (default_bin_dir != (const char *) NULL) + return strdup (default_bin_dir); + else + return (char *) NULL; + } + + dir = br_build_path (prefix, "bin"); + free (prefix); + return dir; +} + + +/** Locate the application's superuser binary folder. + * + * The path is generated by the following pseudo-code evaluation: + * \code + * prefix + "/sbin" + * \endcode + * + * @param default_sbin_dir A default path which will used as fallback. + * @return A string containing the sbin folder's path, which must be freed when + * no longer necessary. If BinReloc is not initialized, or if the + * initialization function failed, then a copy of default_sbin_dir will + * be returned. If default_bin_dir is NULL, then NULL will be returned. + */ +char * +br_find_sbin_dir (const char *default_sbin_dir) +{ + char *prefix, *dir; + + prefix = br_find_prefix ((const char *) NULL); + if (prefix == (char *) NULL) { + /* BinReloc not initialized. */ + if (default_sbin_dir != (const char *) NULL) + return strdup (default_sbin_dir); + else + return (char *) NULL; + } + + dir = br_build_path (prefix, "sbin"); + free (prefix); + return dir; +} + + +/** Locate the application's data folder. + * + * The path is generated by the following pseudo-code evaluation: + * \code + * prefix + "/share" + * \endcode + * + * @param default_data_dir A default path which will used as fallback. + * @return A string containing the data folder's path, which must be freed when + * no longer necessary. If BinReloc is not initialized, or if the + * initialization function failed, then a copy of default_data_dir + * will be returned. If default_data_dir is NULL, then NULL will be + * returned. + */ +char * +br_find_data_dir (const char *default_data_dir) +{ + char *prefix, *dir; + + prefix = br_find_prefix ((const char *) NULL); + if (prefix == (char *) NULL) { + /* BinReloc not initialized. */ + if (default_data_dir != (const char *) NULL) + return strdup (default_data_dir); + else + return (char *) NULL; + } + + dir = br_build_path (prefix, "share"); + free (prefix); + return dir; +} + + +/** Locate the application's localization folder. + * + * The path is generated by the following pseudo-code evaluation: + * \code + * prefix + "/share/locale" + * \endcode + * + * @param default_locale_dir A default path which will used as fallback. + * @return A string containing the localization folder's path, which must be freed when + * no longer necessary. If BinReloc is not initialized, or if the + * initialization function failed, then a copy of default_locale_dir will be returned. + * If default_locale_dir is NULL, then NULL will be returned. + */ +char * +br_find_locale_dir (const char *default_locale_dir) +{ + char *data_dir, *dir; + + data_dir = br_find_data_dir ((const char *) NULL); + if (data_dir == (char *) NULL) { + /* BinReloc not initialized. */ + if (default_locale_dir != (const char *) NULL) + return strdup (default_locale_dir); + else + return (char *) NULL; + } + + dir = br_build_path (data_dir, "locale"); + free (data_dir); + return dir; +} + + +/** Locate the application's library folder. + * + * The path is generated by the following pseudo-code evaluation: + * \code + * prefix + "/lib" + * \endcode + * + * @param default_lib_dir A default path which will used as fallback. + * @return A string containing the library folder's path, which must be freed when + * no longer necessary. If BinReloc is not initialized, or if the initialization + * function failed, then a copy of default_lib_dir will be returned. + * If default_lib_dir is NULL, then NULL will be returned. + */ +char * +br_find_lib_dir (const char *default_lib_dir) +{ + char *prefix, *dir; + + prefix = br_find_prefix ((const char *) NULL); + if (prefix == (char *) NULL) { + /* BinReloc not initialized. */ + if (default_lib_dir != (const char *) NULL) + return strdup (default_lib_dir); + else + return (char *) NULL; + } + + dir = br_build_path (prefix, "lib"); + free (prefix); + return dir; +} + + +/** Locate the application's libexec folder. + * + * The path is generated by the following pseudo-code evaluation: + * \code + * prefix + "/libexec" + * \endcode + * + * @param default_libexec_dir A default path which will used as fallback. + * @return A string containing the libexec folder's path, which must be freed when + * no longer necessary. If BinReloc is not initialized, or if the initialization + * function failed, then a copy of default_libexec_dir will be returned. + * If default_libexec_dir is NULL, then NULL will be returned. + */ +char * +br_find_libexec_dir (const char *default_libexec_dir) +{ + char *prefix, *dir; + + prefix = br_find_prefix ((const char *) NULL); + if (prefix == (char *) NULL) { + /* BinReloc not initialized. */ + if (default_libexec_dir != (const char *) NULL) + return strdup (default_libexec_dir); + else + return (char *) NULL; + } + + dir = br_build_path (prefix, "libexec"); + free (prefix); + return dir; +} + + +/** Locate the application's configuration files folder. + * + * The path is generated by the following pseudo-code evaluation: + * \code + * prefix + "/etc" + * \endcode + * + * @param default_etc_dir A default path which will used as fallback. + * @return A string containing the etc folder's path, which must be freed when + * no longer necessary. If BinReloc is not initialized, or if the initialization + * function failed, then a copy of default_etc_dir will be returned. + * If default_etc_dir is NULL, then NULL will be returned. + */ +char * +br_find_etc_dir (const char *default_etc_dir) +{ + char *prefix, *dir; + + prefix = br_find_prefix ((const char *) NULL); + if (prefix == (char *) NULL) { + /* BinReloc not initialized. */ + if (default_etc_dir != (const char *) NULL) + return strdup (default_etc_dir); + else + return (char *) NULL; + } + + dir = br_build_path (prefix, "etc"); + free (prefix); + return dir; +} + + +/*********************** + * Utility functions + ***********************/ + +/** Concatenate str1 and str2 to a newly allocated string. + * + * @param str1 A string. + * @param str2 Another string. + * @returns A newly-allocated string. This string should be freed when no longer needed. + */ +char * +br_strcat (const char *str1, const char *str2) +{ + char *result; + size_t len1, len2; + + if (str1 == NULL) + str1 = ""; + if (str2 == NULL) + str2 = ""; + + len1 = strlen (str1); + len2 = strlen (str2); + + result = (char *) malloc (len1 + len2 + 1); + /* Handle OOM (Tracker issue #35) */ + if (result) + { + memcpy (result, str1, len1); + memcpy (result + len1, str2, len2); + result[len1 + len2] = '\0'; + } + return result; +} + + +char * +br_build_path (const char *dir, const char *file) +{ + char *dir2, *result; + size_t len; + int must_free = 0; + + len = strlen (dir); + if (len > 0 && dir[len - 1] != '/') { + dir2 = br_strcat (dir, "/"); + must_free = 1; + } else + dir2 = (char *) dir; + + result = br_strcat (dir2, file); + if (must_free) + free (dir2); + return result; +} + + +/* Emulates glibc's strndup() */ +static char * +br_strndup (const char *str, size_t size) +{ + char *result = (char *) NULL; + size_t len; + + if (str == (const char *) NULL) + return (char *) NULL; + + len = strlen (str); + if (len == 0) + return strdup (""); + if (size > len) + size = len; + + result = (char *) malloc (len + 1); + /* Handle OOM (Tracker issue #35) */ + if (result) + { + memcpy (result, str, size); + result[size] = '\0'; + } + return result; +} + + +/** Extracts the directory component of a path. + * + * Similar to g_dirname() or the dirname commandline application. + * + * Example: + * \code + * br_dirname ("/usr/local/foobar"); --> Returns: "/usr/local" + * \endcode + * + * @param path A path. + * @returns A directory name. This string should be freed when no longer needed. + */ +char * +br_dirname (const char *path) +{ + char *end, *result; + + if (path == (const char *) NULL) + return (char *) NULL; + + end = strrchr (path, '/'); + if (end == (const char *) NULL) + return strdup ("."); + + while (end > path && *end == '/') + end--; + result = br_strndup (path, end - path + 1); + if (result[0] == 0) { + free (result); + return strdup ("/"); + } else + return result; +} + + +#ifdef __cplusplus +} +#endif /* __cplusplus */ + +#endif /* __BINRELOC_C__ */ diff --git a/LHAPDF/lhapdf-5.9.1/src/binreloc.h b/LHAPDF/lhapdf-5.9.1/src/binreloc.h new file mode 100644 index 00000000000..ba34c42fc9d --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/binreloc.h @@ -0,0 +1,81 @@ +/* + * BinReloc - a library for creating relocatable executables + * Written by: Hongli Lai + * http://autopackage.org/ + * + * This source code is public domain. You can relicense this code + * under whatever license you want. + * + * See http://autopackage.org/docs/binreloc/ for + * more information and how to use this. + */ + +#ifndef __BINRELOC_H__ +#define __BINRELOC_H__ + +#ifdef __cplusplus +extern "C" { +#endif /* __cplusplus */ + + +/** These error codes can be returned by br_init(), br_init_lib(), gbr_init() or gbr_init_lib(). */ +typedef enum { + /** Cannot allocate memory. */ + BR_INIT_ERROR_NOMEM, + /** Unable to open /proc/self/maps; see errno for details. */ + BR_INIT_ERROR_OPEN_MAPS, + /** Unable to read from /proc/self/maps; see errno for details. */ + BR_INIT_ERROR_READ_MAPS, + /** The file format of /proc/self/maps is invalid; kernel bug? */ + BR_INIT_ERROR_INVALID_MAPS, + /** BinReloc is disabled (the ENABLE_BINRELOC macro is not defined). */ + BR_INIT_ERROR_DISABLED +} BrInitError; + + +#ifndef BINRELOC_RUNNING_DOXYGEN + /* Mangle symbol names to avoid symbol + * collisions with other ELF objects. + */ + #define br_init rBve99009253050923_br_init + #define br_init_lib rBve99009253050923_br_init_lib + #define br_find_exe rBve99009253050923_br_find_exe + #define br_find_exe_dir rBve99009253050923_br_find_exe_dir + #define br_find_prefix rBve99009253050923_br_find_prefix + #define br_find_bin_dir rBve99009253050923_br_find_bin_dir + #define br_find_sbin_dir rBve99009253050923_br_find_sbin_dir + #define br_find_data_dir rBve99009253050923_br_find_data_dir + #define br_find_locale_dir rBve99009253050923_br_find_locale_dir + #define br_find_lib_dir rBve99009253050923_br_find_lib_dir + #define br_find_libexec_dir rBve99009253050923_br_find_libexec_dir + #define br_find_etc_dir rBve99009253050923_br_find_etc_dir + #define br_strcat rBve99009253050923_br_strcat + #define br_build_path rBve99009253050923_br_build_path + #define br_dirname rBve99009253050923_br_dirname +#endif + +int br_init (BrInitError *error); +int br_init_lib (BrInitError *error); + +char *br_find_exe (const char *default_exe); +char *br_find_exe_dir (const char *default_dir); +char *br_find_prefix (const char *default_prefix); +char *br_find_bin_dir (const char *default_bin_dir); +char *br_find_sbin_dir (const char *default_sbin_dir); +char *br_find_data_dir (const char *default_data_dir); +char *br_find_locale_dir (const char *default_locale_dir); +char *br_find_lib_dir (const char *default_lib_dir); +char *br_find_libexec_dir (const char *default_libexec_dir); +char *br_find_etc_dir (const char *default_etc_dir); + +/* Utility functions */ +char *br_strcat (const char *str1, const char *str2); +char *br_build_path (const char *dir, const char *file); +char *br_dirname (const char *path); + + +#ifdef __cplusplus +} +#endif /* __cplusplus */ + +#endif /* __BINRELOC_H__ */ diff --git a/LHAPDF/lhapdf-5.9.1/src/common.inc b/LHAPDF/lhapdf-5.9.1/src/common.inc new file mode 100644 index 00000000000..1ee68a56395 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/common.inc @@ -0,0 +1,7 @@ +! Shortcut include for all LHAPDF steering common blocks +!include 'parmsetup.inc' +include 'commonlhacontrol.inc' +include 'commonlhaglsta.inc' +include 'commonlhapdfc.inc' +include 'commonlhapdf.inc' +include 'commonlhasets.inc' diff --git a/LHAPDF/lhapdf-5.9.1/src/commoninit.f b/LHAPDF/lhapdf-5.9.1/src/commoninit.f new file mode 100644 index 00000000000..a98aa7ddffc --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/commoninit.f @@ -0,0 +1,48 @@ +! -*- F90 -*- + + +subroutine commoninit() + include 'common.inc' + integer i + + if (commoninitflag .ne. 'commonblockinitdone') then + !print *, "Initialising LHAPDF steering data" + commoninitflag = 'commonblockinitdone' + + ! LHAPDF common block + lhaname = ' ' + lhaset = 0 + lhamemb = 0 + + ! LHASETS common block + do i = 1, nmxset + lhanames(i) = ' ' + lhanumbers(i) = 0 + lhamembers(i) = 0 + end do + nsets = 0 + + ! LHAPDFC common block + lhapath = 'pdfsets' + + ! LHACONTROL common block + + do i = 1, 20 + lhaparm(i) = ' ' + lhavalue(i) = 0.0d0 + end do + + ! LHAGLSTA common block + xminnum = 0.0d0 + xmaxnum = 0.0d0 + q2minnum = 0.0d0 + q2maxnum = 0.0d0 + totnum = 0.0d0 + xminnup = 0.0d0 + xmaxnup = 0.0d0 + q2minnup = 0.0d0 + q2maxnup = 0.0d0 + totnup = 0.0d0 + end if + +end subroutine commoninit diff --git a/LHAPDF/lhapdf-5.9.1/src/commonlhacontrol.inc b/LHAPDF/lhapdf-5.9.1/src/commonlhacontrol.inc new file mode 100644 index 00000000000..32d92387ccb --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/commonlhacontrol.inc @@ -0,0 +1,7 @@ +! LHACONTROL common block +!implicit none +character*20 lhaparm(20) +double precision lhavalue(20) +character*20 commoninitflag +common /lhacontrol/ lhaparm, lhavalue, commoninitflag +save /lhacontrol/ diff --git a/LHAPDF/lhapdf-5.9.1/src/commonlhaglsta.inc b/LHAPDF/lhapdf-5.9.1/src/commonlhaglsta.inc new file mode 100644 index 00000000000..c3a10f6a26d --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/commonlhaglsta.inc @@ -0,0 +1,10 @@ +! LHAGLSTA common block +!implicit none +double precision xminnum, xmaxnum +double precision q2minnum, q2maxnum +double precision totnum +double precision xminnup, xmaxnup +double precision q2minnup, q2maxnup +double precision totnup +common /lhaglsta/ xminnum, xmaxnum, q2minnum, q2maxnum, totnum, xminnup, xmaxnup, q2minnup, q2maxnup, totnup +save /lhaglsta/ diff --git a/LHAPDF/lhapdf-5.9.1/src/commonlhapdf.inc b/LHAPDF/lhapdf-5.9.1/src/commonlhapdf.inc new file mode 100644 index 00000000000..2b4dc5ffbc3 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/commonlhapdf.inc @@ -0,0 +1,6 @@ +! LHAPDF common block +!implicit none +character*1024 lhaname +integer lhaset, lhamemb +common /lhapdf/ lhaname, lhaset, lhamemb +save /lhapdf/ diff --git a/LHAPDF/lhapdf-5.9.1/src/commonlhapdfc.inc b/LHAPDF/lhapdf-5.9.1/src/commonlhapdfc.inc new file mode 100644 index 00000000000..83e39189426 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/commonlhapdfc.inc @@ -0,0 +1,5 @@ +! LHAPDFC common block +!implicit none +character*1024 lhapath +common /lhapdfc/ lhapath +save /lhapdfc/ diff --git a/LHAPDF/lhapdf-5.9.1/src/commonlhasets.inc b/LHAPDF/lhapdf-5.9.1/src/commonlhasets.inc new file mode 100644 index 00000000000..7a7cf0d6488 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/commonlhasets.inc @@ -0,0 +1,8 @@ +! LHASETS common block +!implicit none +include 'parmsetup.inc' +character*1024 lhanames(nmxset) +integer lhanumbers(nmxset), lhamembers(nmxset) +integer nsets +common /lhasets/ lhanames, lhanumbers, lhamembers, nsets +save /lhasets/ diff --git a/LHAPDF/lhapdf-5.9.1/src/description.f b/LHAPDF/lhapdf-5.9.1/src/description.f new file mode 100644 index 00000000000..5e28b089475 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/description.f @@ -0,0 +1,58 @@ +! -*- F90 -*- + + +subroutine descriptionPDF(nset,id) + implicit none + include 'parmsetup.inc' + integer nset + integer id,token,l,nline + character*64 string + character*64 desc(nmxset,linemax) + integer lhasilent + common/lhasilent/lhasilent + save nline,desc + + l=0 + if (lhasilent.eq.0) then + write(*,*) '>>>>>> PDF description: <<<<<<' + endif +1 read(1,*) string + id=token(string) + if (id.eq.0) then + if(lhasilent.eq.0) then + write(*,*) string + endif + l=l+1 + if (l.gt.linemax) then + write(*,*) 'Too many lines in PDF description to store.' + write(*,*) 'Increase linemax variable in parmsetup.inc' + write(*,*) 'Ignoring additional description lines' + l=linemax + else + desc(nset,l)=string + goto 1 + endif + endif + nline=l + if (lhasilent.eq.0) then + write(*,*)'>>>>>> <<<<<<' + write(*,*) + endif + return + + entry GetDescM(nset) + do l=1,nline + write(*,*) desc(nset,l) + enddo + return + +end subroutine descriptionPDF + + +subroutine GetDesc() + implicit none + integer nset + nset = 1 + call GetDescM(nset) + return +end subroutine GetDesc diff --git a/LHAPDF/lhapdf-5.9.1/src/eks98.f b/LHAPDF/lhapdf-5.9.1/src/eks98.f new file mode 100644 index 00000000000..5a76bb53a94 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/eks98.f @@ -0,0 +1,1976 @@ +! -*- F90 -*- + + +!*********************************************************************** +! +! eks98.f +! +! An interface for calculating the SCALE DEPENDENT NUCLEAR RATIOS +! R_f^A(x,Q) = f_A(x,Q)/f_p(x,Q) +! where f_A is the distribution of parton flavour f in a proton of a +! nucleus A, and f_p is the corresponding parton distribution in the +! free proton. +! +! When you are using this interface, please REFER TO: +! K.J. Eskola, V.J. Kolhinen and C.A. Salgado, +! "The scale dependent nuclear effects in parton distributions for +! practical applications", Eur. Phys. J. C9 (1999) 61, +! JYFL-8/98, US-FT/14-98, hep-ph/9807297. +! +! The detailed formulation of our approach is given in +! K.J. Eskola, V.J. Kolhinen and P.V. Ruuskanen, +! "Scale evolution of nuclear parton distributions" +! Nucl. Phys. B535 (1998) 351, CERN-TH/97-345, JYFL-2/98, hep-ph/9802350 +! so please refer also to this paper. +! +! The ratios R_f^A are to a good approximation independent of the choice +! of the parton distribution set for the free proton, so the absolute +! distributions of parton flavour f in a proton of a nucleus A can be +! obtained simply by: +! f_A(x,Q) = R_f^A(x,Q) * f_p(x,Q), +! where f_p is from any modern (lowest order) set of parton distribution +! The corresponding distributions in a neutron of the nucleus can be +! obtained through the isospin symmetry (=an approximation for non-isosc +! nuclei) +! +! Questions & comments to: +! salgado@fpaxp1.usc.es +! vesa.kolhinen@phys.jyu.fi +! kari.eskola@phys.jyu.fi +! +! August 4, 1998 +! April 12, 2000 Modified for PDFLIB: common areas removed, +! unnecessary functions eksar0, eksara removed +! and code inserted in the main program. +! +!------------------------------------------------------------------- +! +! INSTRUCTIONS: +! +! call eks98(x,Q,A,ruv,rdv,ru,rd,rs,rc,rb,rt,rg) +! +! Returns the nuclear corrections R_f^A(x,Q) in double precision for f= +! +! u_valence: ruv +! d_valence: rdv (=ruv) +! u_sea: ru +! d_sea: rd (=ru) +! s: rs +! c: rc +! b: rb +! t: rt (always set to 1) +! glue: rg +! +! For x, Q (Q is in GeV) and atomic number A. +! x, Q and A are in DOUBLE PRECISION +! +! No initialization is needed. +! +! This program needs data files par0.all and parxQA.all. +! They must be located in current working directory. +! +! This parametrization should only be applied at +! 1e-6 < x < almost 1, 1.5 < Q< 100 GeV +! Warning: No warning is given if the above kinematic region +! in x&Q is exceeded. +! If A<=2, the function returns 1. +! +! +! +!------------------------------------------------------------------- + + subroutine eks98(x,q,a,ruv,rdv,ru,rd,rs,rc,rb,rt,rg) + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + dimension pqq(3),r(5),qq0(3),ptm(10) + dimension pa(3,10,3,8) + dimension pk0(3,180,8) + dimension nm(5), kpt(5) + + data qq0 /2.25d0, 2.54958d0, 21.3474d0/, & + & x1 /1.d-6/, x116 /.263553d-01/, & + & aa1 /4.d0/, aa8 /208.d0/ + data nm/1, 1, 2, 3, 1/, & + & kpt/1, 3, 6, 7, 8/ + + data ((pa(l,k, 1, 1),l=1,3),k=1,10)/ & + & 0.14090000E-04,0.35210931E-04,-.10411635E-05, & + & -.23558300E-04,-.47985653E-04,0.16458061E-06, & + & 0.13239300E-04,0.29205666E-04,-.45352667E-06, & + & -.64469800E-02,-.17417529E-01,0.49554572E-02, & + & -.30124100E+00,-.12625918E+01,-.11011743E+00, & + & -.29042100E-02,0.17355629E-01,0.18402482E-02, & + & 0.80649600E-03,-.29284958E-01,-.32113722E-02, & + & 0.14213800E-01,0.29406779E-01,0.17581578E-02, & + & -.29676000E-01,-.29727508E-01,-.62500264E-04, & + & -.77003800E-03,-.23781571E-02,-.10994586E-03/ + data ((pa(l,k, 2, 1),l=1,3),k=1,10)/ & + & 0.17000000E-06,0.18985118E-06,0.82013212E-08, & + & 0.16474400E-05,0.36813732E-05,-.59321277E-07, & + & -.55010200E-06,-.12540454E-05,0.27720641E-07, & + & -.13804600E-02,-.30966872E-02,-.18530724E-03, & + & 0.40170100E-01,0.12539375E+00,0.21618396E-02, & + & 0.15982700E-03,-.11026677E-02,-.12710860E-03, & + & 0.90663000E-04,0.19106476E-02,0.21070340E-03, & + & -.79382100E-03,-.17157888E-02,-.11568196E-03, & + & 0.13137200E-02,0.13618002E-02,0.11352389E-04, & + & 0.35091800E-04,0.14286549E-03,0.86585471E-05/ + data ((pa(l,k, 3, 1),l=1,3),k=1,10)/ & + & -.16400000E-05,-.50839329E-05,-.15011569E-07, & + & -.13462100E-04,-.31763817E-04,0.81732900E-06, & + & 0.32475600E-05,0.79437036E-05,-.27370123E-06, & + & 0.43531300E-01,0.99797852E-01,-.33765052E-05, & + & -.76361300E+00,-.20805721E+01,0.72384172E-01, & + & -.71183400E-02,0.16229048E-01,0.22778774E-02, & + & 0.71346100E-02,-.25258922E-01,-.35348045E-02, & + & 0.47070800E-02,0.20942318E-01,0.18750739E-02, & + & -.28156400E-01,-.30653515E-01,-.34157177E-03, & + & -.17631200E-03,-.23306961E-02,-.17336719E-03/ + data ((pa(l,k, 1, 2),l=1,3),k=1,10)/ & + & 0.61380000E-04,0.14853900E-03,-.36750639E-05, & + & 0.15968100E-04,0.41020319E-04,-.16392288E-05, & + & 0.88363500E-05,0.19033020E-04,-.16968139E-06, & + & -.16496400E-01,-.40413725E-01,0.43192710E-02, & + & 0.10657600E+00,-.27029148E+00,-.93432786E-01, & + & -.28217000E-02,0.17181617E-01,0.18454212E-02, & + & -.86241900E-03,-.30223559E-01,-.31258007E-02, & + & 0.13956700E-01,0.28853854E-01,0.16995086E-02, & + & -.24456600E-01,-.25064682E-01,-.10377551E-03, & + & -.62888900E-03,-.22721641E-02,-.11715903E-03/ + data ((pa(l,k, 2, 2),l=1,3),k=1,10)/ & + & -.19000000E-06,-.10044773E-05,0.61298878E-07, & + & 0.33967100E-06,0.73940302E-06,0.31650756E-07, & + & -.53868400E-06,-.12281937E-05,0.18049452E-07, & + & 0.21490200E-03,0.63825136E-03,-.19376196E-03, & + & 0.31242300E-02,0.30844484E-01,0.23502040E-02, & + & 0.14637900E-03,-.10280021E-02,-.11516974E-03, & + & 0.13515000E-03,0.18142272E-02,0.18674764E-03, & + & -.72518000E-03,-.15785224E-02,-.10146757E-03, & + & 0.10602500E-02,0.11233630E-02,0.10292593E-04, & + & 0.27129200E-04,0.13007019E-03,0.81434799E-05/ + data ((pa(l,k, 3, 2),l=1,3),k=1,10)/ & + & -.90700000E-05,-.26248056E-04,0.49314368E-06, & + & -.23052500E-04,-.49923281E-04,0.27354603E-06, & + & 0.80499500E-05,0.18679598E-04,-.33424836E-06, & + & 0.12089900E-01,0.25464894E-01,0.11934209E-02, & + & -.28895900E+00,-.83762649E+00,0.42726650E-01, & + & -.48770900E-02,0.13994036E-01,0.18830252E-02, & + & 0.33748500E-02,-.22264470E-01,-.28819285E-02, & + & 0.54743100E-02,0.18101633E-01,0.15213690E-02, & + & -.22589700E-01,-.24105648E-01,-.33008792E-03, & + & -.17070800E-03,-.19670336E-02,-.14766491E-03/ + data ((pa(l,k, 1, 3),l=1,3),k=1,10)/ & + & 0.44222800E-02,0.74796930E-02,-.48653299E-03, & + & 0.59383000E-03,0.10192475E-02,-.71331775E-04, & + & -.39855500E-04,-.61655017E-04,0.11503163E-04, & + & -.22521400E+00,-.40590456E+00,0.16937813E-01, & + & 0.37195900E+01,0.60005449E+01,-.48930655E+00, & + & 0.30258700E-02,-.54273565E-03,0.76587657E-04, & + & -.42620500E-02,0.43944658E-02,-.25228842E-03, & + & 0.14056100E-01,0.70383618E-02,-.33994041E-04, & + & -.26556200E-01,-.21355055E-01,0.49703670E-03, & + & -.20423500E-02,-.24351757E-02,-.39484822E-05/ + data ((pa(l,k, 2, 3),l=1,3),k=1,10)/ & + & -.16147000E-03,-.26895650E-03,0.20678351E-04, & + & -.33956600E-04,-.56432821E-04,0.47413027E-05, & + & 0.89641200E-06,0.97071095E-06,-.51137705E-06, & + & 0.14154800E-01,0.25838370E-01,-.18537242E-02, & + & -.23950500E+00,-.42226853E+00,0.41208339E-01, & + & 0.10307600E-03,-.76253410E-03,-.42040028E-04, & + & 0.29854600E-03,0.19112958E-02,0.99559330E-04, & + & -.10087600E-02,-.20066724E-02,-.55885278E-04, & + & 0.14489900E-02,0.16363993E-02,-.10654975E-04, & + & 0.88101000E-04,0.18509813E-03,0.14169991E-05/ + data ((pa(l,k, 3, 3),l=1,3),k=1,10)/ & + & -.20939400E-02,-.36074626E-02,0.19156847E-03, & + & -.11838200E-03,-.27260062E-03,-.93137551E-05, & + & 0.84978700E-04,0.14943069E-03,-.10654041E-04, & + & -.16893400E+00,-.23871983E+00,0.69182509E-01, & + & 0.32437100E+01,0.41987821E+01,-.11809893E+01, & + & 0.22920000E-02,0.19368165E-01,0.11864272E-02, & + & -.40666100E-01,-.80447246E-01,-.31240079E-02, & + & 0.50270100E-01,0.76175679E-01,0.18308670E-02, & + & -.44848100E-01,-.57740531E-01,0.23954032E-03, & + & -.52800800E-03,-.17673218E-02,0.20697993E-04/ + data ((pa(l,k, 1, 4),l=1,3),k=1,10)/ & + & 0.44222800E-02,0.74796930E-02,-.48653299E-03, & + & 0.59383000E-03,0.10192475E-02,-.71331775E-04, & + & -.39855500E-04,-.61655017E-04,0.11503163E-04, & + & -.22521400E+00,-.40590456E+00,0.16937813E-01, & + & 0.37195900E+01,0.60005449E+01,-.48930655E+00, & + & 0.30258700E-02,-.54273565E-03,0.76587657E-04, & + & -.42620500E-02,0.43944658E-02,-.25228842E-03, & + & 0.14056100E-01,0.70383618E-02,-.33994041E-04, & + & -.26556200E-01,-.21355055E-01,0.49703670E-03, & + & -.20423500E-02,-.24351757E-02,-.39484822E-05/ + data ((pa(l,k, 2, 4),l=1,3),k=1,10)/ & + & -.16147000E-03,-.26895650E-03,0.20678351E-04, & + & -.33956600E-04,-.56432821E-04,0.47413027E-05, & + & 0.89641200E-06,0.97071095E-06,-.51137705E-06, & + & 0.14154800E-01,0.25838370E-01,-.18537242E-02, & + & -.23950500E+00,-.42226853E+00,0.41208339E-01, & + & 0.10307600E-03,-.76253410E-03,-.42040028E-04, & + & 0.29854600E-03,0.19112958E-02,0.99559330E-04, & + & -.10087600E-02,-.20066724E-02,-.55885278E-04, & + & 0.14489900E-02,0.16363993E-02,-.10654975E-04, & + & 0.88101000E-04,0.18509813E-03,0.14169991E-05/ + data ((pa(l,k, 3, 4),l=1,3),k=1,10)/ & + & -.20939400E-02,-.36074626E-02,0.19156847E-03, & + & -.11838200E-03,-.27260062E-03,-.93137551E-05, & + & 0.84978700E-04,0.14943069E-03,-.10654041E-04, & + & -.16893400E+00,-.23871983E+00,0.69182509E-01, & + & 0.32437100E+01,0.41987821E+01,-.11809893E+01, & + & 0.22920000E-02,0.19368165E-01,0.11864272E-02, & + & -.40666100E-01,-.80447246E-01,-.31240079E-02, & + & 0.50270100E-01,0.76175679E-01,0.18308670E-02, & + & -.44848100E-01,-.57740531E-01,0.23954032E-03, & + & -.52800800E-03,-.17673218E-02,0.20697993E-04/ + data ((pa(l,k, 1, 5),l=1,3),k=1,10)/ & + & 0.44845800E-02,0.75813459E-02,-.49633111E-03, & + & 0.62746000E-03,0.10650655E-02,-.79101830E-04, & + & -.50490100E-04,-.76547625E-04,0.13978409E-04, & + & -.26483700E+00,-.50371666E+00,0.11914335E-01, & + & 0.33268000E+01,0.63907392E+01,-.49536068E+00, & + & 0.15007800E-01,0.37291585E-01,0.22229452E-02, & + & -.22978200E-01,-.61596530E-01,-.37776891E-02, & + & 0.23703900E-01,0.46152502E-01,0.20695893E-02, & + & -.25386800E-01,-.28920674E-01,-.54551888E-04, & + & -.21454100E-02,-.37248798E-02,-.16659417E-03/ + data ((pa(l,k, 2, 5),l=1,3),k=1,10)/ & + & -.16048000E-03,-.26724915E-03,0.20709354E-04, & + & -.33396500E-04,-.55088829E-04,0.49309457E-05, & + & 0.56120600E-06,0.29620983E-06,-.54778567E-06, & + & 0.12460300E-01,0.23127396E-01,-.20231139E-02, & + & -.15550600E+00,-.28039359E+00,0.45451576E-01, & + & 0.11876200E-03,-.58939849E-03,-.62714393E-04, & + & -.33678900E-04,0.13657628E-02,0.13448844E-03, & + & -.67097200E-03,-.15695610E-02,-.78462377E-04, & + & 0.13328300E-02,0.15163247E-02,-.52430392E-05, & + & 0.10240500E-03,0.18954366E-03,0.40054816E-05/ + data ((pa(l,k, 3, 5),l=1,3),k=1,10)/ & + & -.23352600E-02,-.40041989E-02,0.22280333E-03, & + & -.28523500E-03,-.56130916E-03,0.11583071E-04, & + & 0.14209200E-03,0.24635266E-03,-.18223806E-04, & + & 0.13243600E+00,0.30806831E+00,0.95226565E-01, & + & -.13163400E+01,-.39408794E+01,-.12402760E+01, & + & -.68116000E-01,-.98238919E-01,-.34258159E-02, & + & 0.96171400E-01,0.13422345E+00,0.33947152E-02, & + & -.36353500E-01,-.52689855E-01,-.14904227E-02, & + & -.41063700E-01,-.38415039E-01,0.14310422E-02, & + & 0.37885100E-03,-.51323741E-04,0.34237799E-03/ + data ((pa(l,k, 1, 6),l=1,3),k=1,10)/ & + & 0.35266000E-02,0.59933727E-02,-.36692786E-03, & + & 0.36285000E-03,0.63679303E-03,-.36104798E-04, & + & -.36462300E-04,-.60025589E-04,0.81293376E-05, & + & -.18853200E+00,-.32876665E+00,0.79975149E-02, & + & 0.22463800E+01,0.33126946E+01,-.38302624E+00, & + & 0.10597500E-01,0.11040625E-01,0.28139630E-03, & + & -.19728000E-02,0.69755582E-02,-.13699242E-03, & + & 0.72868300E-02,-.33399200E-02,-.23761882E-03, & + & -.26059800E-01,-.16839722E-01,0.58515148E-03, & + & -.20515600E-02,-.23252028E-02,-.34962122E-04/ + data ((pa(l,k, 2, 6),l=1,3),k=1,10)/ & + & -.13317000E-03,-.22276611E-03,0.16454499E-04, & + & -.25562000E-04,-.42991824E-04,0.35028592E-05, & + & 0.96007200E-06,0.12213552E-05,-.48153415E-06, & + & 0.12991300E-01,0.23827400E-01,-.11280363E-02, & + & -.13709100E+00,-.24324855E+00,0.32625195E-01, & + & -.11790700E-02,-.26475520E-02,-.88878320E-04, & + & 0.13084100E-02,0.32913187E-02,0.12900752E-03, & + & -.11930900E-02,-.21489951E-02,-.61358893E-04, & + & 0.15210600E-02,0.15176937E-02,-.70379041E-05, & + & 0.16704500E-03,0.29529963E-03,0.78644942E-05/ + data ((pa(l,k, 3, 6),l=1,3),k=1,10)/ & + & -.11418000E-03,-.28801533E-03,-.50162205E-04, & + & 0.40845500E-03,0.63815903E-03,-.86521388E-04, & + & 0.33060300E-04,0.69342929E-04,0.49976234E-05, & + & -.27146800E+00,-.48641306E+00,0.46499887E-01, & + & 0.22103200E+01,0.35696673E+01,-.10038513E+01, & + & 0.28317600E-01,0.60547503E-01,0.16782368E-02, & + & -.35867300E-01,-.78056467E-01,-.22058781E-02, & + & 0.26307000E-01,0.46634608E-01,0.98735335E-03, & + & -.41748400E-01,-.44276120E-01,0.27442134E-03, & + & -.37396200E-02,-.68228378E-02,-.16825971E-03/ + data ((pa(l,k, 1, 7),l=1,3),k=1,10)/ & + & 0.21692300E-02,0.36952769E-02,-.21010349E-03, & + & 0.17592800E-03,0.31783026E-03,-.15502296E-04, & + & -.18683600E-04,-.31611478E-04,0.40080356E-05, & + & -.12202000E+00,-.20622823E+00,0.61096182E-02, & + & 0.15770800E+01,0.21750242E+01,-.25358005E+00, & + & 0.83402700E-02,0.67734664E-02,0.22627540E-03, & + & -.27332400E-02,0.63426934E-02,-.72491227E-04, & + & 0.86311100E-02,-.55382432E-03,-.28636130E-03, & + & -.26152900E-01,-.19105241E-01,0.65797151E-03, & + & -.15538600E-02,-.15893496E-02,-.24541168E-04/ + data ((pa(l,k, 2, 7),l=1,3),k=1,10)/ & + & -.76380000E-04,-.12733149E-03,0.86215493E-05, & + & -.12255000E-04,-.21528506E-04,0.15487340E-05, & + & 0.48724600E-06,0.72344695E-06,-.23221259E-06, & + & 0.69999500E-02,0.12663170E-01,-.53981131E-03, & + & -.72149800E-01,-.12775289E+00,0.16386406E-01, & + & -.50290300E-03,-.13183355E-02,-.49142332E-04, & + & 0.48767200E-03,0.15498641E-02,0.69481269E-04, & + & -.76578300E-03,-.12339477E-02,-.27788711E-04, & + & 0.13320600E-02,0.12715671E-02,-.13519969E-04, & + & 0.89711000E-04,0.16032593E-03,0.41675546E-05/ + data ((pa(l,k, 3, 7),l=1,3),k=1,10)/ & + & 0.17840000E-04,0.35458069E-04,-.11614547E-04, & + & 0.63084400E-04,0.94159278E-04,-.98121820E-05, & + & 0.24251500E-05,0.63701608E-05,0.70554838E-06, & + & -.32182300E-01,-.59258463E-01,0.49396169E-02, & + & 0.21794500E+00,0.36064906E+00,-.11054416E+00, & + & 0.29890200E-02,0.74401436E-02,0.24613170E-03, & + & -.37742000E-02,-.93764364E-02,-.31786519E-03, & + & 0.41737100E-02,0.66501930E-02,0.12548505E-03, & + & -.98392800E-02,-.93367060E-02,0.32700119E-04, & + & -.49142500E-03,-.90951301E-03,-.23706858E-04/ + data ((pa(l,k, 1, 8),l=1,3),k=1,10)/ & + & 0.45569100E-02,0.77982882E-02,-.44016735E-03, & + & 0.33143000E-03,0.59861127E-03,-.16446211E-04, & + & -.49979300E-04,-.84282669E-04,0.81672928E-05, & + & -.14697500E+00,-.27088643E+00,-.65341872E-03, & + & 0.12453800E+01,0.21262786E+01,-.20137579E+00, & + & 0.17633600E-01,0.37868613E-01,0.20909133E-02, & + & -.31127900E-01,-.52905407E-01,-.28222375E-02, & + & 0.49221700E-01,0.54858710E-01,0.98233606E-03, & + & -.67330200E-01,-.60969566E-01,0.56950780E-03, & + & -.28949100E-02,-.46048285E-02,-.17187653E-03/ + data ((pa(l,k, 2, 8),l=1,3),k=1,10)/ & + & -.21141000E-03,-.35691000E-03,0.23971219E-04, & + & -.29700200E-04,-.50563745E-04,0.33904455E-05, & + & 0.11311100E-05,0.15438373E-05,-.47771887E-06, & + & 0.11091600E-01,0.19439138E-01,-.16586512E-02, & + & -.41908500E-01,-.23856210E-01,0.36544019E-01, & + & -.29486000E-02,-.54287526E-02,-.17324155E-03, & + & 0.51199700E-02,0.79784550E-02,0.21583359E-03, & + & -.47555400E-02,-.58710962E-02,-.81300361E-04, & + & 0.32006800E-02,0.30646671E-02,-.14162448E-04, & + & 0.36106200E-03,0.60841738E-03,0.16983488E-04/ + data ((pa(l,k, 3, 8),l=1,3),k=1,10)/ & + & 0.78489000E-03,0.11365806E-02,-.21063087E-03, & + & 0.78569200E-03,0.12087424E-02,-.16201037E-03, & + & 0.90177800E-04,0.17930061E-03,0.32461910E-05, & + & -.35399100E+00,-.58029245E+00,0.12341179E+00, & + & -.13867800E+00,-.25956776E+01,-.19832421E+01, & + & 0.10291500E+00,0.21979607E+00,0.44907795E-02, & + & -.12476100E+00,-.27286984E+00,-.52889947E-02, & + & 0.72597700E-01,0.14439439E+00,0.22982672E-02, & + & -.54130600E-01,-.68893260E-01,0.24353123E-03, & + & -.13702100E-01,-.25940355E-01,-.53133565E-03/ + + + data ((pk0(l,k, 1),l=1,3),k= 1, 15)/ & + & 0.98805500E+00,-.29579874E-01,0.41936474E-03, & + & 0.98805600E+00,-.29577460E-01,0.41913443E-03, & + & 0.98805600E+00,-.29574714E-01,0.41897684E-03, & + & 0.98805800E+00,-.29573275E-01,0.41902654E-03, & + & 0.98805800E+00,-.29570265E-01,0.41882206E-03, & + & 0.98805900E+00,-.29567222E-01,0.41858194E-03, & + & 0.98806100E+00,-.29564971E-01,0.41862252E-03, & + & 0.98806300E+00,-.29560869E-01,0.41826973E-03, & + & 0.98807100E+00,-.29560883E-01,0.41866558E-03, & + & 0.98806800E+00,-.29553342E-01,0.41770607E-03, & + & 0.98806600E+00,-.29552281E-01,0.41830376E-03, & + & 0.98806300E+00,-.29548063E-01,0.41804157E-03, & + & 0.98806800E+00,-.29544846E-01,0.41788272E-03, & + & 0.98806500E+00,-.29532692E-01,0.41594764E-03, & + & 0.98807100E+00,-.29532367E-01,0.41660640E-03/ + data ((pk0(l,k, 1),l=1,3),k= 16, 30)/ & + & 0.98807700E+00,-.29531715E-01,0.41769536E-03, & + & 0.98808300E+00,-.29530264E-01,0.41801263E-03, & + & 0.98808200E+00,-.29521192E-01,0.41708452E-03, & + & 0.98808300E+00,-.29513120E-01,0.41645956E-03, & + & 0.98808400E+00,-.29503972E-01,0.41546815E-03, & + & 0.98808700E+00,-.29497753E-01,0.41541099E-03, & + & 0.98809200E+00,-.29492909E-01,0.41558773E-03, & + & 0.98809100E+00,-.29486954E-01,0.41580607E-03, & + & 0.98809900E+00,-.29478824E-01,0.41534508E-03, & + & 0.98809600E+00,-.29468423E-01,0.41473919E-03, & + & 0.98810100E+00,-.29460799E-01,0.41458652E-03, & + & 0.98810900E+00,-.29451330E-01,0.41421981E-03, & + & 0.98811300E+00,-.29441179E-01,0.41395156E-03, & + & 0.98811300E+00,-.29427432E-01,0.41291184E-03, & + & 0.98812200E+00,-.29417874E-01,0.41272928E-03/ + data ((pk0(l,k, 1),l=1,3),k= 31, 45)/ & + & 0.98812800E+00,-.29404982E-01,0.41210654E-03, & + & 0.98813100E+00,-.29393646E-01,0.41196984E-03, & + & 0.98813800E+00,-.29378057E-01,0.41110962E-03, & + & 0.98814200E+00,-.29363157E-01,0.41052055E-03, & + & 0.98814900E+00,-.29348119E-01,0.41022056E-03, & + & 0.98816000E+00,-.29332713E-01,0.40957699E-03, & + & 0.98816400E+00,-.29314311E-01,0.40896478E-03, & + & 0.98817200E+00,-.29291110E-01,0.40704747E-03, & + & 0.98817900E+00,-.29273512E-01,0.40717798E-03, & + & 0.98818900E+00,-.29251814E-01,0.40621427E-03, & + & 0.98819900E+00,-.29228853E-01,0.40512445E-03, & + & 0.98820800E+00,-.29204449E-01,0.40412969E-03, & + & 0.98822100E+00,-.29179043E-01,0.40329040E-03, & + & 0.98823000E+00,-.29150607E-01,0.40198100E-03, & + & 0.98824300E+00,-.29123106E-01,0.40126168E-03/ + data ((pk0(l,k, 1),l=1,3),k= 46, 60)/ & + & 0.98825500E+00,-.29091675E-01,0.39991981E-03, & + & 0.98827200E+00,-.29059487E-01,0.39882305E-03, & + & 0.98828500E+00,-.29023922E-01,0.39735082E-03, & + & 0.98829900E+00,-.28985348E-01,0.39551940E-03, & + & 0.98831400E+00,-.28945167E-01,0.39388608E-03, & + & 0.98833300E+00,-.28906000E-01,0.39291261E-03, & + & 0.98834900E+00,-.28858687E-01,0.39051615E-03, & + & 0.98836900E+00,-.28812875E-01,0.38911143E-03, & + & 0.98839100E+00,-.28761597E-01,0.38697151E-03, & + & 0.98841300E+00,-.28709159E-01,0.38497692E-03, & + & 0.98843400E+00,-.28651219E-01,0.38252825E-03, & + & 0.98846100E+00,-.28591488E-01,0.38038817E-03, & + & 0.98848800E+00,-.28527928E-01,0.37793833E-03, & + & 0.98851200E+00,-.28458456E-01,0.37498109E-03, & + & 0.98854400E+00,-.28388390E-01,0.37269367E-03/ + data ((pk0(l,k, 1),l=1,3),k= 61, 75)/ & + & 0.98857400E+00,-.28311034E-01,0.36954463E-03, & + & 0.98860800E+00,-.28231022E-01,0.36660487E-03, & + & 0.98864400E+00,-.28145957E-01,0.36351441E-03, & + & 0.98868100E+00,-.28054036E-01,0.35980195E-03, & + & 0.98872000E+00,-.27957403E-01,0.35607963E-03, & + & 0.98876400E+00,-.27857152E-01,0.35272440E-03, & + & 0.98880600E+00,-.27746515E-01,0.34809236E-03, & + & 0.98885400E+00,-.27633423E-01,0.34416643E-03, & + & 0.98890300E+00,-.27511837E-01,0.33956954E-03, & + & 0.98895600E+00,-.27383732E-01,0.33490582E-03, & + & 0.98901100E+00,-.27246542E-01,0.32963692E-03, & + & 0.98907000E+00,-.27104335E-01,0.32480728E-03, & + & 0.98913300E+00,-.26952741E-01,0.31935086E-03, & + & 0.98919800E+00,-.26790835E-01,0.31340954E-03, & + & 0.98926800E+00,-.26621619E-01,0.30751914E-03/ + data ((pk0(l,k, 1),l=1,3),k= 76, 90)/ & + & 0.98934100E+00,-.26441398E-01,0.30109164E-03, & + & 0.98942000E+00,-.26252020E-01,0.29444788E-03, & + & 0.98950100E+00,-.26050504E-01,0.28731111E-03, & + & 0.98958800E+00,-.25838372E-01,0.27993224E-03, & + & 0.98968100E+00,-.25616559E-01,0.27270793E-03, & + & 0.98977600E+00,-.25379392E-01,0.26451913E-03, & + & 0.98987800E+00,-.25130589E-01,0.25634065E-03, & + & 0.98998600E+00,-.24867667E-01,0.24769411E-03, & + & 0.99009800E+00,-.24588894E-01,0.23832791E-03, & + & 0.99021800E+00,-.24297120E-01,0.22923106E-03, & + & 0.99034500E+00,-.23989402E-01,0.21961454E-03, & + & 0.99047800E+00,-.23663977E-01,0.20948636E-03, & + & 0.99061700E+00,-.23319923E-01,0.19886184E-03, & + & 0.99076500E+00,-.22958411E-01,0.18798797E-03, & + & 0.99092100E+00,-.22577868E-01,0.17692038E-03/ + data ((pk0(l,k, 1),l=1,3),k= 91,105)/ & + & 0.99108500E+00,-.22176430E-01,0.16550703E-03, & + & 0.99125700E+00,-.21752277E-01,0.15344099E-03, & + & 0.99143900E+00,-.21305047E-01,0.14108019E-03, & + & 0.99162400E+00,-.20834344E-01,0.12877821E-03, & + & 0.99182700E+00,-.20334672E-01,0.11488639E-03, & + & 0.99204600E+00,-.19813472E-01,0.10237765E-03, & + & 0.99227200E+00,-.19263641E-01,0.89224701E-04, & + & 0.99251100E+00,-.18679496E-01,0.75420170E-04, & + & 0.99275500E+00,-.18061734E-01,0.61050831E-04, & + & 0.99302600E+00,-.17420251E-01,0.49219499E-04, & + & 0.99330600E+00,-.16731847E-01,0.35382781E-04, & + & 0.99360100E+00,-.16004447E-01,0.21237047E-04, & + & 0.99391600E+00,-.15234560E-01,0.74743978E-05, & + & 0.99424900E+00,-.14417068E-01,-.64800042E-05, & + & 0.99460300E+00,-.13551375E-01,-.19830104E-04/ + data ((pk0(l,k, 1),l=1,3),k=106,120)/ & + & 0.99497500E+00,-.12631829E-01,-.32253740E-04, & + & 0.99538100E+00,-.11656034E-01,-.44328786E-04, & + & 0.99580400E+00,-.10616951E-01,-.55042428E-04, & + & 0.99626200E+00,-.95135519E-02,-.63675877E-04, & + & 0.99675100E+00,-.83280611E-02,-.72663823E-04, & + & 0.99727400E+00,-.70622158E-02,-.79424860E-04, & + & 0.99784000E+00,-.57154893E-02,-.81837119E-04, & + & 0.99844600E+00,-.42649820E-02,-.82798792E-04, & + & 0.99910100E+00,-.27124368E-02,-.78960178E-04, & + & 0.99980500E+00,-.10447937E-02,-.69975933E-04, & + & 0.10005700E+01,0.73538220E-03,-.52967542E-04, & + & 0.10013600E+01,0.25715563E-02,-.30311898E-04, & + & 0.10021800E+01,0.44194917E-02,-.12766878E-05, & + & 0.10030100E+01,0.62578295E-02,0.34893028E-04, & + & 0.10038400E+01,0.80714467E-02,0.75584238E-04/ + data ((pk0(l,k, 1),l=1,3),k=121,135)/ & + & 0.10046800E+01,0.98148722E-02,0.12340889E-03, & + & 0.10055100E+01,0.11478096E-01,0.17096066E-03, & + & 0.10063300E+01,0.13007302E-01,0.22030138E-03, & + & 0.10071200E+01,0.14380777E-01,0.26511540E-03, & + & 0.10078800E+01,0.15544251E-01,0.30407445E-03, & + & 0.10086000E+01,0.16466054E-01,0.33188516E-03, & + & 0.10092600E+01,0.17121077E-01,0.34107920E-03, & + & 0.10098600E+01,0.17478694E-01,0.32792040E-03, & + & 0.10112200E+01,0.18307583E-01,0.26138702E-03, & + & 0.10122800E+01,0.18619387E-01,0.15939029E-03, & + & 0.10130900E+01,0.18519253E-01,0.27009905E-04, & + & 0.10136700E+01,0.18110723E-01,-.12344489E-03, & + & 0.10140300E+01,0.17496051E-01,-.27769739E-03, & + & 0.10141900E+01,0.16749844E-01,-.41810465E-03, & + & 0.10141200E+01,0.15920406E-01,-.52615496E-03/ + data ((pk0(l,k, 1),l=1,3),k=136,150)/ & + & 0.10138000E+01,0.15005243E-01,-.58672528E-03, & + & 0.10131700E+01,0.13975559E-01,-.59192299E-03, & + & 0.10121800E+01,0.12740951E-01,-.53813782E-03, & + & 0.10107500E+01,0.11236568E-01,-.43905669E-03, & + & 0.10088600E+01,0.93505682E-02,-.30574238E-03, & + & 0.10064600E+01,0.70411372E-02,-.15948770E-03, & + & 0.10035300E+01,0.42762699E-02,-.17404487E-04, & + & 0.10000500E+01,0.10410833E-02,0.11229892E-03, & + & 0.99611500E+00,-.27586838E-02,0.24273533E-03, & + & 0.99174800E+00,-.71635519E-02,0.38513059E-03, & + & 0.98678000E+00,-.11857106E-01,0.47076429E-03, & + & 0.98127900E+00,-.16583879E-01,0.45718377E-03, & + & 0.97539500E+00,-.21782577E-01,0.53296129E-03, & + & 0.96939000E+00,-.27132384E-01,0.61156658E-03, & + & 0.96369400E+00,-.32215089E-01,0.67535930E-03/ + data ((pk0(l,k, 1),l=1,3),k=151,165)/ & + & 0.96241400E+00,-.33360577E-01,0.68795480E-03, & + & 0.96123000E+00,-.34423853E-01,0.69963768E-03, & + & 0.96014000E+00,-.35391481E-01,0.70959966E-03, & + & 0.95916700E+00,-.36260184E-01,0.71735378E-03, & + & 0.95831100E+00,-.37027861E-01,0.72488951E-03, & + & 0.95758100E+00,-.37681782E-01,0.73088783E-03, & + & 0.95698100E+00,-.38220825E-01,0.73595805E-03, & + & 0.95652000E+00,-.38632853E-01,0.73938901E-03, & + & 0.95620700E+00,-.38914732E-01,0.74167984E-03, & + & 0.95604500E+00,-.39057645E-01,0.74264427E-03, & + & 0.95622000E+00,-.38902390E-01,0.73954442E-03, & + & 0.95778500E+00,-.37514334E-01,0.71344315E-03, & + & 0.96091200E+00,-.34734622E-01,0.66036545E-03, & + & 0.96560200E+00,-.30567869E-01,0.58152764E-03, & + & 0.97185600E+00,-.25008112E-01,0.47536361E-03/ + data ((pk0(l,k, 1),l=1,3),k=166,180)/ & + & 0.97967300E+00,-.18059299E-01,0.34285939E-03, & + & 0.98906000E+00,-.97286265E-02,0.18559549E-03, & + & 0.10000000E+01,-.23134272E-13,-.64878658E-14, & + & 0.10125000E+01,0.11119766E-01,-.21243592E-03, & + & 0.10265800E+01,0.23616219E-01,-.44808781E-03, & + & 0.10422200E+01,0.37510483E-01,-.71302034E-03, & + & 0.10594200E+01,0.52792213E-01,-.10027142E-02, & + & 0.10781800E+01,0.69462743E-01,-.13193591E-02, & + & 0.10985000E+01,0.87535352E-01,-.16654905E-02, & + & 0.11203900E+01,0.10698448E+00,-.20338674E-02, & + & 0.11438500E+01,0.12781732E+00,-.24288130E-02, & + & 0.11688600E+01,0.15005424E+00,-.28529975E-02, & + & 0.11954400E+01,0.17367534E+00,-.33024553E-02, & + & 0.12235900E+01,0.19867996E+00,-.37770251E-02, & + & 0.10000000E+01,-.23134272E-13,-.64878658E-14/ + data ((pk0(l,k, 2),l=1,3),k= 1, 15)/ & + & 0.98805500E+00,-.29579422E-01,0.41918637E-03, & + & 0.98805600E+00,-.29577255E-01,0.41912607E-03, & + & 0.98805700E+00,-.29575099E-01,0.41901529E-03, & + & 0.98805700E+00,-.29572995E-01,0.41898641E-03, & + & 0.98805800E+00,-.29569798E-01,0.41870508E-03, & + & 0.98805900E+00,-.29566762E-01,0.41851172E-03, & + & 0.98806100E+00,-.29564500E-01,0.41847276E-03, & + & 0.98806500E+00,-.29565946E-01,0.41928874E-03, & + & 0.98806800E+00,-.29562397E-01,0.41904924E-03, & + & 0.98806700E+00,-.29557672E-01,0.41874452E-03, & + & 0.98806500E+00,-.29547754E-01,0.41690676E-03, & + & 0.98807200E+00,-.29548491E-01,0.41779847E-03, & + & 0.98807100E+00,-.29543145E-01,0.41761585E-03, & + & 0.98807200E+00,-.29539157E-01,0.41760575E-03, & + & 0.98807600E+00,-.29537403E-01,0.41779584E-03/ + data ((pk0(l,k, 2),l=1,3),k= 16, 30)/ & + & 0.98807000E+00,-.29528117E-01,0.41695576E-03, & + & 0.98807600E+00,-.29523422E-01,0.41652643E-03, & + & 0.98808100E+00,-.29517279E-01,0.41619558E-03, & + & 0.98808000E+00,-.29511410E-01,0.41605618E-03, & + & 0.98808600E+00,-.29510141E-01,0.41687506E-03, & + & 0.98809000E+00,-.29501900E-01,0.41609066E-03, & + & 0.98809200E+00,-.29493344E-01,0.41563413E-03, & + & 0.98809800E+00,-.29487687E-01,0.41573871E-03, & + & 0.98809500E+00,-.29476777E-01,0.41497622E-03, & + & 0.98809800E+00,-.29469183E-01,0.41472176E-03, & + & 0.98810500E+00,-.29462639E-01,0.41498449E-03, & + & 0.98810600E+00,-.29449045E-01,0.41362074E-03, & + & 0.98811200E+00,-.29442003E-01,0.41401876E-03, & + & 0.98811500E+00,-.29427270E-01,0.41263684E-03, & + & 0.98812100E+00,-.29417525E-01,0.41260094E-03/ + data ((pk0(l,k, 2),l=1,3),k= 31, 45)/ & + & 0.98812400E+00,-.29404390E-01,0.41197122E-03, & + & 0.98813400E+00,-.29393587E-01,0.41201594E-03, & + & 0.98813700E+00,-.29377078E-01,0.41098551E-03, & + & 0.98814300E+00,-.29363177E-01,0.41044204E-03, & + & 0.98815000E+00,-.29346938E-01,0.40969978E-03, & + & 0.98815700E+00,-.29330933E-01,0.40932537E-03, & + & 0.98816600E+00,-.29312769E-01,0.40846381E-03, & + & 0.98817200E+00,-.29293908E-01,0.40777243E-03, & + & 0.98818000E+00,-.29272371E-01,0.40676801E-03, & + & 0.98819000E+00,-.29251629E-01,0.40602360E-03, & + & 0.98819900E+00,-.29228230E-01,0.40497727E-03, & + & 0.98820700E+00,-.29203913E-01,0.40415329E-03, & + & 0.98821900E+00,-.29179447E-01,0.40335511E-03, & + & 0.98823200E+00,-.29151742E-01,0.40218934E-03, & + & 0.98824300E+00,-.29122463E-01,0.40102918E-03/ + data ((pk0(l,k, 2),l=1,3),k= 46, 60)/ & + & 0.98825500E+00,-.29091818E-01,0.39993138E-03, & + & 0.98826900E+00,-.29058597E-01,0.39857081E-03, & + & 0.98828300E+00,-.29022917E-01,0.39710944E-03, & + & 0.98829900E+00,-.28986253E-01,0.39581522E-03, & + & 0.98831500E+00,-.28946108E-01,0.39404654E-03, & + & 0.98833300E+00,-.28904441E-01,0.39250854E-03, & + & 0.98835100E+00,-.28860047E-01,0.39083459E-03, & + & 0.98837100E+00,-.28812606E-01,0.38895691E-03, & + & 0.98839000E+00,-.28761328E-01,0.38682235E-03, & + & 0.98841400E+00,-.28709131E-01,0.38495965E-03, & + & 0.98843700E+00,-.28652534E-01,0.38286068E-03, & + & 0.98846100E+00,-.28591659E-01,0.38036712E-03, & + & 0.98848700E+00,-.28530106E-01,0.37842096E-03, & + & 0.98851000E+00,-.28455867E-01,0.37445697E-03, & + & 0.98854600E+00,-.28387063E-01,0.37230645E-03/ + data ((pk0(l,k, 2),l=1,3),k= 61, 75)/ & + & 0.98857700E+00,-.28315116E-01,0.37042360E-03, & + & 0.98860500E+00,-.28229924E-01,0.36649952E-03, & + & 0.98864700E+00,-.28147210E-01,0.36369733E-03, & + & 0.98868000E+00,-.28055986E-01,0.36033572E-03, & + & 0.98872700E+00,-.27959354E-01,0.35638864E-03, & + & 0.98876000E+00,-.27854857E-01,0.35223250E-03, & + & 0.98880800E+00,-.27750707E-01,0.34894082E-03, & + & 0.98885000E+00,-.27631049E-01,0.34378450E-03, & + & 0.98890200E+00,-.27510766E-01,0.33920808E-03, & + & 0.98895500E+00,-.27382868E-01,0.33478069E-03, & + & 0.98901200E+00,-.27249588E-01,0.33016442E-03, & + & 0.98906700E+00,-.27103681E-01,0.32473835E-03, & + & 0.98913500E+00,-.26954085E-01,0.31971153E-03, & + & 0.98919800E+00,-.26790600E-01,0.31330552E-03, & + & 0.98927000E+00,-.26623148E-01,0.30776191E-03/ + data ((pk0(l,k, 2),l=1,3),k= 76, 90)/ & + & 0.98934200E+00,-.26441154E-01,0.30089075E-03, & + & 0.98941900E+00,-.26253614E-01,0.29486609E-03, & + & 0.98950100E+00,-.26051183E-01,0.28739844E-03, & + & 0.98958700E+00,-.25840329E-01,0.28051278E-03, & + & 0.98967900E+00,-.25615225E-01,0.27251777E-03, & + & 0.98977800E+00,-.25380845E-01,0.26488027E-03, & + & 0.98987800E+00,-.25130104E-01,0.25613287E-03, & + & 0.98998500E+00,-.24867669E-01,0.24767884E-03, & + & 0.99009900E+00,-.24590881E-01,0.23892411E-03, & + & 0.99021700E+00,-.24296717E-01,0.22908159E-03, & + & 0.99034600E+00,-.23989222E-01,0.21958444E-03, & + & 0.99047500E+00,-.23662171E-01,0.20912645E-03, & + & 0.99061600E+00,-.23319130E-01,0.19868654E-03, & + & 0.99076600E+00,-.22959887E-01,0.18832960E-03, & + & 0.99092000E+00,-.22577449E-01,0.17688179E-03/ + data ((pk0(l,k, 2),l=1,3),k= 91,105)/ & + & 0.99108500E+00,-.22175675E-01,0.16530403E-03, & + & 0.99125700E+00,-.21753393E-01,0.15367794E-03, & + & 0.99143900E+00,-.21306679E-01,0.14142751E-03, & + & 0.99163000E+00,-.20836087E-01,0.12886254E-03, & + & 0.99183300E+00,-.20338732E-01,0.11577485E-03, & + & 0.99204600E+00,-.19815237E-01,0.10263771E-03, & + & 0.99227100E+00,-.19264134E-01,0.89528699E-04, & + & 0.99250800E+00,-.18681008E-01,0.75880463E-04, & + & 0.99275900E+00,-.18067005E-01,0.62547218E-04, & + & 0.99302400E+00,-.17415435E-01,0.48312314E-04, & + & 0.99330400E+00,-.16728941E-01,0.34611857E-04, & + & 0.99360000E+00,-.16001145E-01,0.20586329E-04, & + & 0.99391400E+00,-.15231651E-01,0.68684177E-05, & + & 0.99424800E+00,-.14416633E-01,-.65055015E-05, & + & 0.99460100E+00,-.13550693E-01,-.19753475E-04/ + data ((pk0(l,k, 2),l=1,3),k=106,120)/ & + & 0.99497600E+00,-.12634288E-01,-.31975398E-04, & + & 0.99537300E+00,-.11654449E-01,-.44279286E-04, & + & 0.99579800E+00,-.10613818E-01,-.55376119E-04, & + & 0.99626900E+00,-.95115958E-02,-.64486309E-04, & + & 0.99674600E+00,-.83228618E-02,-.74190358E-04, & + & 0.99727000E+00,-.70592795E-02,-.80132292E-04, & + & 0.99784100E+00,-.57163068E-02,-.81697957E-04, & + & 0.99844900E+00,-.42650027E-02,-.82897883E-04, & + & 0.99909900E+00,-.27108850E-02,-.79382365E-04, & + & 0.99980100E+00,-.10407039E-02,-.70860060E-04, & + & 0.10005700E+01,0.73496284E-03,-.52853587E-04, & + & 0.10013600E+01,0.25779583E-02,-.31954040E-04, & + & 0.10021800E+01,0.44193494E-02,-.98916638E-06, & + & 0.10030100E+01,0.62550459E-02,0.35649425E-04, & + & 0.10038400E+01,0.80714467E-02,0.75584238E-04/ + data ((pk0(l,k, 2),l=1,3),k=121,135)/ & + & 0.10046800E+01,0.98198157E-02,0.12206626E-03, & + & 0.10055100E+01,0.11477953E-01,0.17124818E-03, & + & 0.10063300E+01,0.13004872E-01,0.22091642E-03, & + & 0.10071200E+01,0.14380777E-01,0.26511540E-03, & + & 0.10078800E+01,0.15544251E-01,0.30407445E-03, & + & 0.10086000E+01,0.16466054E-01,0.33188516E-03, & + & 0.10092600E+01,0.17122955E-01,0.34066574E-03, & + & 0.10098600E+01,0.17483841E-01,0.32582259E-03, & + & 0.10112200E+01,0.18307583E-01,0.26138702E-03, & + & 0.10122800E+01,0.18624601E-01,0.15801885E-03, & + & 0.10130900E+01,0.18519253E-01,0.27009905E-04, & + & 0.10136700E+01,0.18108292E-01,-.12282984E-03, & + & 0.10140300E+01,0.17500442E-01,-.27883844E-03, & + & 0.10141900E+01,0.16749844E-01,-.41810465E-03, & + & 0.10141300E+01,0.15911342E-01,-.52439906E-03/ + data ((pk0(l,k, 2),l=1,3),k=136,150)/ & + & 0.10138000E+01,0.15005243E-01,-.58672528E-03, & + & 0.10131700E+01,0.13973270E-01,-.59159547E-03, & + & 0.10121800E+01,0.12740951E-01,-.53813782E-03, & + & 0.10107500E+01,0.11236568E-01,-.43905669E-03, & + & 0.10088600E+01,0.93480554E-02,-.30501479E-03, & + & 0.10064500E+01,0.70477706E-02,-.16062856E-03, & + & 0.10035200E+01,0.42808098E-02,-.17931712E-04, & + & 0.10000500E+01,0.10431767E-02,0.11168529E-03, & + & 0.99611100E+00,-.27563642E-02,0.24240882E-03, & + & 0.99174800E+00,-.71610203E-02,0.38448017E-03, & + & 0.98677500E+00,-.11856521E-01,0.47077353E-03, & + & 0.98127900E+00,-.16584692E-01,0.45765935E-03, & + & 0.97539600E+00,-.21783703E-01,0.53320789E-03, & + & 0.96939000E+00,-.27133682E-01,0.61199590E-03, & + & 0.96369600E+00,-.32216511E-01,0.67564928E-03/ + data ((pk0(l,k, 2),l=1,3),k=151,165)/ & + & 0.96241400E+00,-.33361165E-01,0.68800456E-03, & + & 0.96122800E+00,-.34423928E-01,0.69970926E-03, & + & 0.96014400E+00,-.35392551E-01,0.70953920E-03, & + & 0.95916900E+00,-.36264643E-01,0.71839860E-03, & + & 0.95831300E+00,-.37031377E-01,0.72575471E-03, & + & 0.95757600E+00,-.37681048E-01,0.73072509E-03, & + & 0.95698600E+00,-.38223649E-01,0.73649836E-03, & + & 0.95651800E+00,-.38632128E-01,0.73926571E-03, & + & 0.95620200E+00,-.38912153E-01,0.74136405E-03, & + & 0.95604500E+00,-.39057706E-01,0.74271120E-03, & + & 0.95622200E+00,-.38902954E-01,0.73961296E-03, & + & 0.95778400E+00,-.37512940E-01,0.71313056E-03, & + & 0.96091200E+00,-.34734810E-01,0.66040680E-03, & + & 0.96560200E+00,-.30566472E-01,0.58115604E-03, & + & 0.97185600E+00,-.25007680E-01,0.47515663E-03/ + data ((pk0(l,k, 2),l=1,3),k=166,180)/ & + & 0.97967500E+00,-.18061875E-01,0.34342023E-03, & + & 0.98905800E+00,-.97255699E-02,0.18481515E-03, & + & 0.10000000E+01,-.23134272E-13,-.64878658E-14, & + & 0.10125100E+01,0.11112990E-01,-.21100754E-03, & + & 0.10265800E+01,0.23621096E-01,-.44945784E-03, & + & 0.10422100E+01,0.37517055E-01,-.71369353E-03, & + & 0.10594100E+01,0.52801676E-01,-.10049392E-02, & + & 0.10781800E+01,0.69469519E-01,-.13207875E-02, & + & 0.10985000E+01,0.87532718E-01,-.16641203E-02, & + & 0.11203900E+01,0.10697980E+00,-.20330527E-02, & + & 0.11438400E+01,0.12783116E+00,-.24319791E-02, & + & 0.11688600E+01,0.15005237E+00,-.28525840E-02, & + & 0.11954400E+01,0.17367747E+00,-.33030503E-02, & + & 0.12235900E+01,0.19867522E+00,-.37759426E-02, & + & 0.10000000E+01,-.23134272E-13,-.64878658E-14/ + data ((pk0(l,k, 3),l=1,3),k= 1, 15)/ & + & 0.94051600E+00,-.10489579E+00,0.48715284E-02, & + & 0.94051700E+00,-.10489404E+00,0.48710030E-02, & + & 0.94051900E+00,-.10489153E+00,0.48704553E-02, & + & 0.94051900E+00,-.10488780E+00,0.48696017E-02, & + & 0.94052300E+00,-.10488456E+00,0.48688296E-02, & + & 0.94052600E+00,-.10487964E+00,0.48676979E-02, & + & 0.94052900E+00,-.10487553E+00,0.48667815E-02, & + & 0.94053300E+00,-.10487066E+00,0.48656727E-02, & + & 0.94053600E+00,-.10486555E+00,0.48645820E-02, & + & 0.94054100E+00,-.10486048E+00,0.48635400E-02, & + & 0.94054400E+00,-.10485316E+00,0.48619598E-02, & + & 0.94054900E+00,-.10484693E+00,0.48607066E-02, & + & 0.94055300E+00,-.10483849E+00,0.48589269E-02, & + & 0.94055800E+00,-.10483053E+00,0.48573568E-02, & + & 0.94056500E+00,-.10482288E+00,0.48557996E-02/ + data ((pk0(l,k, 3),l=1,3),k= 16, 30)/ & + & 0.94057100E+00,-.10481312E+00,0.48539251E-02, & + & 0.94057800E+00,-.10480329E+00,0.48520071E-02, & + & 0.94058500E+00,-.10479213E+00,0.48498371E-02, & + & 0.94059300E+00,-.10478051E+00,0.48476639E-02, & + & 0.94060300E+00,-.10476852E+00,0.48453988E-02, & + & 0.94061100E+00,-.10475352E+00,0.48426394E-02, & + & 0.94062000E+00,-.10473818E+00,0.48398114E-02, & + & 0.94063200E+00,-.10472289E+00,0.48369962E-02, & + & 0.94064300E+00,-.10470517E+00,0.48337586E-02, & + & 0.94065600E+00,-.10468669E+00,0.48305374E-02, & + & 0.94066900E+00,-.10466632E+00,0.48268946E-02, & + & 0.94068400E+00,-.10464439E+00,0.48229787E-02, & + & 0.94070000E+00,-.10462153E+00,0.48190192E-02, & + & 0.94071600E+00,-.10459559E+00,0.48145052E-02, & + & 0.94073400E+00,-.10456954E+00,0.48101036E-02/ + data ((pk0(l,k, 3),l=1,3),k= 31, 45)/ & + & 0.94075400E+00,-.10454042E+00,0.48051454E-02, & + & 0.94077400E+00,-.10450802E+00,0.47996399E-02, & + & 0.94079600E+00,-.10447371E+00,0.47938437E-02, & + & 0.94082100E+00,-.10443845E+00,0.47879584E-02, & + & 0.94084600E+00,-.10439889E+00,0.47814248E-02, & + & 0.94087300E+00,-.10435708E+00,0.47746171E-02, & + & 0.94090300E+00,-.10431131E+00,0.47669746E-02, & + & 0.94093500E+00,-.10426349E+00,0.47593740E-02, & + & 0.94097000E+00,-.10421115E+00,0.47507777E-02, & + & 0.94100800E+00,-.10415626E+00,0.47420034E-02, & + & 0.94104400E+00,-.10409522E+00,0.47322911E-02, & + & 0.94108700E+00,-.10403239E+00,0.47224022E-02, & + & 0.94113300E+00,-.10396366E+00,0.47116258E-02, & + & 0.94118100E+00,-.10388976E+00,0.47000362E-02, & + & 0.94123300E+00,-.10381108E+00,0.46878408E-02/ + data ((pk0(l,k, 3),l=1,3),k= 46, 60)/ & + & 0.94128700E+00,-.10372604E+00,0.46746893E-02, & + & 0.94134700E+00,-.10363695E+00,0.46610886E-02, & + & 0.94141100E+00,-.10354017E+00,0.46463506E-02, & + & 0.94147900E+00,-.10343543E+00,0.46302788E-02, & + & 0.94155000E+00,-.10332211E+00,0.46130279E-02, & + & 0.94162700E+00,-.10320533E+00,0.45957277E-02, & + & 0.94171000E+00,-.10307847E+00,0.45767402E-02, & + & 0.94179900E+00,-.10294307E+00,0.45566523E-02, & + & 0.94189300E+00,-.10279733E+00,0.45350974E-02, & + & 0.94199300E+00,-.10264231E+00,0.45124000E-02, & + & 0.94210100E+00,-.10247579E+00,0.44879939E-02, & + & 0.94221400E+00,-.10229881E+00,0.44622560E-02, & + & 0.94233800E+00,-.10211028E+00,0.44350670E-02, & + & 0.94246700E+00,-.10190857E+00,0.44060822E-02, & + & 0.94260500E+00,-.10169310E+00,0.43754108E-02/ + data ((pk0(l,k, 3),l=1,3),k= 61, 75)/ & + & 0.94275300E+00,-.10146313E+00,0.43427253E-02, & + & 0.94290900E+00,-.10121892E+00,0.43083875E-02, & + & 0.94307500E+00,-.10095816E+00,0.42718661E-02, & + & 0.94325500E+00,-.10068124E+00,0.42332193E-02, & + & 0.94344100E+00,-.10038444E+00,0.41922240E-02, & + & 0.94364300E+00,-.10007120E+00,0.41492262E-02, & + & 0.94385600E+00,-.99736735E-01,0.41035380E-02, & + & 0.94408200E+00,-.99378942E-01,0.40548772E-02, & + & 0.94432300E+00,-.99002645E-01,0.40042297E-02, & + & 0.94457500E+00,-.98598802E-01,0.39501093E-02, & + & 0.94484400E+00,-.98170855E-01,0.38930944E-02, & + & 0.94513000E+00,-.97719666E-01,0.38336228E-02, & + & 0.94543000E+00,-.97237328E-01,0.37703421E-02, & + & 0.94575100E+00,-.96730771E-01,0.37049429E-02, & + & 0.94608600E+00,-.96189509E-01,0.36350707E-02/ + data ((pk0(l,k, 3),l=1,3),k= 76, 90)/ & + & 0.94644200E+00,-.95618951E-01,0.35621343E-02, & + & 0.94681500E+00,-.95014272E-01,0.34855445E-02, & + & 0.94721200E+00,-.94375945E-01,0.34054298E-02, & + & 0.94762600E+00,-.93700439E-01,0.33216907E-02, & + & 0.94806500E+00,-.92991241E-01,0.32346442E-02, & + & 0.94852300E+00,-.92237194E-01,0.31425553E-02, & + & 0.94900600E+00,-.91447332E-01,0.30476655E-02, & + & 0.94951500E+00,-.90613643E-01,0.29484184E-02, & + & 0.95004500E+00,-.89737513E-01,0.28454922E-02, & + & 0.95060100E+00,-.88816909E-01,0.27388927E-02, & + & 0.95118300E+00,-.87847995E-01,0.26274728E-02, & + & 0.95179600E+00,-.86836954E-01,0.25136794E-02, & + & 0.95242500E+00,-.85769916E-01,0.23944759E-02, & + & 0.95309200E+00,-.84660480E-01,0.22732017E-02, & + & 0.95378300E+00,-.83496408E-01,0.21474545E-02/ + data ((pk0(l,k, 3),l=1,3),k= 91,105)/ & + & 0.95450100E+00,-.82282802E-01,0.20190161E-02, & + & 0.95524600E+00,-.81015982E-01,0.18872765E-02, & + & 0.95601600E+00,-.79692699E-01,0.17519318E-02, & + & 0.95682000E+00,-.78317905E-01,0.16141570E-02, & + & 0.95765100E+00,-.76887515E-01,0.14741437E-02, & + & 0.95851000E+00,-.75406868E-01,0.13329105E-02, & + & 0.95939800E+00,-.73865930E-01,0.11887084E-02, & + & 0.96031600E+00,-.72277198E-01,0.10448877E-02, & + & 0.96125600E+00,-.70629274E-01,0.89938631E-03, & + & 0.96222700E+00,-.68923924E-01,0.75250841E-03, & + & 0.96322800E+00,-.67171996E-01,0.60735176E-03, & + & 0.96425300E+00,-.65364956E-01,0.46250599E-03, & + & 0.96529900E+00,-.63505098E-01,0.31908929E-03, & + & 0.96638200E+00,-.61601483E-01,0.17865032E-03, & + & 0.96748400E+00,-.59644723E-01,0.39548326E-04/ + data ((pk0(l,k, 3),l=1,3),k=106,120)/ & + & 0.96861000E+00,-.57639565E-01,-.96555044E-04, & + & 0.96976400E+00,-.55598945E-01,-.22688480E-03, & + & 0.97094000E+00,-.53515509E-01,-.35296675E-03, & + & 0.97213800E+00,-.51398581E-01,-.47323236E-03, & + & 0.97335800E+00,-.49248920E-01,-.58784941E-03, & + & 0.97460000E+00,-.47079449E-01,-.69450336E-03, & + & 0.97585400E+00,-.44894291E-01,-.79329273E-03, & + & 0.97712200E+00,-.42701967E-01,-.88385405E-03, & + & 0.97841000E+00,-.40526023E-01,-.96429278E-03, & + & 0.97969300E+00,-.38366552E-01,-.10375401E-02, & + & 0.98098500E+00,-.36257763E-01,-.11003177E-02, & + & 0.98229400E+00,-.34179783E-01,-.11534616E-02, & + & 0.98360300E+00,-.32120367E-01,-.11988169E-02, & + & 0.98494000E+00,-.30101841E-01,-.12334068E-02, & + & 0.98629400E+00,-.28122503E-01,-.12598669E-02/ + data ((pk0(l,k, 3),l=1,3),k=121,135)/ & + & 0.98766100E+00,-.26194901E-01,-.12775121E-02, & + & 0.98904300E+00,-.24317995E-01,-.12895868E-02, & + & 0.99043800E+00,-.22507118E-01,-.12951502E-02, & + & 0.99185100E+00,-.20757308E-01,-.12987447E-02, & + & 0.99327300E+00,-.19085296E-01,-.12984059E-02, & + & 0.99471800E+00,-.17483854E-01,-.12984710E-02, & + & 0.99615200E+00,-.15949496E-01,-.13014977E-02, & + & 0.99751600E+00,-.14574443E-01,-.13204913E-02, & + & 0.99752000E+00,-.14578003E-01,-.13199632E-02, & + & 0.99751800E+00,-.14575385E-01,-.13203117E-02, & + & 0.99751800E+00,-.14574061E-01,-.13206655E-02, & + & 0.99751800E+00,-.14574988E-01,-.13204144E-02, & + & 0.99751900E+00,-.14575169E-01,-.13204198E-02, & + & 0.99751900E+00,-.14575643E-01,-.13203115E-02, & + & 0.99751800E+00,-.14574669E-01,-.13205369E-02/ + data ((pk0(l,k, 3),l=1,3),k=136,150)/ & + & 0.99751800E+00,-.14574284E-01,-.13205754E-02, & + & 0.99752000E+00,-.14576291E-01,-.13201361E-02, & + & 0.99751900E+00,-.14575495E-01,-.13203060E-02, & + & 0.99751900E+00,-.14575069E-01,-.13203659E-02, & + & 0.99752100E+00,-.14575803E-01,-.13202931E-02, & + & 0.99751800E+00,-.14576127E-01,-.13201530E-02, & + & 0.99752100E+00,-.14576630E-01,-.13201782E-02, & + & 0.99751500E+00,-.14574665E-01,-.13204692E-02, & + & 0.99611100E+00,-.13299123E-01,-.15676561E-02, & + & 0.99174700E+00,-.93435647E-02,-.23338257E-02, & + & 0.98677800E+00,-.77463430E-02,-.23593058E-02, & + & 0.98127900E+00,-.15677166E-01,0.62981698E-04, & + & 0.97539500E+00,-.21784370E-01,0.53342489E-03, & + & 0.96938700E+00,-.27131873E-01,0.61159911E-03, & + & 0.96369600E+00,-.32215883E-01,0.67548543E-03/ + data ((pk0(l,k, 3),l=1,3),k=151,165)/ & + & 0.96241400E+00,-.33362549E-01,0.68832117E-03, & + & 0.96122600E+00,-.34423292E-01,0.69962733E-03, & + & 0.96014300E+00,-.35392434E-01,0.70945212E-03, & + & 0.95917000E+00,-.36263826E-01,0.71824208E-03, & + & 0.95831200E+00,-.37028908E-01,0.72532537E-03, & + & 0.95758000E+00,-.37683966E-01,0.73126832E-03, & + & 0.95698200E+00,-.38221559E-01,0.73606070E-03, & + & 0.95652200E+00,-.38632504E-01,0.73928543E-03, & + & 0.95620600E+00,-.38910023E-01,0.74069082E-03, & + & 0.95604600E+00,-.39058042E-01,0.74274698E-03, & + & 0.95622100E+00,-.38903045E-01,0.73964725E-03, & + & 0.95778300E+00,-.37513059E-01,0.71322236E-03, & + & 0.96091300E+00,-.34735600E-01,0.66051381E-03, & + & 0.96560000E+00,-.30564832E-01,0.58082345E-03, & + & 0.97185800E+00,-.25009451E-01,0.47546715E-03/ + data ((pk0(l,k, 3),l=1,3),k=166,180)/ & + & 0.97967200E+00,-.18059928E-01,0.34280564E-03, & + & 0.98905500E+00,-.97255290E-02,0.18483470E-03, & + & 0.10000000E+01,-.23134272E-13,-.64878658E-14, & + & 0.10125100E+01,0.11112990E-01,-.21100754E-03, & + & 0.10265800E+01,0.23616219E-01,-.44808781E-03, & + & 0.10422200E+01,0.37507991E-01,-.71193763E-03, & + & 0.10594100E+01,0.52799245E-01,-.10043241E-02, & + & 0.10781800E+01,0.69467404E-01,-.13205290E-02, & + & 0.10985000E+01,0.87535210E-01,-.16652030E-02, & + & 0.11203900E+01,0.10698480E+00,-.20348630E-02, & + & 0.11438500E+01,0.12782210E+00,-.24302232E-02, & + & 0.11688600E+01,0.15005703E+00,-.28537539E-02, & + & 0.11954500E+01,0.17366628E+00,-.33006994E-02, & + & 0.12235900E+01,0.19868247E+00,-.37777527E-02, & + & 0.10000000E+01,-.23134272E-13,-.64878658E-14/ + data ((pk0(l,k, 4),l=1,3),k= 1, 15)/ & + & 0.94051600E+00,-.10489579E+00,0.48715284E-02, & + & 0.94051700E+00,-.10489404E+00,0.48710030E-02, & + & 0.94051900E+00,-.10489153E+00,0.48704553E-02, & + & 0.94051900E+00,-.10488780E+00,0.48696017E-02, & + & 0.94052300E+00,-.10488456E+00,0.48688296E-02, & + & 0.94052600E+00,-.10487964E+00,0.48676979E-02, & + & 0.94052900E+00,-.10487553E+00,0.48667815E-02, & + & 0.94053300E+00,-.10487066E+00,0.48656727E-02, & + & 0.94053600E+00,-.10486555E+00,0.48645820E-02, & + & 0.94054100E+00,-.10486048E+00,0.48635400E-02, & + & 0.94054400E+00,-.10485316E+00,0.48619598E-02, & + & 0.94054900E+00,-.10484693E+00,0.48607066E-02, & + & 0.94055300E+00,-.10483849E+00,0.48589269E-02, & + & 0.94055800E+00,-.10483053E+00,0.48573568E-02, & + & 0.94056500E+00,-.10482288E+00,0.48557996E-02/ + data ((pk0(l,k, 4),l=1,3),k= 16, 30)/ & + & 0.94057100E+00,-.10481312E+00,0.48539251E-02, & + & 0.94057800E+00,-.10480329E+00,0.48520071E-02, & + & 0.94058500E+00,-.10479213E+00,0.48498371E-02, & + & 0.94059300E+00,-.10478051E+00,0.48476639E-02, & + & 0.94060300E+00,-.10476852E+00,0.48453988E-02, & + & 0.94061100E+00,-.10475352E+00,0.48426394E-02, & + & 0.94062000E+00,-.10473818E+00,0.48398114E-02, & + & 0.94063200E+00,-.10472289E+00,0.48369962E-02, & + & 0.94064300E+00,-.10470517E+00,0.48337586E-02, & + & 0.94065600E+00,-.10468669E+00,0.48305374E-02, & + & 0.94066900E+00,-.10466632E+00,0.48268946E-02, & + & 0.94068400E+00,-.10464439E+00,0.48229787E-02, & + & 0.94070000E+00,-.10462153E+00,0.48190192E-02, & + & 0.94071600E+00,-.10459559E+00,0.48145052E-02, & + & 0.94073400E+00,-.10456954E+00,0.48101036E-02/ + data ((pk0(l,k, 4),l=1,3),k= 31, 45)/ & + & 0.94075400E+00,-.10454042E+00,0.48051454E-02, & + & 0.94077400E+00,-.10450802E+00,0.47996399E-02, & + & 0.94079600E+00,-.10447371E+00,0.47938437E-02, & + & 0.94082100E+00,-.10443845E+00,0.47879584E-02, & + & 0.94084600E+00,-.10439889E+00,0.47814248E-02, & + & 0.94087300E+00,-.10435708E+00,0.47746171E-02, & + & 0.94090300E+00,-.10431131E+00,0.47669746E-02, & + & 0.94093500E+00,-.10426349E+00,0.47593740E-02, & + & 0.94097000E+00,-.10421115E+00,0.47507777E-02, & + & 0.94100800E+00,-.10415626E+00,0.47420034E-02, & + & 0.94104400E+00,-.10409522E+00,0.47322911E-02, & + & 0.94108700E+00,-.10403239E+00,0.47224022E-02, & + & 0.94113300E+00,-.10396366E+00,0.47116258E-02, & + & 0.94118100E+00,-.10388976E+00,0.47000362E-02, & + & 0.94123300E+00,-.10381108E+00,0.46878408E-02/ + data ((pk0(l,k, 4),l=1,3),k= 46, 60)/ & + & 0.94128700E+00,-.10372604E+00,0.46746893E-02, & + & 0.94134700E+00,-.10363695E+00,0.46610886E-02, & + & 0.94141100E+00,-.10354017E+00,0.46463506E-02, & + & 0.94147900E+00,-.10343543E+00,0.46302788E-02, & + & 0.94155000E+00,-.10332211E+00,0.46130279E-02, & + & 0.94162700E+00,-.10320533E+00,0.45957277E-02, & + & 0.94171000E+00,-.10307847E+00,0.45767402E-02, & + & 0.94179900E+00,-.10294307E+00,0.45566523E-02, & + & 0.94189300E+00,-.10279733E+00,0.45350974E-02, & + & 0.94199300E+00,-.10264231E+00,0.45124000E-02, & + & 0.94210100E+00,-.10247579E+00,0.44879939E-02, & + & 0.94221400E+00,-.10229881E+00,0.44622560E-02, & + & 0.94233800E+00,-.10211028E+00,0.44350670E-02, & + & 0.94246700E+00,-.10190857E+00,0.44060822E-02, & + & 0.94260500E+00,-.10169310E+00,0.43754108E-02/ + data ((pk0(l,k, 4),l=1,3),k= 61, 75)/ & + & 0.94275300E+00,-.10146313E+00,0.43427253E-02, & + & 0.94290900E+00,-.10121892E+00,0.43083875E-02, & + & 0.94307500E+00,-.10095816E+00,0.42718661E-02, & + & 0.94325500E+00,-.10068124E+00,0.42332193E-02, & + & 0.94344100E+00,-.10038444E+00,0.41922240E-02, & + & 0.94364300E+00,-.10007120E+00,0.41492262E-02, & + & 0.94385600E+00,-.99736735E-01,0.41035380E-02, & + & 0.94408200E+00,-.99378942E-01,0.40548772E-02, & + & 0.94432300E+00,-.99002645E-01,0.40042297E-02, & + & 0.94457500E+00,-.98598802E-01,0.39501093E-02, & + & 0.94484400E+00,-.98170855E-01,0.38930944E-02, & + & 0.94513000E+00,-.97719666E-01,0.38336228E-02, & + & 0.94543000E+00,-.97237328E-01,0.37703421E-02, & + & 0.94575100E+00,-.96730771E-01,0.37049429E-02, & + & 0.94608600E+00,-.96189509E-01,0.36350707E-02/ + data ((pk0(l,k, 4),l=1,3),k= 76, 90)/ & + & 0.94644200E+00,-.95618951E-01,0.35621343E-02, & + & 0.94681500E+00,-.95014272E-01,0.34855445E-02, & + & 0.94721200E+00,-.94375945E-01,0.34054298E-02, & + & 0.94762600E+00,-.93700439E-01,0.33216907E-02, & + & 0.94806500E+00,-.92991241E-01,0.32346442E-02, & + & 0.94852300E+00,-.92237194E-01,0.31425553E-02, & + & 0.94900600E+00,-.91447332E-01,0.30476655E-02, & + & 0.94951500E+00,-.90613643E-01,0.29484184E-02, & + & 0.95004500E+00,-.89737513E-01,0.28454922E-02, & + & 0.95060100E+00,-.88816909E-01,0.27388927E-02, & + & 0.95118300E+00,-.87847995E-01,0.26274728E-02, & + & 0.95179600E+00,-.86836954E-01,0.25136794E-02, & + & 0.95242500E+00,-.85769916E-01,0.23944759E-02, & + & 0.95309200E+00,-.84660480E-01,0.22732017E-02, & + & 0.95378300E+00,-.83496408E-01,0.21474545E-02/ + data ((pk0(l,k, 4),l=1,3),k= 91,105)/ & + & 0.95450100E+00,-.82282802E-01,0.20190161E-02, & + & 0.95524600E+00,-.81015982E-01,0.18872765E-02, & + & 0.95601600E+00,-.79692699E-01,0.17519318E-02, & + & 0.95682000E+00,-.78317905E-01,0.16141570E-02, & + & 0.95765100E+00,-.76887515E-01,0.14741437E-02, & + & 0.95851000E+00,-.75406868E-01,0.13329105E-02, & + & 0.95939800E+00,-.73865930E-01,0.11887084E-02, & + & 0.96031600E+00,-.72277198E-01,0.10448877E-02, & + & 0.96125600E+00,-.70629274E-01,0.89938631E-03, & + & 0.96222700E+00,-.68923924E-01,0.75250841E-03, & + & 0.96322800E+00,-.67171996E-01,0.60735176E-03, & + & 0.96425300E+00,-.65364956E-01,0.46250599E-03, & + & 0.96529900E+00,-.63505098E-01,0.31908929E-03, & + & 0.96638200E+00,-.61601483E-01,0.17865032E-03, & + & 0.96748400E+00,-.59644723E-01,0.39548326E-04/ + data ((pk0(l,k, 4),l=1,3),k=106,120)/ & + & 0.96861000E+00,-.57639565E-01,-.96555044E-04, & + & 0.96976400E+00,-.55598945E-01,-.22688480E-03, & + & 0.97094000E+00,-.53515509E-01,-.35296675E-03, & + & 0.97213800E+00,-.51398581E-01,-.47323236E-03, & + & 0.97335800E+00,-.49248920E-01,-.58784941E-03, & + & 0.97460000E+00,-.47079449E-01,-.69450336E-03, & + & 0.97585400E+00,-.44894291E-01,-.79329273E-03, & + & 0.97712200E+00,-.42701967E-01,-.88385405E-03, & + & 0.97841000E+00,-.40526023E-01,-.96429278E-03, & + & 0.97969300E+00,-.38366552E-01,-.10375401E-02, & + & 0.98098500E+00,-.36257763E-01,-.11003177E-02, & + & 0.98229400E+00,-.34179783E-01,-.11534616E-02, & + & 0.98360300E+00,-.32120367E-01,-.11988169E-02, & + & 0.98494000E+00,-.30101841E-01,-.12334068E-02, & + & 0.98629400E+00,-.28122503E-01,-.12598669E-02/ + data ((pk0(l,k, 4),l=1,3),k=121,135)/ & + & 0.98766100E+00,-.26194901E-01,-.12775121E-02, & + & 0.98904300E+00,-.24317995E-01,-.12895868E-02, & + & 0.99043800E+00,-.22507118E-01,-.12951502E-02, & + & 0.99185100E+00,-.20757308E-01,-.12987447E-02, & + & 0.99327300E+00,-.19085296E-01,-.12984059E-02, & + & 0.99471800E+00,-.17483854E-01,-.12984710E-02, & + & 0.99615200E+00,-.15949496E-01,-.13014977E-02, & + & 0.99751600E+00,-.14574443E-01,-.13204913E-02, & + & 0.99752000E+00,-.14578003E-01,-.13199632E-02, & + & 0.99751800E+00,-.14575385E-01,-.13203117E-02, & + & 0.99751800E+00,-.14574061E-01,-.13206655E-02, & + & 0.99751800E+00,-.14574988E-01,-.13204144E-02, & + & 0.99751900E+00,-.14575169E-01,-.13204198E-02, & + & 0.99751900E+00,-.14575643E-01,-.13203115E-02, & + & 0.99751800E+00,-.14574669E-01,-.13205369E-02/ + data ((pk0(l,k, 4),l=1,3),k=136,150)/ & + & 0.99751800E+00,-.14574284E-01,-.13205754E-02, & + & 0.99752000E+00,-.14576291E-01,-.13201361E-02, & + & 0.99751900E+00,-.14575495E-01,-.13203060E-02, & + & 0.99751900E+00,-.14575069E-01,-.13203659E-02, & + & 0.99752100E+00,-.14575803E-01,-.13202931E-02, & + & 0.99751800E+00,-.14576127E-01,-.13201530E-02, & + & 0.99752100E+00,-.14576630E-01,-.13201782E-02, & + & 0.99751500E+00,-.14574665E-01,-.13204692E-02, & + & 0.99611100E+00,-.13299123E-01,-.15676561E-02, & + & 0.99174700E+00,-.93435647E-02,-.23338257E-02, & + & 0.98677800E+00,-.77463430E-02,-.23593058E-02, & + & 0.98127900E+00,-.15677166E-01,0.62981698E-04, & + & 0.97539500E+00,-.21784370E-01,0.53342489E-03, & + & 0.96938700E+00,-.27131873E-01,0.61159911E-03, & + & 0.96369600E+00,-.32215883E-01,0.67548543E-03/ + data ((pk0(l,k, 4),l=1,3),k=151,165)/ & + & 0.96241400E+00,-.33362549E-01,0.68832117E-03, & + & 0.96122600E+00,-.34423292E-01,0.69962733E-03, & + & 0.96014300E+00,-.35392434E-01,0.70945212E-03, & + & 0.95917000E+00,-.36263826E-01,0.71824208E-03, & + & 0.95831200E+00,-.37028908E-01,0.72532537E-03, & + & 0.95758000E+00,-.37683966E-01,0.73126832E-03, & + & 0.95698200E+00,-.38221559E-01,0.73606070E-03, & + & 0.95652200E+00,-.38632504E-01,0.73928543E-03, & + & 0.95620600E+00,-.38910023E-01,0.74069082E-03, & + & 0.95604600E+00,-.39058042E-01,0.74274698E-03, & + & 0.95622100E+00,-.38903045E-01,0.73964725E-03, & + & 0.95778300E+00,-.37513059E-01,0.71322236E-03, & + & 0.96091300E+00,-.34735600E-01,0.66051381E-03, & + & 0.96560000E+00,-.30564832E-01,0.58082345E-03, & + & 0.97185800E+00,-.25009451E-01,0.47546715E-03/ + data ((pk0(l,k, 4),l=1,3),k=166,180)/ & + & 0.97967200E+00,-.18059928E-01,0.34280564E-03, & + & 0.98905500E+00,-.97255290E-02,0.18483470E-03, & + & 0.10000000E+01,-.23134272E-13,-.64878658E-14, & + & 0.10125100E+01,0.11112990E-01,-.21100754E-03, & + & 0.10265800E+01,0.23616219E-01,-.44808781E-03, & + & 0.10422200E+01,0.37507991E-01,-.71193763E-03, & + & 0.10594100E+01,0.52799245E-01,-.10043241E-02, & + & 0.10781800E+01,0.69467404E-01,-.13205290E-02, & + & 0.10985000E+01,0.87535210E-01,-.16652030E-02, & + & 0.11203900E+01,0.10698480E+00,-.20348630E-02, & + & 0.11438500E+01,0.12782210E+00,-.24302232E-02, & + & 0.11688600E+01,0.15005703E+00,-.28537539E-02, & + & 0.11954500E+01,0.17366628E+00,-.33006994E-02, & + & 0.12235900E+01,0.19868247E+00,-.37777527E-02, & + & 0.10000000E+01,-.23134272E-13,-.64878658E-14/ + data ((pk0(l,k, 5),l=1,3),k= 1, 15)/ & + & 0.94051800E+00,-.10489927E+00,0.48721665E-02, & + & 0.94051700E+00,-.10489526E+00,0.48714084E-02, & + & 0.94052000E+00,-.10489276E+00,0.48706977E-02, & + & 0.94052100E+00,-.10488659E+00,0.48692605E-02, & + & 0.94052500E+00,-.10488518E+00,0.48688837E-02, & + & 0.94052600E+00,-.10488170E+00,0.48682060E-02, & + & 0.94052900E+00,-.10487543E+00,0.48668201E-02, & + & 0.94053500E+00,-.10487153E+00,0.48657996E-02, & + & 0.94053500E+00,-.10486561E+00,0.48646134E-02, & + & 0.94053600E+00,-.10485692E+00,0.48628164E-02, & + & 0.94054700E+00,-.10485306E+00,0.48618460E-02, & + & 0.94055300E+00,-.10484740E+00,0.48606687E-02, & + & 0.94055400E+00,-.10484014E+00,0.48593123E-02, & + & 0.94055900E+00,-.10483165E+00,0.48575938E-02, & + & 0.94056500E+00,-.10482224E+00,0.48556709E-02/ + data ((pk0(l,k, 5),l=1,3),k= 16, 30)/ & + & 0.94057100E+00,-.10481336E+00,0.48539866E-02, & + & 0.94057800E+00,-.10480381E+00,0.48521380E-02, & + & 0.94058500E+00,-.10479209E+00,0.48498370E-02, & + & 0.94059300E+00,-.10478057E+00,0.48477216E-02, & + & 0.94060200E+00,-.10476826E+00,0.48453986E-02, & + & 0.94061100E+00,-.10475369E+00,0.48426192E-02, & + & 0.94062100E+00,-.10473876E+00,0.48398824E-02, & + & 0.94063200E+00,-.10472362E+00,0.48371592E-02, & + & 0.94064200E+00,-.10470454E+00,0.48336412E-02, & + & 0.94065500E+00,-.10468596E+00,0.48303564E-02, & + & 0.94066900E+00,-.10466609E+00,0.48268063E-02, & + & 0.94068400E+00,-.10464483E+00,0.48230728E-02, & + & 0.94069900E+00,-.10462042E+00,0.48187997E-02, & + & 0.94071600E+00,-.10459605E+00,0.48145867E-02, & + & 0.94073400E+00,-.10456829E+00,0.48097527E-02/ + data ((pk0(l,k, 5),l=1,3),k= 31, 45)/ & + & 0.94075300E+00,-.10453947E+00,0.48049469E-02, & + & 0.94077400E+00,-.10450777E+00,0.47995672E-02, & + & 0.94079700E+00,-.10447440E+00,0.47939405E-02, & + & 0.94082100E+00,-.10443896E+00,0.47881241E-02, & + & 0.94084600E+00,-.10439823E+00,0.47812577E-02, & + & 0.94087400E+00,-.10435734E+00,0.47745992E-02, & + & 0.94090300E+00,-.10431171E+00,0.47670973E-02, & + & 0.94093500E+00,-.10426349E+00,0.47593560E-02, & + & 0.94097000E+00,-.10421141E+00,0.47509147E-02, & + & 0.94100800E+00,-.10415763E+00,0.47424216E-02, & + & 0.94104500E+00,-.10409502E+00,0.47322118E-02, & + & 0.94108700E+00,-.10403304E+00,0.47226460E-02, & + & 0.94113200E+00,-.10396220E+00,0.47112837E-02, & + & 0.94118300E+00,-.10389106E+00,0.47002677E-02, & + & 0.94123200E+00,-.10380917E+00,0.46873355E-02/ + data ((pk0(l,k, 5),l=1,3),k= 46, 60)/ & + & 0.94128600E+00,-.10372566E+00,0.46746509E-02, & + & 0.94134600E+00,-.10363545E+00,0.46608132E-02, & + & 0.94141100E+00,-.10353955E+00,0.46462155E-02, & + & 0.94147800E+00,-.10343542E+00,0.46303638E-02, & + & 0.94155100E+00,-.10332462E+00,0.46135086E-02, & + & 0.94162700E+00,-.10320559E+00,0.45957125E-02, & + & 0.94171100E+00,-.10307817E+00,0.45765917E-02, & + & 0.94179900E+00,-.10294294E+00,0.45565872E-02, & + & 0.94189200E+00,-.10279643E+00,0.45349311E-02, & + & 0.94199400E+00,-.10264394E+00,0.45128139E-02, & + & 0.94210200E+00,-.10247802E+00,0.44884585E-02, & + & 0.94221600E+00,-.10230034E+00,0.44626258E-02, & + & 0.94233500E+00,-.10210978E+00,0.44350482E-02, & + & 0.94246500E+00,-.10190818E+00,0.44061459E-02, & + & 0.94260500E+00,-.10169206E+00,0.43752241E-02/ + data ((pk0(l,k, 5),l=1,3),k= 61, 75)/ & + & 0.94275000E+00,-.10146216E+00,0.43424527E-02, & + & 0.94290800E+00,-.10121846E+00,0.43081910E-02, & + & 0.94307600E+00,-.10095842E+00,0.42718863E-02, & + & 0.94325400E+00,-.10068134E+00,0.42332605E-02, & + & 0.94344200E+00,-.10038417E+00,0.41921131E-02, & + & 0.94364200E+00,-.10006989E+00,0.41489387E-02, & + & 0.94385500E+00,-.99733574E-01,0.41028285E-02, & + & 0.94408200E+00,-.99379297E-01,0.40547561E-02, & + & 0.94432000E+00,-.99000000E-01,0.40036563E-02, & + & 0.94457500E+00,-.98599499E-01,0.39501051E-02, & + & 0.94484300E+00,-.98172777E-01,0.38935760E-02, & + & 0.94513100E+00,-.97720122E-01,0.38337351E-02, & + & 0.94543200E+00,-.97239302E-01,0.37708312E-02, & + & 0.94575000E+00,-.96729365E-01,0.37044929E-02, & + & 0.94608400E+00,-.96188368E-01,0.36348208E-02/ + data ((pk0(l,k, 5),l=1,3),k= 76, 90)/ & + & 0.94644000E+00,-.95619707E-01,0.35623625E-02, & + & 0.94681400E+00,-.95011393E-01,0.34849301E-02, & + & 0.94720900E+00,-.94375253E-01,0.34053878E-02, & + & 0.94762200E+00,-.93700380E-01,0.33217959E-02, & + & 0.94806300E+00,-.92988322E-01,0.32342508E-02, & + & 0.94852800E+00,-.92240573E-01,0.31432276E-02, & + & 0.94901000E+00,-.91448018E-01,0.30478539E-02, & + & 0.94951100E+00,-.90611102E-01,0.29478617E-02, & + & 0.95004800E+00,-.89738838E-01,0.28456873E-02, & + & 0.95060300E+00,-.88819151E-01,0.27394469E-02, & + & 0.95119000E+00,-.87852205E-01,0.26283834E-02, & + & 0.95179000E+00,-.86834794E-01,0.25131843E-02, & + & 0.95242800E+00,-.85771806E-01,0.23948526E-02, & + & 0.95309300E+00,-.84661131E-01,0.22732222E-02, & + & 0.95377700E+00,-.83494651E-01,0.21472670E-02/ + data ((pk0(l,k, 5),l=1,3),k= 91,105)/ & + & 0.95449600E+00,-.82282556E-01,0.20191048E-02, & + & 0.95524900E+00,-.81018000E-01,0.18877668E-02, & + & 0.95602300E+00,-.79695230E-01,0.17523131E-02, & + & 0.95681700E+00,-.78314658E-01,0.16135400E-02, & + & 0.95765500E+00,-.76892606E-01,0.14751914E-02, & + & 0.95850500E+00,-.75404417E-01,0.13324193E-02, & + & 0.95939100E+00,-.73864207E-01,0.11884763E-02, & + & 0.96031600E+00,-.72276656E-01,0.10446806E-02, & + & 0.96126000E+00,-.70628157E-01,0.89896085E-03, & + & 0.96222800E+00,-.68926676E-01,0.75313433E-03, & + & 0.96322600E+00,-.67171332E-01,0.60731316E-03, & + & 0.96425200E+00,-.65364959E-01,0.46263818E-03, & + & 0.96530300E+00,-.63506858E-01,0.31933858E-03, & + & 0.96638100E+00,-.61597972E-01,0.17767399E-03, & + & 0.96748400E+00,-.59642946E-01,0.39211281E-04/ + data ((pk0(l,k, 5),l=1,3),k=106,120)/ & + & 0.96861300E+00,-.57642431E-01,-.95909921E-04, & + & 0.96976400E+00,-.55598255E-01,-.22700177E-03, & + & 0.97094000E+00,-.53515378E-01,-.35308858E-03, & + & 0.97213700E+00,-.51396959E-01,-.47359298E-03, & + & 0.97335700E+00,-.49250448E-01,-.58736734E-03, & + & 0.97459600E+00,-.47079175E-01,-.69427829E-03, & + & 0.97585100E+00,-.44893476E-01,-.79324535E-03, & + & 0.97712300E+00,-.42703523E-01,-.88369229E-03, & + & 0.97840600E+00,-.40523717E-01,-.96483373E-03, & + & 0.97969400E+00,-.38368184E-01,-.10370794E-02, & + & 0.98098500E+00,-.36258308E-01,-.11002307E-02, & + & 0.98229100E+00,-.34179213E-01,-.11535924E-02, & + & 0.98360800E+00,-.32123194E-01,-.11983136E-02, & + & 0.98494300E+00,-.30102757E-01,-.12332308E-02, & + & 0.98629300E+00,-.28121962E-01,-.12599465E-02/ + data ((pk0(l,k, 5),l=1,3),k=121,135)/ & + & 0.98765800E+00,-.26192207E-01,-.12779998E-02, & + & 0.98904100E+00,-.24317305E-01,-.12895695E-02, & + & 0.99043900E+00,-.22506077E-01,-.12953099E-02, & + & 0.99185300E+00,-.20761320E-01,-.12977667E-02, & + & 0.99327600E+00,-.19085711E-01,-.12983204E-02, & + & 0.99471300E+00,-.17483438E-01,-.12983620E-02, & + & 0.99614800E+00,-.15947607E-01,-.13017554E-02, & + & 0.99751800E+00,-.14575165E-01,-.13203890E-02, & + & 0.99751900E+00,-.14573745E-01,-.13206503E-02, & + & 0.99752000E+00,-.14576742E-01,-.13199577E-02, & + & 0.99751700E+00,-.14574336E-01,-.13204642E-02, & + & 0.99751900E+00,-.14574886E-01,-.13205282E-02, & + & 0.99752000E+00,-.14575833E-01,-.13202857E-02, & + & 0.99751700E+00,-.14575289E-01,-.13203482E-02, & + & 0.99752100E+00,-.14576566E-01,-.13200389E-02/ + data ((pk0(l,k, 5),l=1,3),k=136,150)/ & + & 0.99751600E+00,-.14574271E-01,-.13205695E-02, & + & 0.99752200E+00,-.14576311E-01,-.13201008E-02, & + & 0.99752200E+00,-.14577331E-01,-.13198203E-02, & + & 0.99752000E+00,-.14577444E-01,-.13200046E-02, & + & 0.99751700E+00,-.14573437E-01,-.13208271E-02, & + & 0.99752200E+00,-.14577228E-01,-.13201381E-02, & + & 0.99751800E+00,-.14573177E-01,-.13208026E-02, & + & 0.99751700E+00,-.14574866E-01,-.13203565E-02, & + & 0.99611500E+00,-.13302124E-01,-.15670510E-02, & + & 0.99174600E+00,-.93432647E-02,-.23339214E-02, & + & 0.98677900E+00,-.77467985E-02,-.23592684E-02, & + & 0.98127800E+00,-.15675498E-01,0.62620242E-04, & + & 0.97539500E+00,-.21783557E-01,0.53319817E-03, & + & 0.96939200E+00,-.27132454E-01,0.61171928E-03, & + & 0.96369600E+00,-.32215883E-01,0.67548543E-03/ + data ((pk0(l,k, 5),l=1,3),k=151,165)/ & + & 0.96241300E+00,-.33361374E-01,0.68806592E-03, & + & 0.96122700E+00,-.34423495E-01,0.69964192E-03, & + & 0.96014300E+00,-.35393005E-01,0.70966679E-03, & + & 0.95917000E+00,-.36263486E-01,0.71806012E-03, & + & 0.95831000E+00,-.37027813E-01,0.72500464E-03, & + & 0.95758000E+00,-.37682858E-01,0.73090799E-03, & + & 0.95698200E+00,-.38220775E-01,0.73589149E-03, & + & 0.95652100E+00,-.38635326E-01,0.73989907E-03, & + & 0.95620800E+00,-.38911433E-01,0.74070396E-03, & + & 0.95604700E+00,-.39062098E-01,0.74380474E-03, & + & 0.95622100E+00,-.38902097E-01,0.73944003E-03, & + & 0.95778400E+00,-.37513365E-01,0.71323615E-03, & + & 0.96091100E+00,-.34733938E-01,0.66022535E-03, & + & 0.96560200E+00,-.30566980E-01,0.58125515E-03, & + & 0.97185500E+00,-.25006518E-01,0.47484624E-03/ + data ((pk0(l,k, 5),l=1,3),k=166,180)/ & + & 0.97967700E+00,-.18062892E-01,0.34359296E-03, & + & 0.98905600E+00,-.97270665E-02,0.18524243E-03, & + & 0.10000000E+01,-.23134272E-13,-.64878658E-14, & + & 0.10125100E+01,0.11112990E-01,-.21100754E-03, & + & 0.10265800E+01,0.23619003E-01,-.44884420E-03, & + & 0.10422200E+01,0.37507849E-01,-.71165011E-03, & + & 0.10594100E+01,0.52801892E-01,-.10051393E-02, & + & 0.10781800E+01,0.69469917E-01,-.13212566E-02, & + & 0.10985000E+01,0.87532718E-01,-.16641203E-02, & + & 0.11204000E+01,0.10697986E+00,-.20335203E-02, & + & 0.11438500E+01,0.12781718E+00,-.24285255E-02, & + & 0.11688600E+01,0.15005237E+00,-.28525840E-02, & + & 0.11954500E+01,0.17366892E+00,-.33011683E-02, & + & 0.12235900E+01,0.19868198E+00,-.37777261E-02, & + & 0.10000000E+01,-.23134272E-13,-.64878658E-14/ + data ((pk0(l,k, 6),l=1,3),k= 1, 15)/ & + & 0.94109400E+00,-.10395382E+00,0.47926122E-02, & + & 0.94111600E+00,-.10391988E+00,0.47890616E-02, & + & 0.94113600E+00,-.10388665E+00,0.47860324E-02, & + & 0.94116000E+00,-.10385001E+00,0.47822053E-02, & + & 0.94118200E+00,-.10380738E+00,0.47773965E-02, & + & 0.94121200E+00,-.10377003E+00,0.47738376E-02, & + & 0.94123300E+00,-.10372765E+00,0.47696293E-02, & + & 0.94126300E+00,-.10368148E+00,0.47645417E-02, & + & 0.94129400E+00,-.10363988E+00,0.47608436E-02, & + & 0.94132800E+00,-.10359299E+00,0.47560336E-02, & + & 0.94135400E+00,-.10353669E+00,0.47497259E-02, & + & 0.94138900E+00,-.10348322E+00,0.47440918E-02, & + & 0.94142500E+00,-.10343005E+00,0.47389282E-02, & + & 0.94145900E+00,-.10337244E+00,0.47331463E-02, & + & 0.94149300E+00,-.10330704E+00,0.47259639E-02/ + data ((pk0(l,k, 6),l=1,3),k= 16, 30)/ & + & 0.94154200E+00,-.10324853E+00,0.47203686E-02, & + & 0.94158000E+00,-.10317885E+00,0.47129443E-02, & + & 0.94163300E+00,-.10310923E+00,0.47056355E-02, & + & 0.94167500E+00,-.10303002E+00,0.46969598E-02, & + & 0.94172000E+00,-.10295449E+00,0.46894442E-02, & + & 0.94177500E+00,-.10287276E+00,0.46808326E-02, & + & 0.94183000E+00,-.10278642E+00,0.46717674E-02, & + & 0.94188700E+00,-.10269507E+00,0.46620755E-02, & + & 0.94194800E+00,-.10260081E+00,0.46522889E-02, & + & 0.94201000E+00,-.10250060E+00,0.46417847E-02, & + & 0.94207700E+00,-.10239536E+00,0.46306538E-02, & + & 0.94214700E+00,-.10228439E+00,0.46188544E-02, & + & 0.94222000E+00,-.10216867E+00,0.46067870E-02, & + & 0.94229700E+00,-.10204665E+00,0.45939388E-02, & + & 0.94237700E+00,-.10191830E+00,0.45804342E-02/ + data ((pk0(l,k, 6),l=1,3),k= 31, 45)/ & + & 0.94246300E+00,-.10178285E+00,0.45659942E-02, & + & 0.94255100E+00,-.10164072E+00,0.45510736E-02, & + & 0.94264600E+00,-.10149277E+00,0.45356530E-02, & + & 0.94274400E+00,-.10133501E+00,0.45189050E-02, & + & 0.94284900E+00,-.10117132E+00,0.45017608E-02, & + & 0.94295900E+00,-.10099750E+00,0.44833630E-02, & + & 0.94307300E+00,-.10081582E+00,0.44642982E-02, & + & 0.94319400E+00,-.10062530E+00,0.44444051E-02, & + & 0.94332100E+00,-.10042309E+00,0.44230275E-02, & + & 0.94345400E+00,-.10021135E+00,0.44007895E-02, & + & 0.94359400E+00,-.99988154E-01,0.43773028E-02, & + & 0.94374000E+00,-.99753491E-01,0.43526188E-02, & + & 0.94389400E+00,-.99508369E-01,0.43271723E-02, & + & 0.94405500E+00,-.99248926E-01,0.42999677E-02, & + & 0.94422500E+00,-.98978445E-01,0.42718677E-02/ + data ((pk0(l,k, 6),l=1,3),k= 46, 60)/ & + & 0.94440400E+00,-.98692456E-01,0.42419831E-02, & + & 0.94459100E+00,-.98393170E-01,0.42110451E-02, & + & 0.94478800E+00,-.98078577E-01,0.41785450E-02, & + & 0.94499500E+00,-.97748812E-01,0.41444943E-02, & + & 0.94520900E+00,-.97401236E-01,0.41088161E-02, & + & 0.94543700E+00,-.97036701E-01,0.40712695E-02, & + & 0.94567500E+00,-.96656137E-01,0.40327532E-02, & + & 0.94592300E+00,-.96254511E-01,0.39916373E-02, & + & 0.94618400E+00,-.95832967E-01,0.39488176E-02, & + & 0.94645800E+00,-.95393111E-01,0.39045521E-02, & + & 0.94674400E+00,-.94930433E-01,0.38580018E-02, & + & 0.94704600E+00,-.94446016E-01,0.38095342E-02, & + & 0.94735700E+00,-.93937420E-01,0.37590751E-02, & + & 0.94768500E+00,-.93403800E-01,0.37059738E-02, & + & 0.94803100E+00,-.92848365E-01,0.36516533E-02/ + data ((pk0(l,k, 6),l=1,3),k= 61, 75)/ & + & 0.94838800E+00,-.92263289E-01,0.35942171E-02, & + & 0.94876400E+00,-.91651946E-01,0.35347517E-02, & + & 0.94915500E+00,-.91014061E-01,0.34734450E-02, & + & 0.94956500E+00,-.90344269E-01,0.34090305E-02, & + & 0.94999200E+00,-.89644425E-01,0.33423585E-02, & + & 0.95043500E+00,-.88911916E-01,0.32732158E-02, & + & 0.95090200E+00,-.88149314E-01,0.32020915E-02, & + & 0.95138400E+00,-.87352144E-01,0.31284930E-02, & + & 0.95188900E+00,-.86516565E-01,0.30513966E-02, & + & 0.95241400E+00,-.85649275E-01,0.29730470E-02, & + & 0.95296200E+00,-.84741321E-01,0.28915217E-02, & + & 0.95353400E+00,-.83798337E-01,0.28084985E-02, & + & 0.95412000E+00,-.82808267E-01,0.27214881E-02, & + & 0.95473300E+00,-.81780062E-01,0.26328031E-02, & + & 0.95537800E+00,-.80711421E-01,0.25417395E-02/ + data ((pk0(l,k, 6),l=1,3),k= 76, 90)/ & + & 0.95603600E+00,-.79593530E-01,0.24478547E-02, & + & 0.95672700E+00,-.78434382E-01,0.23524147E-02, & + & 0.95744000E+00,-.77224264E-01,0.22539632E-02, & + & 0.95818600E+00,-.75968720E-01,0.21537520E-02, & + & 0.95895400E+00,-.74667204E-01,0.20528775E-02, & + & 0.95974900E+00,-.73306289E-01,0.19481479E-02, & + & 0.96057700E+00,-.71897916E-01,0.18428588E-02, & + & 0.96143900E+00,-.70436031E-01,0.17360222E-02, & + & 0.96232100E+00,-.68916103E-01,0.16275994E-02, & + & 0.96323600E+00,-.67339680E-01,0.15182472E-02, & + & 0.96419000E+00,-.65703864E-01,0.14074898E-02, & + & 0.96516400E+00,-.64000186E-01,0.12948368E-02, & + & 0.96618400E+00,-.62243056E-01,0.11835809E-02, & + & 0.96723700E+00,-.60418894E-01,0.10715517E-02, & + & 0.96832300E+00,-.58528666E-01,0.95975299E-03/ + data ((pk0(l,k, 6),l=1,3),k= 91,105)/ & + & 0.96944000E+00,-.56568291E-01,0.84819515E-03, & + & 0.97060600E+00,-.54535797E-01,0.73685940E-03, & + & 0.97180300E+00,-.52428747E-01,0.62645033E-03, & + & 0.97305000E+00,-.50246146E-01,0.51758060E-03, & + & 0.97433000E+00,-.47978109E-01,0.40938247E-03, & + & 0.97566000E+00,-.45626773E-01,0.30340512E-03, & + & 0.97704100E+00,-.43186961E-01,0.19984400E-03, & + & 0.97847300E+00,-.40649938E-01,0.98336265E-04, & + & 0.97996200E+00,-.38010099E-01,-.71780752E-06, & + & 0.98151100E+00,-.35262685E-01,-.96433306E-04, & + & 0.98312500E+00,-.32397444E-01,-.18909779E-03, & + & 0.98481000E+00,-.29409098E-01,-.27775771E-03, & + & 0.98656600E+00,-.26286570E-01,-.36275705E-03, & + & 0.98840100E+00,-.23024771E-01,-.44325990E-03, & + & 0.99031800E+00,-.19619179E-01,-.51846068E-03/ + data ((pk0(l,k, 6),l=1,3),k=106,120)/ & + & 0.99231600E+00,-.16069022E-01,-.58730401E-03, & + & 0.99439600E+00,-.12375506E-01,-.64927423E-03, & + & 0.99655500E+00,-.85483897E-02,-.70260403E-03, & + & 0.99878100E+00,-.45980707E-02,-.74696629E-03, & + & 0.10010700E+01,-.55627421E-03,-.77892348E-03, & + & 0.10033900E+01,0.35574767E-02,-.79964143E-03, & + & 0.10057400E+01,0.76933230E-02,-.80483551E-03, & + & 0.10080700E+01,0.11822733E-01,-.79688409E-03, & + & 0.10103800E+01,0.15871931E-01,-.77083835E-03, & + & 0.10126200E+01,0.19807879E-01,-.73006473E-03, & + & 0.10147800E+01,0.23559271E-01,-.67160095E-03, & + & 0.10168200E+01,0.27090433E-01,-.59922858E-03, & + & 0.10187200E+01,0.30362805E-01,-.51513320E-03, & + & 0.10204700E+01,0.33328592E-01,-.42031855E-03, & + & 0.10220600E+01,0.35975702E-01,-.31912734E-03/ + data ((pk0(l,k, 6),l=1,3),k=121,135)/ & + & 0.10234700E+01,0.38298332E-01,-.21695143E-03, & + & 0.10247200E+01,0.40279467E-01,-.11534940E-03, & + & 0.10258000E+01,0.41933013E-01,-.18748739E-04, & + & 0.10267300E+01,0.43276457E-01,0.64478314E-04, & + & 0.10274900E+01,0.44311601E-01,0.13449307E-03, & + & 0.10281000E+01,0.45057082E-01,0.18392936E-03, & + & 0.10285600E+01,0.45496509E-01,0.21359471E-03, & + & 0.10288400E+01,0.45647847E-01,0.22030041E-03, & + & 0.10289600E+01,0.45501819E-01,0.20784383E-03, & + & 0.10288700E+01,0.45063295E-01,0.17848282E-03, & + & 0.10285900E+01,0.44313589E-01,0.13993585E-03, & + & 0.10280600E+01,0.43256417E-01,0.95886597E-04, & + & 0.10272500E+01,0.41854750E-01,0.57740914E-04, & + & 0.10261400E+01,0.40086701E-01,0.32009573E-04, & + & 0.10246900E+01,0.37927772E-01,0.24160248E-04/ + data ((pk0(l,k, 6),l=1,3),k=136,150)/ & + & 0.10228600E+01,0.35345170E-01,0.37875655E-04, & + & 0.10206200E+01,0.32335860E-01,0.66964384E-04, & + & 0.10179600E+01,0.28873036E-01,0.11139332E-03, & + & 0.10148700E+01,0.24965690E-01,0.16272753E-03, & + & 0.10113600E+01,0.20636723E-01,0.21484270E-03, & + & 0.10074400E+01,0.15928527E-01,0.26248359E-03, & + & 0.10031200E+01,0.10902477E-01,0.30147539E-03, & + & 0.99844600E+00,0.55939282E-02,0.33817677E-03, & + & 0.99344100E+00,0.71209519E-04,0.37253025E-03, & + & 0.98814900E+00,-.56070352E-02,0.40939211E-03, & + & 0.98266000E+00,-.11371452E-01,0.45183488E-03, & + & 0.97708000E+00,-.17115286E-01,0.49946980E-03, & + & 0.97160200E+00,-.22658282E-01,0.54818223E-03, & + & 0.96651500E+00,-.27748597E-01,0.59393420E-03, & + & 0.96237200E+00,-.31906542E-01,0.63167611E-03/ + data ((pk0(l,k, 6),l=1,3),k=151,165)/ & + & 0.96159200E+00,-.32697322E-01,0.63793026E-03, & + & 0.96095700E+00,-.33358719E-01,0.64369653E-03, & + & 0.96047900E+00,-.33865188E-01,0.64727459E-03, & + & 0.96019500E+00,-.34198309E-01,0.64869250E-03, & + & 0.96012800E+00,-.34328429E-01,0.64729839E-03, & + & 0.96032800E+00,-.34220553E-01,0.64318452E-03, & + & 0.96085300E+00,-.33814103E-01,0.63415387E-03, & + & 0.96179500E+00,-.33034937E-01,0.61977710E-03, & + & 0.96329200E+00,-.31758265E-01,0.59746312E-03, & + & 0.96550700E+00,-.29826762E-01,0.56313247E-03, & + & 0.96879200E+00,-.26962929E-01,0.51406263E-03, & + & 0.97326400E+00,-.23019555E-01,0.44520254E-03, & + & 0.97895400E+00,-.17995214E-01,0.35652278E-03, & + & 0.98585100E+00,-.11896730E-01,0.24863867E-03, & + & 0.99394700E+00,-.47271855E-02,0.11999481E-03/ + data ((pk0(l,k, 6),l=1,3),k=166,180)/ & + & 0.10032300E+01,0.35038488E-02,-.27903889E-04, & + & 0.10137100E+01,0.12782894E-01,-.19415889E-03, & + & 0.10253600E+01,0.23118512E-01,-.38226199E-03, & + & 0.10381800E+01,0.34487196E-01,-.58823893E-03, & + & 0.10521600E+01,0.46900639E-01,-.81611719E-03, & + & 0.10672900E+01,0.60337415E-01,-.10624948E-02, & + & 0.10835700E+01,0.74797213E-01,-.13302408E-02, & + & 0.11009900E+01,0.90259372E-01,-.16148269E-02, & + & 0.11195300E+01,0.10672487E+00,-.19197944E-02, & + & 0.11391800E+01,0.12417862E+00,-.22441098E-02, & + & 0.11599900E+01,0.14264489E+00,-.25864390E-02, & + & 0.11791300E+01,0.15965863E+00,-.29047314E-02, & + & 0.12012500E+01,0.17929509E+00,-.32693768E-02, & + & 0.10000000E+01,-.23134272E-13,-.64878658E-14, & + & 0.10000000E+01,-.23134272E-13,-.64878658E-14/ + data ((pk0(l,k, 7),l=1,3),k= 1, 15)/ & + & 0.95235500E+00,-.84969702E-01,0.35149944E-02, & + & 0.95251700E+00,-.84706057E-01,0.34979614E-02, & + & 0.95267400E+00,-.84437382E-01,0.34807445E-02, & + & 0.95283100E+00,-.84156997E-01,0.34617001E-02, & + & 0.95300100E+00,-.83879612E-01,0.34439024E-02, & + & 0.95316200E+00,-.83595425E-01,0.34255485E-02, & + & 0.95333500E+00,-.83306528E-01,0.34066974E-02, & + & 0.95351200E+00,-.83011412E-01,0.33874157E-02, & + & 0.95369000E+00,-.82711461E-01,0.33676825E-02, & + & 0.95387000E+00,-.82412887E-01,0.33493170E-02, & + & 0.95404900E+00,-.82099306E-01,0.33284042E-02, & + & 0.95423500E+00,-.81783494E-01,0.33079002E-02, & + & 0.95442800E+00,-.81467020E-01,0.32880563E-02, & + & 0.95462100E+00,-.81138360E-01,0.32664744E-02, & + & 0.95481800E+00,-.80806913E-01,0.32452840E-02/ + data ((pk0(l,k, 7),l=1,3),k= 16, 30)/ & + & 0.95501700E+00,-.80467541E-01,0.32232046E-02, & + & 0.95522200E+00,-.80124110E-01,0.32012545E-02, & + & 0.95542900E+00,-.79773259E-01,0.31785793E-02, & + & 0.95563900E+00,-.79416131E-01,0.31556583E-02, & + & 0.95585400E+00,-.79053186E-01,0.31324654E-02, & + & 0.95607200E+00,-.78682049E-01,0.31085271E-02, & + & 0.95629600E+00,-.78306082E-01,0.30846056E-02, & + & 0.95652200E+00,-.77922231E-01,0.30600955E-02, & + & 0.95675400E+00,-.77531230E-01,0.30350288E-02, & + & 0.95698800E+00,-.77131678E-01,0.30094643E-02, & + & 0.95722700E+00,-.76726668E-01,0.29838369E-02, & + & 0.95747300E+00,-.76313793E-01,0.29576618E-02, & + & 0.95772000E+00,-.75891596E-01,0.29307972E-02, & + & 0.95797500E+00,-.75463072E-01,0.29036189E-02, & + & 0.95823200E+00,-.75024948E-01,0.28759136E-02/ + data ((pk0(l,k, 7),l=1,3),k= 31, 45)/ & + & 0.95849500E+00,-.74578981E-01,0.28476505E-02, & + & 0.95876400E+00,-.74124729E-01,0.28190553E-02, & + & 0.95903700E+00,-.73661106E-01,0.27898110E-02, & + & 0.95931600E+00,-.73188778E-01,0.27601523E-02, & + & 0.95960000E+00,-.72706668E-01,0.27297733E-02, & + & 0.95988900E+00,-.72215548E-01,0.26989749E-02, & + & 0.96018500E+00,-.71713730E-01,0.26674301E-02, & + & 0.96048500E+00,-.71202768E-01,0.26355387E-02, & + & 0.96079200E+00,-.70682302E-01,0.26032425E-02, & + & 0.96110700E+00,-.70150527E-01,0.25699181E-02, & + & 0.96142500E+00,-.69608719E-01,0.25364422E-02, & + & 0.96175300E+00,-.69055212E-01,0.25019906E-02, & + & 0.96208500E+00,-.68489747E-01,0.24667335E-02, & + & 0.96242500E+00,-.67915394E-01,0.24316973E-02, & + & 0.96277000E+00,-.67326497E-01,0.23951902E-02/ + data ((pk0(l,k, 7),l=1,3),k= 46, 60)/ & + & 0.96312300E+00,-.66726618E-01,0.23583250E-02, & + & 0.96348400E+00,-.66114006E-01,0.23206868E-02, & + & 0.96384800E+00,-.65487373E-01,0.22821726E-02, & + & 0.96422800E+00,-.64852726E-01,0.22439985E-02, & + & 0.96461000E+00,-.64201268E-01,0.22044071E-02, & + & 0.96499800E+00,-.63533171E-01,0.21634454E-02, & + & 0.96539900E+00,-.62855868E-01,0.21228206E-02, & + & 0.96580300E+00,-.62160127E-01,0.20806175E-02, & + & 0.96621900E+00,-.61451477E-01,0.20380220E-02, & + & 0.96664300E+00,-.60728208E-01,0.19946205E-02, & + & 0.96708000E+00,-.59991088E-01,0.19509104E-02, & + & 0.96752000E+00,-.59235444E-01,0.19060071E-02, & + & 0.96797500E+00,-.58467816E-01,0.18611045E-02, & + & 0.96843300E+00,-.57676646E-01,0.18137332E-02, & + & 0.96890700E+00,-.56876568E-01,0.17677014E-02/ + data ((pk0(l,k, 7),l=1,3),k= 61, 75)/ & + & 0.96938500E+00,-.56053732E-01,0.17197571E-02, & + & 0.96987500E+00,-.55212823E-01,0.16706444E-02, & + & 0.97037500E+00,-.54355281E-01,0.16210886E-02, & + & 0.97089000E+00,-.53483096E-01,0.15717470E-02, & + & 0.97141000E+00,-.52589322E-01,0.15212875E-02, & + & 0.97194100E+00,-.51671177E-01,0.14687000E-02, & + & 0.97248500E+00,-.50739993E-01,0.14172029E-02, & + & 0.97304200E+00,-.49790263E-01,0.13649320E-02, & + & 0.97360800E+00,-.48814300E-01,0.13109817E-02, & + & 0.97419000E+00,-.47821546E-01,0.12571509E-02, & + & 0.97477700E+00,-.46802078E-01,0.12018895E-02, & + & 0.97538200E+00,-.45766116E-01,0.11468533E-02, & + & 0.97599500E+00,-.44706196E-01,0.10911307E-02, & + & 0.97661300E+00,-.43615582E-01,0.10331017E-02, & + & 0.97725100E+00,-.42510802E-01,0.97659144E-03/ + data ((pk0(l,k, 7),l=1,3),k= 76, 90)/ & + & 0.97791700E+00,-.41387934E-01,0.92062648E-03, & + & 0.97857600E+00,-.40233816E-01,0.86304621E-03, & + & 0.97925500E+00,-.39054834E-01,0.80492862E-03, & + & 0.97994800E+00,-.37852703E-01,0.74700356E-03, & + & 0.98065400E+00,-.36626264E-01,0.68922457E-03, & + & 0.98137200E+00,-.35371450E-01,0.63072983E-03, & + & 0.98210700E+00,-.34093341E-01,0.57303390E-03, & + & 0.98285500E+00,-.32787501E-01,0.51521225E-03, & + & 0.98361700E+00,-.31454463E-01,0.45763494E-03, & + & 0.98439400E+00,-.30092948E-01,0.40015672E-03, & + & 0.98518700E+00,-.28705090E-01,0.34368706E-03, & + & 0.98599600E+00,-.27287726E-01,0.28749764E-03, & + & 0.98681800E+00,-.25840584E-01,0.23203107E-03, & + & 0.98765800E+00,-.24363425E-01,0.17743863E-03, & + & 0.98851500E+00,-.22856529E-01,0.12405703E-03/ + data ((pk0(l,k, 7),l=1,3),k= 91,105)/ & + & 0.98938700E+00,-.21317350E-01,0.71621853E-04, & + & 0.99027700E+00,-.19746121E-01,0.20574717E-04, & + & 0.99118600E+00,-.18141116E-01,-.29149398E-04, & + & 0.99211300E+00,-.16501155E-01,-.77354445E-04, & + & 0.99305900E+00,-.14825134E-01,-.12398274E-03, & + & 0.99402400E+00,-.13113789E-01,-.16823268E-03, & + & 0.99501300E+00,-.11361227E-01,-.21127706E-03, & + & 0.99602300E+00,-.95723810E-02,-.25127040E-03, & + & 0.99705300E+00,-.77404123E-02,-.28912585E-03, & + & 0.99810800E+00,-.58640576E-02,-.32512970E-03, & + & 0.99919100E+00,-.39498867E-02,-.35676633E-03, & + & 0.10002900E+01,-.19841359E-02,-.38755957E-03, & + & 0.10014200E+01,0.18816645E-04,-.41395543E-03, & + & 0.10025700E+01,0.20640567E-02,-.43693906E-03, & + & 0.10037400E+01,0.41406020E-02,-.45424312E-03/ + data ((pk0(l,k, 7),l=1,3),k=106,120)/ & + & 0.10049300E+01,0.62600592E-02,-.47007478E-03, & + & 0.10061400E+01,0.83833077E-02,-.47614257E-03, & + & 0.10073500E+01,0.10540248E-01,-.48187632E-03, & + & 0.10085700E+01,0.12680000E-01,-.47802504E-03, & + & 0.10097700E+01,0.14820217E-01,-.47103719E-03, & + & 0.10109600E+01,0.16913123E-01,-.45525503E-03, & + & 0.10121200E+01,0.18962367E-01,-.43507382E-03, & + & 0.10132400E+01,0.20928863E-01,-.40610649E-03, & + & 0.10143100E+01,0.22806127E-01,-.37325332E-03, & + & 0.10153100E+01,0.24557237E-01,-.33265757E-03, & + & 0.10162400E+01,0.26175089E-01,-.28791124E-03, & + & 0.10170900E+01,0.27644659E-01,-.23988125E-03, & + & 0.10178600E+01,0.28930035E-01,-.18522098E-03, & + & 0.10185200E+01,0.30060834E-01,-.13363398E-03, & + & 0.10191000E+01,0.31002247E-01,-.81774481E-04/ + data ((pk0(l,k, 7),l=1,3),k=121,135)/ & + & 0.10195700E+01,0.31772549E-01,-.34136782E-04, & + & 0.10199500E+01,0.32353657E-01,0.11376809E-04, & + & 0.10202200E+01,0.32769581E-01,0.48089795E-04, & + & 0.10204000E+01,0.32996418E-01,0.79940644E-04, & + & 0.10204700E+01,0.33055045E-01,0.10215330E-03, & + & 0.10204400E+01,0.32935182E-01,0.11465650E-03, & + & 0.10202800E+01,0.32640638E-01,0.11788856E-03, & + & 0.10200000E+01,0.32155419E-01,0.11476627E-03, & + & 0.10195800E+01,0.31486051E-01,0.10494415E-03, & + & 0.10190100E+01,0.30613851E-01,0.92830537E-04, & + & 0.10182700E+01,0.29524648E-01,0.82989383E-04, & + & 0.10173300E+01,0.28211722E-01,0.75886340E-04, & + & 0.10161700E+01,0.26667821E-01,0.73121772E-04, & + & 0.10147800E+01,0.24841298E-01,0.83874034E-04, & + & 0.10131300E+01,0.22729400E-01,0.10631839E-03/ + data ((pk0(l,k, 7),l=1,3),k=136,150)/ & + & 0.10112000E+01,0.20324338E-01,0.13677618E-03, & + & 0.10089700E+01,0.17622056E-01,0.17265905E-03, & + & 0.10064400E+01,0.14594168E-01,0.21523796E-03, & + & 0.10036000E+01,0.11265273E-01,0.25833683E-03, & + & 0.10004500E+01,0.76518006E-02,0.29879656E-03, & + & 0.99700000E+00,0.37718292E-02,0.33645387E-03, & + & 0.99326900E+00,-.33719714E-03,0.37001506E-03, & + & 0.98927900E+00,-.46480833E-02,0.40351736E-03, & + & 0.98506800E+00,-.91117258E-02,0.43753516E-03, & + & 0.98068400E+00,-.13666612E-01,0.47319156E-03, & + & 0.97622300E+00,-.18234828E-01,0.51177388E-03, & + & 0.97182000E+00,-.22680858E-01,0.54996382E-03, & + & 0.96771200E+00,-.26798407E-01,0.58585926E-03, & + & 0.96419000E+00,-.30338349E-01,0.61541498E-03, & + & 0.96231600E+00,-.32320355E-01,0.62598807E-03/ + data ((pk0(l,k, 7),l=1,3),k=151,165)/ & + & 0.96218700E+00,-.32507812E-01,0.62453556E-03, & + & 0.96224700E+00,-.32520835E-01,0.62052235E-03, & + & 0.96254200E+00,-.32322598E-01,0.61355606E-03, & + & 0.96310800E+00,-.31878689E-01,0.60306541E-03, & + & 0.96399500E+00,-.31143393E-01,0.58788873E-03, & + & 0.96526600E+00,-.30060220E-01,0.56702265E-03, & + & 0.96700600E+00,-.28558116E-01,0.53946958E-03, & + & 0.96931600E+00,-.26543174E-01,0.50282005E-03, & + & 0.97233200E+00,-.23909194E-01,0.45569054E-03, & + & 0.97617400E+00,-.20521797E-01,0.39532538E-03, & + & 0.98100600E+00,-.16260262E-01,0.31933515E-03, & + & 0.98685400E+00,-.11088106E-01,0.22618120E-03, & + & 0.99371600E+00,-.50167195E-02,0.11702011E-03, & + & 0.10015800E+01,0.19481780E-02,-.87074678E-05, & + & 0.10104400E+01,0.97992347E-02,-.15146582E-03/ + data ((pk0(l,k, 7),l=1,3),k=166,180)/ & + & 0.10202900E+01,0.18529139E-01,-.31108955E-03, & + & 0.10311100E+01,0.28137513E-01,-.48756304E-03, & + & 0.10429100E+01,0.38603323E-01,-.67888754E-03, & + & 0.10556800E+01,0.49931095E-01,-.88739298E-03, & + & 0.10694000E+01,0.62128210E-01,-.11141357E-02, & + & 0.10840900E+01,0.75165728E-01,-.13551184E-02, & + & 0.10997600E+01,0.89063308E-01,-.16132238E-02, & + & 0.11164100E+01,0.10383650E+00,-.18867012E-02, & + & 0.11340800E+01,0.11954941E+00,-.21822401E-02, & + & 0.11529300E+01,0.13627364E+00,-.24936969E-02, & + & 0.11737100E+01,0.15473172E+00,-.28409284E-02, & + & 0.11938700E+01,0.17264047E+00,-.31782963E-02, & + & 0.12194500E+01,0.19534615E+00,-.36048393E-02, & + & 0.10000000E+01,-.23134272E-13,-.64878658E-14, & + & 0.10000000E+01,-.23134272E-13,-.64878658E-14/ + data ((pk0(l,k, 8),l=1,3),k= 1, 15)/ & + & 0.94059400E+00,-.10476988E+00,0.48643361E-02, & + & 0.94060100E+00,-.10476099E+00,0.48632393E-02, & + & 0.94060700E+00,-.10475064E+00,0.48619364E-02, & + & 0.94061300E+00,-.10474016E+00,0.48607408E-02, & + & 0.94062100E+00,-.10473029E+00,0.48597003E-02, & + & 0.94062800E+00,-.10471820E+00,0.48582348E-02, & + & 0.94063700E+00,-.10470636E+00,0.48568392E-02, & + & 0.94064500E+00,-.10469233E+00,0.48552050E-02, & + & 0.94065400E+00,-.10467871E+00,0.48536152E-02, & + & 0.94066300E+00,-.10466187E+00,0.48513824E-02, & + & 0.94067500E+00,-.10464700E+00,0.48497764E-02, & + & 0.94068500E+00,-.10462972E+00,0.48477851E-02, & + & 0.94069600E+00,-.10461140E+00,0.48455879E-02, & + & 0.94070900E+00,-.10459227E+00,0.48433507E-02, & + & 0.94072400E+00,-.10457256E+00,0.48410537E-02/ + data ((pk0(l,k, 8),l=1,3),k= 16, 30)/ & + & 0.94073700E+00,-.10455020E+00,0.48384892E-02, & + & 0.94075200E+00,-.10452675E+00,0.48356810E-02, & + & 0.94076800E+00,-.10450248E+00,0.48328497E-02, & + & 0.94078500E+00,-.10447613E+00,0.48297833E-02, & + & 0.94080400E+00,-.10444845E+00,0.48265332E-02, & + & 0.94082200E+00,-.10441679E+00,0.48225828E-02, & + & 0.94084400E+00,-.10438656E+00,0.48192181E-02, & + & 0.94086600E+00,-.10435269E+00,0.48151522E-02, & + & 0.94088700E+00,-.10431577E+00,0.48107455E-02, & + & 0.94091300E+00,-.10427942E+00,0.48067624E-02, & + & 0.94093900E+00,-.10423732E+00,0.48015096E-02, & + & 0.94096800E+00,-.10419414E+00,0.47964666E-02, & + & 0.94099700E+00,-.10414840E+00,0.47911822E-02, & + & 0.94102900E+00,-.10409932E+00,0.47853797E-02, & + & 0.94106300E+00,-.10404835E+00,0.47794833E-02/ + data ((pk0(l,k, 8),l=1,3),k= 31, 45)/ & + & 0.94109800E+00,-.10399371E+00,0.47731849E-02, & + & 0.94113600E+00,-.10393298E+00,0.47658114E-02, & + & 0.94117700E+00,-.10387088E+00,0.47585283E-02, & + & 0.94121800E+00,-.10380443E+00,0.47508709E-02, & + & 0.94126400E+00,-.10373366E+00,0.47426432E-02, & + & 0.94131400E+00,-.10365936E+00,0.47339752E-02, & + & 0.94136800E+00,-.10358047E+00,0.47247561E-02, & + & 0.94142000E+00,-.10349462E+00,0.47147789E-02, & + & 0.94147700E+00,-.10340367E+00,0.47041375E-02, & + & 0.94154100E+00,-.10330931E+00,0.46931457E-02, & + & 0.94160600E+00,-.10320691E+00,0.46812216E-02, & + & 0.94167700E+00,-.10309859E+00,0.46685599E-02, & + & 0.94175200E+00,-.10298326E+00,0.46551571E-02, & + & 0.94183100E+00,-.10286179E+00,0.46411490E-02, & + & 0.94191400E+00,-.10273271E+00,0.46263089E-02/ + data ((pk0(l,k, 8),l=1,3),k= 46, 60)/ & + & 0.94200000E+00,-.10259278E+00,0.46099730E-02, & + & 0.94209300E+00,-.10244492E+00,0.45925330E-02, & + & 0.94219600E+00,-.10229236E+00,0.45752111E-02, & + & 0.94230000E+00,-.10212512E+00,0.45557262E-02, & + & 0.94241400E+00,-.10195003E+00,0.45354007E-02, & + & 0.94253300E+00,-.10176549E+00,0.45142722E-02, & + & 0.94266100E+00,-.10156755E+00,0.44913309E-02, & + & 0.94279300E+00,-.10135852E+00,0.44674797E-02, & + & 0.94293400E+00,-.10113628E+00,0.44420964E-02, & + & 0.94308200E+00,-.10089829E+00,0.44144396E-02, & + & 0.94324300E+00,-.10064968E+00,0.43862502E-02, & + & 0.94341200E+00,-.10038681E+00,0.43563187E-02, & + & 0.94359200E+00,-.10010720E+00,0.43244509E-02, & + & 0.94378500E+00,-.99813361E-01,0.42914732E-02, & + & 0.94397900E+00,-.99495217E-01,0.42552498E-02/ + data ((pk0(l,k, 8),l=1,3),k= 61, 75)/ & + & 0.94419000E+00,-.99163800E-01,0.42180893E-02, & + & 0.94441300E+00,-.98809822E-01,0.41779865E-02, & + & 0.94465300E+00,-.98442285E-01,0.41372470E-02, & + & 0.94490300E+00,-.98047247E-01,0.40928755E-02, & + & 0.94516000E+00,-.97628433E-01,0.40461149E-02, & + & 0.94543900E+00,-.97188052E-01,0.39968478E-02, & + & 0.94573500E+00,-.96728565E-01,0.39466602E-02, & + & 0.94604200E+00,-.96237153E-01,0.38924908E-02, & + & 0.94637300E+00,-.95719600E-01,0.38355202E-02, & + & 0.94670800E+00,-.95172401E-01,0.37760094E-02, & + & 0.94707300E+00,-.94597221E-01,0.37133254E-02, & + & 0.94745000E+00,-.93994737E-01,0.36488318E-02, & + & 0.94785100E+00,-.93358011E-01,0.35806935E-02, & + & 0.94826900E+00,-.92686001E-01,0.35090527E-02, & + & 0.94869700E+00,-.91974440E-01,0.34331870E-02/ + data ((pk0(l,k, 8),l=1,3),k= 76, 90)/ & + & 0.94915800E+00,-.91233372E-01,0.33554379E-02, & + & 0.94964600E+00,-.90457384E-01,0.32746954E-02, & + & 0.95014200E+00,-.89635725E-01,0.31893927E-02, & + & 0.95067600E+00,-.88777216E-01,0.31011247E-02, & + & 0.95122200E+00,-.87876987E-01,0.30095449E-02, & + & 0.95179700E+00,-.86935232E-01,0.29147022E-02, & + & 0.95239600E+00,-.85949021E-01,0.28162863E-02, & + & 0.95302000E+00,-.84918086E-01,0.27145995E-02, & + & 0.95367200E+00,-.83841511E-01,0.26095746E-02, & + & 0.95434800E+00,-.82717814E-01,0.25014191E-02, & + & 0.95505000E+00,-.81546426E-01,0.23902002E-02, & + & 0.95578000E+00,-.80325984E-01,0.22758707E-02, & + & 0.95653700E+00,-.79056682E-01,0.21588993E-02, & + & 0.95731900E+00,-.77735808E-01,0.20390305E-02, & + & 0.95813000E+00,-.76364019E-01,0.19167679E-02/ + data ((pk0(l,k, 8),l=1,3),k= 91,105)/ & + & 0.95896800E+00,-.74941013E-01,0.17924232E-02, & + & 0.95983300E+00,-.73465361E-01,0.16659918E-02, & + & 0.96072400E+00,-.71935499E-01,0.15377731E-02, & + & 0.96164600E+00,-.70351924E-01,0.14081479E-02, & + & 0.96259500E+00,-.68711470E-01,0.12772577E-02, & + & 0.96357300E+00,-.67013233E-01,0.11455719E-02, & + & 0.96458200E+00,-.65253582E-01,0.10134026E-02, & + & 0.96562700E+00,-.63427563E-01,0.88060944E-03, & + & 0.96670800E+00,-.61529750E-01,0.74806344E-03, & + & 0.96783100E+00,-.59546608E-01,0.61469288E-03, & + & 0.96900500E+00,-.57470271E-01,0.48181574E-03, & + & 0.97023800E+00,-.55280169E-01,0.34829552E-03, & + & 0.97154400E+00,-.52958541E-01,0.21496190E-03, & + & 0.97293400E+00,-.50477316E-01,0.81241477E-04, & + & 0.97442900E+00,-.47810235E-01,-.52358496E-04/ + data ((pk0(l,k, 8),l=1,3),k=106,120)/ & + & 0.97604500E+00,-.44919547E-01,-.18680518E-03, & + & 0.97779800E+00,-.41772983E-01,-.32071742E-03, & + & 0.97971300E+00,-.38337767E-01,-.45363222E-03, & + & 0.98180700E+00,-.34587716E-01,-.58334172E-03, & + & 0.98408600E+00,-.30494651E-01,-.70966769E-03, & + & 0.98655800E+00,-.26059426E-01,-.82746422E-03, & + & 0.98922000E+00,-.21284059E-01,-.93517401E-03, & + & 0.99205000E+00,-.16195871E-01,-.10283596E-02, & + & 0.99502900E+00,-.10852597E-01,-.11009720E-02, & + & 0.99811500E+00,-.53117183E-02,-.11512421E-02, & + & 0.10012600E+01,0.32997879E-03,-.11732838E-02, & + & 0.10044100E+01,0.59838560E-02,-.11663937E-02, & + & 0.10075200E+01,0.11519301E-01,-.11224844E-02, & + & 0.10105200E+01,0.16867585E-01,-.10501179E-02, & + & 0.10133700E+01,0.21918561E-01,-.94570631E-03/ + data ((pk0(l,k, 8),l=1,3),k=121,135)/ & + & 0.10160300E+01,0.26613762E-01,-.81694804E-03, & + & 0.10185000E+01,0.30879617E-01,-.66237422E-03, & + & 0.10207400E+01,0.34717135E-01,-.49503916E-03, & + & 0.10227800E+01,0.38115411E-01,-.32040593E-03, & + & 0.10246300E+01,0.41096209E-01,-.14762822E-03, & + & 0.10263000E+01,0.43680602E-01,0.15774997E-04, & + & 0.10278300E+01,0.45886991E-01,0.16252758E-03, & + & 0.10291900E+01,0.47706552E-01,0.27037782E-03, & + & 0.10303700E+01,0.49140868E-01,0.33614823E-03, & + & 0.10313900E+01,0.50209897E-01,0.35489836E-03, & + & 0.10322400E+01,0.50904549E-01,0.33125458E-03, & + & 0.10328700E+01,0.51246626E-01,0.26516534E-03, & + & 0.10332800E+01,0.51180433E-01,0.17686697E-03, & + & 0.10333800E+01,0.50690926E-01,0.78870717E-04, & + & 0.10331200E+01,0.49727997E-01,-.84494076E-05/ + data ((pk0(l,k, 8),l=1,3),k=136,150)/ & + & 0.10324200E+01,0.48238686E-01,-.68915230E-04, & + & 0.10312100E+01,0.46160489E-01,-.90709546E-04, & + & 0.10294200E+01,0.43425857E-01,-.70895804E-04, & + & 0.10270100E+01,0.39987526E-01,-.17389344E-04, & + & 0.10239500E+01,0.35831762E-01,0.56501292E-04, & + & 0.10202400E+01,0.31000964E-01,0.13221232E-03, & + & 0.10159000E+01,0.25570795E-01,0.19550358E-03, & + & 0.10109900E+01,0.19604510E-01,0.24918183E-03, & + & 0.10055300E+01,0.13229129E-01,0.28817197E-03, & + & 0.99956200E+00,0.65055762E-02,0.32514379E-03, & + & 0.99314400E+00,-.48405797E-03,0.36750779E-03, & + & 0.98636200E+00,-.76450544E-02,0.41828283E-03, & + & 0.97937700E+00,-.14839168E-01,0.47858660E-03, & + & 0.97244500E+00,-.21814878E-01,0.53925043E-03, & + & 0.96599800E+00,-.28222181E-01,0.59900754E-03/ + data ((pk0(l,k, 8),l=1,3),k=151,165)/ & + & 0.96455600E+00,-.29650458E-01,0.61246712E-03, & + & 0.96321700E+00,-.30971286E-01,0.62491475E-03, & + & 0.96199600E+00,-.32179818E-01,0.63623776E-03, & + & 0.96089300E+00,-.33273659E-01,0.64734500E-03, & + & 0.95992400E+00,-.34245951E-01,0.65723720E-03, & + & 0.95908200E+00,-.35089686E-01,0.66585983E-03, & + & 0.95837900E+00,-.35798879E-01,0.67301379E-03, & + & 0.95782900E+00,-.36373251E-01,0.67929856E-03, & + & 0.95743100E+00,-.36809421E-01,0.68623596E-03, & + & 0.95718700E+00,-.37086794E-01,0.68972774E-03, & + & 0.95728800E+00,-.37058557E-01,0.69023751E-03, & + & 0.95878500E+00,-.35784004E-01,0.66952880E-03, & + & 0.96185100E+00,-.33108007E-01,0.62414454E-03, & + & 0.96648500E+00,-.29030736E-01,0.55347105E-03, & + & 0.97268800E+00,-.23556955E-01,0.45798312E-03/ + data ((pk0(l,k, 8),l=1,3),k=166,180)/ & + & 0.98045800E+00,-.16680459E-01,0.33540170E-03, & + & 0.98979800E+00,-.84135625E-02,0.18878148E-03, & + & 0.10007100E+01,0.12484545E-02,0.16020231E-04, & + & 0.10131800E+01,0.12310747E-01,-.18421235E-03, & + & 0.10272200E+01,0.24762793E-01,-.40958970E-03, & + & 0.10428200E+01,0.38616849E-01,-.66323716E-03, & + & 0.10599900E+01,0.53861952E-01,-.94418186E-03, & + & 0.10787300E+01,0.70498191E-01,-.12502559E-02, & + & 0.10990300E+01,0.88524884E-01,-.15826029E-02, & + & 0.11209100E+01,0.10793378E+00,-.19400499E-02, & + & 0.11443400E+01,0.12874635E+00,-.23266218E-02, & + & 0.11693300E+01,0.15095911E+00,-.27419202E-02, & + & 0.11959000E+01,0.17454826E+00,-.31816023E-02, & + & 0.12240200E+01,0.19953275E+00,-.36480860E-02, & + & 0.10000000E+01,-.23134272E-13,-.64878658E-14/ + + rt=1.d0 + if ((a.le.2.d0).or.(1.d0.le.x)) then + ruv=1.d0 + rdv=1.d0 + ru=1.d0 + rd=1.d0 + rs=1.d0 + rc=1.d0 + rb=1.d0 + rg=1.d0 + return + endif + v1= log(a/aa1) + v2= log(x/x1) + if (x.le.0.6d0) then + vtem= log10(0.6d0)+6.d0 + aindx= aint(( log10(x)+6.d0)/vtem* & + & 149.d0+1.d-7) + indx=1+ int(aindx) + if (indx.lt.2) indx=2 + else + aindx= aint(75.d0*(x-0.6d0)+1.d-7) + indx=150+ int(aindx) + endif + do 33 inum=1,5 + aqq=q*q + nmin=nm(inum) + ikpt=kpt(inum) + if (aqq.lt.qq0(nmin)) aqq=qq0(nmin) + qlq= log(aqq/qq0(nmin)) + q1=pk0(1,indx,ikpt)+pk0(2,indx,ikpt)*v1 & + & +pk0(3,indx,ikpt)*v1*v1 + indx=indx+1 + q2=pk0(1,indx,ikpt)+pk0(2,indx,ikpt)*v1 & + & +pk0(3,indx,ikpt)*v1*v1 + indx=indx-1 + if (x.le.0.6d0) then + xxp=10.d0**(-6.d0+(indx-1)*vtem/149.d0) + xxu=10.d0**(-6.d0+(indx)*vtem/149.d0) + else + xxp=0.6d0+(indx-150)*0.4d0/30.d0 + xxu=0.6d0+(indx+1-150)*0.4d0/30.d0 + endif + r0=q1+(q2-q1)/(xxp-xxu)*(xxp-x) + do 32 jk=1,3 + indpi=jk + do 31 kl=1,10 + p0=pa(1,kl,indpi,ikpt) + p1=pa(2,kl,indpi,ikpt) + p2=pa(3,kl,indpi,ikpt) + ptm(kl)=p0+p1*v1+p2*v1*v1 + 31 continue + pqq(jk)=eksarp(x,v2,x1,x116,ptm,indpi) + 32 continue + r(inum)=r0+pqq(1)*qlq+pqq(2)*qlq*qlq+pqq(3)*dsqrt(qlq) + if (inum.eq.2) then + do 34 jk=1,3 + indpi=jk + do 35 kl=1,10 + p0=pa(1,kl,indpi,5) + p1=pa(2,kl,indpi,5) + p2=pa(3,kl,indpi,5) + ptm(kl)=p0+p1*v1+p2*v1*v1 + 35 continue + pqq(jk)=eksarp(x,v2,x1,x116,ptm,indpi) + 34 continue + rs=r0+pqq(1)*qlq+pqq(2)*qlq*qlq+pqq(3)*dsqrt(qlq) + endif + 33 continue + ruv=r(1) + rdv=ruv + ru=r(2) + rd=ru + rc=r(3) + rb=r(4) + rg=r(5) + + return + END diff --git a/LHAPDF/lhapdf-5.9.1/src/eksarp.f b/LHAPDF/lhapdf-5.9.1/src/eksarp.f new file mode 100644 index 00000000000..b5184407604 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/eksarp.f @@ -0,0 +1,23 @@ +! -*- F90 -*- + + + function eksarp(x,v2,x1,x116,ptm,indpi) + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + dimension ptm(10) + + z=v2 + xx=x-x1 + if (x.le.x116) then + eksarp=ptm(1)+ptm(2)*z+ptm(3)*z**2+ptm(4)*xx+ptm(5)*xx**2 + else + z1= log(x116/x1) + xx1=x116-x1 + ff0=ptm(1)+ptm(2)*z1+ptm(3)*z1**2+ptm(4)*xx1+ptm(5)*xx1**2 + xx16=x-x116 + z16= log(x/x116) + qexp=19.d0+(indpi-1)*(indpi-2)*8.d0/2.d0 + eksarp=ff0+ptm(6)*xx16+ptm(7)*xx16**2+ptm(8)*xx16**3 & + & +ptm(9)*xx16**qexp+ptm(10)*z16 + endif + 11 return + END diff --git a/LHAPDF/lhapdf-5.9.1/src/eps08.f b/LHAPDF/lhapdf-5.9.1/src/eps08.f new file mode 100644 index 00000000000..497638ac03e --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/eps08.f @@ -0,0 +1,401 @@ +! -*- F90 -*- + + +!**************************************************************************** +! +! eps08.f +! +! An interface for calculating the scale dependent nuclear modifications +! R_f^A(x,Q) = f_A(x,Q)/f_p(x,Q) +! where f_A is the distribution of the parton flavour f for a PROTON in a +! nucleus A, and f_p is the corresponding parton distribution in the +! free proton. +! +! The EPS08 set of modifications R_f^A(x,Q) which we provide here, +! corresponds to the LO DGLAP evolution of the nPDFs f_A(x,Q). +! +! When using this interface, please refer to: +! +! K.J. Eskola, H. Paukkunen and C.A. Salgado, +! "An improved global analysis of nuclear parton distribution functions +! including RHIC data" +! arXiv:0802.0139 [hep-ph]. +! +! Questions & comments to: +! hannu.paukkunen@phys.jyu.fi +! carlos.salgado@cern.ch +! kari.eskola@phys.jyu.fi +! +! *************************************************************************** +! Instructions: +! +! To obtain the nuclear corrections for given input +! values of momentum fraction x, scale Q (in GeV), +! and atomic number A (all in double precision), use the command +! +! Call eps08(x,Q,A,ruv,rdv,ru,rd,rs,rc,rb,rt,rg) +! +! which returns the bound proton nuclear corrections R_f^A(x,Q) +! (in double precision) for +! +! ruv = up valence +! rdv = down valence +! ru = up sea +! rd = down sea +! rs = strange +! rc = charm +! rb = bottom (=0 for Q < mb=4.64) +! rt = top (=1 for all x and Q) +! rg = gluons +! +! The nuclear corrections for bound neutrons can be obtained +! by the isospin symmetry (see Sec.2 of article quoted above), +! so that e.g. the total up quark distribution per nucleon in a +! nucleus A with Z protons is +! +! u_A(x,Q) = Z/A * [ruv*uV_p(x,Q) + ru*uSea_p(x,Q)] + +! (A-Z)/A * [rdv*dV_p(x,Q) + rd*dSea_p(x,Q)] +! +! Note that the parametrization should only be applied at the region +! +! 1e-6 <= x < 1 +! 1.3 <= Q <= 1000 GeV +! 2 <= A <= 208 +! +! No warning message is displayed if these limits are +! exceeded, and outside these boundaries the modifications +! are frozen to the boundary values, i.e +! +! for Q > 1000, the modifications at Q=1000 are returned, +! for Q < 1.3, the modifications at Q=1.3 are returned, +! for x < 1e-6, the modifications at x=1e-6 are returned, +! for A > 208, the modifications at A=208 are returned, +! for A <= 2 or x >= 1, the function returns 1. +! +! The program uses the data file eps08dta.all, +! which must be located in current working directory. +! +! ********************************************************* +! ********************************************************* + +subroutine eps08(xxx,q,aaa,ruv,rdv,ru,rd,rs,rc,rb,rt,rg) + + implicit double precision(a-h,o-z) + dimension rateps08(8) + dimension pint08(5), pint082(5) + common/eps0800/qq0, qqb + common/eps0803/ kty, ind + common/eps0810/qq1 + common/eps0811/pp08(5) + external eps08gv, eps08se + data readFR/0/ + + aa = aaa + xx = xxx + qq = q**2 + rt = 1.d0 + + if (readFR.ne.1) then + call eps08init + readFR=1 + endif + if ((aa.le.2.d0).or.(1.d0.le.xx)) then + ruv=1.d0 + rdv=1.d0 + ru=1.d0 + rd=1.d0 + rs=1.d0 + rc=1.d0 + rb=1.d0 + rg=1.d0 + return + endif + + if (qq .lt. qq0) then + qq = qq0 + end if + + if (qq .gt. 1.d6) then + qq = 1.d6 + end if + + if (aa .gt. 208.d0) then + aa = 208.d0 + end if + + if (xx .lt. 1.d-6) then + xx = 1.d-6 + end if + + if (xx .gt. 0.964) then + xx = 0.964 + end if + + x2=xx+10.d0**(dlog10(xx)-2.5) + ind=1+int(20.d0*(dlog10(x2)+6.d0)) + x0=10.d0**(-6.d0+(ind-1)/20.d0) + x1=10.d0**(-6.d0+ind/20.d0) + if(x2.gt.0.1d0) then + ind=int((x2-0.1d0)/0.009d0+101.d0) + x0=0.1d0+(ind-101)*0.009d0 + x1=0.1d0+(ind-100)*0.009d0 + endif + do ikty=1,3 + kty=ikty + if(ikty.eq.3) kty=8 + qq1=qq0 + ! The xx arg was not used anywhere! + !call ppeps08(xx,aa,pint08,pint082) + call ppeps08(aa,pint08,pint082) + do ii=1,5 + pp08(ii)=pint08(ii) + enddo + tt1=eps08gv(qq) + do ii=1,5 + pp08(ii)=pint082(ii) + enddo + tt2=eps08gv(qq) + rateps08(kty)=tt1+(tt2-tt1)/(x1-x0)*(xx-x0) + enddo + do ikty=3,7 + kty=ikty + qq1=qq0 + + if(kty.eq.7) then + qq1=qqb + if(qq .lt. qqb) then + rateps08(7)=0.d0 + Goto 125 + end if + end if + + ! The xx arg was not used anywhere! + !call ppeps08(xx,aa,pint08,pint082) + call ppeps08(aa,pint08,pint082) + do ii=1,5 + pp08(ii)=pint08(ii) + enddo + tt1=eps08se(qq) + do ii=1,5 + pp08(ii)=pint082(ii) + enddo + tt2=eps08se(qq) + rateps08(ikty)=tt1+(tt2-tt1)/(x1-x0)*(xx-x0) + enddo + +125 continue + + ruv=rateps08(1) + rdv=rateps08(2) + rs=rateps08(3) + ru=rateps08(4) + rd=rateps08(5) + rc=rateps08(6) + rb=rateps08(7) + rg=rateps08(8) + return +end subroutine eps08 + +subroutine ppeps08(aa,pint08,pint082) + !subroutine ppeps08(xx,aa,pint08,pint082) + ! The xx arg was not used anywhere! + implicit double precision(a-h,o-z) + dimension pint08(5), pint082(5), paint081(13), paint082(13) + common/eps0801/ peps08i(197,13,8,5) + common/eps0802/ amx(13) + common/eps0803/ kty, ind + do ip=1,5 + do ia=1,13 + paint081(ia)=peps08i(ind,ia,kty,ip) + paint082(ia)=peps08i(ind+1,ia,kty,ip) + if(ind.eq.197) paint082(ia)=paint081(ia) + enddo + pint08(ip)=eps08ddv(paint081,amx,13,aa,1) + pint082(ip)=eps08ddv(paint082,amx,13,aa,1) + enddo +end subroutine ppeps08 + + +function eps08gv(qq) + implicit double precision(a-h,o-z) + common/eps0810/qq1 + common/eps0811/yy1,p1,p2,p3,p4 + z=dlog(qq/qq1) + zz=dlog(1.d0+z) + eps08gv=yy1+p1*zz+p2*zz**2+p3*zz**0.5+p4/(1.d0+zz)**4-p4 + return +end function eps08gv + +function eps08se(qq) + implicit double precision(a-h,o-z) + common/eps0810/qq1 + common/eps0811/yy1,p1,p2,p3,p4 + z=dlog(qq/qq1) + zz=dlog(1.d0+z) + eps08se=yy1+p1*zz+p2*zz**2+p3*zz**3+p4/(1.d0+zz)-p4 + return +end function eps08se + +subroutine eps08init + implicit double precision(a-h,o-z) + include 'commonlhapdfc.inc' + include 'commonlhacontrol.inc' + ! + ! the LHAPDF bits + ! + character*512 dirpath,setpath + common/eps0800/qq0, qqb + common/eps0801/peps08i(197,13,8,5) + common/eps0802/ amx(13) + data readFR2/0/ + + ! Initialise common blocks + call commoninit() + + qq0 = 1.69d0 + qqb = 21.516d0 + + amx(1) = 4.d0 + amx(2) = 6.d0 + amx(3) = 9.d0 + amx(4) = 12.d0 + amx(5) = 27.d0 + amx(6) = 40.d0 + amx(7) = 56.d0 + amx(8) = 64.d0 + amx(9) = 108.d0 + amx(10) = 117.d0 + amx(11) = 184.d0 + amx(12) = 197.d0 + amx(13) = 208.d0 + + if (readFR2.ne.1) then + ! + ! sort out the path to the input file + ! + call getdirpath(dirpath) + + setpath=dirpath(:LEN_TRIM(dirpath))//"/"//'eps08dta.LHgrid' + open(11,file=setpath(:LEN_TRIM(setpath)),status='unknown') + do ik=1,8 + do ia=1,13 + do ix=1,197 + read(11,137) peps08i(ix,ia,ik,1), peps08i(ix,ia,ik,2), & + peps08i(ix,ia,ik,3), peps08i(ix,ia,ik,4), peps08i(ix,ia,ik,5) + enddo + enddo + enddo + close(11) + readFR2=1 + endif + return +137 format(5f15.8) +end subroutine eps08init + + +! divdif routine from CERNLIB adapted to double precision +! +! $Id: divdif.F,v 1.1.1.1 1996/02/15 17:48:36 mclareni Exp $ +! +! $Log: divdif.F,v $ +! Revision 1.1.1.1 1996/02/15 17:48:36 mclareni +! Kernlib +! +! +FUNCTION EPS08ddv(F,A,NN,X,MM) + implicit double precision (a-h,o-z) + DIMENSION A(NN),F(NN),T(20),D(20) + LOGICAL EXTRA + LOGICAL MFLAG !,RFLAG + DATA MMAX/10/ + ! + ! TABULAR INTERPOLATION USING SYMMETRICALLY PLACED ARGUMENT POINTS. + ! + ! START. FIND SUBSCRIPT IX OF X IN ARRAY A. + !carlos IF( (NN.LT.2) .OR. (MM.LT.1) ) GOTO 20 + N=NN + M=MIN0(MM,MMAX,N-1) + MPLUS=M+1 + IX=0 + IY=N+1 + IF(A(1).GT.A(N)) GOTO 4 + ! (SEARCH INCREASING ARGUMENTS.) +1 MID=(IX+IY)/2 + IF(X.GE.A(MID)) GOTO 2 + IY=MID + GOTO 3 + ! (IF TRUE.) +2 IX=MID +3 IF(IY-IX.GT.1) GOTO 1 + GOTO 7 + ! (SEARCH DECREASING ARGUMENTS.) +4 MID=(IX+IY)/2 + IF(X.LE.A(MID)) GOTO 5 + IY=MID + GOTO 6 + ! (IF TRUE.) +5 IX=MID +6 IF(IY-IX.GT.1) GOTO 4 + ! + ! COPY REORDERED INTERPOLATION POINTS INTO (T(I),D(I)), SETTING + ! *EXTRA* TO TRUE IF M+2 POINTS TO BE USED. +7 NPTS=M+2-MOD(M,2) + IP=0 + L=0 + GOTO 9 +8 L=-L + IF(L.GE.0) L=L+1 +9 ISUB=IX+L + IF((1.LE.ISUB).AND.(ISUB.LE.N)) GOTO 10 + ! (SKIP POINT.) + NPTS=MPLUS + GOTO 11 + ! (INSERT POINT.) +10 IP=IP+1 + T(IP)=A(ISUB) + D(IP)=F(ISUB) +11 IF(IP.LT.NPTS) GOTO 8 + EXTRA=NPTS.NE.MPLUS + ! + ! REPLACE D BY THE LEADING DIAGONAL OF A DIVIDED-DIFFERENCE TABLE, SUP- + ! PLEMENTED BY AN EXTRA LINE IF *EXTRA* IS TRUE. + DO L=1,M + IF(.NOT.EXTRA) GOTO 12 + ISUB=MPLUS-L + D(M+2)=(D(M+2)-D(M))/(T(M+2)-T(ISUB)) +12 I=MPLUS + DO J=L,M + ISUB=I-L + D(I)=(D(I)-D(I-1))/(T(I)-T(ISUB)) + I=I-1 + ENDDO + ENDDO + ! + ! EVALUATE THE NEWTON INTERPOLATION FORMULA AT X, AVERAGING TWO VALUES + ! OF LAST DIFFERENCE IF *EXTRA* IS TRUE. + SUM=D(MPLUS) + IF(EXTRA) SUM=0.5*(SUM+D(M+2)) + J=M + DO L=1,M + SUM=D(J)+(X-T(J))*SUM + J=J-1 + ENDDO + EPS08ddv=SUM + RETURN + ! + !carlos 20 CALL KERMTR('E105.1',LGFILE,MFLAG,RFLAG) + EPS08ddv=0 + IF(MFLAG) THEN + IF(LGFILE.EQ.0) THEN + IF(MM.LT.1) WRITE(*,101) MM + IF(NN.LT.2) WRITE(*,102) NN + ELSE + IF(MM.LT.1) WRITE(LGFILE,101) MM + IF(NN.LT.2) WRITE(LGFILE,102) NN + ENDIF + ENDIF + !carlos IF(.NOT.RFLAG) CALL ABEND + RETURN +101 FORMAT( 7X, 'FUNCTION EPS08ddv ... M =',I6,' IS LESS THAN 1') +102 FORMAT( 7X, 'FUNCTION EPS08ddv ... N =',I6,' IS LESS THAN 2') +END FUNCTION EPS08ddv diff --git a/LHAPDF/lhapdf-5.9.1/src/eps09.f b/LHAPDF/lhapdf-5.9.1/src/eps09.f new file mode 100644 index 00000000000..eba1cd2da1d --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/eps09.f @@ -0,0 +1,364 @@ +!**************************************************************************** +! +! EPS09.f +! +! An interface for the scale dependent nuclear modifications +! R_f^A(x,Q) = f_A(x,Q)/f_p(x,Q) +! where f_A is the distribution of the parton flavour f for a PROTON in a +! nucleus A, and f_p is the corresponding parton distribution in the +! free proton. +! +! When using this interface, please refer to: +! +! K.J. Eskola, H. Paukkunen and C.A. Salgado, +! "EPS09 - a New Generation of NLO and LO Nuclear Parton Distribution Functions," +! Published as JHEP04(2009) 065. +! Eprint: arXiv:0902.4154 [hep-ph]. +! +! Questions & comments to: +! hannu.paukkunen@phys.jyu.fi +! kari.eskola@phys.jyu.fi +! carlos.salgado@usc.es +! +! *************************************************************************** +! Instructions: +! +! For given input values of +! +! order: 1=LO, 2=NLO ; integer +! pset : 1...31 ; integer +! 1 = central fit +! 2,3 = error sets S{+1}, S{-1} +! 4,5 = error sets S{+2}, S{-2} +! ... ... +! 30,31 = error sets {S+15}, {S-15} +! A : atomic number ; integer +! x : Bjorken-x ; double precision +! Q : scale in GeV ; double precision +! +! the command +! +! Call EPS09(order, pset, A, x, Q, ruv, rdv, ru, rd, rs, rc, rb, rg) +! +! returns the bound proton nuclear corrections R_f^A(x,Q) +! (in double precision) for +! +! ruv = up valence +! rdv = down valence +! ru = up sea +! rd = down sea +! rs = strange +! rc = charm +! rb = bottom +! rg = gluons +! +! The nuclear corrections for bound neutrons can be obtained +! by the isospin symmetry, e.g. the total up quark distribution +! per nucleon in a nucleus A with Z protons is +! +! u_A(x,Q) = Z/A * [ruv*uV_p(x,Q) + ru*uSea_p(x,Q)] + +! (A-Z)/A * [rdv*dV_p(x,Q) + rd*dSea_p(x,Q)] +! +! Note that the parametrization should only be applied at the +! kinematical domain +! +! 1e-6 <= x <= 1 +! 1.3 <= Q <= 1000 GeV. +! +! No warning message is displayed if these limits are +! exceeded, and outside these boundaries the modifications +! are frozen to the boundary values, i.e +! +! for Q > 1000, the modifications at Q=1000 are returned, +! for Q < 1.3, the modifications at Q=1.3 are returned, +! for x > 1, the modifications at x=1 are returned +! for x < 1e-6, the modifications at x=1e-6 are returned, +! +! The data used by the program for required order +! and atomic number A, are stored in separate files +! +! LO : EPS09LOR_A +! NLO: EPS09NLOR_A +! +! which must be located in the working directory. +! +! The error bands for absolute cross-sections and for +! their nuclear ratios should be computed as explained +! in Secs. 2.5 and 4 of arXiv:0902.4154 [hep-ph]. For +! the absolute cross sections, both the errors in the +! free-proton PDFs f_p(x,Q) and the errors in +! the modifications R_f^A(x,Q) should be accounted for. +! For the nuclear ratios, it is sufficient to account only +! for the errors in the modifications R_f^A(x,Q). +! +! ********************************************************* +! ********************************************************* + + + + Subroutine EPS09(order, pset, AAA, xxx, QQQ,ruv, rdv, ru, rd, rs, rc, rb, rg) + + Implicit none + Double precision :: ruv, rdv, ru, rd, rs, rc, rb, rg, QQQ, xxx + Double precision :: LSTEP, x, Q, Q2, allvalues(1:31,1:8,0:50,0:50) + Double precision :: x_i=0.000001, arg(4), fu(4), res, fg(3) + Double precision :: result(9), dummy + Double precision :: realQ, Q2min=1.69, Q2max=1000000.0, Qsteps=50.0 + Double precision :: n_x, zero=0.0 + + Character (Len=50) filenimi + + Integer :: xlinsteps=25, xlogsteps=25, startline, lineno + Integer :: k, p, t, Qpoint, xpoint, pset, iovar + Integer :: setnumber,j, A, openchannel, order, AAA + Integer :: psetlast = -10, Alast = -10, orderlast = -10 + + character*512 dirpath,setpath + + save Alast + save psetlast + save orderlast + save allvalues + +! ********************************************* +! Stop if the set specifications are wrong ones +! ********************************************* + + If (order .NE. 1 .and. order .NE. 2) then + Write(*,*) 'Wrong order!' + Write(*,*) 'LO : order = 1' + Write(*,*) 'NLO: order = 2' + Stop + End If + + If (pset .LT. 1 .or. pset .GT. 31) then + Write(*,*) 'Wrong set!' + Write(*,*) 'Central set: pset = 1' + Write(*,*) 'Error sets : pset = 2...31' + Stop + End If + +! ******************************** +! Make sure not to change any +! specifications given by the user +! ******************************** + + A = AAA + x = xxx + Q = QQQ + Q2 = Q*Q + +! ******************************* +! Freeze x if it's < 10E-6 or > 1 +! ******************************* + + If (x .LT. x_i) Then + x = x_i + End If + If (x .GT. 1) Then + x = 1.0 + End If + +! ************************************ +! Freeze Q^2 if it's < 1.69 or > 10E+6 +! ************************************ + + If (Q2 .LT. Q2min) Then + Q2 = Q2min + End If + If (Q2 .GT. Q2max) Then + Q2 = Q2max + End If + +! If the set specifications have been changed, read the tables again + + If (A .NE. Alast .or. order .NE. orderlast) Then + +! Write(*,*) 'Set changed!' + +! Read the table1 + + If (order .EQ. 1) then + + If (A < 10) Then + Write(filenimi,'("EPS09LOR_", I1)'), A + Else If (A < 100) Then + Write(filenimi,'("EPS09LOR_", I2)'), A + Else If (A < 1000) Then + Write(filenimi,'("EPS09LOR_", I3)'), A + End If + + Else + + If (A < 10) Then + Write(filenimi,'("EPS09NLOR_", I1)'), A + Else If (A < 100) Then + Write(filenimi,'("EPS09NLOR_", I2)'), A + Else If (A < 1000) Then + Write(filenimi,'("EPS09NLOR_", I3)'), A + End If + + End If + + call getdirpath(dirpath) + setpath=dirpath(:LEN_TRIM(dirpath))//"/"//filenimi(:LEN_TRIM(filenimi))//".LHgrid" + print *,setpath(:LEN_TRIM(setpath)) + OPEN (11, file = setpath(:LEN_TRIM(setpath)), status='OLD', IOSTAT=iovar) + + If (iovar .NE. 0) Then + Write(*,*) 'Missing file: ',filenimi + stop + End If + + Do setnumber = 1, 31 + + Do k = 0,50 + + Read(11,*) dummy + + Do t = 0,50 + + Read(11,*) (allvalues(setnumber,p,k,t), p=1,8) + + End Do + End Do + + End Do + + Close(11) + + psetlast = pset + Alast = A + orderlast = order + + End If + +! Find out the position in the loglog Q^2-grid + + realQ = Qsteps * (log(log(Q2)/log(Q2min)))/(log(log(Q2max)/log(Q2min))) + Qpoint = Aint(realQ) + + If (Qpoint .LE. 0) Then + Qpoint = 1 + End If + If (Qpoint .GE. Anint(Qsteps)-1) Then + Qpoint = Anint(Qsteps)-1 + End If + + LSTEP = (1.0/(xlogsteps)) * LOG(0.1/x_i) + +! ********************* +! Interpolate the grids +! ********************* + + Do t=1,8 + +! Find the position in the x-grid + + If (x .LE. 0.1) then + n_x = ((1.0/LSTEP) * Log(x/x_i)) + xpoint = Aint(n_x) + Else + n_x = ((x-0.1)*xlinsteps/(1.0-0.1) + xlogsteps) + xpoint = Aint(n_x) + End If + + If (xpoint .LE. 0) Then + xpoint = 1 + End If + + If (t .EQ. 1 .or. t .EQ. 2) Then + If (xpoint .GE. (xlinsteps+xlogsteps)-4) Then + xpoint = (xlinsteps+xlogsteps)-4 + End If + End If + + If (t .EQ. 3 .or. t .EQ. 4 .or. t .EQ. 5 .or. t .EQ. 6 .or. t .EQ. 7) Then + If (xpoint .GE. (xlinsteps+xlogsteps)-7) Then + xpoint = (xlinsteps+xlogsteps)-7 + End If + End If + + If (t .EQ. 8) Then + If (xpoint .GE. (xlinsteps+xlogsteps)-4) Then + xpoint = (xlinsteps+xlogsteps)-4 + End If + End If + + Do k = 1, 4 + If (xpoint-2+k .LT. xlogsteps) Then + arg(k) = (x_i) * exp(LSTEP * (xpoint-2+k)) + Else + arg(k) = 0.1 + (xpoint-2+k-xlogsteps) * (1-0.1)/xlinsteps + End If + End Do + + Do j=1,3 + + fu(1) = allvalues(pset,t,Qpoint-2+j,xpoint-1) + fu(2) = allvalues(pset,t,Qpoint-2+j,xpoint) + fu(3) = allvalues(pset,t,Qpoint-2+j,xpoint+1) + fu(4) = allvalues(pset,t,Qpoint-2+j,xpoint+2) + Call luovi(fu,arg,4,x,res) + fg(j) = res + +! ***************************************** +! ***************************************** + + End Do + + arg(1) = Qpoint-1 + arg(2) = Qpoint + arg(3) = Qpoint+1 + + Call luovi(fg,arg,3,realQ,res) + + result(t) = res + + End Do + + ruv = max(result(1),zero) + rdv = max(result(2),zero) + ru = max(result(3),zero) + rd = max(result(4),zero) + rs = max(result(5),zero) + rc = max(result(6),zero) + rb = max(result(7),zero) + rg = max(result(8),zero) + +200 Continue + + End Subroutine EPS09 + +! ******************************** +! Modified version of Cern Library +! interpolation routine E100 +! ******************************** + + SUBROUTINE luovi(F,ARG,MMM,Z,SUM) + + Implicit none + INTEGER :: MMM + Double precision :: F(MMM), ARG(MMM), COF(MMM), SUM, Z + INTEGER :: M, MM, I, J, JNDEX, INDEX + + MM = MIN(MMM, 20) + M = MM - 1 + DO 1780 I= 1, MM + COF(I) = F(I) + 1780 Continue + DO 1800 I= 1, M + DO 1790 J= I, M + JNDEX = MM - J + INDEX = JNDEX + I + COF(INDEX) = (COF(INDEX)-COF(INDEX-1))/(ARG(INDEX)-ARG(JNDEX)) + 1790 CONTINUE + 1800 CONTINUE + SUM = COF(MM) + DO 1810 I= 1, M + INDEX = MM - I + SUM = (Z-ARG(INDEX))*SUM + COF(INDEX) + 1810 CONTINUE + + End SUBROUTINE luovi + diff --git a/LHAPDF/lhapdf-5.9.1/src/evolution.f b/LHAPDF/lhapdf-5.9.1/src/evolution.f new file mode 100644 index 00000000000..9a4947c8906 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/evolution.f @@ -0,0 +1,83 @@ +! -*- F90 -*- + + +subroutine GetOrderPDF(order) + implicit none + integer nset,order + double precision Q,Q2 + nset = 1 + call GetOrderPDFM(nset,order) + return + + entry GetRenFac(Q) + nset = 1 + call GetRenFacM(nset,Q) + return + + entry GetQ2fit(Q2) + nset = 1 + call GetQ2fitM(nset,Q2) + return +end subroutine GetOrderPDF + +subroutine InitEvolve(nset) + implicit none + character*16 s2 + character*64 ctemp + double precision Q,Q2,Q2fit,muR + integer nset,order,EvlOrd,nFlav,nf,i1,i2,i3 + + save EvlOrd,Q2fit,muR,nFlav + EvlOrd=-1 + read(1,'(a)') ctemp + i1=index(ctemp,',') + i2=index(ctemp(i1+1:),',') + i3=index(ctemp(i1+i2+1:),',') + if(i3>0) then + read(ctemp,*) s2,Q2fit,muR,nFlav + else + read(ctemp,*) s2,Q2fit,muR + nFlav=-1 + endif + if (index(s2,'lo').eq.1) EvlOrd=0 + if (index(s2,'nlo').eq.1) EvlOrd=1 + if (index(s2,'nnlo').eq.1) EvlOrd=2 + if (EvlOrd.lt.0) then + write(*,*) 'File description error:' + write(*,*) 'Unknown PDF evolution order ',s2 + stop + endif + if (muR.ne.1.0d0) then + write(*,*) '***********************************************' + write(*,*) '* Note than the renormalization scale is *' + write(*,*) '* unequal to the factorization scale for this *' + write(*,*) '* particular PDF set. *' + write(*,*) '* See manual for proper use. *' + write(*,*) '***********************************************' + endif +! print *,'calling readevolve', nset + call readevolve(nset) + return + + entry InitEvolveCode(nset) +! print *,'calling initevolution', nset,Evlord,Q2fit + call initevolution(nset,EvlOrd,Q2fit) + return + + entry GetOrderPDFM(nset,order) + order=EvlOrd + return + + entry GetRenFacM(nset,Q) + Q=muR + return + + entry GetQ2fitM(nset,Q2) + Q2=Q2fit + return + + entry GetNFlavM(nset,nf) + nf=nFlav + return + +end subroutine InitEvolve diff --git a/LHAPDF/lhapdf-5.9.1/src/getdatapath.cxx b/LHAPDF/lhapdf-5.9.1/src/getdatapath.cxx new file mode 100644 index 00000000000..a6de90bbff1 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/getdatapath.cxx @@ -0,0 +1,94 @@ +#include "LHAPDF/FortranWrappers.h" +#include +#include +#include +#include +#include +#include +#include "binreloc.h" + +using namespace std; + + +#define SIZE 499 + + +extern "C" { + + + #define fgetdirpath FC_FUNC(getdirpath, GETDIRPATH) + void fgetdirpath(char*, int); + + + #define fgetprefixpath FC_FUNC(getprefixpath, GETPREFIXPATH) + void fgetprefixpath(char* prefixpath, int length) { + BrInitError error; + br_init_lib(&error); + char* tmp = br_find_prefix(DEFAULTPREFIXPATH); + string prefixdir(tmp); + free(tmp); + string test1 = prefixdir + "/share/lhapdf"; + if (access(test1.c_str(), R_OK) != 0) { + prefixdir = DEFAULTPREFIXPATH; + } + assert(prefixdir.length() <= (unsigned) length); + strncpy(prefixpath, prefixdir.c_str(), length); + // Replace null-terminated string convention with Fortran "trailing spaces" convention: + for (size_t i = strlen(prefixpath); i < (unsigned) length; ++i) { + prefixpath[i] = ' '; + } + } + + + #define fgetindexpath FC_FUNC(getindexpath, GETINDEXPATH) + void fgetindexpath(char* indexpath, int length) { + char tmp[SIZE+1]; + tmp[SIZE] = '\0'; + fgetdirpath(tmp, SIZE); + //for (size_t i = 0; i < SIZE; ++i) { + // tmp[i] = ' '; + //} + for (size_t i = SIZE-1; i >= 0; --i) { + if (tmp[i] != ' ') break; + tmp[i] = '\0'; + } + string try1(tmp), try2(tmp); + try1 += "/PDFsets.index"; + try2 += ".index"; + if (access(try1.c_str(), R_OK) == 0) { + assert(try1.length() <= (unsigned) length); + strncpy(indexpath, try1.c_str(), length); + } else { + assert(try2.length() <= (unsigned) length); + strncpy(indexpath, try2.c_str(), length); + } + // Replace null-terminated string convention with Fortran "trailing spaces" convention: + for (size_t i = strlen(indexpath); i < (unsigned) length; ++i) { + indexpath[i] = ' '; + } + } + + + #define fgetdatapath FC_FUNC(getdatapath, GETDATAPATH) + void fgetdatapath(char* datapath, int length) { + BrInitError error; + br_init_lib(&error); + char * ctmp = br_find_data_dir(DEFAULTLHAPATH); + string sharedir(ctmp); + free(ctmp); + string tmp = sharedir + "/lhapdf/PDFsets"; + string test1 = tmp + "/cteq6.LHpdf"; + if (access(test1.c_str(), R_OK) != 0) { + // tmp = string(DEFAULTLHAPATH) + "/lhapdf/PDFsets"; + tmp = string(DEFAULTLHAPATH); + } + assert(tmp.length() <= (unsigned) length); + strncpy(datapath, tmp.c_str(), length); + // Replace null-terminated string convention with Fortran "trailing spaces" convention: + for (size_t i = strlen(datapath); i < (unsigned) length; ++i) { + datapath[i] = ' '; + } + } + + +} diff --git a/LHAPDF/lhapdf-5.9.1/src/inputPDF.F b/LHAPDF/lhapdf-5.9.1/src/inputPDF.F new file mode 100644 index 00000000000..2186abaa54c --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/inputPDF.F @@ -0,0 +1,683 @@ +! -*- F90 -*- + + +subroutine weightPDF(x) + implicit none + integer nset,imem,nfmax + double precision x,Q + nset=1 + call weightPDFM(nset,x) + return + + entry GetNF(nfmax) + nset=1 + call GetNFM(nset,nfmax) + return + + entry GetThreshold(imem,Q) + nset=1 + call GetThresholdM(nset,imem,Q) + return +end subroutine weightPDF + + +subroutine parmPDF(nset,x,pdf) + implicit none +! include 'parmsetup.inc' + include 'commonlhasets.inc' + integer nset + character*16 name(nmxset) + integer nmem(nmxset),ndef(nmxset),mem + common/NAME/name,nmem,ndef,mem + real xp(40),x4,fgdis4 + character*16 s1,s2 + integer i,j,imem,nop,Nfunc(nmxset),Fw(nmxset),nfmax!,M,parmN + double precision x,b0,Poly,pdf(-6:6),Fparm(nopmax),F(nofmax)!,N + double precision Ccoef(nmxset,-6:6,nofmax),Fpow(nmxset,nofmax) + double precision Q,Treshold(nmxset,-6:6) + ! data Treshold/39*0d0/ + integer Fmap(nmxset,nofmax,npfmax) + integer Ftype(nmxset,nofmax),Fn(nmxset,nofmax),Ctype(nmxset,-6:6) + integer lhasilent + common/lhasilent/lhasilent + logical first + data first/.true./ + save Nfunc,Fn,Fw,Fpow,Fmap,Ccoef,Fparm,Ftype,Ctype,first,Treshold +#ifdef NNPDF +! NNPDF variables + INTEGER KREP + integer MXPDF + parameter(MXPDF=13) + integer NTOTPDF + parameter(NTOTPDF=5) + integer MXPAR + parameter(MXPAR=2e2) + integer MXL,MXN + parameter(MXL=5,MXN=10) + integer NPAR(MXPDF) + integer tnl(ntotpdf),neu(mxl,ntotpdf) + real*8 XNOR(2,NTOTPDF),PDFNOR(2,NTOTPDF),PDFOUT(MXPDF),FFF(nofmax) + real*8 PDFEXP(2,NTOTPDF) + real*8 PDFDELTA(NTOTPDF) + real*8 XDELTALIN(NTOTPDF),XDELTALOG(NTOTPDF) + common/nnpdf10CNNARC/PDFEXP,PDFNOR,PDFDELTA,XDELTALIN & + & ,XDELTALOG,XNOR,NEU,TNL +! +#endif + integer Nx(nmxset), Nt(nmxset), NfMx(nmxset) + common/ CtqPar2 / Nx, Nt, NfMx + do i=1,Nfunc(nset) + if (Ftype(nset,i).eq.1) then + Poly=1.0 + + do j=4,Fn(nset,i) + Poly=Poly+Fparm(Fmap(nset,i,j))*x**(float(j-3)/Fpow(nset,i)) + enddo + Poly=Fparm(Fmap(nset,i,1))*Poly + F(i)=x**Fparm(Fmap(nset,i,2))*(1.0-x)**Fparm(Fmap(nset,i,3))*Poly + endif + if (Ftype(nset,i).eq.2) then + if (x.lt.0.9999999) then + Poly = Fparm(Fmap(nset,i,2))*log(x)+Fparm(Fmap(nset,i,3))*log(1.0-x) & + + Fparm(Fmap(nset,i,4))*x & + + Fparm(Fmap(nset,i,6))*log(1.0+x*exp(Fparm(Fmap(nset,i,5)))) + F(i) = Fparm(Fmap(nset,i,1))*exp(Poly) + else + F(i)=0d0 + endif + endif + if (Ftype(nset,i).eq.101) then + Poly = exp(Fparm(Fmap(nset,i,1))) * x**(Fparm(Fmap(nset,i,2))-1) * (1d0-x)**Fparm(Fmap(nset,i,3)) + Poly = Poly + (1d0+Fparm(Fmap(nset,i,4))*x) * (1d0-x)**Fparm(Fmap(nset,i,5)) + b0=10d0 + if (Poly.gt.b0) then + F(i)=Poly + elseif (Poly.lt.-b0) then + F(i)=0d0 + else + F(i)=Poly+log(1d0+exp(-b0*Poly)-exp(-b0))/b0 + endif + endif + ! - to add the mrst2004 gluon convolution + if (Ftype(nset,i).eq.201) then + xp(2) = Fparm(Fmap(nset,i,1)) + xp(3) = Fparm(Fmap(nset,i,2)) + xp(23)= Fparm(Fmap(nset,i,3)) + xp(16)= Fparm(Fmap(nset,i,4)) + xp(5) = Fparm(Fmap(nset,i,5)) + xp(40)= Fparm(Fmap(nset,i,6)) + xp(24)= Fparm(Fmap(nset,i,7)) + xp(20)= Fparm(Fmap(nset,i,8)) + xp(4) = Fparm(Fmap(nset,i,9)) + xp(1) = Fparm(Fmap(nset,i,10)) + x4 = x + call gconv(x4,xp,fgdis4) + F(i) = FGDIS4 + endif + +#ifdef NNPDF +! NNPDF + if (Ftype(nset,i).eq.301) then + KREP = mem + if(krep.le.0.or.krep.gt.1000)then + write(*,*)"krep has a value not allowed in inputPDF" + endif + call LH_PDFIN(x,PDFOUT) ! In wrapXNN.f: pdfout(1:13) sing,g,uv,dv,sv,cv,bv,tv,t3,t8,t15,t24,t35 + call LH_PDFEVLN2INPAR(PDFOUT,FFF) ! in EVLNNPDF.f: F: sing,g,Triplet,ValTot, SeaAsym + F(i) = FFF(I) + endif + !-- +#endif + enddo + do i=-6,6 + pdf(i)=0.0 + if (Ctype(nset,i).gt.0) then + if (Ctype(nset,i).eq.1) then + do j=1,Nfunc(nset) + pdf(i)=pdf(i)+Ccoef(nset,i,j)*F(j) + ! print *,i,j,Ccoef(i,j),F(j) + enddo + endif + if (Ctype(nset,i).eq.101) then + if (i.eq.-2) then + pdf(i)=F(int(Ccoef(nset,i,1)))/(F(int(Ccoef(nset,i,2)))+1d0) + endif + if (i.eq.-1) then + pdf(i) = F(int(Ccoef(nset,i,1)))/(1d0/F(int(Ccoef(nset,i,2)))+1d0) + endif + if (i.eq.1) then + pdf(i)=F(1)+pdf(-1) + endif + if (i.eq.2) then + pdf(i)=F(2)+pdf(-2) + endif + endif + endif + enddo + ! print *,pdf + return + + entry weightPDFM(nset,x) + if (Fw(nset).ge.0) then + x=Fparm(Fw(nset)) + else + call numberPDF(nop) + x=1.0/float(nop) + endif + return + + ! entry GetParmPDFM(nset,imem,x) + entry GetParmPDF(nset,imem,x) + x=Fparm(imem) + return + + entry GetNfM(nset,nfmax) + if (name(nset).eq.'MRST' .or. name(nset).eq.'EVLCTEQ' .or. name(nset)(1:6).eq.'QCDNUM') then + nfmax=0 + do i=1,6 + if (Treshold(nset,-i).ge.0d0) nfmax=nfmax+1 + if (Treshold(nset,i).ge.0d0) nfmax=nfmax+1 + enddo + nfmax=nfmax/2 + else if(name(nset)(1:2).eq.'CT') then + nfmax = NfMx(nset) + else + call getNflavM(nset,nfmax) + endif + return + + entry GetThresholdM(nset,imem,Q) + Q=Treshold(nset,imem) + return + + ! entry InitEvolvePDFM(nset,imem) + entry InitEvolvePDF(nset,imem) + ! print*, 'calling listPDF',nset,imem + call listPDF(nset,imem,Fparm) + ! print *,Fparm + return + + ! entry initInputPDFM(nset) + entry initInputPDF(nset) + if(first) then + do i=1,nmxset + do j=-6,6 + Treshold(i,j)=0.0d0 + enddo + enddo + first=.false. + endif + read(1,*) s1,Fw(nset),Nfunc(nset) + ! print *,s1,Fw,Nfunc + if (lhasilent.eq.0) then + write(*,*) 'Parametrization: ',s1 + write(*,*) + endif + do i=1,Nfunc(nset) + Ftype(nset,i)=-1 + read(1,*) s1,s2 + if (index(s2,'x-taylor').eq.1) then + Ftype(nset,i)=1 + read(1,*) FPow(nset,i),Fn(nset,i) + read(1,*) (Fmap(nset,i,j),j=1,Fn(nset,i)) + endif + if (index(s2,'log-pade').eq.1) then + Ftype(nset,i)=2 + FPow(nset,i)=0d0 + read(1,*) Fn(nset,i) + read(1,*) (Fmap(nset,i,j),j=1,Fn(nset,i)) + endif + if (index(s2,'cteq6-ratio').eq.1) then + Ftype(nset,i)=101 + Fpow(nset,i)=0d0 + Fn(nset,i)=5 + read(1,*) (Fmap(nset,i,j),j=1,Fn(nset,i)) + endif + if (index(s2,'convol').eq.1) then + Ftype(nset,i)=201 + read(1,*) Fn(nset,i) + read(1,*) (Fmap(nset,i,j),j=1,Fn(nset,i)) + endif +#ifdef NNPDF + if (index(s2,'XNNPDF').eq.1) then + Ftype(nset,i)=301 + read(1,*) tnl(i) + read(1,*) (neu(j,i),j=1,tnl(i)) + read(1,*) (xnor(j,i),j=1,2) + read(1,*) (pdfnor(j,i),j=1,2) + read(1,*) (pdfexp(j,i),j=1,2) + read(1,*) NPAR(i) + endif +#endif + if (Ftype(nset,i).lt.0) then + write(*,*) 'File description error:' + write(*,*) 'Unknown functional ',s2 + stop + endif + enddo + read(1,*) s1 + do i=-6,6 + Ctype(nset,i)=-1 + read(1,*) s1,s2 + ! print *,s1,s2 + if (index(s2,'none').eq.1) then + Ctype(nset,i)=0 + Treshold(nset,i)=-1d0 + endif + if (index(s2,'treshold').eq.1) then + Ctype(nset,i)=0 + read(1,*) Treshold(nset,i) + endif + if (index(s2,'composite').eq.1) then + Ctype(nset,i)=1 + Treshold(nset,i)=0d0 + read(1,*) (Ccoef(nset,i,j),j=1,Nfunc(nset)) + endif + if (index(s2,'cteq6-ratio').eq.1) then + Ctype(nset,i)=101 + Treshold(nset,i)=0d0 + read(1,*) (Ccoef(nset,i,j),j=1,3) + endif + if (Ctype(nset,i).lt.0) then + write(*,*) 'File description error:' + write(*,*) 'Unknown composit type ',s2 + stop + endif + enddo + if (Fw(nset).ge.0) then + write(*,*) '***********************************************' + write(*,*) '* Note that this is a weighted PDF set. *' + write(*,*) '* See manual for proper use. *' + write(*,*) '***********************************************' + endif + return +end subroutine parmPDF + + +FUNCTION BETA_LHA(X1,X2) + CALL GAMMA_LHA(X1,G1,IER) + IF(IER.NE.0) write(16,*) 'GAMMA_LHA ERROR: IER= ',IER,X1,X2 + CALL GAMMA_LHA(X2,G2,IER) + IF(IER.NE.0) write(16,*) 'GAMMA_LHA ERROR: IER= ',IER,X1,X2 + X3=X1+X2 + CALL GAMMA_LHA(X3,G3,IER) + IF(IER.NE.0) write(16,*) 'GAMMA_LHA ERROR: IER= ',IER,X1,X2 + BETA_LHA=G1*G2/G3 + RETURN +END FUNCTION BETA_LHA + + +SUBROUTINE GAMMA_LHA(XX,GX,IER) + IF((XX-34.5).LE.0) THEN + GOTO 6 + ELSE + GOTO 4 + ENDIF +4 IER=2 + GX=1.E38 + RETURN +6 X=XX + ERR=1.0E-6 + IER=0 + GX=1.0 + IF((X-2.0).LE.0) THEN + GOTO 50 + ELSE + GOTO 15 + ENDIF +10 IF((X-2.0).LE.0) THEN + GOTO 110 + ELSE + GOTO 15 + ENDIF +15 X=X-1.0 + GX=GX*X + GOTO 10 +50 IF((X-1.0).LT.0) THEN + GOTO 60 + ELSE IF ((X-1.0).EQ.0) THEN + GOTO 120 + ELSE + GOTO 110 + ENDIF + ! SEE IF X IS NEAR NEGATIVE INTEGER OR ZERO +60 IF((X-ERR).LE.0) THEN + GOTO 62 + ELSE + GOTO 80 + ENDIF +62 K=X + Y=FLOAT(K)-X + IF((ABS(Y)-ERR).LE.0) THEN + GOTO 130 + ELSE + GOTO 64 + ENDIF +64 IF((1.0-Y-ERR).LE.0) THEN + GOTO 130 + ELSE + GOTO 70 + ENDIF + ! X NOT NEAR A NEGATIVE INTEGER OR ZERO +70 IF((X-1.0).LE.0) THEN + GOTO 80 + ELSE + GOTO 110 + ENDIF +80 GX=GX/X + X=X+1.0 + GOTO 70 +110 Y=X-1.0 + GY=1.0+Y*(-0.5771017+Y*(+0.9858540+Y*(-0.8764218+Y*(+0.8328212+Y*(-0.5684729+Y*(+0.2548205+Y*(-0.05149930))))))) + GX=GX*GY +120 RETURN +130 IER=1 + RETURN +END SUBROUTINE GAMMA_LHA + + +FUNCTION ALPHA(T,AL) + COMMON/AINPUT/IORD,QSCT,QSDT + COMMON/PARAM/PARA(40) + DATA PI/3.14159/ + DATA TOL/.0005/ + ITH=0 + TT=T + qsctt=qsct/4. + qsdtt=qsdt/4. + ! AL=para(1) + AL2=AL*AL + FLAV=4. + QS=AL2*EXP(T) + + ! CHECK: explicitly initialising ALFQC{3,4,5} (by AB) + ALFQC3 = 0 + ALFQC4 = 0 + ALFQC5 = 0 + + if (qs.lt.0.5d0) then !! running stops below 0.5 + qs=0.5d0 + t=alog(qs/al2) + tt=t + endif + + IF(QS.gt.QSCTT) GOTO 12 + IF(QS.lt.QSDTT) GOTO 312 +11 CONTINUE + B0=11-2.*FLAV/3. + IF(IORD.LE.0) THEN + GOTO 1 + ELSE + GOTO 2 + ENDIF + ! IF(IORD)2,2,2 !TAKE CARE !! +1 CONTINUE + ALPHA=4.*PI/B0/T + RETURN +2 CONTINUE + X1=4.*PI/B0 + B1=102.-38.*FLAV/3. + X2=B1/B0**2 + AS=X1/T*(1.-X2*aLOG(T)/T) +5 CONTINUE + F=-T+X1/AS-X2*aLOG(X1/AS+X2) + FP=-X1/AS**2*(1.-X2/(X1/AS+X2)) + AS2=AS-F/FP + DEL=ABS(F/FP/AS) + IF((DEL-TOL).LE.0) THEN + GOTO 3 + ELSE + GOTO 4 + ENDIF +3 CONTINUE + ALPHA=AS2 + IF(ITH.EQ.0) RETURN + GOTO (13,14,15) ITH +4 CONTINUE + AS=AS2 + GOTO 5 +12 ITH=1 + T=aLOG(QSCTT/AL2) + GOTO 11 +13 ALFQC4=ALPHA + FLAV=5. + ITH=2 + GOTO 11 +14 ALFQC5=ALPHA + ITH=3 + T=TT + GOTO 11 +15 ALFQS5=ALPHA + ALFINV=1./ALFQS5+1./ALFQC4-1./ALFQC5 + ALPHA=1./ALFINV + RETURN +311 CONTINUE + B0=11-2.*FLAV/3. + IF(IORD.LE.0)THEN + GOTO 31 + ELSE + GOTO 32 + ENDIF + ! IF(IORD)32,32,32 !TAKE CARE !! +31 CONTINUE + ALPHA=4.*PI/B0/T + RETURN +32 CONTINUE + X1=4.*PI/B0 + B1=102.-38.*FLAV/3. + X2=B1/B0**2 + AS=X1/T*(1.-X2*aLOG(T)/T) +35 CONTINUE + F=-T+X1/AS-X2*aLOG(X1/AS+X2) + FP=-X1/AS**2*(1.-X2/(X1/AS+X2)) + AS2=AS-F/FP + DEL=ABS(F/FP/AS) + ! IF(DEL-TOL)33,33,34 + IF((DEL-TOL).LE.0) THEN + GOTO 33 + ELSE + GOTO 34 + ENDIF +33 CONTINUE + ALPHA=AS2 + IF(ITH.EQ.0) RETURN + GOTO (313,314,315) ITH +34 CONTINUE + AS=AS2 + GOTO 35 +312 ITH=1 + T=aLOG(QSDTT/AL2) + GOTO 311 +313 ALFQC4=ALPHA + FLAV=3. + ITH=2 + GOTO 311 +314 ALFQC3=ALPHA + ITH=3 + T=TT + GOTO 311 +315 ALFQS3=ALPHA + ALFINV=1./ALFQS3+1./ALFQC4-1./ALFQC3 + ALPHA=1./ALFINV + RETURN +END FUNCTION ALPHA + + +SUBROUTINE WATE96 + !******************************************************************* + !***** ***** + !***** THE X(I) AND W(I) ARE THE DIRECT OUTPUT FROM A PROGRAM ***** + !***** USING NAG ROUTINE D01BCF TO CALCULATE THE ***** + !***** GAUSS-LEGENDRE WEIGHTS FOR 96 POINT INTEGRATION. ***** + !***** THEY AGREE TO TYPICALLY 14 DECIMAL PLACES WITH THE ***** + !***** TABLE IN ABRAMOWITZ & STEGUN, PAGE 919. ***** + !***** ***** + !***** ----> PETER HARRIMAN, APRIL 3RD 1990. ***** + !***** ***** + !******************************************************************* + DIMENSION X(48),W(48) + COMMON/GAUS96/XI(96),WI(96),nterms,XX(97) + NTERMS=96 + X( 1)= 0.01627674484960183561 + X( 2)= 0.04881298513604856015 + X( 3)= 0.08129749546442434360 + X( 4)= 0.11369585011066471632 + X( 5)= 0.14597371465489567682 + X( 6)= 0.17809688236761733390 + X( 7)= 0.21003131046056591064 + X( 8)= 0.24174315616383866556 + X( 9)= 0.27319881259104774468 + X(10)= 0.30436494435449495954 + X(11)= 0.33520852289262397655 + X(12)= 0.36569686147231213885 + X(13)= 0.39579764982890709712 + X(14)= 0.42547898840729897474 + X(15)= 0.45470942216774136446 + X(16)= 0.48345797392059470382 + X(17)= 0.51169417715466604391 + X(18)= 0.53938810832435567233 + X(19)= 0.56651041856139533470 + X(20)= 0.59303236477757022282 + X(21)= 0.61892584012546672523 + X(22)= 0.64416340378496526886 + X(23)= 0.66871831004391424358 + X(24)= 0.69256453664216964528 + X(25)= 0.71567681234896561582 + X(26)= 0.73803064374439816819 + X(27)= 0.75960234117664555964 + X(28)= 0.78036904386743123629 + X(29)= 0.80030874413913884180 + X(30)= 0.81940031073792957139 + X(31)= 0.83762351122818502758 + X(32)= 0.85495903343459936363 + X(33)= 0.87138850590929436968 + X(34)= 0.88689451740241818933 + X(35)= 0.90146063531585023110 + X(36)= 0.91507142312089592706 + X(37)= 0.92771245672230655266 + X(38)= 0.93937033975275308073 + X(39)= 0.95003271778443564022 + X(40)= 0.95968829144874048809 + X(41)= 0.96832682846326217918 + X(42)= 0.97593917458513455843 + X(43)= 0.98251726356301274934 + X(44)= 0.98805412632962202890 + X(45)= 0.99254390032376081654 + X(46)= 0.99598184298720747465 + X(47)= 0.99836437586317963722 + X(48)= 0.99968950388322870559 + W( 1)= 0.03255061449236316962 + W( 2)= 0.03251611871386883307 + W( 3)= 0.03244716371406427668 + W( 4)= 0.03234382256857594104 + W( 5)= 0.03220620479403026124 + W( 6)= 0.03203445623199267876 + W( 7)= 0.03182875889441101874 + W( 8)= 0.03158933077072719007 + W( 9)= 0.03131642559686137819 + W(10)= 0.03101033258631386231 + W(11)= 0.03067137612366917839 + W(12)= 0.03029991542082762553 + W(13)= 0.02989634413632842385 + W(14)= 0.02946108995816795100 + W(15)= 0.02899461415055528410 + W(16)= 0.02849741106508543861 + W(17)= 0.02797000761684838950 + W(18)= 0.02741296272602931385 + W(19)= 0.02682686672559184485 + W(20)= 0.02621234073567250055 + W(21)= 0.02557003600534944960 + W(22)= 0.02490063322248370695 + W(23)= 0.02420484179236479915 + W(24)= 0.02348339908592633665 + W(25)= 0.02273706965832950717 + W(26)= 0.02196664443874448477 + W(27)= 0.02117293989219144572 + W(28)= 0.02035679715433347898 + W(29)= 0.01951908114014518992 + W(30)= 0.01866067962741165898 + W(31)= 0.01778250231604547316 + W(32)= 0.01688547986424539715 + W(33)= 0.01597056290256253144 + W(34)= 0.01503872102699521608 + W(35)= 0.01409094177231515264 + W(36)= 0.01312822956696188190 + W(37)= 0.01215160467108866759 + W(38)= 0.01116210209983888144 + W(39)= 0.01016077053500880978 + W(40)= 0.00914867123078384552 + W(41)= 0.00812687692569928101 + W(42)= 0.00709647079115442616 + W(43)= 0.00605854550423662775 + W(44)= 0.00501420274292825661 + W(45)= 0.00396455433844564804 + W(46)= 0.00291073181793626202 + W(47)= 0.00185396078894924657 + W(48)= 0.00079679206555731759 + DO I=1,48 + XI(I)=-X(49-I) + WI(I)=W(49-I) + XI(I+48)=X(I) + WI(I+48)=W(I) + END DO + DO I=1,96 + XX(I)=0.5*(XI(I)+1.) + END DO + XX(97)=1.0 + EXPON=1.0 + DO I=1,96 + YI=2.*(0.5*(1.+XI(I)))**EXPON-1. + WI(I)=WI(I)/(1.+XI(I))*(1.+YI)*EXPON + XI(I)=YI + XX(I)=0.5*(1.+YI) + END DO + RETURN +END SUBROUTINE WATE96 + + +subroutine gconv(x,xp,fgdis) + COMMON/AINPUT/IORD,QSCT,QSDT + common/GAUS96/XI(96),WI(96),NTERMS,XX(97) + dimension xp(40) + logical first + data first/.true./ + if (first) then + call wate96 + first=.false. + endif + PI = 3.14159 + PI2 = PI*PI + iord = 1 + qsdt=8.18 !! This is the value of 4m_c^2 + qsct=74.0 !! This is the value of 4m_b^2 + cf = 4./3. + eta4 = xp(40) + T=alog(1/xp(1)**2) + ! AL = 0.550/(4.* 3.14159) + AL=ALPHA(T,xp(1))/(4.* pi) + rx=sqrt(x) + FF1 = BETA_LHA(XP(2),XP(3)+1.)+XP(16)*BETA_LHA(XP(2)+1.,XP(3)+1.)+XP(23)*BETA_LHA(XP(2)+0.5,XP(3)+1.) + FF2 = BETA_LHA(XP(2)+1.,XP(3)+1.)+XP(16)*BETA_LHA(XP(2)+2.,XP(3)+1.)+XP(23)*BETA_LHA(XP(2)+1.5,XP(3)+1.) + FF3 = BETA_LHA(XP(5),ETA4+1.)+XP(20)*BETA_LHA(XP(5)+1.,ETA4+1.)+XP(24)*BETA_LHA(XP(5)+0.5,ETA4+1.) + FF4 = BETA_LHA(XP(5)+1.,ETA4+1.)+XP(20)*BETA_LHA(XP(5)+2.,ETA4+1.)+XP(24)*BETA_LHA(XP(5)+1.5,ETA4+1.) + COEFU = 2.*XP(4)/FF1 + COEFD = XP(4)/FF3 + ! print *,'coefu ',coefu + ! print *,'coefd ',coefd + UV=coefu*X**XP(2)*(1.-X)**XP(3)*(1.+XP(16)*X+XP(23)*SQRT(X)) + DV=coefd*X**XP(5)*(1.-X)**ETA4*(1.+XP(20)*X+XP(24)*SQRT(X)) + FGDIS=al*CF*(-9.-2.*PI2/3.+alog(1.-x)*(-3.+2.*alog(1.-x)))*(UV+DV) + + DO M=1,NTERMS + Y=0.5*(1.-X)*XI(M)+0.5*(1.+X) + XY=X/Y + UVXY = coefu*XY**XP(2) * (1.-XY)**XP(3) * (1.+XP(16) * XY + XP(23) * SQRT(XY)) + DVXY = coefd*XY**XP(5) * (1.-XY)**ETA4 * (1.+XP(20) * XY + XP(24) * SQRT(XY)) + AL1=ALOG(1.-Y) + C22=CF*(6.+4.*Y-2.*(1.+Y*Y)/(1.-Y)*ALOG(Y)-2.*(1.+Y)*ALOG(1.-Y)) + C23=CF*(-3.+4.*ALOG(1.-Y))/(1.-Y) + FGDIS=FGDIS+.5*(1.-X)*WI(M)*al*(C22*(uvxy+dvxy)+C23*(uvxy+dvxy-uv-dv)) + END DO + + return +end subroutine gconv diff --git a/LHAPDF/lhapdf-5.9.1/src/inputPDF.f b/LHAPDF/lhapdf-5.9.1/src/inputPDF.f new file mode 100644 index 00000000000..2186abaa54c --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/inputPDF.f @@ -0,0 +1,683 @@ +! -*- F90 -*- + + +subroutine weightPDF(x) + implicit none + integer nset,imem,nfmax + double precision x,Q + nset=1 + call weightPDFM(nset,x) + return + + entry GetNF(nfmax) + nset=1 + call GetNFM(nset,nfmax) + return + + entry GetThreshold(imem,Q) + nset=1 + call GetThresholdM(nset,imem,Q) + return +end subroutine weightPDF + + +subroutine parmPDF(nset,x,pdf) + implicit none +! include 'parmsetup.inc' + include 'commonlhasets.inc' + integer nset + character*16 name(nmxset) + integer nmem(nmxset),ndef(nmxset),mem + common/NAME/name,nmem,ndef,mem + real xp(40),x4,fgdis4 + character*16 s1,s2 + integer i,j,imem,nop,Nfunc(nmxset),Fw(nmxset),nfmax!,M,parmN + double precision x,b0,Poly,pdf(-6:6),Fparm(nopmax),F(nofmax)!,N + double precision Ccoef(nmxset,-6:6,nofmax),Fpow(nmxset,nofmax) + double precision Q,Treshold(nmxset,-6:6) + ! data Treshold/39*0d0/ + integer Fmap(nmxset,nofmax,npfmax) + integer Ftype(nmxset,nofmax),Fn(nmxset,nofmax),Ctype(nmxset,-6:6) + integer lhasilent + common/lhasilent/lhasilent + logical first + data first/.true./ + save Nfunc,Fn,Fw,Fpow,Fmap,Ccoef,Fparm,Ftype,Ctype,first,Treshold +#ifdef NNPDF +! NNPDF variables + INTEGER KREP + integer MXPDF + parameter(MXPDF=13) + integer NTOTPDF + parameter(NTOTPDF=5) + integer MXPAR + parameter(MXPAR=2e2) + integer MXL,MXN + parameter(MXL=5,MXN=10) + integer NPAR(MXPDF) + integer tnl(ntotpdf),neu(mxl,ntotpdf) + real*8 XNOR(2,NTOTPDF),PDFNOR(2,NTOTPDF),PDFOUT(MXPDF),FFF(nofmax) + real*8 PDFEXP(2,NTOTPDF) + real*8 PDFDELTA(NTOTPDF) + real*8 XDELTALIN(NTOTPDF),XDELTALOG(NTOTPDF) + common/nnpdf10CNNARC/PDFEXP,PDFNOR,PDFDELTA,XDELTALIN & + & ,XDELTALOG,XNOR,NEU,TNL +! +#endif + integer Nx(nmxset), Nt(nmxset), NfMx(nmxset) + common/ CtqPar2 / Nx, Nt, NfMx + do i=1,Nfunc(nset) + if (Ftype(nset,i).eq.1) then + Poly=1.0 + + do j=4,Fn(nset,i) + Poly=Poly+Fparm(Fmap(nset,i,j))*x**(float(j-3)/Fpow(nset,i)) + enddo + Poly=Fparm(Fmap(nset,i,1))*Poly + F(i)=x**Fparm(Fmap(nset,i,2))*(1.0-x)**Fparm(Fmap(nset,i,3))*Poly + endif + if (Ftype(nset,i).eq.2) then + if (x.lt.0.9999999) then + Poly = Fparm(Fmap(nset,i,2))*log(x)+Fparm(Fmap(nset,i,3))*log(1.0-x) & + + Fparm(Fmap(nset,i,4))*x & + + Fparm(Fmap(nset,i,6))*log(1.0+x*exp(Fparm(Fmap(nset,i,5)))) + F(i) = Fparm(Fmap(nset,i,1))*exp(Poly) + else + F(i)=0d0 + endif + endif + if (Ftype(nset,i).eq.101) then + Poly = exp(Fparm(Fmap(nset,i,1))) * x**(Fparm(Fmap(nset,i,2))-1) * (1d0-x)**Fparm(Fmap(nset,i,3)) + Poly = Poly + (1d0+Fparm(Fmap(nset,i,4))*x) * (1d0-x)**Fparm(Fmap(nset,i,5)) + b0=10d0 + if (Poly.gt.b0) then + F(i)=Poly + elseif (Poly.lt.-b0) then + F(i)=0d0 + else + F(i)=Poly+log(1d0+exp(-b0*Poly)-exp(-b0))/b0 + endif + endif + ! - to add the mrst2004 gluon convolution + if (Ftype(nset,i).eq.201) then + xp(2) = Fparm(Fmap(nset,i,1)) + xp(3) = Fparm(Fmap(nset,i,2)) + xp(23)= Fparm(Fmap(nset,i,3)) + xp(16)= Fparm(Fmap(nset,i,4)) + xp(5) = Fparm(Fmap(nset,i,5)) + xp(40)= Fparm(Fmap(nset,i,6)) + xp(24)= Fparm(Fmap(nset,i,7)) + xp(20)= Fparm(Fmap(nset,i,8)) + xp(4) = Fparm(Fmap(nset,i,9)) + xp(1) = Fparm(Fmap(nset,i,10)) + x4 = x + call gconv(x4,xp,fgdis4) + F(i) = FGDIS4 + endif + +#ifdef NNPDF +! NNPDF + if (Ftype(nset,i).eq.301) then + KREP = mem + if(krep.le.0.or.krep.gt.1000)then + write(*,*)"krep has a value not allowed in inputPDF" + endif + call LH_PDFIN(x,PDFOUT) ! In wrapXNN.f: pdfout(1:13) sing,g,uv,dv,sv,cv,bv,tv,t3,t8,t15,t24,t35 + call LH_PDFEVLN2INPAR(PDFOUT,FFF) ! in EVLNNPDF.f: F: sing,g,Triplet,ValTot, SeaAsym + F(i) = FFF(I) + endif + !-- +#endif + enddo + do i=-6,6 + pdf(i)=0.0 + if (Ctype(nset,i).gt.0) then + if (Ctype(nset,i).eq.1) then + do j=1,Nfunc(nset) + pdf(i)=pdf(i)+Ccoef(nset,i,j)*F(j) + ! print *,i,j,Ccoef(i,j),F(j) + enddo + endif + if (Ctype(nset,i).eq.101) then + if (i.eq.-2) then + pdf(i)=F(int(Ccoef(nset,i,1)))/(F(int(Ccoef(nset,i,2)))+1d0) + endif + if (i.eq.-1) then + pdf(i) = F(int(Ccoef(nset,i,1)))/(1d0/F(int(Ccoef(nset,i,2)))+1d0) + endif + if (i.eq.1) then + pdf(i)=F(1)+pdf(-1) + endif + if (i.eq.2) then + pdf(i)=F(2)+pdf(-2) + endif + endif + endif + enddo + ! print *,pdf + return + + entry weightPDFM(nset,x) + if (Fw(nset).ge.0) then + x=Fparm(Fw(nset)) + else + call numberPDF(nop) + x=1.0/float(nop) + endif + return + + ! entry GetParmPDFM(nset,imem,x) + entry GetParmPDF(nset,imem,x) + x=Fparm(imem) + return + + entry GetNfM(nset,nfmax) + if (name(nset).eq.'MRST' .or. name(nset).eq.'EVLCTEQ' .or. name(nset)(1:6).eq.'QCDNUM') then + nfmax=0 + do i=1,6 + if (Treshold(nset,-i).ge.0d0) nfmax=nfmax+1 + if (Treshold(nset,i).ge.0d0) nfmax=nfmax+1 + enddo + nfmax=nfmax/2 + else if(name(nset)(1:2).eq.'CT') then + nfmax = NfMx(nset) + else + call getNflavM(nset,nfmax) + endif + return + + entry GetThresholdM(nset,imem,Q) + Q=Treshold(nset,imem) + return + + ! entry InitEvolvePDFM(nset,imem) + entry InitEvolvePDF(nset,imem) + ! print*, 'calling listPDF',nset,imem + call listPDF(nset,imem,Fparm) + ! print *,Fparm + return + + ! entry initInputPDFM(nset) + entry initInputPDF(nset) + if(first) then + do i=1,nmxset + do j=-6,6 + Treshold(i,j)=0.0d0 + enddo + enddo + first=.false. + endif + read(1,*) s1,Fw(nset),Nfunc(nset) + ! print *,s1,Fw,Nfunc + if (lhasilent.eq.0) then + write(*,*) 'Parametrization: ',s1 + write(*,*) + endif + do i=1,Nfunc(nset) + Ftype(nset,i)=-1 + read(1,*) s1,s2 + if (index(s2,'x-taylor').eq.1) then + Ftype(nset,i)=1 + read(1,*) FPow(nset,i),Fn(nset,i) + read(1,*) (Fmap(nset,i,j),j=1,Fn(nset,i)) + endif + if (index(s2,'log-pade').eq.1) then + Ftype(nset,i)=2 + FPow(nset,i)=0d0 + read(1,*) Fn(nset,i) + read(1,*) (Fmap(nset,i,j),j=1,Fn(nset,i)) + endif + if (index(s2,'cteq6-ratio').eq.1) then + Ftype(nset,i)=101 + Fpow(nset,i)=0d0 + Fn(nset,i)=5 + read(1,*) (Fmap(nset,i,j),j=1,Fn(nset,i)) + endif + if (index(s2,'convol').eq.1) then + Ftype(nset,i)=201 + read(1,*) Fn(nset,i) + read(1,*) (Fmap(nset,i,j),j=1,Fn(nset,i)) + endif +#ifdef NNPDF + if (index(s2,'XNNPDF').eq.1) then + Ftype(nset,i)=301 + read(1,*) tnl(i) + read(1,*) (neu(j,i),j=1,tnl(i)) + read(1,*) (xnor(j,i),j=1,2) + read(1,*) (pdfnor(j,i),j=1,2) + read(1,*) (pdfexp(j,i),j=1,2) + read(1,*) NPAR(i) + endif +#endif + if (Ftype(nset,i).lt.0) then + write(*,*) 'File description error:' + write(*,*) 'Unknown functional ',s2 + stop + endif + enddo + read(1,*) s1 + do i=-6,6 + Ctype(nset,i)=-1 + read(1,*) s1,s2 + ! print *,s1,s2 + if (index(s2,'none').eq.1) then + Ctype(nset,i)=0 + Treshold(nset,i)=-1d0 + endif + if (index(s2,'treshold').eq.1) then + Ctype(nset,i)=0 + read(1,*) Treshold(nset,i) + endif + if (index(s2,'composite').eq.1) then + Ctype(nset,i)=1 + Treshold(nset,i)=0d0 + read(1,*) (Ccoef(nset,i,j),j=1,Nfunc(nset)) + endif + if (index(s2,'cteq6-ratio').eq.1) then + Ctype(nset,i)=101 + Treshold(nset,i)=0d0 + read(1,*) (Ccoef(nset,i,j),j=1,3) + endif + if (Ctype(nset,i).lt.0) then + write(*,*) 'File description error:' + write(*,*) 'Unknown composit type ',s2 + stop + endif + enddo + if (Fw(nset).ge.0) then + write(*,*) '***********************************************' + write(*,*) '* Note that this is a weighted PDF set. *' + write(*,*) '* See manual for proper use. *' + write(*,*) '***********************************************' + endif + return +end subroutine parmPDF + + +FUNCTION BETA_LHA(X1,X2) + CALL GAMMA_LHA(X1,G1,IER) + IF(IER.NE.0) write(16,*) 'GAMMA_LHA ERROR: IER= ',IER,X1,X2 + CALL GAMMA_LHA(X2,G2,IER) + IF(IER.NE.0) write(16,*) 'GAMMA_LHA ERROR: IER= ',IER,X1,X2 + X3=X1+X2 + CALL GAMMA_LHA(X3,G3,IER) + IF(IER.NE.0) write(16,*) 'GAMMA_LHA ERROR: IER= ',IER,X1,X2 + BETA_LHA=G1*G2/G3 + RETURN +END FUNCTION BETA_LHA + + +SUBROUTINE GAMMA_LHA(XX,GX,IER) + IF((XX-34.5).LE.0) THEN + GOTO 6 + ELSE + GOTO 4 + ENDIF +4 IER=2 + GX=1.E38 + RETURN +6 X=XX + ERR=1.0E-6 + IER=0 + GX=1.0 + IF((X-2.0).LE.0) THEN + GOTO 50 + ELSE + GOTO 15 + ENDIF +10 IF((X-2.0).LE.0) THEN + GOTO 110 + ELSE + GOTO 15 + ENDIF +15 X=X-1.0 + GX=GX*X + GOTO 10 +50 IF((X-1.0).LT.0) THEN + GOTO 60 + ELSE IF ((X-1.0).EQ.0) THEN + GOTO 120 + ELSE + GOTO 110 + ENDIF + ! SEE IF X IS NEAR NEGATIVE INTEGER OR ZERO +60 IF((X-ERR).LE.0) THEN + GOTO 62 + ELSE + GOTO 80 + ENDIF +62 K=X + Y=FLOAT(K)-X + IF((ABS(Y)-ERR).LE.0) THEN + GOTO 130 + ELSE + GOTO 64 + ENDIF +64 IF((1.0-Y-ERR).LE.0) THEN + GOTO 130 + ELSE + GOTO 70 + ENDIF + ! X NOT NEAR A NEGATIVE INTEGER OR ZERO +70 IF((X-1.0).LE.0) THEN + GOTO 80 + ELSE + GOTO 110 + ENDIF +80 GX=GX/X + X=X+1.0 + GOTO 70 +110 Y=X-1.0 + GY=1.0+Y*(-0.5771017+Y*(+0.9858540+Y*(-0.8764218+Y*(+0.8328212+Y*(-0.5684729+Y*(+0.2548205+Y*(-0.05149930))))))) + GX=GX*GY +120 RETURN +130 IER=1 + RETURN +END SUBROUTINE GAMMA_LHA + + +FUNCTION ALPHA(T,AL) + COMMON/AINPUT/IORD,QSCT,QSDT + COMMON/PARAM/PARA(40) + DATA PI/3.14159/ + DATA TOL/.0005/ + ITH=0 + TT=T + qsctt=qsct/4. + qsdtt=qsdt/4. + ! AL=para(1) + AL2=AL*AL + FLAV=4. + QS=AL2*EXP(T) + + ! CHECK: explicitly initialising ALFQC{3,4,5} (by AB) + ALFQC3 = 0 + ALFQC4 = 0 + ALFQC5 = 0 + + if (qs.lt.0.5d0) then !! running stops below 0.5 + qs=0.5d0 + t=alog(qs/al2) + tt=t + endif + + IF(QS.gt.QSCTT) GOTO 12 + IF(QS.lt.QSDTT) GOTO 312 +11 CONTINUE + B0=11-2.*FLAV/3. + IF(IORD.LE.0) THEN + GOTO 1 + ELSE + GOTO 2 + ENDIF + ! IF(IORD)2,2,2 !TAKE CARE !! +1 CONTINUE + ALPHA=4.*PI/B0/T + RETURN +2 CONTINUE + X1=4.*PI/B0 + B1=102.-38.*FLAV/3. + X2=B1/B0**2 + AS=X1/T*(1.-X2*aLOG(T)/T) +5 CONTINUE + F=-T+X1/AS-X2*aLOG(X1/AS+X2) + FP=-X1/AS**2*(1.-X2/(X1/AS+X2)) + AS2=AS-F/FP + DEL=ABS(F/FP/AS) + IF((DEL-TOL).LE.0) THEN + GOTO 3 + ELSE + GOTO 4 + ENDIF +3 CONTINUE + ALPHA=AS2 + IF(ITH.EQ.0) RETURN + GOTO (13,14,15) ITH +4 CONTINUE + AS=AS2 + GOTO 5 +12 ITH=1 + T=aLOG(QSCTT/AL2) + GOTO 11 +13 ALFQC4=ALPHA + FLAV=5. + ITH=2 + GOTO 11 +14 ALFQC5=ALPHA + ITH=3 + T=TT + GOTO 11 +15 ALFQS5=ALPHA + ALFINV=1./ALFQS5+1./ALFQC4-1./ALFQC5 + ALPHA=1./ALFINV + RETURN +311 CONTINUE + B0=11-2.*FLAV/3. + IF(IORD.LE.0)THEN + GOTO 31 + ELSE + GOTO 32 + ENDIF + ! IF(IORD)32,32,32 !TAKE CARE !! +31 CONTINUE + ALPHA=4.*PI/B0/T + RETURN +32 CONTINUE + X1=4.*PI/B0 + B1=102.-38.*FLAV/3. + X2=B1/B0**2 + AS=X1/T*(1.-X2*aLOG(T)/T) +35 CONTINUE + F=-T+X1/AS-X2*aLOG(X1/AS+X2) + FP=-X1/AS**2*(1.-X2/(X1/AS+X2)) + AS2=AS-F/FP + DEL=ABS(F/FP/AS) + ! IF(DEL-TOL)33,33,34 + IF((DEL-TOL).LE.0) THEN + GOTO 33 + ELSE + GOTO 34 + ENDIF +33 CONTINUE + ALPHA=AS2 + IF(ITH.EQ.0) RETURN + GOTO (313,314,315) ITH +34 CONTINUE + AS=AS2 + GOTO 35 +312 ITH=1 + T=aLOG(QSDTT/AL2) + GOTO 311 +313 ALFQC4=ALPHA + FLAV=3. + ITH=2 + GOTO 311 +314 ALFQC3=ALPHA + ITH=3 + T=TT + GOTO 311 +315 ALFQS3=ALPHA + ALFINV=1./ALFQS3+1./ALFQC4-1./ALFQC3 + ALPHA=1./ALFINV + RETURN +END FUNCTION ALPHA + + +SUBROUTINE WATE96 + !******************************************************************* + !***** ***** + !***** THE X(I) AND W(I) ARE THE DIRECT OUTPUT FROM A PROGRAM ***** + !***** USING NAG ROUTINE D01BCF TO CALCULATE THE ***** + !***** GAUSS-LEGENDRE WEIGHTS FOR 96 POINT INTEGRATION. ***** + !***** THEY AGREE TO TYPICALLY 14 DECIMAL PLACES WITH THE ***** + !***** TABLE IN ABRAMOWITZ & STEGUN, PAGE 919. ***** + !***** ***** + !***** ----> PETER HARRIMAN, APRIL 3RD 1990. ***** + !***** ***** + !******************************************************************* + DIMENSION X(48),W(48) + COMMON/GAUS96/XI(96),WI(96),nterms,XX(97) + NTERMS=96 + X( 1)= 0.01627674484960183561 + X( 2)= 0.04881298513604856015 + X( 3)= 0.08129749546442434360 + X( 4)= 0.11369585011066471632 + X( 5)= 0.14597371465489567682 + X( 6)= 0.17809688236761733390 + X( 7)= 0.21003131046056591064 + X( 8)= 0.24174315616383866556 + X( 9)= 0.27319881259104774468 + X(10)= 0.30436494435449495954 + X(11)= 0.33520852289262397655 + X(12)= 0.36569686147231213885 + X(13)= 0.39579764982890709712 + X(14)= 0.42547898840729897474 + X(15)= 0.45470942216774136446 + X(16)= 0.48345797392059470382 + X(17)= 0.51169417715466604391 + X(18)= 0.53938810832435567233 + X(19)= 0.56651041856139533470 + X(20)= 0.59303236477757022282 + X(21)= 0.61892584012546672523 + X(22)= 0.64416340378496526886 + X(23)= 0.66871831004391424358 + X(24)= 0.69256453664216964528 + X(25)= 0.71567681234896561582 + X(26)= 0.73803064374439816819 + X(27)= 0.75960234117664555964 + X(28)= 0.78036904386743123629 + X(29)= 0.80030874413913884180 + X(30)= 0.81940031073792957139 + X(31)= 0.83762351122818502758 + X(32)= 0.85495903343459936363 + X(33)= 0.87138850590929436968 + X(34)= 0.88689451740241818933 + X(35)= 0.90146063531585023110 + X(36)= 0.91507142312089592706 + X(37)= 0.92771245672230655266 + X(38)= 0.93937033975275308073 + X(39)= 0.95003271778443564022 + X(40)= 0.95968829144874048809 + X(41)= 0.96832682846326217918 + X(42)= 0.97593917458513455843 + X(43)= 0.98251726356301274934 + X(44)= 0.98805412632962202890 + X(45)= 0.99254390032376081654 + X(46)= 0.99598184298720747465 + X(47)= 0.99836437586317963722 + X(48)= 0.99968950388322870559 + W( 1)= 0.03255061449236316962 + W( 2)= 0.03251611871386883307 + W( 3)= 0.03244716371406427668 + W( 4)= 0.03234382256857594104 + W( 5)= 0.03220620479403026124 + W( 6)= 0.03203445623199267876 + W( 7)= 0.03182875889441101874 + W( 8)= 0.03158933077072719007 + W( 9)= 0.03131642559686137819 + W(10)= 0.03101033258631386231 + W(11)= 0.03067137612366917839 + W(12)= 0.03029991542082762553 + W(13)= 0.02989634413632842385 + W(14)= 0.02946108995816795100 + W(15)= 0.02899461415055528410 + W(16)= 0.02849741106508543861 + W(17)= 0.02797000761684838950 + W(18)= 0.02741296272602931385 + W(19)= 0.02682686672559184485 + W(20)= 0.02621234073567250055 + W(21)= 0.02557003600534944960 + W(22)= 0.02490063322248370695 + W(23)= 0.02420484179236479915 + W(24)= 0.02348339908592633665 + W(25)= 0.02273706965832950717 + W(26)= 0.02196664443874448477 + W(27)= 0.02117293989219144572 + W(28)= 0.02035679715433347898 + W(29)= 0.01951908114014518992 + W(30)= 0.01866067962741165898 + W(31)= 0.01778250231604547316 + W(32)= 0.01688547986424539715 + W(33)= 0.01597056290256253144 + W(34)= 0.01503872102699521608 + W(35)= 0.01409094177231515264 + W(36)= 0.01312822956696188190 + W(37)= 0.01215160467108866759 + W(38)= 0.01116210209983888144 + W(39)= 0.01016077053500880978 + W(40)= 0.00914867123078384552 + W(41)= 0.00812687692569928101 + W(42)= 0.00709647079115442616 + W(43)= 0.00605854550423662775 + W(44)= 0.00501420274292825661 + W(45)= 0.00396455433844564804 + W(46)= 0.00291073181793626202 + W(47)= 0.00185396078894924657 + W(48)= 0.00079679206555731759 + DO I=1,48 + XI(I)=-X(49-I) + WI(I)=W(49-I) + XI(I+48)=X(I) + WI(I+48)=W(I) + END DO + DO I=1,96 + XX(I)=0.5*(XI(I)+1.) + END DO + XX(97)=1.0 + EXPON=1.0 + DO I=1,96 + YI=2.*(0.5*(1.+XI(I)))**EXPON-1. + WI(I)=WI(I)/(1.+XI(I))*(1.+YI)*EXPON + XI(I)=YI + XX(I)=0.5*(1.+YI) + END DO + RETURN +END SUBROUTINE WATE96 + + +subroutine gconv(x,xp,fgdis) + COMMON/AINPUT/IORD,QSCT,QSDT + common/GAUS96/XI(96),WI(96),NTERMS,XX(97) + dimension xp(40) + logical first + data first/.true./ + if (first) then + call wate96 + first=.false. + endif + PI = 3.14159 + PI2 = PI*PI + iord = 1 + qsdt=8.18 !! This is the value of 4m_c^2 + qsct=74.0 !! This is the value of 4m_b^2 + cf = 4./3. + eta4 = xp(40) + T=alog(1/xp(1)**2) + ! AL = 0.550/(4.* 3.14159) + AL=ALPHA(T,xp(1))/(4.* pi) + rx=sqrt(x) + FF1 = BETA_LHA(XP(2),XP(3)+1.)+XP(16)*BETA_LHA(XP(2)+1.,XP(3)+1.)+XP(23)*BETA_LHA(XP(2)+0.5,XP(3)+1.) + FF2 = BETA_LHA(XP(2)+1.,XP(3)+1.)+XP(16)*BETA_LHA(XP(2)+2.,XP(3)+1.)+XP(23)*BETA_LHA(XP(2)+1.5,XP(3)+1.) + FF3 = BETA_LHA(XP(5),ETA4+1.)+XP(20)*BETA_LHA(XP(5)+1.,ETA4+1.)+XP(24)*BETA_LHA(XP(5)+0.5,ETA4+1.) + FF4 = BETA_LHA(XP(5)+1.,ETA4+1.)+XP(20)*BETA_LHA(XP(5)+2.,ETA4+1.)+XP(24)*BETA_LHA(XP(5)+1.5,ETA4+1.) + COEFU = 2.*XP(4)/FF1 + COEFD = XP(4)/FF3 + ! print *,'coefu ',coefu + ! print *,'coefd ',coefd + UV=coefu*X**XP(2)*(1.-X)**XP(3)*(1.+XP(16)*X+XP(23)*SQRT(X)) + DV=coefd*X**XP(5)*(1.-X)**ETA4*(1.+XP(20)*X+XP(24)*SQRT(X)) + FGDIS=al*CF*(-9.-2.*PI2/3.+alog(1.-x)*(-3.+2.*alog(1.-x)))*(UV+DV) + + DO M=1,NTERMS + Y=0.5*(1.-X)*XI(M)+0.5*(1.+X) + XY=X/Y + UVXY = coefu*XY**XP(2) * (1.-XY)**XP(3) * (1.+XP(16) * XY + XP(23) * SQRT(XY)) + DVXY = coefd*XY**XP(5) * (1.-XY)**ETA4 * (1.+XP(20) * XY + XP(24) * SQRT(XY)) + AL1=ALOG(1.-Y) + C22=CF*(6.+4.*Y-2.*(1.+Y*Y)/(1.-Y)*ALOG(Y)-2.*(1.+Y)*ALOG(1.-Y)) + C23=CF*(-3.+4.*ALOG(1.-Y))/(1.-Y) + FGDIS=FGDIS+.5*(1.-X)*WI(M)*al*(C22*(uvxy+dvxy)+C23*(uvxy+dvxy-uv-dv)) + END DO + + return +end subroutine gconv diff --git a/LHAPDF/lhapdf-5.9.1/src/lhaglue.f b/LHAPDF/lhapdf-5.9.1/src/lhaglue.f new file mode 100644 index 00000000000..e3aecbeaa48 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/lhaglue.f @@ -0,0 +1,2558 @@ +! -*- F90 -*- + + +! LHAGLUE Interface to LHAPDF library of modern parton +! density functions (PDF) with uncertainties +! +! Authors for v4: Dimitri Bourilkov, Craig Group, Mike Whalley +! +! Authors for v3: Dimitri Bourilkov, Craig Group, Mike Whalley +! +! Author for v1 and v2: Dimitri Bourilkov bourilkov@mailaps.org +! University of Florida +! +! HERWIG interface by Dimitri Bourilkov and Craig Group +! +! New numbering scheme and upgrade for LHAPDF v2.1 +! by Dimitri Bourilkov and Mike Whalley +! +! For more information, or when you cite this interface, currently +! the official reference is: +! D.Bourilkov, "Study of Parton Density Function Uncertainties with +! LHAPDF and PYTHIA at LHC", hep-ph/0305126. +! +! The official LHAPDF page is: +! +! http://durpdg.dur.ac.uk/lhapdf/index.html +! +! The interface contains four subroutines (similar to PDFLIB). +! It can be used seamlessly by Monte Carlo generators +! interfaced to PDFLIB or in stand-alone mode. +! +! For initialization (called once) +! +! PDFSET(PARM,VALUE) +! +! For the proton/pion structure functions +! +! STRUCTM(X,Q,UPV,DNV,USEA,DSEA,STR,CHM,BOT,TOP,GLU) +! +! For the photon structure functions +! +! STRUCTP(X,Q2,P2,IP2,UPV,DNV,USEA,DSEA,STR,CHM,BOT,TOP,GLU) +! +! For statistics ON structure functions (under/over-flows) +! +! PDFSTA +! +! This interface can be invoked in 3 ways depending +! on the value of PARM(1) provided by the user when +! calling PDFSET(PARM,VALUE): +! +! For PYTHIA: PARM(1).EQ.'NPTYPE' +! (this is set automatically by PYTHIA) +! +! For HERWIG: PARM(1).EQ.'HWLHAPDF' +! (set by the USER e.g. in the main program like this: +! AUTPDF(1) = 'HWLHAPDF' +! AUTPDF(2) = 'HWLHAPDF' ) +! +! For Stand-alone: PARM(1).EQ.'DEFAULT' +! (can be used for PDF studies or when interfacing +! new generators) +! +! The LHAPDF set/member is selected depending on the value of: +! +! PYTHIA: ABS(MSTP(51)) - proton +! ABS(MSTP(53)) - pion +! ABS(MSTP(55)) - photon +! +! HERWIG: ABS(INT(VALUE(1))) +! +! STAND-ALONE: ABS(INT(VALUE(1))) +! +! +! CONTROL switches: +! ================== +! +! THE LOCATION OF THE LHAPDF LIBRARY HAS TO BE SPECIFIED +! AS DESCRIBED BELOW (the rest is optional) +! +! if the user does nothing, sensible defaults +! are active; to change the behaviour, the corresponding +! values of LHAPARM() should be set to the values given below +! +! Location of the LHAPDF library of PDFs (pathname): +! uses common block /LHAPDFC/ +! +! If the user does nothing => default = subdir PDFsets of the +! current directory (can be real subdir +! OR a soft link to the real location) +! If the user sets LHAPATH => supplied by the USER who defines the +! path in common block COMMON/LHAPDFC/LHAPATH +! BEFORE calling PDFSET +! +! Other controls: +! =============== +! use common block /LHACONTROL/ +! +! Collect statistics on under/over-flow requests for PDFs +! outside their validity ranges in X and Q**2 +! (call PDFSTA at end of run to print it out) +! +! LHAPARM(16).EQ.'NOSTAT' => No statistics (faster) +! LHAPARM(16).NE.'NOSTAT' => Default: collect statistics +! +! Option to use the values for the strong coupling alpha_s +! as computed in LHAPDF in the MC generator +! (to ensure uniformity between the MC generator and the PDF set) +! WARNING: implemented ONLY for PYTHIA in LHAPDFv4 +! +! LHAPARM(17).EQ.'LHAPDF' => Use alpha_s from LHAPDF +! LHAPARM(17).NE.'LHAPDF' => Default (same as LHAPDF v1/v3) +! +! Extrapolation of PDFs outside LHAPDF validity range given by +! [Xmin,Xmax] and [Q2min,Q2max]; DEFAULT => PDFs "frozen" at the +! boundaries +! +! LHAPARM(18).EQ.'EXTRAPOLATE' => Extrapolate PDFs on OWN RISK +! WARNING: Crazy values can be returned +! +! Printout of initialization information in PDFSET (by default) +! +! LHAPARM(19).EQ.'SILENT' => No printout (silent mode) +! LHAPARM(19).EQ.'LOWKEY' => Print 5 times (almost silent mode) +! +! +!********************************************************************* +! +! $Id: lhaglue.f 1448 2013-09-24 15:03:20Z whalley $ +! +! $Log$ +! Revision 1.7 2005/12/02 14:50:54 whalley +! Changes for new CTEQ code/AB sets +! +! Revision 1.6 2005/10/18 15:35:48 whalley +! fix to allow LHAPATH to be user defined as well as lhapdf-config +! +! Revision 1.5 2005/10/18 11:47:48 whalley +! Change to only set LHAPATH once per run +! +! Revision 1.1.1.2 1996/10/30 08:29:06 cernlib +! Version 7.04 +! +! Revision 1.1.1.1 1996/04/12 15:29:26 plothow +! Version 7.01 +! +! v5.0 06-Oct-2005 Major change to allow multiset-initializations +! v4.0 28-Apr-2005 PDFSTA routine; option to use Alfa_s from LHAPDF +! v4.0 21-Mar-2005 Photon/pion/new p PDFs, updated for LHAPDF v4 +! v3.1 26-Apr-2004 New numbering scheme, updated for LHAPDF v2/v3 +! v3.0 23-Jan-2004 HERWIG interface added +! v2.0 20-Sep-2003 PDFLIB style adopted +! v1.0 05-Mar-2003 First working version from PYTHIA to LHAPDF v1 +! +! interface to LHAPDF library +!********************************************************************* + + +! PDFSET +! Initialization for use of parton distributions +! according to the LHAPDF interface. +! +! v4.0 28-Apr-2005 Option to use Alfa_s from LHAPDF +! v4.0 21-Mar-2005 Photon/pion/new p PDFs, updated for LHAPDF v4 +! v3.1 26-Apr-2004 New numbering scheme +! v3.0 23-Jan-2004 HERWIG interface added +! +! Interface to LHAPDF library +subroutine pdfset(parm,value, mstu11, mstp51, mstp53, mstp55, qcdl4, qcdl5, axmin, axmax, aq2min, aq2max) +entry pdfset_herwig(parm, value) + ! Double precision and integer declarations. + implicit double precision(a-h, o-z) + implicit integer(i-n) + ! Common blocks + include 'commonlhapdf.inc' + include 'commonlhasets.inc' + include 'commonlhapdfc.inc' + include 'commonlhacontrol.inc' + include 'commonlhaglsta.inc' + ! additions for multiset use + double precision xxmin(nmxset),xxmax(nmxset),qq2min(nmxset),qq2max(nmxset) + save xxmin,xxmax,qq2min,qq2max + ! Interface to LHAPDFLIB. + double precision qcdlha4, qcdlha5 + integer nfllha + common/lhapdfr/qcdlha4, qcdlha5, nfllha + save /lhapdfr/ + integer lhaextrp + common/lhapdfe/lhaextrp + save /lhapdfe/ + integer lhasilent + common/lhasilent/lhasilent + save /lhasilent/ + ! Interface to PDFLIB. + common/w50511/ nptypepdfl,ngrouppdfl,nsetpdfl,modepdfl,nflpdfl,lopdfl,tmaspdfl + save /w50511/ + double precision tmaspdfl + ! Interface to PDFLIB. + ! common/w50512/qcdl4,qcdl5 + ! save /w50512/ + ! double precision qcdl4,qcdl5 + ! Interface to PDFLIB. + common/w50513/xmin,xmax,q2min,q2max + save /w50513/ + double precision xmin,xmax,q2min,q2max + double precision axmin, axmax, aq2min, aq2max + ! Local arrays and character variables (NOT USED here DB) + character*20 parm(20) + double precision value(20) + integer lhapathlen + integer :: lhainput = 1 + !integer lhaselect + integer lhaprint + integer lhaonce + integer lhafive + save lhaonce + save lhafive + data lhaonce/0/ + data lhafive/0/ + logical first + data first/.true./ + character*512 dirpath + save first + character*1000 chroot + chroot=' ' + ! Initialise common blocks + call commoninit() + +! if (first) then +! call getdirpath(dirpath) +! first = .FALSE. +! endif + if(first .AND. (LHAPARM(20).NE.'LHAPATH')) then +!...overide the default PDFsets path +! ... check first if the environmental variable LHAPATH is set + call getenv('LHAPATH',lhapath) + if(lhapath.eq.'') then +! The environment variable LHAPATH is not set. +! Take the data from $ALICE_ROOT/LHAPDF/PDFsets + CALL GETENV('ALICE_ROOT',CHROOT) + LNROOT = LNBLNK(CHROOT) + IF(LNROOT.LE.0) THEN + LHAPATH='PDFsets' ! Default value + ELSE + LHAPATH=CHROOT(1:LNROOT)//'/LHAPDF/PDFsets' + ENDIF + endif + first=.FALSE. + endif + + ! Init + lhaextrp = 0 + if(lhaparm(18).EQ.'EXTRAPOLATE') then ! Extrapolate PDFs on own risk + lhaextrp = 1 + endif + lhasilent = 0 + if (lhaparm(19).EQ.'SILENT') then ! No printout (silent MODE) + lhasilent = 1 + elseif (lhaparm(19).EQ.'LOWKEY') then ! print 5 times (lowkey mode) + if (lhafive .lt. 6) then + lhafive = lhafive + 1 + else + lhasilent = 1 + endif + endif + if (parm(1).EQ.'NPTYPE') then ! pythia + lhaprint = mstu11 + if(value(1) .eq. 1) then ! nucleon + lhainput = abs(mstp51) + elseif(value(1) .eq. 2) then ! pion + lhainput = abs(mstp53) + elseif(value(1) .eq. 3) then ! photon + lhainput = abs(mstp55) + endif + if (lhasilent .ne. 1) print *,'==== PYTHIA WILL USE LHAPDF ====' + elseif(parm(1).EQ.'HWLHAPDF') then ! herwig + lhainput = abs(int(value(1))) + if(lhaonce.eq.lhainput) return + if(lhasilent .ne. 1) print *,'==== HERWIG WILL USE LHAPDF ====' + lhaprint = 6 + lhaonce = lhainput + elseif(parm(1).EQ.'DEFAULT') then ! stand-alone + lhainput = abs(int(value(1))) + if(lhaonce.eq.lhainput) return + if(lhasilent .ne. 1) print *,'==== STAND-ALONE LHAGLUE MODE TO USE LHAPDF ====' + lhaprint = 6 + lhaonce = lhainput + else + print *,'== UNKNOWN LHAPDF INTERFACE CALL! STOP EXECUTION! ==' + stop + endif + ! Initialize parton distributions: LHAPDFLIB. + lhapathlen=index(lhapath,' ') - 1 + lhaset = lhainput + xmin = 1.0D-6 ! X_min for current PDF set + xmax = 1.0D0 ! X_max for current PDF set + q2min = 1.0D0**2 ! Q**2_min scale for current PDF set [GeV] + q2max = 1.0D5**2 ! Q**2_max scale for current PDF set [GeV] + ! + ! Protons + ! + ! CTEQ Family + if (((lhainput.ge.10000).and.(lhainput .le. 10999)).or.((lhainput.ge.19000).and.(lhainput .le. 19999))) then + q2max = 1.0d08 + if ((lhainput .ge. 10000) .and. (lhainput .le. 10040)) then + lhaset = 10000 + lhaname=lhapath(1:lhapathlen)//'/cteq6.LHpdf' + q2min = 1.69d0 + elseif((lhainput .ge. 10041) .and. (lhainput .le. 10041)) then + lhaset = 10041 + lhaname=lhapath(1:lhapathlen)//'/cteq6l.LHpdf' + q2min = 1.69d0 + elseif((lhainput .ge. 10042) .and. (lhainput .le. 10042)) then + lhaset = 10042 + lhaname=lhapath(1:lhapathlen)//'/cteq6ll.LHpdf' + q2min = 1.69d0 + elseif((lhainput .ge. 10050) .and. (lhainput .le. 10090)) then + lhaset = 10050 + lhaname=lhapath(1:lhapathlen)//'/cteq6mE.LHgrid' + q2min = 1.69d0 + elseif((lhainput .ge. 10100) .and. (lhainput .le. 10140)) then + lhaset = 10100 + lhaname=lhapath(1:lhapathlen)//'/cteq61.LHpdf' + q2min = 1.69d0 + elseif((lhainput .ge. 10150) .and. (lhainput .le. 10190)) then + lhaset = 10150 + lhaname=lhapath(1:lhapathlen)//'/cteq61.LHgrid' + q2min = 1.69d0 + elseif((lhainput .ge. 10250) .and. (lhainput .le. 10269)) then + lhaset = 10250 + lhaname=lhapath(1:lhapathlen)//'/cteq6AB.LHgrid' + q2min = 1.69d0 + elseif((lhainput .ge. 10350) .and. (lhainput .le. 10390)) then + lhaset = 10350 + lhaname=lhapath(1:lhapathlen)//'/cteq65.LHgrid' + q2min = 1.69d0 + q2max = 1.0d10 + xmin = 1.0d-7 + elseif((lhainput .ge. 10450) .and. (lhainput .le. 10456)) then + lhaset = 10450 + lhaname=lhapath(1:lhapathlen)//'/cteq65c.LHgrid' + q2min = 1.69d0 + q2max = 1.0d10 + xmin = 1.0d-7 + elseif((lhainput .ge. 10460) .and. (lhainput .le. 10467)) then + lhaset = 10460 + lhaname=lhapath(1:lhapathlen)//'/cteq65s.LHgrid' + q2min = 1.69d0 + q2max = 1.0d10 + xmin = 1.0d-7 + elseif((lhainput .ge. 10550) .and. (lhainput .le. 10594)) then + lhaset = 10550 + lhaname=lhapath(1:lhapathlen)//'/cteq66.LHgrid' + q2min = 1.69d0 + q2max = 1.0d10 + xmin = 1.0d-8 + elseif((lhainput .ge. 10595) .and. (lhainput .le. 10599)) then + lhaset = 10595 + lhaname=lhapath(1:lhapathlen)//'/cteq66alphas.LHgrid' + q2min = 1.69d0 + q2max = 1.0d10 + xmin = 1.0d-8 + elseif((lhainput .ge. 10650) .and. (lhainput .le. 10653)) then + lhaset = 10650 + lhaname=lhapath(1:lhapathlen)//'/cteq66c.LHgrid' + q2min = 1.69d0 + q2max = 1.0d10 + xmin = 1.0d-8 + elseif((lhainput .ge. 10660) .and. (lhainput .le. 10660)) then + lhaset = 10660 + lhaname=lhapath(1:lhapathlen)//'/cteq66a0.LHgrid' + q2min = 1.69d0 + q2max = 1.0d10 + xmin = 1.0d-8 + elseif((lhainput .ge. 10661) .and. (lhainput .le. 10661)) then + lhaset = 10661 + lhaname=lhapath(1:lhapathlen)//'/cteq66a1.LHgrid' + q2min = 1.69d0 + q2max = 1.0d10 + xmin = 1.0d-8 + elseif((lhainput .ge. 10662) .and. (lhainput .le. 10662)) then + lhaset = 10662 + lhaname=lhapath(1:lhapathlen)//'/cteq66a2.LHgrid' + q2min = 1.69d0 + q2max = 1.0d10 + xmin = 1.0d-8 + elseif((lhainput .ge. 10663) .and. (lhainput .le. 10663)) then + lhaset = 10663 + lhaname=lhapath(1:lhapathlen)//'/cteq66a3.LHgrid' + q2min = 1.69d0 + q2max = 1.0d10 + xmin = 1.0d-8 + elseif((lhainput .ge. 10670) .and. (lhainput .le. 10677)) then + lhaset = 10670 + lhaname=lhapath(1:lhapathlen)//'/cteq6lg.LHgrid' + q2min = 1.69d0 + elseif((lhainput .ge. 10770) .and. (lhainput .le. 10770)) then + lhaset = 10770 + lhaname=lhapath(1:lhapathlen)//'/CT09MCS.LHgrid' + q2min = 1.69d0 + q2max = 1.0d10 + xmin = 1.0d-8 + elseif((lhainput .ge. 10771) .and. (lhainput .le. 10771)) then + lhaset = 10771 + lhaname=lhapath(1:lhapathlen)//'/CT09MC1.LHgrid' + q2min = 1.69d0 + q2max = 1.0d10 + xmin = 1.0d-8 + elseif((lhainput .ge. 10772) .and. (lhainput .le. 10772)) then + lhaset = 10772 + lhaname=lhapath(1:lhapathlen)//'/CT09MC2.LHgrid' + q2min = 1.69d0 + q2max = 1.0d10 + xmin = 1.0d-8 + elseif((lhainput .ge. 10800) .and. (lhainput .le. 10852)) then + lhaset = 10800 + lhaname=lhapath(1:lhapathlen)//'/CT10.LHgrid' + q2min = 1.69d0 + q2max = 1.0d10 + xmin = 1.0d-8 + elseif((lhainput .ge. 10860) .and. (lhainput .le. 10870)) then + lhaset = 10860 + lhaname=lhapath(1:lhapathlen)//'/CT10as.LHgrid' + q2min = 1.69d0 + q2max = 1.0d10 + xmin = 1.0d-8 + elseif((lhainput .ge. 10900) .and. (lhainput .le. 10952)) then + lhaset = 10900 + lhaname=lhapath(1:lhapathlen)//'/CT10w.LHgrid' + q2min = 1.69d0 + q2max = 1.0d10 + xmin = 1.0d-8 + elseif((lhainput .ge. 10960) .and. (lhainput .le. 10970)) then + lhaset = 10960 + lhaname=lhapath(1:lhapathlen)//'/CT10was.LHgrid' + q2min = 1.69d0 + q2max = 1.0d10 + xmin = 1.0d-8 + elseif((lhainput .ge. 10980) .and. (lhainput .le. 10980)) then + lhaset = 10980 + lhaname=lhapath(1:lhapathlen)//'/CT10f3.LHgrid' + q2min = 1.69d0 + q2max = 1.0d10 + xmin = 1.0d-8 + elseif((lhainput .ge. 10981) .and. (lhainput .le. 10981)) then + lhaset = 10981 + lhaname=lhapath(1:lhapathlen)//'/CT10f4.LHgrid' + q2min = 1.69d0 + q2max = 1.0d10 + xmin = 1.0d-8 + elseif((lhainput .ge. 10982) .and. (lhainput .le. 10982)) then + lhaset = 10982 + lhaname=lhapath(1:lhapathlen)//'/CT10wf3.LHgrid' + q2min = 1.69d0 + q2max = 1.0d10 + xmin = 1.0d-8 + elseif((lhainput .ge. 10983) .and. (lhainput .le. 10983)) then + lhaset = 10983 + lhaname=lhapath(1:lhapathlen)//'/CT10wf4.LHgrid' + q2min = 1.69d0 + q2max = 1.0d10 + xmin = 1.0d-8 + elseif((lhainput .ge. 19050) .and. (lhainput .le. 19050)) then + lhaset = 19050 + lhaname=lhapath(1:lhapathlen)//'/cteq5m.LHgrid' + xmin=1.0d-5 + elseif((lhainput .ge. 19051) .and. (lhainput .le. 19051)) then + lhaset = 19051 + lhaname=lhapath(1:lhapathlen)//'/cteq5m1.LHgrid' + xmin=1.0d-5 + elseif((lhainput .ge. 19053) .and. (lhainput .le. 19053)) then + lhaset = 19053 + lhaname=lhapath(1:lhapathlen)//'/cteq5f3.LHgrid' + xmin=1.0d-5 + elseif((lhainput .ge. 19054) .and. (lhainput .le. 19054)) then + lhaset = 19054 + lhaname=lhapath(1:lhapathlen)//'/cteq5f4.LHgrid' + xmin=1.0d-5 + elseif((lhainput .ge. 19060) .and. (lhainput .le. 19060)) then + lhaset = 19060 + lhaname=lhapath(1:lhapathlen)//'/cteq5d.LHgrid' + xmin=1.0d-5 + elseif((lhainput .ge. 19070) .and. (lhainput .le. 19070)) then + lhaset = 19070 + lhaname=lhapath(1:lhapathlen)//'/cteq5l.LHgrid' + xmin=1.0d-5 + elseif((lhainput .ge. 19150) .and. (lhainput .le. 19150)) then + lhaset = 19150 + lhaname=lhapath(1:lhapathlen)//'/cteq4m.LHgrid' + q2min = 2.56d0 + xmin=1.0d-5 + elseif((lhainput .ge. 19160) .and. (lhainput .le. 19160)) then + lhaset = 19160 + lhaname=lhapath(1:lhapathlen)//'/cteq4d.LHgrid' + q2min = 2.56d0 + xmin=1.0d-5 + elseif((lhainput .ge. 19170) .and. (lhainput .le. 19170)) then + lhaset = 19170 + lhaname=lhapath(1:lhapathlen)//'/cteq4l.LHgrid' + q2min = 2.56d0 + xmin=1.0d-5 + else + write(lhaprint,5150) lhaset + stop + endif + + ! New CT10 (ct12 format) family) + elseif((lhainput .ge. 11000) .and. (lhainput .le. 11280)) then + q2min = 1.69d0 + q2max = 1.0d10 + xmin = 1.0d-8 + !ct10nlo + if ((lhainput .ge. 11000) .and. (lhainput .le. 11052)) then + lhaset = 11000 + lhaname=lhapath(1:lhapathlen)//'/CT10nlo.LHgrid' + !ct10nlo_as_xxxx + elseif ((lhainput .ge. 11062) .and. (lhainput .le. 11062)) then + lhaset = 11062 + lhaname=lhapath(1:lhapathlen)//'/CT10nlo_as_0112.LHgrid' + elseif ((lhainput .ge. 11063) .and. (lhainput .le. 11063)) then + lhaset = 11063 + lhaname=lhapath(1:lhapathlen)//'/CT10nlo_as_0113.LHgrid' + elseif ((lhainput .ge. 11064) .and. (lhainput .le. 11064)) then + lhaset = 11064 + lhaname=lhapath(1:lhapathlen)//'/CT10nlo_as_0114.LHgrid' + elseif ((lhainput .ge. 11065) .and. (lhainput .le. 11065)) then + lhaset = 11065 + lhaname=lhapath(1:lhapathlen)//'/CT10nlo_as_0115.LHgrid' + elseif ((lhainput .ge. 11066) .and. (lhainput .le. 11066)) then + lhaset = 11066 + lhaname=lhapath(1:lhapathlen)//'/CT10nlo_as_0116.LHgrid' + elseif ((lhainput .ge. 11067) .and. (lhainput .le. 11067)) then + lhaset = 11067 + lhaname=lhapath(1:lhapathlen)//'/CT10nlo_as_0117.LHgrid' + elseif ((lhainput .ge. 11068) .and. (lhainput .le. 11068)) then + lhaset = 11068 + lhaname=lhapath(1:lhapathlen)//'/CT10nlo_as_0118.LHgrid' + elseif ((lhainput .ge. 11069) .and. (lhainput .le. 11069)) then + lhaset = 11069 + lhaname=lhapath(1:lhapathlen)//'/CT10nlo_as_0119.LHgrid' + elseif ((lhainput .ge. 11070) .and. (lhainput .le. 11070)) then + lhaset = 11070 + lhaname=lhapath(1:lhapathlen)//'/CT10nlo_as_0120.LHgrid' + elseif ((lhainput .ge. 11071) .and. (lhainput .le. 11071)) then + lhaset = 11071 + lhaname=lhapath(1:lhapathlen)//'/CT10nlo_as_0121.LHgrid' + elseif ((lhainput .ge. 11072) .and. (lhainput .le. 11072)) then + lhaset = 11072 + lhaname=lhapath(1:lhapathlen)//'/CT10nlo_as_0122.LHgrid' + elseif ((lhainput .ge. 11073) .and. (lhainput .le. 11073)) then + lhaset = 11073 + lhaname=lhapath(1:lhapathlen)//'/CT10nlo_as_0123.LHgrid' + elseif ((lhainput .ge. 11074) .and. (lhainput .le. 11074)) then + lhaset = 11074 + lhaname=lhapath(1:lhapathlen)//'/CT10nlo_as_0124.LHgrid' + elseif ((lhainput .ge. 11075) .and. (lhainput .le. 11075)) then + lhaset = 11075 + lhaname=lhapath(1:lhapathlen)//'/CT10nlo_as_0125.LHgrid' + elseif ((lhainput .ge. 11076) .and. (lhainput .le. 11076)) then + lhaset = 11076 + lhaname=lhapath(1:lhapathlen)//'/CT10nlo_as_0126.LHgrid' + elseif ((lhainput .ge. 11077) .and. (lhainput .le. 11077)) then + lhaset = 11077 + lhaname=lhapath(1:lhapathlen)//'/CT10nlo_as_0127.LHgrid' + !ct10nlo_nf3/4 + elseif ((lhainput .ge. 11080) .and. (lhainput .le. 11081)) then + lhaset = 11080 + lhaname=lhapath(1:lhapathlen)//'/CT10nlo_nf3.LHgrid' + elseif ((lhainput .ge. 11082) .and. (lhainput .le. 11083)) then + lhaset = 11082 + lhaname=lhapath(1:lhapathlen)//'/CT10nlo_nf4.LHgrid' + !ct10wnlo + elseif ((lhainput .ge. 11100) .and. (lhainput .le. 11152)) then + lhaset = 11100 + lhaname=lhapath(1:lhapathlen)//'/CT10wnlo.LHgrid' + !ct10wnlo_as_xxxx + elseif ((lhainput .ge. 11162) .and. (lhainput .le. 11162)) then + lhaset = 11162 + lhaname=lhapath(1:lhapathlen)//'/CT10wnlo_as_0112.LHgrid' + elseif ((lhainput .ge. 11163) .and. (lhainput .le. 11163)) then + lhaset = 11163 + lhaname=lhapath(1:lhapathlen)//'/CT10wnlo_as_0113.LHgrid' + elseif ((lhainput .ge. 11164) .and. (lhainput .le. 11164)) then + lhaset = 11164 + lhaname=lhapath(1:lhapathlen)//'/CT10wnlo_as_0114.LHgrid' + elseif ((lhainput .ge. 11165) .and. (lhainput .le. 11165)) then + lhaset = 11165 + lhaname=lhapath(1:lhapathlen)//'/CT10wnlo_as_0115.LHgrid' + elseif ((lhainput .ge. 11166) .and. (lhainput .le. 11166)) then + lhaset = 11166 + lhaname=lhapath(1:lhapathlen)//'/CT10wnlo_as_0116.LHgrid' + elseif ((lhainput .ge. 11167) .and. (lhainput .le. 11167)) then + lhaset = 11167 + lhaname=lhapath(1:lhapathlen)//'/CT10wnlo_as_0117.LHgrid' + elseif ((lhainput .ge. 11168) .and. (lhainput .le. 11168)) then + lhaset = 11168 + lhaname=lhapath(1:lhapathlen)//'/CT10wnlo_as_0118.LHgrid' + elseif ((lhainput .ge. 11169) .and. (lhainput .le. 11169)) then + lhaset = 11169 + lhaname=lhapath(1:lhapathlen)//'/CT10wnlo_as_0119.LHgrid' + elseif ((lhainput .ge. 11170) .and. (lhainput .le. 11170)) then + lhaset = 11170 + lhaname=lhapath(1:lhapathlen)//'/CT10wnlo_as_0120.LHgrid' + elseif ((lhainput .ge. 11171) .and. (lhainput .le. 11171)) then + lhaset = 11171 + lhaname=lhapath(1:lhapathlen)//'/CT10wnlo_as_0121.LHgrid' + elseif ((lhainput .ge. 11172) .and. (lhainput .le. 11172)) then + lhaset = 11172 + lhaname=lhapath(1:lhapathlen)//'/CT10wnlo_as_0122.LHgrid' + elseif ((lhainput .ge. 11173) .and. (lhainput .le. 11173)) then + lhaset = 11173 + lhaname=lhapath(1:lhapathlen)//'/CT10wnlo_as_0123.LHgrid' + elseif ((lhainput .ge. 11174) .and. (lhainput .le. 11174)) then + lhaset = 11174 + lhaname=lhapath(1:lhapathlen)//'/CT10wnlo_as_0124.LHgrid' + elseif ((lhainput .ge. 11175) .and. (lhainput .le. 11175)) then + lhaset = 11175 + lhaname=lhapath(1:lhapathlen)//'/CT10wnlo_as_0125.LHgrid' + elseif ((lhainput .ge. 11176) .and. (lhainput .le. 11176)) then + lhaset = 11176 + lhaname=lhapath(1:lhapathlen)//'/CT10wnlo_as_0126.LHgrid' + elseif ((lhainput .ge. 11177) .and. (lhainput .le. 11177)) then + lhaset = 11177 + lhaname=lhapath(1:lhapathlen)//'/CT10wnlo_as_0127.LHgrid' + !ct10wnlo_nf3/4 + elseif ((lhainput .ge. 11180) .and. (lhainput .le. 11181)) then + lhaset = 11180 + lhaname=lhapath(1:lhapathlen)//'/CT10wnlo_nf3.LHgrid' + elseif ((lhainput .ge. 11182) .and. (lhainput .le. 11183)) then + lhaset = 11182 + lhaname=lhapath(1:lhapathlen)//'/CT10wnlo_nf4.LHgrid' + !ct10nnlo + elseif ((lhainput .ge. 11200) .and. (lhainput .le. 11250)) then + lhaset = 11200 + lhaname=lhapath(1:lhapathlen)//'/CT10nnlo.LHgrid' + !ct10nnlo_as_xxxx + elseif ((lhainput .ge. 11260) .and. (lhainput .le. 11260)) then + lhaset = 11260 + lhaname=lhapath(1:lhapathlen)//'/CT10nnlo_as_0110.LHgrid' + elseif ((lhainput .ge. 11261) .and. (lhainput .le. 11261)) then + lhaset = 11261 + lhaname=lhapath(1:lhapathlen)//'/CT10nnlo_as_0111.LHgrid' + elseif ((lhainput .ge. 11262) .and. (lhainput .le. 11262)) then + lhaset = 11262 + lhaname=lhapath(1:lhapathlen)//'/CT10nnlo_as_0112.LHgrid' + elseif ((lhainput .ge. 11263) .and. (lhainput .le. 11263)) then + lhaset = 11263 + lhaname=lhapath(1:lhapathlen)//'/CT10nnlo_as_0113.LHgrid' + elseif ((lhainput .ge. 11264) .and. (lhainput .le. 11264)) then + lhaset = 11264 + lhaname=lhapath(1:lhapathlen)//'/CT10nnlo_as_0114.LHgrid' + elseif ((lhainput .ge. 11265) .and. (lhainput .le. 11265)) then + lhaset = 11265 + lhaname=lhapath(1:lhapathlen)//'/CT10nnlo_as_0115.LHgrid' + elseif ((lhainput .ge. 11266) .and. (lhainput .le. 11266)) then + lhaset = 11266 + lhaname=lhapath(1:lhapathlen)//'/CT10nnlo_as_0116.LHgrid' + elseif ((lhainput .ge. 11267) .and. (lhainput .le. 11267)) then + lhaset = 11267 + lhaname=lhapath(1:lhapathlen)//'/CT10nnlo_as_0117.LHgrid' + elseif ((lhainput .ge. 11268) .and. (lhainput .le. 11268)) then + lhaset = 11268 + lhaname=lhapath(1:lhapathlen)//'/CT10nnlo_as_0118.LHgrid' + elseif ((lhainput .ge. 11269) .and. (lhainput .le. 11269)) then + lhaset = 11269 + lhaname=lhapath(1:lhapathlen)//'/CT10nnlo_as_0119.LHgrid' + elseif ((lhainput .ge. 11270) .and. (lhainput .le. 11270)) then + lhaset = 11270 + lhaname=lhapath(1:lhapathlen)//'/CT10nnlo_as_0120.LHgrid' + elseif ((lhainput .ge. 11271) .and. (lhainput .le. 11271)) then + lhaset = 11271 + lhaname=lhapath(1:lhapathlen)//'/CT10nnlo_as_0121.LHgrid' + elseif ((lhainput .ge. 11272) .and. (lhainput .le. 11272)) then + lhaset = 11272 + lhaname=lhapath(1:lhapathlen)//'/CT10nnlo_as_0122.LHgrid' + elseif ((lhainput .ge. 11273) .and. (lhainput .le. 11273)) then + lhaset = 11273 + lhaname=lhapath(1:lhapathlen)//'/CT10nnlo_as_0123.LHgrid' + elseif ((lhainput .ge. 11274) .and. (lhainput .le. 11274)) then + lhaset = 11274 + lhaname=lhapath(1:lhapathlen)//'/CT10nnlo_as_0124.LHgrid' + elseif ((lhainput .ge. 11275) .and. (lhainput .le. 11275)) then + lhaset = 11275 + lhaname=lhapath(1:lhapathlen)//'/CT10nnlo_as_0125.LHgrid' + elseif ((lhainput .ge. 11276) .and. (lhainput .le. 11276)) then + lhaset = 11276 + lhaname=lhapath(1:lhapathlen)//'/CT10nnlo_as_0126.LHgrid' + elseif ((lhainput .ge. 11277) .and. (lhainput .le. 11277)) then + lhaset = 11277 + lhaname=lhapath(1:lhapathlen)//'/CT10nnlo_as_0127.LHgrid' + elseif ((lhainput .ge. 11278) .and. (lhainput .le. 11278)) then + lhaset = 11278 + lhaname=lhapath(1:lhapathlen)//'/CT10nnlo_as_0128.LHgrid' + elseif ((lhainput .ge. 11279) .and. (lhainput .le. 11279)) then + lhaset = 11279 + lhaname=lhapath(1:lhapathlen)//'/CT10nnlo_as_0129.LHgrid' + elseif ((lhainput .ge. 11280) .and. (lhainput .le. 11280)) then + lhaset = 11280 + lhaname=lhapath(1:lhapathlen)//'/CT10nnlo_as_0130.LHgrid' + else + write(lhaprint,5150) lhaset + stop + endif + + ! CJ12 (family) + elseif((lhainput .ge. 12000) .and. (lhainput .le. 12238)) then + q2min = 1.69d0 + q2max = 1.0d10 + xmin = 1.0d-6 + !cj12min + if ((lhainput .ge. 12000) .and. (lhainput .le. 12038)) then + lhaset = 12000 + lhaname=lhapath(1:lhapathlen)//'/CJ12min.LHgrid' + !cj12mid + elseif ((lhainput .ge. 12100) .and. (lhainput .le. 12138)) then + lhaset = 12100 + lhaname=lhapath(1:lhapathlen)//'/CJ12mid.LHgrid' + !cj12max + elseif ((lhainput .ge. 12200) .and. (lhainput .le. 12238)) then + lhaset = 12200 + lhaname=lhapath(1:lhapathlen)//'/CJ12max.LHgrid' + else + write(lhaprint,5150) lhaset + stop + endif + + ! MRST Family + elseif((lhainput .ge. 20000) .and. (lhainput .le. 20999)) then + q2min = 1.25d0 + q2max = 1.0d07 + xmin = 1.0d-5 + if((lhainput .ge. 20000) .and. (lhainput .le. 20004)) then + lhaset = 20000 + lhaname=lhapath(1:lhapathlen)//'/MRST2001nlo.LHpdf' + elseif((lhainput .ge. 20050) .and. (lhainput .le. 20054)) then + lhaset = 20050 + lhaname=lhapath(1:lhapathlen)//'/MRST2001nlo.LHgrid' + elseif((lhainput .ge. 20060) .and. (lhainput .le. 20061)) then + lhaset = 20060 + lhaname=lhapath(1:lhapathlen)//'/MRST2001lo.LHgrid' + elseif((lhainput .ge. 20070) .and. (lhainput .le. 20074)) then + lhaset = 20070 + lhaname=lhapath(1:lhapathlen)//'/MRST2001nnlo.LHgrid' + elseif((lhainput .ge. 20100) .and. (lhainput .le. 20130)) then + lhaset = 20100 + lhaname=lhapath(1:lhapathlen)//'/MRST2001E.LHpdf' + elseif((lhainput .ge. 20150) .and. (lhainput .le. 20180)) then + lhaset = 20150 + lhaname=lhapath(1:lhapathlen)//'/MRST2001E.LHgrid' + elseif((lhainput .ge. 20200) .and. (lhainput .le. 20201)) then + lhaset = 20200 + lhaname=lhapath(1:lhapathlen)//'/MRST2002nlo.LHpdf' + elseif((lhainput .ge. 20250) .and. (lhainput .le. 20251)) then + lhaset = 20250 + lhaname=lhapath(1:lhapathlen)//'/MRST2002nlo.LHgrid' + elseif((lhainput .ge. 20270) .and. (lhainput .le. 20271)) then + lhaset = 20270 + lhaname=lhapath(1:lhapathlen)//'/MRST2002nnlo.LHgrid' + elseif((lhainput .ge. 20300) .and. (lhainput .le. 20301)) then + lhaset = 20300 + lhaname=lhapath(1:lhapathlen)//'/MRST2003cnlo.LHpdf' + q2min = 10.0d0 + xmin = 1.0d-3 + elseif((lhainput .ge. 20350) .and. (lhainput .le. 20351)) then + lhaset = 20350 + lhaname=lhapath(1:lhapathlen)//'/MRST2003cnlo.LHgrid' + q2min = 10.0d0 + xmin = 1.0d-3 + elseif((lhainput .ge. 20370) .and. (lhainput .le. 20371)) then + lhaset = 20370 + lhaname=lhapath(1:lhapathlen)//'/MRST2003cnnlo.LHgrid' + q2min = 7.0d0 + xmin = 1.0d-3 + elseif((lhainput .ge. 20400) .and. (lhainput .le. 20401)) then + lhaset = 20400 + lhaname=lhapath(1:lhapathlen)//'/MRST2004nlo.LHpdf' + elseif((lhainput .ge. 20406) .and. (lhainput .le. 20407)) then + lhaset = 20406 + lhaname=lhapath(1:lhapathlen)//'/MRST2004FF3nlo.LHpdf' + elseif((lhainput .ge. 20408) .and. (lhainput .le. 20409)) then + lhaset = 20408 + lhaname=lhapath(1:lhapathlen)//'/MRST2004FF4nlo.LHpdf' + elseif((lhainput .ge. 20450) .and. (lhainput .le. 20451)) then + lhaset = 20450 + lhaname=lhapath(1:lhapathlen)//'/MRST2004nlo.LHgrid' + elseif((lhainput .ge. 20452) .and. (lhainput .le. 20453)) then + lhaset = 20452 + lhaname=lhapath(1:lhapathlen)//'/MRST2004FF3lo.LHgrid' + elseif((lhainput .ge. 20454) .and. (lhainput .le. 20455)) then + lhaset = 20454 + lhaname=lhapath(1:lhapathlen)//'/MRST2004FF4lo.LHgrid' + elseif((lhainput .ge. 20456) .and. (lhainput .le. 20457)) then + lhaset = 20456 + lhaname=lhapath(1:lhapathlen)//'/MRST2004FF3nlo.LHgrid' + elseif((lhainput .ge. 20458) .and. (lhainput .le. 20459)) then + lhaset = 20458 + lhaname=lhapath(1:lhapathlen)//'/MRST2004FF4nlo.LHgrid' + elseif((lhainput .ge. 20460) .and. (lhainput .le. 20462)) then + lhaset = 20460 + lhaname=lhapath(1:lhapathlen)//'/MRST2004qed.LHgrid' + elseif((lhainput .ge. 20470) .and. (lhainput .le. 20471)) then + lhaset = 20470 + lhaname=lhapath(1:lhapathlen)//'/MRST2004nnlo.LHgrid' + elseif((lhainput .ge. 20550) .and. (lhainput .le. 20580)) then + lhaset = 20550 + lhaname=lhapath(1:lhapathlen)//'/MRST2006nnlo.LHgrid' + q2min = 1.0d0 + q2max = 1.0d09 + xmin = 1.0d-6 + elseif((lhainput .ge. 20650) .and. (lhainput .le. 20650)) then + lhaset = 20650 + lhaname=lhapath(1:lhapathlen)//'/MRST2007lomod.LHgrid' + elseif((lhainput .ge. 20651) .and. (lhainput .le. 20651)) then + lhaset = 20651 + lhaname=lhapath(1:lhapathlen)//'/MRSTMCal.LHgrid' + else + write(lhaprint,5150) lhaset + stop + endif + ! next are MSTW + elseif((lhainput .ge. 21000) .and. (lhainput .le. 23896)) then + q2min = 1.0d0 + q2max = 1.0d09 + xmin = 1.0d-6 + if((lhainput .ge. 21000) .and. (lhainput .le. 21040)) then + lhaset = 21000 + lhaname=lhapath(1:lhapathlen)//'/MSTW2008lo68cl.LHgrid' + elseif((lhainput .ge. 21041) .and. (lhainput .le. 21080)) then + lhaset = 21040 + lhaname=lhapath(1:lhapathlen)//'/MSTW2008lo90cl.LHgrid' + elseif((lhainput .ge. 21100) .and. (lhainput .le. 21140)) then + lhaset = 21100 + lhaname=lhapath(1:lhapathlen)//'/MSTW2008nlo68cl.LHgrid' + elseif((lhainput .ge. 21141) .and. (lhainput .le. 21180)) then + lhaset = 21140 + lhaname=lhapath(1:lhapathlen)//'/MSTW2008nlo90cl.LHgrid' + elseif((lhainput .ge. 21200) .and. (lhainput .le. 21240)) then + lhaset = 21200 + lhaname=lhapath(1:lhapathlen)//'/MSTW2008nnlo68cl.LHgrid' + elseif((lhainput .ge. 21241) .and. (lhainput .le. 21280)) then + lhaset = 21240 + lhaname=lhapath(1:lhapathlen)//'/MSTW2008nnlo90cl.LHgrid' +! + elseif((lhainput .ge. 22000) .and. (lhainput .le. 22021)) then + lhaset = 22000 + lhaname=lhapath(1:lhapathlen)//'/MSTW2008nlo_asmzrange.LHgrid' + elseif((lhainput .ge. 22100) .and. (lhainput .le. 22140)) then + lhaset = 22100 + lhaname=lhapath(1:lhapathlen)//'/MSTW2008nlo68cl_asmz+68cl.LHgrid' + elseif((lhainput .ge. 22150) .and. (lhainput .le. 22190)) then + lhaset = 22150 + lhaname=lhapath(1:lhapathlen)//'/MSTW2008nlo68cl_asmz-68cl.LHgrid' + elseif((lhainput .ge. 22200) .and. (lhainput .le. 22240)) then + lhaset = 22200 + lhaname=lhapath(1:lhapathlen)//'/MSTW2008nlo68cl_asmz+68clhalf.LHgrid' + elseif((lhainput .ge. 22250) .and. (lhainput .le. 22290)) then + lhaset = 22250 + lhaname=lhapath(1:lhapathlen)//'/MSTW2008nlo68cl_asmz-68clhalf.LHgrid' + elseif((lhainput .ge. 22300) .and. (lhainput .le. 22340)) then + lhaset = 22300 + lhaname=lhapath(1:lhapathlen)//'/MSTW2008nlo90cl_asmz+90cl.LHgrid' + elseif((lhainput .ge. 22350) .and. (lhainput .le. 22390)) then + lhaset = 22350 + lhaname=lhapath(1:lhapathlen)//'/MSTW2008nlo90cl_asmz-90cl.LHgrid' + elseif((lhainput .ge. 22400) .and. (lhainput .le. 22440)) then + lhaset = 22400 + lhaname=lhapath(1:lhapathlen)//'/MSTW2008nlo90cl_asmz+90clhalf.LHgrid' + elseif((lhainput .ge. 22450) .and. (lhainput .le. 22490)) then + lhaset = 22450 + lhaname=lhapath(1:lhapathlen)//'/MSTW2008nlo90cl_asmz-90clhalf.LHgrid' +! + elseif((lhainput .ge. 22500) .and. (lhainput .le. 22521)) then + lhaset = 22500 + lhaname=lhapath(1:lhapathlen)//'/MSTW2008nnlo_asmzrange.LHgrid' + elseif((lhainput .ge. 22600) .and. (lhainput .le. 22640)) then + lhaset = 22600 + lhaname=lhapath(1:lhapathlen)//'/MSTW2008nnlo68cl_asmz+68cl.LHgrid' + elseif((lhainput .ge. 22650) .and. (lhainput .le. 22690)) then + lhaset = 22650 + lhaname=lhapath(1:lhapathlen)//'/MSTW2008nnlo68cl_asmz-68cl.LHgrid' + elseif((lhainput .ge. 22700) .and. (lhainput .le. 22740)) then + lhaset = 22700 + lhaname=lhapath(1:lhapathlen)//'/MSTW2008nnlo68cl_asmz+68clhalf.LHgrid' + elseif((lhainput .ge. 22750) .and. (lhainput .le. 22790)) then + lhaset = 22750 + lhaname=lhapath(1:lhapathlen)//'/MSTW2008nnlo68cl_asmz-68clhalf.LHgrid' + elseif((lhainput .ge. 22800) .and. (lhainput .le. 22840)) then + lhaset = 22800 + lhaname=lhapath(1:lhapathlen)//'/MSTW2008nnlo90cl_asmz+90cl.LHgrid' + elseif((lhainput .ge. 22850) .and. (lhainput .le. 22890)) then + lhaset = 22850 + lhaname=lhapath(1:lhapathlen)//'/MSTW2008nnlo90cl_asmz-90cl.LHgrid' + elseif((lhainput .ge. 22900) .and. (lhainput .le. 22940)) then + lhaset = 22900 + lhaname=lhapath(1:lhapathlen)//'/MSTW2008nnlo90cl_asmz+90clhalf.LHgrid' + elseif((lhainput .ge. 22950) .and. (lhainput .le. 22990)) then + lhaset = 22950 + lhaname=lhapath(1:lhapathlen)//'/MSTW2008nnlo90cl_asmz-90clhalf.LHgrid' +! + elseif((lhainput .ge. 23000) .and. (lhainput .le. 23040)) then + lhaset = 23000 + lhaname=lhapath(1:lhapathlen)//'/MSTW2008lo68cl_nf3.LHgrid' + elseif((lhainput .ge. 23041) .and. (lhainput .le. 23080)) then + lhaset = 23041 + lhaname=lhapath(1:lhapathlen)//'/MSTW2008lo90cl_nf3.LHgrid' + elseif((lhainput .ge. 23100) .and. (lhainput .le. 23140)) then + lhaset = 23100 + lhaname=lhapath(1:lhapathlen)//'/MSTW2008lo68cl_nf4.LHgrid' + elseif((lhainput .ge. 23141) .and. (lhainput .le. 23180)) then + lhaset = 23141 + lhaname=lhapath(1:lhapathlen)//'/MSTW2008lo90cl_nf4.LHgrid' +! + elseif((lhainput .ge. 23200) .and. (lhainput .le. 23240)) then + lhaset = 23200 + lhaname=lhapath(1:lhapathlen)//'/MSTW2008nlo68cl_nf3.LHgrid' + elseif((lhainput .ge. 23241) .and. (lhainput .le. 23280)) then + lhaset = 23241 + lhaname=lhapath(1:lhapathlen)//'/MSTW2008nlo90cl_nf3.LHgrid' + elseif((lhainput .ge. 23300) .and. (lhainput .le. 23340)) then + lhaset = 23300 + lhaname=lhapath(1:lhapathlen)//'/MSTW2008nlo68cl_nf4.LHgrid' + elseif((lhainput .ge. 23341) .and. (lhainput .le. 23380)) then + lhaset = 23341 + lhaname=lhapath(1:lhapathlen)//'/MSTW2008nlo90cl_nf4.LHgrid' +! + elseif((lhainput .ge. 23400) .and. (lhainput .le. 23414)) then + lhaset = 23400 + lhaname=lhapath(1:lhapathlen)//'/MSTW2008nlo_mcrange.LHgrid' + elseif((lhainput .ge. 23420) .and. (lhainput .le. 23434)) then + lhaset = 23420 + lhaname=lhapath(1:lhapathlen)//'/MSTW2008nlo_mcrange_nf3.LHgrid' + elseif((lhainput .ge. 23440) .and. (lhainput .le. 23454)) then + lhaset = 23440 + lhaname=lhapath(1:lhapathlen)//'/MSTW2008nlo_mcrange_fixasmz.LHgrid' + elseif((lhainput .ge. 23460) .and. (lhainput .le. 23474)) then + lhaset = 23460 + lhaname=lhapath(1:lhapathlen)//'/MSTW2008nlo_mcrange_fixasmz_nf3.LHgrid' + elseif((lhainput .ge. 23480) .and. (lhainput .le. 23486)) then + lhaset = 23480 + lhaname=lhapath(1:lhapathlen)//'/MSTW2008nlo_mbrange.LHgrid' + elseif((lhainput .ge. 23490) .and. (lhainput .le. 23496)) then + lhaset = 23490 + lhaname=lhapath(1:lhapathlen)//'/MSTW2008nlo_mbrange_nf4.LHgrid' +! + elseif((lhainput .ge. 23500) .and. (lhainput .le. 23540)) then + lhaset = 23500 + lhaname=lhapath(1:lhapathlen)//'/MSTW2008nnlo68cl_nf3.LHgrid' + elseif((lhainput .ge. 23541) .and. (lhainput .le. 23580)) then + lhaset = 23541 + lhaname=lhapath(1:lhapathlen)//'/MSTW2008nnlo90cl_nf3.LHgrid' + elseif((lhainput .ge. 23600) .and. (lhainput .le. 23640)) then + lhaset = 23600 + lhaname=lhapath(1:lhapathlen)//'/MSTW2008nnlo68cl_nf4.LHgrid' + elseif((lhainput .ge. 23641) .and. (lhainput .le. 23680)) then + lhaset = 23641 + lhaname=lhapath(1:lhapathlen)//'/MSTW2008nnlo90cl_nf4.LHgrid' +! + elseif((lhainput .ge. 23700) .and. (lhainput .le. 23714)) then + lhaset = 23700 + lhaname=lhapath(1:lhapathlen)//'/MSTW2008nnlo_mcrange.LHgrid' + elseif((lhainput .ge. 23720) .and. (lhainput .le. 23734)) then + lhaset = 23720 + lhaname=lhapath(1:lhapathlen)//'/MSTW2008nnlo_mcrange_nf3.LHgrid' + elseif((lhainput .ge. 23740) .and. (lhainput .le. 23754)) then + lhaset = 23740 + lhaname=lhapath(1:lhapathlen)//'/MSTW2008nnlo_mcrange_fixasmz.LHgrid' + elseif((lhainput .ge. 23760) .and. (lhainput .le. 23774)) then + lhaset = 23760 + lhaname=lhapath(1:lhapathlen)//'/MSTW2008nnlo_mcrange_fixasmz_nf3.LHgrid' + elseif((lhainput .ge. 23780) .and. (lhainput .le. 23786)) then + lhaset = 23780 + lhaname=lhapath(1:lhapathlen)//'/MSTW2008nnlo_mbrange.LHgrid' + elseif((lhainput .ge. 23790) .and. (lhainput .le. 23796)) then + lhaset = 23790 + lhaname=lhapath(1:lhapathlen)//'/MSTW2008nnlo_mbrange_nf4.LHgrid' + elseif((lhainput .ge. 23800) .and. (lhainput .le. 23846)) then + lhaset = 23800 + lhaname=lhapath(1:lhapathlen)//'/MSTW2008CPdeutnlo68cl.LHgrid' + elseif((lhainput .ge. 23850) .and. (lhainput .le. 23896)) then + lhaset = 23850 + lhaname=lhapath(1:lhapathlen)//'/MSTW2008CPdeutnnlo68cl.LHgrid' +! + else + write(lhaprint,5150) lhaset + stop + endif + ! old MRST98 sets + elseif((lhainput .ge. 29000) .and. (lhainput .le. 29999)) then + q2min = 1.25d0 + q2max = 1.0d07 + xmin = 1.0d-5 + if((lhainput .ge. 29000) .and. (lhainput .le. 29003)) then + lhaset = 29000 + lhaname=lhapath(1:lhapathlen)//'/MRST98.LHpdf' + elseif((lhainput .ge. 29040) .and. (lhainput .le. 29045)) then + lhaset = 29040 + lhaname=lhapath(1:lhapathlen)//'/MRST98lo.LHgrid' + elseif((lhainput .ge. 29050) .and. (lhainput .le. 29055)) then + lhaset = 29050 + lhaname=lhapath(1:lhapathlen)//'/MRST98nlo.LHgrid' + elseif((lhainput .ge. 29060) .and. (lhainput .le. 29065)) then + lhaset = 29060 + lhaname=lhapath(1:lhapathlen)//'/MRST98dis.LHgrid' + elseif((lhainput .ge. 29070) .and. (lhainput .le. 29071)) then + lhaset = 29070 + lhaname=lhapath(1:lhapathlen)//'/MRST98ht.LHgrid' + else + write(lhaprint,5150) lhaset + stop + endif + ! Fermi Family + elseif((lhainput .ge. 30000) .and. (lhainput .le. 39999)) then + if((lhainput .ge. 30100) .and. (lhainput .le. 30200)) then + lhaset = 30100 + lhaname=lhapath(1:lhapathlen)//'/Fermi2002_100.LHpdf' + elseif((lhainput .ge. 31000) .and. (lhainput .le. 32000)) then + lhaset = 31000 + lhaname=lhapath(1:lhapathlen)//'/Fermi2002_1000.LHpdf' + else + write(lhaprint,5150) lhaset + stop + endif + ! a02m Family + elseif((lhainput .ge. 40350) .and. (lhainput .le. 40567)) then + xmin = 1.0d-7 + q2min = 0.8d0 + q2max = 2.0d08 + if((lhainput .ge. 40350) .and. (lhainput .le. 40367)) then + lhaset = 40350 + lhaname=lhapath(1:lhapathlen)//'/a02m_lo.LHgrid' + elseif((lhainput .ge. 40450) .and. (lhainput .le. 40467)) then + lhaset = 40450 + lhaname=lhapath(1:lhapathlen)//'/a02m_nlo.LHgrid' + elseif((lhainput .ge. 40550) .and. (lhainput .le. 40567)) then + lhaset = 40550 + lhaname=lhapath(1:lhapathlen)//'/a02m_nnlo.LHgrid' + else + write(lhaprint,5150) lhaset + stop + endif + ! abkm09 Family + elseif((lhainput .ge. 40650) .and. (lhainput .le. 40975)) then + xmin = 1.0d-7 + q2min = 0.8d0 + q2max = 2.0d08 + if((lhainput .ge. 40650) .and. (lhainput .le. 40675)) then + lhaset = 40650 + lhaname=lhapath(1:lhapathlen)//'/abkm09_3_nlo.LHgrid' + elseif((lhainput .ge. 40750) .and. (lhainput .le. 40775)) then + lhaset = 40750 + lhaname=lhapath(1:lhapathlen)//'/abkm09_3_nnlo.LHgrid' + elseif((lhainput .ge. 40780) .and. (lhainput .le. 40805)) then + lhaset = 40780 + lhaname=lhapath(1:lhapathlen)//'/abkm09_4_nlo.LHgrid' + elseif((lhainput .ge. 40810) .and. (lhainput .le. 40835)) then + lhaset = 40810 + lhaname=lhapath(1:lhapathlen)//'/abkm09_4_nnlo.LHgrid' + elseif((lhainput .ge. 40850) .and. (lhainput .le. 40875)) then + lhaset = 40850 + lhaname=lhapath(1:lhapathlen)//'/abkm09_5_nlo.LHgrid' + elseif((lhainput .ge. 40950) .and. (lhainput .le. 40975)) then + lhaset = 40950 + lhaname=lhapath(1:lhapathlen)//'/abkm09_5_nnlo.LHgrid' + else + write(lhaprint,5150) lhaset + stop + endif + ! abm11 Family + elseif((lhainput .ge. 42000) .and. (lhainput .le. 42246)) then + xmin = 1.0d-7 + q2min = 0.8d0 + q2max = 2.0d08 + if((lhainput .ge. 42000) .and. (lhainput .le. 42028)) then + lhaset = 42000 + lhaname=lhapath(1:lhapathlen)//'/abm11_3n_nlo.LHgrid' + elseif((lhainput .ge. 42030) .and. (lhainput .le. 42058)) then + lhaset = 42030 + lhaname=lhapath(1:lhapathlen)//'/abm11_4n_nlo.LHgrid' + elseif((lhainput .ge. 42060) .and. (lhainput .le. 42088)) then + lhaset = 42060 + lhaname=lhapath(1:lhapathlen)//'/abm11_5n_nlo.LHgrid' + elseif((lhainput .ge. 42100) .and. (lhainput .le. 42128)) then + lhaset = 42100 + lhaname=lhapath(1:lhapathlen)//'/abm11_3n_nnlo.LHgrid' + elseif((lhainput .ge. 42130) .and. (lhainput .le. 42158)) then + lhaset = 42130 + lhaname=lhapath(1:lhapathlen)//'/abm11_4n_nnlo.LHgrid' + elseif((lhainput .ge. 42160) .and. (lhainput .le. 42188)) then + lhaset = 42160 + lhaname=lhapath(1:lhapathlen)//'/abm11_5n_nnlo.LHgrid' + elseif((lhainput .ge. 42200) .and. (lhainput .le. 42220)) then + lhaset = 42200 + lhaname=lhapath(1:lhapathlen)//'/abm11_5n_as_nlo.LHgrid' + elseif((lhainput .ge. 42230) .and. (lhainput .le. 42246)) then + lhaset = 42230 + lhaname=lhapath(1:lhapathlen)//'/abm11_5n_as_nnlo.LHgrid' + else + write(lhaprint,5150) lhaset + stop + endif + ! Alekhin Family + elseif((lhainput .ge. 40000) .and. (lhainput .le. 41999)) then + if((lhainput .ge. 40100) .and. (lhainput .le. 40200)) then + lhaset = 40100 + lhaname=lhapath(1:lhapathlen)//'/Alekhin_100.LHpdf' + elseif((lhainput .ge. 41000) .and. (lhainput .le. 41999)) then + lhaset = 41000 + lhaname=lhapath(1:lhapathlen)//'/Alekhin_1000.LHpdf' + else + write(lhaprint,5150) lhaset + stop + endif + ! Botje Family + elseif((lhainput .ge. 50000) .and. (lhainput .le. 59999)) then + if((lhainput .ge. 50100) .and. (lhainput .le. 50200)) then + lhaset = 50100 + lhaname=lhapath(1:lhapathlen)//'/Botje_100.LHpdf' + elseif((lhainput .ge. 51000) .and. (lhainput .le. 51999)) then + lhaset = 51000 + lhaname=lhapath(1:lhapathlen)//'/Botje_1000.LHpdf' + else + write(lhaprint,5150) lhaset + stop + endif + ! ZEUS (+ ATLAS) Family + elseif((lhainput .ge. 60000) .and. (lhainput .le. 69999)) then + q2min = 0.3d0 + q2max = 2.0d05 + if((lhainput .ge. 60000) .and. (lhainput .le. 60022)) then + lhaset = 60000 + lhaname=lhapath(1:lhapathlen)//'/ZEUS2002_TR.LHpdf' + elseif((lhainput .ge. 60100) .and. (lhainput .le. 60122)) then + lhaset = 60100 + lhaname=lhapath(1:lhapathlen)//'/ZEUS2002_ZM.LHpdf' + elseif((lhainput .ge. 60200) .and. (lhainput .le. 60222)) then + lhaset = 60200 + lhaname=lhapath(1:lhapathlen)//'/ZEUS2002_FF.LHpdf' + elseif((lhainput .ge. 60300) .and. (lhainput .le. 60322)) then + lhaset = 60300 + lhaname=lhapath(1:lhapathlen)//'/ZEUS2005_ZJ.LHpdf' + elseif((lhainput .ge. 60400) .and. (lhainput .le. 60422)) then + xmin=1.0d-6 + xmax=1.0d0 + q2min=1.0d0 + q2max=1.0d09 + lhaset = 60400 + lhaname=lhapath(1:lhapathlen)//'/HERAPDF01.LHpdf' + elseif((lhainput .ge. 60430) .and. (lhainput .le. 60444)) then + xmin=1.0d-6 + xmax=1.0d0 + q2min=1.0d0 + q2max=2.0d08 + lhaset = 60430 + lhaname=lhapath(1:lhapathlen)//'/HERAPDF01.LHgrid' + elseif((lhainput .ge. 60500) .and. (lhainput .le. 60520)) then + xmin=1.0d-6 + xmax=1.0d0 + q2min=1.0d0 + q2max=2.0d08 + lhaset = 60500 + lhaname=lhapath(1:lhapathlen)//'/HERAPDF10_EIG.LHgrid' + elseif((lhainput .ge. 60530) .and. (lhainput .le. 60543)) then + xmin=1.0d-6 + xmax=1.0d0 + q2min=1.0d0 + q2max=2.0d08 + lhaset = 60530 + lhaname=lhapath(1:lhapathlen)//'/HERAPDF10_VAR.LHgrid' + elseif((lhainput .ge. 60550) .and. (lhainput .le. 60561)) then + xmin=1.0d-6 + xmax=1.0d0 + q2min=1.0d0 + q2max=2.0d08 + lhaset = 60550 + lhaname=lhapath(1:lhapathlen)//'/HERAPDF10_ALPHAS.LHgrid' + elseif((lhainput .ge. 60600) .and. (lhainput .le. 60628)) then + xmin=1.0d-8 + xmax=1.0d0 + q2min=1.0d0 + q2max=1.0d09 + lhaset = 60600 + lhaname=lhapath(1:lhapathlen)//'/HERAPDF15NNLO_EIG.LHgrid' + elseif((lhainput .ge. 60630) .and. (lhainput .le. 60640)) then + xmin=1.0d-8 + xmax=1.0d0 + q2min=1.0d0 + q2max=1.0d09 + lhaset = 60630 + lhaname=lhapath(1:lhapathlen)//'/HERAPDF15NNLO_VAR.LHgrid' + elseif((lhainput .ge. 60650) .and. (lhainput .le. 60661)) then + xmin=1.0d-8 + xmax=1.0d0 + q2min=1.0d0 + q2max=1.0d09 + lhaset = 60650 + lhaname=lhapath(1:lhapathlen)//'/HERAPDF15NNLO_ALPHAS.LHgrid' + elseif((lhainput .ge. 60700) .and. (lhainput .le. 60720)) then + xmin=1.0d-8 + xmax=1.0d0 + q2min=1.0d0 + q2max=1.0d09 + lhaset = 60700 + lhaname=lhapath(1:lhapathlen)//'/HERAPDF15NLO_EIG.LHgrid' + elseif((lhainput .ge. 60730) .and. (lhainput .le. 60742)) then + xmin=1.0d-8 + xmax=1.0d0 + q2min=1.0d0 + q2max=1.0d09 + lhaset = 60730 + lhaname=lhapath(1:lhapathlen)//'/HERAPDF15NLO_VAR.LHgrid' + elseif((lhainput .ge. 60750) .and. (lhainput .le. 60761)) then + xmin=1.0d-8 + xmax=1.0d0 + q2min=1.0d0 + q2max=1.0d09 + lhaset = 60750 + lhaname=lhapath(1:lhapathlen)//'/HERAPDF15NLO_ALPHAS.LHgrid' + elseif((lhainput .ge. 60800) .and. (lhainput .le. 60824)) then + xmin=1.0d-8 + xmax=1.0d0 + q2min=1.0d0 + q2max=1.0d09 + lhaset = 60800 + lhaname=lhapath(1:lhapathlen)//'/LHECNLO_EIG.LHgrid' + elseif((lhainput .ge. 65000) .and. (lhainput .le. 65030)) then + xmin=1.0d-7 + xmax=1.0d0 + q2min=1.0d0 + q2max=1.0d09 + lhaset = 65000 + lhaname=lhapath(1:lhapathlen)//'/ATLAS-epWZ12-EIG.LHgrid' + elseif((lhainput .ge. 65040) .and. (lhainput .le. 65051)) then + xmin=1.0d-7 + xmax=1.0d0 + q2min=1.0d0 + q2max=1.0d09 + lhaset = 65040 + lhaname=lhapath(1:lhapathlen)//'/ATLAS-epWZ12-VAR.LHgrid' + else + write(lhaprint,5150) lhaset + stop + endif + ! H1 Family + elseif((lhainput .ge. 70000) .and. (lhainput .le. 79999)) then + q2min = 1.5d0 + q2max = 3.5d04 + xmin = 5.7d-5 + if((lhainput .ge. 70050) .and. (lhainput .le. 70050)) then + lhaset = 70050 + lhaname=lhapath(1:lhapathlen)//'/H12000ms.LHgrid' + elseif((lhainput .ge. 70051) .and. (lhainput .le. 70070)) then + lhaset = 70050 + lhaname=lhapath(1:lhapathlen)//'/H12000msE.LHgrid' + elseif((lhainput .ge. 70150) .and. (lhainput .le. 70150)) then + lhaset = 70150 + lhaname=lhapath(1:lhapathlen)//'/H12000dis.LHgrid' + elseif((lhainput .ge. 70151) .and. (lhainput .le. 70170)) then + lhaset = 70150 + lhaname=lhapath(1:lhapathlen)//'/H12000disE.LHgrid' + elseif((lhainput .ge. 70250) .and. (lhainput .le. 70250)) then + lhaset = 70250 + lhaname=lhapath(1:lhapathlen)//'/H12000lo.LHgrid' + elseif((lhainput .ge. 70251) .and. (lhainput .le. 70270)) then + lhaset = 70250 + lhaname=lhapath(1:lhapathlen)//'/H12000loE.LHgrid' + ! Temporarily removed on returning to original H12000 files + ! elseif((lhainput .ge. 70350) .and. (lhainput .le. 70350)) then + ! lhaset = 70350 + ! lhaname=lhapath(1:lhapathlen)//'/H12000lo2.LHgrid' + ! elseif((lhainput .ge. 70351) .and. (lhainput .le. 70370)) then + ! lhaset = 70350 + ! lhaname=lhapath(1:lhapathlen)//'/H12000lo2E.LHgrid' + else + write(lhaprint,5150) lhaset + stop + endif + ! GRV/GJR Family + elseif((lhainput .ge. 80000) .and. (lhainput .le. 89999)) then + q2min = 0.8d0 + q2max = 2.0d06 + xmin = 1.0d-9 + if((lhainput .ge. 80050) .and. (lhainput .le. 80051)) then + lhaset = 80050 + lhaname=lhapath(1:lhapathlen)//'/GRV98nlo.LHgrid' + elseif((lhainput .ge. 80060) .and. (lhainput .le. 80060)) then + lhaset = 80060 + lhaname=lhapath(1:lhapathlen)//'/GRV98lo.LHgrid' + elseif((lhainput .ge. 80150) .and. (lhainput .le. 80151)) then + q2min = 0.3d0 + q2max = 1.0d08 + lhaset = 80150 + lhaname=lhapath(1:lhapathlen)//'/GJR08lo.LHgrid' + elseif((lhainput .ge. 80152) .and. (lhainput .le. 80152)) then + q2min = 0.5d0 + q2max = 1.0d08 + lhaset = 80152 + lhaname=lhapath(1:lhapathlen)//'/GJR08FFdis.LHgrid' + elseif((lhainput .ge. 80160) .and. (lhainput .le. 80186)) then + q2min = 0.5d0 + q2max = 1.0d08 + lhaset = 80160 + lhaname=lhapath(1:lhapathlen)//'/GJR08FFnloE.LHgrid' + elseif((lhainput .ge. 80260) .and. (lhainput .le. 80286)) then + q2min = 0.5d0 + q2max = 1.0d08 + lhaset = 80260 + lhaname=lhapath(1:lhapathlen)//'/GJR08VFnloE.LHgrid' + elseif((lhainput .ge. 80360) .and. (lhainput .le. 80386)) then + q2min = 0.55d0 + q2max = 1.0d08 + lhaset = 80360 + lhaname=lhapath(1:lhapathlen)//'/JR09FFnnloE.LHgrid' + elseif((lhainput .ge. 80460) .and. (lhainput .le. 80486)) then + q2min = 0.55d0 + q2max = 1.0d08 + lhaset = 80460 + lhaname=lhapath(1:lhapathlen)//'/JR09VFnnloE.LHgrid' + else + write(lhaprint,5150) lhaset + stop + endif +!...NNPDF Family + ELSEIF((LHAINPUT .GE. 90000) .AND. (LHAINPUT .LE. 98000)) THEN + XMIN = 1.0D-9 + Q2MIN = 2.0D0 + Q2MAX = 1.0D08 + IF((LHAINPUT .GE. 90000) .AND. (LHAINPUT .LE. 90100)) THEN + LHASET = 90000 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF10_100.LHpdf' + ELSEIF((LHAINPUT .GE. 90200) .AND. (LHAINPUT .LE. 90300))THEN + LHASET = 90200 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF10_100.LHgrid' + ELSEIF((LHAINPUT .GE. 90400) .AND. (LHAINPUT .LE. 90500))THEN + LHASET = 90400 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF11_100.LHgrid' + ELSEIF((LHAINPUT .GE. 90600) .AND. (LHAINPUT .LE. 90700))THEN + LHASET = 90600 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF12_100.LHgrid' + ELSEIF((LHAINPUT .GE. 90800) .AND. (LHAINPUT .LE. 90900))THEN + LHASET = 90800 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF20_100.LHgrid' + ELSEIF((LHAINPUT .GE. 90901) .AND. (LHAINPUT .LE. 90901))THEN + LHASET = 90901 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF20_as_0114_100.LHgrid' + ELSEIF((LHAINPUT .GE. 90902) .AND. (LHAINPUT .LE. 90902))THEN + LHASET = 90902 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF20_as_0115_100.LHgrid' + ELSEIF((LHAINPUT .GE. 90903) .AND. (LHAINPUT .LE. 90903))THEN + LHASET = 90903 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF20_as_0116_100.LHgrid' + ELSEIF((LHAINPUT .GE. 90904) .AND. (LHAINPUT .LE. 90904))THEN + LHASET = 90904 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF20_as_0117_100.LHgrid' + ELSEIF((LHAINPUT .GE. 90905) .AND. (LHAINPUT .LE. 90905))THEN + LHASET = 90905 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF20_as_0118_100.LHgrid' + ELSEIF((LHAINPUT .GE. 90906) .AND. (LHAINPUT .LE. 90906))THEN + LHASET = 90906 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF20_as_0120_100.LHgrid' + ELSEIF((LHAINPUT .GE. 90907) .AND. (LHAINPUT .LE. 90907))THEN + LHASET = 90907 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF20_as_0121_100.LHgrid' + ELSEIF((LHAINPUT .GE. 90908) .AND. (LHAINPUT .LE. 90908))THEN + LHASET = 90908 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF20_as_0122_100.LHgrid' + ELSEIF((LHAINPUT .GE. 90909) .AND. (LHAINPUT .LE. 90909))THEN + LHASET = 90909 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF20_as_0123_100.LHgrid' + ELSEIF((LHAINPUT .GE. 90910) .AND. (LHAINPUT .LE. 90910))THEN + LHASET = 90910 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF20_as_0124_100.LHgrid' + ELSEIF((LHAINPUT .GE. 91000) .AND. (LHAINPUT .LE. 92000)) THEN + LHASET = 91000 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF10_1000.LHpdf' + ELSEIF((LHAINPUT .GE. 93000) .AND. (LHAINPUT .LE. 94000))THEN + LHASET = 93000 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF10_1000.LHgrid' + ELSEIF((LHAINPUT .GE. 95000) .AND. (LHAINPUT .LE. 96000))THEN + LHASET = 95000 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF12_1000.LHgrid' + ELSEIF((LHAINPUT .GE. 97000) .AND. (LHAINPUT .LE. 98000))THEN + LHASET = 97000 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF20_1000.LHgrid' + ELSE + WRITE(LHAPRINT,5150) LHASET + STOP + ENDIF +!...NNPDF Family second tranche + ELSEIF((LHAINPUT .GE. 190000) .AND. (LHAINPUT .LE. 210100)) THEN + XMIN = 1.0D-9 + Q2MIN = 2.0D0 + Q2MAX = 1.0D08 + IF((LHAINPUT .GE. 190000) .AND. (LHAINPUT .LE. 190100))THEN + LHASET = 190000 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF20_as_0114_100.LHgrid' + ELSEIF((LHAINPUT .GE. 190200) .AND. (LHAINPUT .LE. 190300))THEN + LHASET = 190200 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF20_as_0115_100.LHgrid' + ELSEIF((LHAINPUT .GE. 190400) .AND. (LHAINPUT .LE. 190500))THEN + LHASET = 190400 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF20_as_0116_100.LHgrid' + ELSEIF((LHAINPUT .GE. 190600) .AND. (LHAINPUT .LE. 190700))THEN + LHASET = 190600 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF20_as_0117_100.LHgrid' + ELSEIF((LHAINPUT .GE. 190800) .AND. (LHAINPUT .LE. 190900))THEN + LHASET = 190800 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF20_as_0118_100.LHgrid' + ELSEIF((LHAINPUT .GE. 191000) .AND. (LHAINPUT .LE. 191100))THEN + LHASET = 191000 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF20_as_0120_100.LHgrid' + ELSEIF((LHAINPUT .GE. 191200) .AND. (LHAINPUT .LE. 191300))THEN + LHASET = 191200 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF20_as_0121_100.LHgrid' + ELSEIF((LHAINPUT .GE. 191400) .AND. (LHAINPUT .LE. 191500))THEN + LHASET = 191400 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF20_as_0122_100.LHgrid' + ELSEIF((LHAINPUT .GE. 191600) .AND. (LHAINPUT .LE. 191700))THEN + LHASET = 191600 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF20_as_0123_100.LHgrid' + ELSEIF((LHAINPUT .GE. 191800) .AND. (LHAINPUT .LE. 191900))THEN + LHASET = 191800 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF20_as_0124_100.LHgrid' + ELSEIF((LHAINPUT .GE. 192000) .AND. (LHAINPUT .LE. 192100))THEN + LHASET = 192000 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF20_heraold_100.LHgrid' + ELSEIF((LHAINPUT .GE. 192200) .AND. (LHAINPUT .LE. 192300))THEN + LHASET = 192200 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF20_dis_100.LHgrid' + ELSEIF((LHAINPUT .GE. 192400) .AND. (LHAINPUT .LE. 192500))THEN + LHASET = 192400 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF20_dis+dy_100.LHgrid' + ELSEIF((LHAINPUT .GE. 192600) .AND. (LHAINPUT .LE. 192700))THEN + LHASET = 192600 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF20_dis+jet_100.LHgrid' + ELSEIF((LHAINPUT .GE. 192800) .AND. (LHAINPUT .LE. 192900))THEN + LHASET = 192800 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF21_100.LHgrid' + ELSEIF((LHAINPUT .GE. 192901) .AND. (LHAINPUT .LE. 193901))THEN + LHASET = 192901 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF21_1000.LHgrid' + ELSEIF((LHAINPUT .GE. 194000) .AND. (LHAINPUT .LE. 194100))THEN + LHASET = 194000 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF21_as_0114_100.LHgrid' + ELSEIF((LHAINPUT .GE. 194200) .AND. (LHAINPUT .LE. 194300))THEN + LHASET = 194200 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF21_as_0115_100.LHgrid' + ELSEIF((LHAINPUT .GE. 194400) .AND. (LHAINPUT .LE. 194500))THEN + LHASET = 194400 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF21_as_0116_100.LHgrid' + ELSEIF((LHAINPUT .GE. 194600) .AND. (LHAINPUT .LE. 194700))THEN + LHASET = 194600 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF21_as_0117_100.LHgrid' + ELSEIF((LHAINPUT .GE. 194800) .AND. (LHAINPUT .LE. 194900))THEN + LHASET = 194800 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF21_as_0118_100.LHgrid' + ELSEIF((LHAINPUT .GE. 195000) .AND. (LHAINPUT .LE. 195100))THEN + LHASET = 195000 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF21_as_0120_100.LHgrid' + ELSEIF((LHAINPUT .GE. 195200) .AND. (LHAINPUT .LE. 195300))THEN + LHASET = 195200 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF21_as_0121_100.LHgrid' + ELSEIF((LHAINPUT .GE. 195400) .AND. (LHAINPUT .LE. 195500))THEN + LHASET = 195400 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF21_as_0122_100.LHgrid' + ELSEIF((LHAINPUT .GE. 195600) .AND. (LHAINPUT .LE. 195700))THEN + LHASET = 195600 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF21_as_0123_100.LHgrid' + ELSEIF((LHAINPUT .GE. 195800) .AND. (LHAINPUT .LE. 195900))THEN + LHASET = 195800 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF21_as_0124_100.LHgrid' + ELSEIF((LHAINPUT .GE. 196000) .AND. (LHAINPUT .LE. 196100))THEN + LHASET = 196000 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF21_mc_15_100.LHgrid' + ELSEIF((LHAINPUT .GE. 196200) .AND. (LHAINPUT .LE. 196300))THEN + LHASET = 196200 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF21_mc_16_100.LHgrid' + ELSEIF((LHAINPUT .GE. 196400) .AND. (LHAINPUT .LE. 196500))THEN + LHASET = 196400 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF21_mc_17_100.LHgrid' + ELSEIF((LHAINPUT .GE. 196600) .AND. (LHAINPUT .LE. 196700))THEN + LHASET = 196600 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF21_mb_425_100.LHgrid' + ELSEIF((LHAINPUT .GE. 196800) .AND. (LHAINPUT .LE. 196900))THEN + LHASET = 196800 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF21_mb_45_100.LHgrid' + ELSEIF((LHAINPUT .GE. 197000) .AND. (LHAINPUT .LE. 197100))THEN + LHASET = 197000 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF21_mb_50_100.LHgrid' + ELSEIF((LHAINPUT .GE. 197200) .AND. (LHAINPUT .LE. 197300))THEN + LHASET = 197200 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF21_mb_525_100.LHgrid' + ELSEIF((LHAINPUT .GE. 197400) .AND. (LHAINPUT .LE. 197500))THEN + LHASET = 197400 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF21_FFN_NF3_100.LHgrid' + ELSEIF((LHAINPUT .GE. 197600) .AND. (LHAINPUT .LE. 197700))THEN + LHASET = 197600 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF21_FFN_NF4_100.LHgrid' + ELSEIF((LHAINPUT .GE. 197800) .AND. (LHAINPUT .LE. 197900))THEN + LHASET = 197800 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF21_FFN_NF5_100.LHgrid' + ELSEIF((LHAINPUT .GE. 198000) .AND. (LHAINPUT .LE. 198100))THEN + LHASET = 198000 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF21_dis_100.LHgrid' + ELSEIF((LHAINPUT .GE. 198101) .AND. (LHAINPUT .LE. 199101))THEN + LHASET = 198101 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF21_dis_1000.LHgrid' + ELSEIF((LHAINPUT .GE. 199200) .AND. (LHAINPUT .LE. 199300))THEN + LHASET = 199200 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF21_dis+dy_100.LHgrid' + ELSEIF((LHAINPUT .GE. 199400) .AND. (LHAINPUT .LE. 199500))THEN + LHASET = 199400 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF21_dis+jet_100.LHgrid' + ELSEIF((LHAINPUT .GE. 200000) .AND. (LHAINPUT .LE.200100))THEN + LHASET = 200000 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF21_nnlo_100.LHgrid' + ELSEIF((LHAINPUT .GE. 200200) .AND. (LHAINPUT .LE.200300))THEN + LHASET = 200200 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF21_lo_as_0119_100.LHgrid' + ELSEIF((LHAINPUT .GE. 200400) .AND. (LHAINPUT .LE.200500))THEN + LHASET = 200400 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF21_lo_as_0130_100.LHgrid' + ELSEIF((LHAINPUT .GE. 200600) .AND. (LHAINPUT .LE.200700))THEN + LHASET = 200600 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF21_lostar_as_0119_100.LHgrid' + ELSEIF((LHAINPUT .GE. 200800) .AND. (LHAINPUT .LE.200900))THEN + LHASET = 200800 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF21_lostar_as_0130_100.LHgrid' + ELSEIF((LHAINPUT .GE. 201000) .AND. (LHAINPUT .LE.202000))THEN + LHASET = 201000 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF21_nnlo_1000.LHgrid' + ELSEIF((LHAINPUT .GE. 203000) .AND. (LHAINPUT .LE.203100))THEN + LHASET = 203000 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF21_nnlo_as_0114_100.LHgrid' + ELSEIF((LHAINPUT .GE. 203200) .AND. (LHAINPUT .LE.203300))THEN + LHASET = 203200 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF21_nnlo_as_0115_100.LHgrid' + ELSEIF((LHAINPUT .GE. 203400) .AND. (LHAINPUT .LE.203500))THEN + LHASET = 203400 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF21_nnlo_as_0116_100.LHgrid' + ELSEIF((LHAINPUT .GE. 203600) .AND. (LHAINPUT .LE.203700))THEN + LHASET = 203600 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF21_nnlo_as_0117_100.LHgrid' + ELSEIF((LHAINPUT .GE. 203800) .AND. (LHAINPUT .LE.203900))THEN + LHASET = 203800 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF21_nnlo_as_0118_100.LHgrid' + ELSEIF((LHAINPUT .GE. 204000) .AND. (LHAINPUT .LE.204100))THEN + LHASET = 204000 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF21_nnlo_as_0120_100.LHgrid' + ELSEIF((LHAINPUT .GE. 204200) .AND. (LHAINPUT .LE.204300))THEN + LHASET = 204200 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF21_nnlo_as_0121_100.LHgrid' + ELSEIF((LHAINPUT .GE. 204400) .AND. (LHAINPUT .LE.204500))THEN + LHASET = 204400 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF21_nnlo_as_0122_100.LHgrid' + ELSEIF((LHAINPUT .GE. 204600) .AND. (LHAINPUT .LE.204700))THEN + LHASET = 204600 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF21_nnlo_as_0123_100.LHgrid' + ELSEIF((LHAINPUT .GE. 204800) .AND. (LHAINPUT .LE.204900))THEN + LHASET = 204800 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF21_nnlo_as_0124_100.LHgrid' + ELSEIF((LHAINPUT .GE. 205000) .AND. (LHAINPUT .LE.205100))THEN + LHASET = 205000 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF21_nnlo_mc_15_100.LHgrid' + ELSEIF((LHAINPUT .GE. 205200) .AND. (LHAINPUT .LE.205300))THEN + LHASET = 205200 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF21_nnlo_mc_16_100.LHgrid' + ELSEIF((LHAINPUT .GE. 205400) .AND. (LHAINPUT .LE.205500))THEN + LHASET = 205400 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF21_nnlo_mc_17_100.LHgrid' + ELSEIF((LHAINPUT .GE. 206000) .AND. (LHAINPUT .LE.206100))THEN + LHASET = 206000 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF21_nnlo_mb_425_100.LHgrid' + ELSEIF((LHAINPUT .GE. 206200) .AND. (LHAINPUT .LE.206300))THEN + LHASET = 206200 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF21_nnlo_mb_45_100.LHgrid' + ELSEIF((LHAINPUT .GE. 206400) .AND. (LHAINPUT .LE.206500))THEN + LHASET = 206400 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF21_nnlo_mb_50_100.LHgrid' + ELSEIF((LHAINPUT .GE. 206600) .AND. (LHAINPUT .LE.206700))THEN + LHASET = 206600 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF21_nnlo_mb_525_100.LHgrid' + ELSEIF((LHAINPUT .GE. 207000) .AND. (LHAINPUT .LE.207100))THEN + LHASET = 207000 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF21_nnlo_dis_100.LHgrid' + ELSEIF((LHAINPUT .GE. 207200) .AND. (LHAINPUT .LE.207300))THEN + LHASET = 207200 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF21_nnlo_dis+dy_100.LHgrid' + ELSEIF((LHAINPUT .GE. 207400) .AND. (LHAINPUT .LE.207500))THEN + LHASET = 207400 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF21_nnlo_heraonly_100.LHgrid' + ELSEIF((LHAINPUT .GE. 207600) .AND. (LHAINPUT .LE.207700))THEN + LHASET = 207600 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF21_nnlo_collider_100.LHgrid' + ELSEIF((LHAINPUT .GE. 207800) .AND. (LHAINPUT .LE.207900))THEN + LHASET = 207800 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF21_nnlo_nf5_100.LHgrid' + ELSEIF((LHAINPUT .GE. 210000) .AND. (LHAINPUT .LE.210100))THEN + LHASET = 210000 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF22_nlo_100.LHgrid' + ELSE + WRITE(LHAPRINT,5150) LHASET + STOP + ENDIF +!...NNPDF 2.3 Family + ELSEIF((LHAINPUT .GE. 229000) .AND. (LHAINPUT .LE. 246700)) THEN + XMIN = 1.0D-9 + Q2MIN = 2.0D0 + Q2MAX = 1.0D08 + + IF((LHAINPUT .GE. 229000) .AND. (LHAINPUT .LE. 229100))THEN + LHASET = 229000 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nlo_as_0114.LHgrid' + ELSEIF((LHAINPUT .GE. 229200) .AND. (LHAINPUT .LE. 229300))THEN + LHASET = 229200 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nlo_as_0115.LHgrid' + ELSEIF((LHAINPUT .GE. 229400) .AND. (LHAINPUT .LE. 229500))THEN + LHASET = 229400 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nlo_as_0116.LHgrid' + ELSEIF((LHAINPUT .GE. 229600) .AND. (LHAINPUT .LE. 229700))THEN + LHASET = 229600 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nlo_as_0117.LHgrid' + ELSEIF((LHAINPUT .GE. 229800) .AND. (LHAINPUT .LE. 229900))THEN + LHASET = 229800 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nlo_as_0118.LHgrid' + ELSEIF((LHAINPUT .GE. 230000) .AND. (LHAINPUT .LE. 230100))THEN + LHASET = 230000 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nlo_as_0119.LHgrid' + ELSEIF((LHAINPUT .GE. 230200) .AND. (LHAINPUT .LE. 230300))THEN + LHASET = 230200 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nlo_as_0120.LHgrid' + ELSEIF((LHAINPUT .GE. 230400) .AND. (LHAINPUT .LE. 230500))THEN + LHASET = 230400 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nlo_as_0121.LHgrid' + ELSEIF((LHAINPUT .GE. 230600) .AND. (LHAINPUT .LE. 230700))THEN + LHASET = 230600 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nlo_as_0122.LHgrid' + ELSEIF((LHAINPUT .GE. 230800) .AND. (LHAINPUT .LE. 230900))THEN + LHASET = 230800 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nlo_as_0123.LHgrid' + ELSEIF((LHAINPUT .GE. 231000) .AND. (LHAINPUT .LE. 231100))THEN + LHASET = 231000 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nlo_as_0124.LHgrid' + + ELSEIF((LHAINPUT .GE. 231200) .AND. (LHAINPUT .LE. 231300))THEN + LHASET = 231200 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nnlo_as_0114.LHgrid' + ELSEIF((LHAINPUT .GE. 231400) .AND. (LHAINPUT .LE. 231500))THEN + LHASET = 231400 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nnlo_as_0115.LHgrid' + ELSEIF((LHAINPUT .GE. 231600) .AND. (LHAINPUT .LE. 231700))THEN + LHASET = 231600 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nnlo_as_0116.LHgrid' + ELSEIF((LHAINPUT .GE. 231800) .AND. (LHAINPUT .LE. 231900))THEN + LHASET = 231800 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nnlo_as_0117.LHgrid' + ELSEIF((LHAINPUT .GE. 232000) .AND. (LHAINPUT .LE. 232100))THEN + LHASET = 232000 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nnlo_as_0118.LHgrid' + ELSEIF((LHAINPUT .GE. 232200) .AND. (LHAINPUT .LE. 232300))THEN + LHASET = 232200 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nnlo_as_0119.LHgrid' + ELSEIF((LHAINPUT .GE. 232400) .AND. (LHAINPUT .LE. 232500))THEN + LHASET = 232400 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nnlo_as_0120.LHgrid' + ELSEIF((LHAINPUT .GE. 232600) .AND. (LHAINPUT .LE. 232700))THEN + LHASET = 232600 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nnlo_as_0121.LHgrid' + ELSEIF((LHAINPUT .GE. 232800) .AND. (LHAINPUT .LE. 232900))THEN + LHASET = 232800 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nnlo_as_0122.LHgrid' + ELSEIF((LHAINPUT .GE. 233000) .AND. (LHAINPUT .LE. 233100))THEN + LHASET = 233000 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nnlo_as_0123.LHgrid' + ELSEIF((LHAINPUT .GE. 233200) .AND. (LHAINPUT .LE. 233300))THEN + LHASET = 233200 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nnlo_as_0124.LHgrid' + + ELSEIF((LHAINPUT .GE. 233400) .AND. (LHAINPUT .LE. 233500))THEN + LHASET = 233400 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nlo_noLHC_as_0116.LHgrid' + ELSEIF((LHAINPUT .GE. 233600) .AND. (LHAINPUT .LE. 233700))THEN + LHASET = 233600 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nlo_noLHC_as_0117.LHgrid' + ELSEIF((LHAINPUT .GE. 233800) .AND. (LHAINPUT .LE. 233900))THEN + LHASET = 233800 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nlo_noLHC_as_0118.LHgrid' + ELSEIF((LHAINPUT .GE. 234000) .AND. (LHAINPUT .LE. 234100))THEN + LHASET = 234000 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nlo_noLHC_as_0119.LHgrid' + ELSEIF((LHAINPUT .GE. 234200) .AND. (LHAINPUT .LE. 234300))THEN + LHASET = 234200 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nlo_noLHC_as_0120.LHgrid' + + ELSEIF((LHAINPUT .GE. 234400) .AND. (LHAINPUT .LE. 234500))THEN + LHASET = 234400 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nnlo_noLHC_as_0116.LHgrid' + ELSEIF((LHAINPUT .GE. 234600) .AND. (LHAINPUT .LE. 234700))THEN + LHASET = 234600 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nnlo_noLHC_as_0117.LHgrid' + ELSEIF((LHAINPUT .GE. 234800) .AND. (LHAINPUT .LE. 234900))THEN + LHASET = 234800 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nnlo_noLHC_as_0118.LHgrid' + ELSEIF((LHAINPUT .GE. 235000) .AND. (LHAINPUT .LE. 235100))THEN + LHASET = 235000 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nnlo_noLHC_as_0119.LHgrid' + ELSEIF((LHAINPUT .GE. 235200) .AND. (LHAINPUT .LE. 235300))THEN + LHASET = 235200 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nnlo_noLHC_as_0120.LHgrid' + + ELSEIF((LHAINPUT .GE. 235400) .AND. (LHAINPUT .LE. 235500))THEN + LHASET = 235400 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nlo_collider_as_0116.LHgrid' + ELSEIF((LHAINPUT .GE. 235600) .AND. (LHAINPUT .LE. 235700))THEN + LHASET = 235600 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nlo_collider_as_0117.LHgrid' + ELSEIF((LHAINPUT .GE. 235800) .AND. (LHAINPUT .LE. 235900))THEN + LHASET = 235800 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nlo_collider_as_0118.LHgrid' + ELSEIF((LHAINPUT .GE. 236000) .AND. (LHAINPUT .LE. 236100))THEN + LHASET = 236000 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nlo_collider_as_0119.LHgrid' + ELSEIF((LHAINPUT .GE. 236200) .AND. (LHAINPUT .LE. 236300))THEN + LHASET = 236200 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nlo_collider_as_0120.LHgrid' + + ELSEIF((LHAINPUT .GE. 236400) .AND. (LHAINPUT .LE. 236500))THEN + LHASET = 236400 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nnlo_collider_as_0116.LHgrid' + ELSEIF((LHAINPUT .GE. 236600) .AND. (LHAINPUT .LE. 236700))THEN + LHASET = 236600 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nnlo_collider_as_0117.LHgrid' + ELSEIF((LHAINPUT .GE. 236800) .AND. (LHAINPUT .LE. 236900))THEN + LHASET = 236800 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nnlo_collider_as_0118.LHgrid' + ELSEIF((LHAINPUT .GE. 237000) .AND. (LHAINPUT .LE. 237100))THEN + LHASET = 237000 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nnlo_collider_as_0119.LHgrid' + ELSEIF((LHAINPUT .GE. 237200) .AND. (LHAINPUT .LE. 237300))THEN + LHASET = 237200 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nnlo_collider_as_0120.LHgrid' + + ELSEIF((LHAINPUT .GE. 237400) .AND. (LHAINPUT .LE. 237500))THEN + LHASET = 237400 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nlo_FFN_NF4_as_0116.LHgrid' + ELSEIF((LHAINPUT .GE. 237600) .AND. (LHAINPUT .LE. 237700))THEN + LHASET = 237600 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nlo_FFN_NF4_as_0117.LHgrid' + ELSEIF((LHAINPUT .GE. 237800) .AND. (LHAINPUT .LE. 237900))THEN + LHASET = 237800 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nlo_FFN_NF4_as_0118.LHgrid' + ELSEIF((LHAINPUT .GE. 238000) .AND. (LHAINPUT .LE. 238100))THEN + LHASET = 238000 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nlo_FFN_NF4_as_0119.LHgrid' + ELSEIF((LHAINPUT .GE. 238200) .AND. (LHAINPUT .LE. 238300))THEN + LHASET = 238200 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nlo_FFN_NF4_as_0120.LHgrid' + + ELSEIF((LHAINPUT .GE. 238400) .AND. (LHAINPUT .LE. 238500))THEN + LHASET = 238400 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nnlo_FFN_NF4_as_0116.LHgrid' + ELSEIF((LHAINPUT .GE. 238600) .AND. (LHAINPUT .LE. 238700))THEN + LHASET = 238600 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nnlo_FFN_NF4_as_0117.LHgrid' + ELSEIF((LHAINPUT .GE. 238800) .AND. (LHAINPUT .LE. 238900))THEN + LHASET = 238800 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nnlo_FFN_NF4_as_0118.LHgrid' + ELSEIF((LHAINPUT .GE. 239000) .AND. (LHAINPUT .LE. 239100))THEN + LHASET = 239000 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nnlo_FFN_NF4_as_0119.LHgrid' + ELSEIF((LHAINPUT .GE. 239200) .AND. (LHAINPUT .LE. 239300))THEN + LHASET = 239200 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nnlo_FFN_NF4_as_0120.LHgrid' + + ELSEIF((LHAINPUT .GE. 239400) .AND. (LHAINPUT .LE. 239500))THEN + LHASET = 239400 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nlo_FFN_NF5_as_0116.LHgrid' + ELSEIF((LHAINPUT .GE. 239600) .AND. (LHAINPUT .LE. 239700))THEN + LHASET = 239600 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nlo_FFN_NF5_as_0117.LHgrid' + ELSEIF((LHAINPUT .GE. 239800) .AND. (LHAINPUT .LE. 239900))THEN + LHASET = 239800 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nlo_FFN_NF5_as_0118.LHgrid' + ELSEIF((LHAINPUT .GE. 240000) .AND. (LHAINPUT .LE. 240100))THEN + LHASET = 240000 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nlo_FFN_NF5_as_0119.LHgrid' + ELSEIF((LHAINPUT .GE. 240200) .AND. (LHAINPUT .LE. 240300))THEN + LHASET = 240200 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nlo_FFN_NF5_as_0120.LHgrid' + + ELSEIF((LHAINPUT .GE. 240400) .AND. (LHAINPUT .LE. 240500))THEN + LHASET = 240400 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nnlo_FFN_NF5_as_0116.LHgrid' + ELSEIF((LHAINPUT .GE. 240600) .AND. (LHAINPUT .LE. 240700))THEN + LHASET = 240600 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nnlo_FFN_NF5_as_0117.LHgrid' + ELSEIF((LHAINPUT .GE. 240800) .AND. (LHAINPUT .LE. 240900))THEN + LHASET = 240800 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nnlo_FFN_NF5_as_0118.LHgrid' + ELSEIF((LHAINPUT .GE. 241000) .AND. (LHAINPUT .LE. 241100))THEN + LHASET = 241000 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nnlo_FFN_NF5_as_0119.LHgrid' + ELSEIF((LHAINPUT .GE. 241200) .AND. (LHAINPUT .LE. 241300))THEN + LHASET = 241200 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nnlo_FFN_NF5_as_0120.LHgrid' + + ELSEIF((LHAINPUT .GE. 241400) .AND. (LHAINPUT .LE. 241500))THEN + LHASET = 241400 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nlo_as_0116_mc.LHgrid' + ELSEIF((LHAINPUT .GE. 241600) .AND. (LHAINPUT .LE. 241700))THEN + LHASET = 241600 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nlo_as_0117_mc.LHgrid' + ELSEIF((LHAINPUT .GE. 241800) .AND. (LHAINPUT .LE. 241900))THEN + LHASET = 241800 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nlo_as_0118_mc.LHgrid' + ELSEIF((LHAINPUT .GE. 242000) .AND. (LHAINPUT .LE. 242100))THEN + LHASET = 242000 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nlo_as_0119_mc.LHgrid' + ELSEIF((LHAINPUT .GE. 242200) .AND. (LHAINPUT .LE. 242300))THEN + LHASET = 242200 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nlo_as_0120_mc.LHgrid' + + ELSEIF((LHAINPUT .GE. 242400) .AND. (LHAINPUT .LE. 242500))THEN + LHASET = 242400 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nlo_FFN_NF4_as_0116_mc.LHgrid' + ELSEIF((LHAINPUT .GE. 242600) .AND. (LHAINPUT .LE. 242700))THEN + LHASET = 242600 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nlo_FFN_NF4_as_0117_mc.LHgrid' + ELSEIF((LHAINPUT .GE. 242800) .AND. (LHAINPUT .LE. 242900))THEN + LHASET = 242800 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nlo_FFN_NF4_as_0118_mc.LHgrid' + ELSEIF((LHAINPUT .GE. 243000) .AND. (LHAINPUT .LE. 243100))THEN + LHASET = 243000 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nlo_FFN_NF4_as_0119_mc.LHgrid' + ELSEIF((LHAINPUT .GE. 243200) .AND. (LHAINPUT .LE. 243300))THEN + LHASET = 243200 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nlo_FFN_NF4_as_0120_mc.LHgrid' + + ELSEIF((LHAINPUT .GE. 243400) .AND. (LHAINPUT .LE. 243500))THEN + LHASET = 243400 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nlo_FFN_NF5_as_0116_mc.LHgrid' + ELSEIF((LHAINPUT .GE. 243600) .AND. (LHAINPUT .LE. 243700))THEN + LHASET = 243600 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nlo_FFN_NF5_as_0117_mc.LHgrid' + ELSEIF((LHAINPUT .GE. 243800) .AND. (LHAINPUT .LE. 243900))THEN + LHASET = 243800 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nlo_FFN_NF5_as_0118_mc.LHgrid' + ELSEIF((LHAINPUT .GE. 244000) .AND. (LHAINPUT .LE. 244100))THEN + LHASET = 244000 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nlo_FFN_NF5_as_0119_mc.LHgrid' + ELSEIF((LHAINPUT .GE. 244200) .AND. (LHAINPUT .LE. 244300))THEN + LHASET = 244200 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nlo_FFN_NF5_as_0120_mc.LHgrid' + + ELSEIF((LHAINPUT .GE. 244400) .AND. (LHAINPUT .LE. 244500))THEN + LHASET = 244400 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nlo_as_0117_qed.LHgrid' + ELSEIF((LHAINPUT .GE. 244600) .AND. (LHAINPUT .LE. 244700))THEN + LHASET = 244600 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nlo_as_0118_qed.LHgrid' + ELSEIF((LHAINPUT .GE. 244800) .AND. (LHAINPUT .LE. 244900))THEN + LHASET = 244800 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nlo_as_0119_qed.LHgrid' + + ELSEIF((LHAINPUT .GE. 245000) .AND. (LHAINPUT .LE. 245100))THEN + LHASET = 245000 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nlo_as_0117_qed_neutron.LHgrid' + ELSEIF((LHAINPUT .GE. 245200) .AND. (LHAINPUT .LE. 245300))THEN + LHASET = 245200 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nlo_as_0118_qed_neutron.LHgrid' + ELSEIF((LHAINPUT .GE. 245400) .AND. (LHAINPUT .LE. 245500))THEN + LHASET = 245400 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nlo_as_0119_qed_neutron.LHgrid' + + ELSEIF((LHAINPUT .GE. 245600) .AND. (LHAINPUT .LE. 245700))THEN + LHASET = 245600 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nnlo_as_0117_qed.LHgrid' + ELSEIF((LHAINPUT .GE. 245800) .AND. (LHAINPUT .LE. 245900))THEN + LHASET = 245800 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nnlo_as_0118_qed.LHgrid' + ELSEIF((LHAINPUT .GE. 246000) .AND. (LHAINPUT .LE. 246100))THEN + LHASET = 246000 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nnlo_as_0119_qed.LHgrid' + ELSEIF((LHAINPUT .GE. 246200) .AND. (LHAINPUT .LE. 246300))THEN + LHASET = 246200 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nnlo_as_0117_qed_neutron.LHgrid' + ELSEIF((LHAINPUT .GE. 246400) .AND. (LHAINPUT .LE. 246500))THEN + LHASET = 246400 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nnlo_as_0118_qed_neutron.LHgrid' + ELSEIF((LHAINPUT .GE. 246600) .AND. (LHAINPUT .LE. 246700))THEN + LHASET = 246600 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDF23_nnlo_as_0119_qed_neutron.LHgrid' + + ELSE + WRITE(LHAPRINT,5150) LHASET + STOP + ENDIF +!...NNPDF Pol Family + ELSEIF((LHAINPUT .GE. 250000) .AND. (LHAINPUT .LE. 250100)) THEN + XMIN = 1.0D-9 + Q2MIN = 2.0D0 + Q2MAX = 1.0D08 + IF((LHAINPUT .GE. 250000) .AND. (LHAINPUT .LE. 250100))THEN + LHASET = 250000 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/NNPDFpol10_100.LHgrid' + ELSE + WRITE(LHAPRINT,5150) LHASET + STOP + ENDIF +!...User defined sets + ELSEIF((LHAINPUT .GE. 99002) .AND. (LHAINPUT .LE. 99004)) THEN + XMIN = 1.0D-9 + Q2MIN = 1.0D0 + Q2MAX = 1.0D09 + IF((LHAINPUT .GE.99002) .AND. (LHAINPUT .LE. 99002)) THEN + LHASET = 99002 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/USERGRIDQ2.LHgrid' + ELSEIF((LHAINPUT .GE. 99003) .AND. (LHAINPUT .LE. 99003))THEN + LHASET = 99003 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/USERGRIDQ3.LHgrid' + ELSEIF((LHAINPUT .GE. 99004) .AND. (LHAINPUT .LE. 99004))THEN + LHASET = 99004 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/USERGRIDQ4.LHgrid' + ELSE + WRITE(LHAPRINT,5150) LHASET + STOP + ENDIF +!...Nuclear PDFs HKN sets + ELSEIF((LHAINPUT .GE. 100050) .AND. (LHAINPUT .LE. 100169)) THEN + XMIN = 1.0D-9 + Q2MIN = 1.0D0 + Q2MAX = 1.0D08 + IF((LHAINPUT .GE.100050) .AND. (LHAINPUT .LE. 100069)) THEN + LHASET = 100050 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/HKNlo.LHgrid' + ELSEIF((LHAINPUT .GE. 100150) .AND. (LHAINPUT .LE. 100169))THEN + LHASET =100150 + LHANAME=LHAPATH(1:LHAPATHLEN)//'/HKNnlo.LHgrid' + ELSE + WRITE(LHAPRINT,5150) LHASET + STOP + ENDIF + ! + ! Pions + ! + ! OW-PI Family + elseif((lhainput .ge. 210) .and. (lhainput .le. 212)) then + q2min = 4.0d0 + q2max = 2.0d03 + xmin = 5.0d-03 + xmax = 0.9998d0 + if((lhainput .ge. 210) .and. (lhainput .le. 212)) then + lhaset = 210 + lhaname=lhapath(1:lhapathlen)//'/OWPI.LHgrid' + else + write(lhaprint,5150) lhaset + stop + endif + ! SMRS-PI Family + elseif((lhainput .ge. 230) .and. (lhainput .le. 233)) then + q2min = 5.0d0 + q2max = 1.31d06 + xmin = 1.0d-05 + xmax = 0.9998d0 + if((lhainput .ge. 230) .and. (lhainput .le. 233)) then + lhaset = 230 + lhaname=lhapath(1:lhapathlen)//'/SMRSPI.LHgrid' + else + write(lhaprint,5150) lhaset + stop + endif + ! GRV-PI Family + elseif((lhainput .ge. 250) .and. (lhainput .le. 252)) then + q2max = 1.00d06 + xmin = 1.0d-05 + xmax = 0.9998d0 + if((lhainput .ge. 250) .and. (lhainput .le. 251)) then + q2min = 3.0d-1 + lhaset = 250 + lhaname=lhapath(1:lhapathlen)//'/GRVPI1.LHgrid' + elseif((lhainput .ge. 252) .and. (lhainput .le. 252)) then + q2min = 2.5d-1 + lhaset = 252 + lhaname=lhapath(1:lhapathlen)//'/GRVPI0.LHgrid' + else + write(lhaprint,5150) lhaset + stop + endif + ! ABFKW-PI Family + elseif((lhainput .ge. 260) .and. (lhainput .le. 263)) then + q2min = 2.0d0 + q2max = 1.00d08 + xmin = 1.0d-03 + xmax = 0.9998d0 + if((lhainput .ge. 260) .and. (lhainput .le. 263)) then + lhaset = 260 + lhaname=lhapath(1:lhapathlen)//'/ABFKWPI.LHgrid' + else + write(lhaprint,5150) lhaset + stop + endif + ! + ! photons + ! + ! DO-G Family + elseif((lhainput .ge. 310) .and. (lhainput .le. 312)) then + q2min = 1.0d01 + q2max = 1.00d04 + xmin = 1.0d-05 + xmax = 0.9d0 + if((lhainput .ge. 310) .and. (lhainput .le. 311)) then + lhaset = 310 + lhaname=lhapath(1:lhapathlen)//'/DOG0.LHgrid' + elseif((lhainput .ge. 312) .and. (lhainput .le. 312)) then + lhaset = 312 + lhaname=lhapath(1:lhapathlen)//'/DOG1.LHgrid' + else + write(lhaprint,5150) lhaset + stop + endif + ! DG-G Family + elseif((lhainput .ge. 320) .and. (lhainput .le. 324)) then + xmin = 1.0d-05 + xmax = 0.9998d0 + lhaset = 320 + if((lhainput .ge. 320) .and. (lhainput .le. 321)) then + q2min = 1.0d0 + q2max = 1.0d04 + ! lhaset = 320 + lhaname=lhapath(1:lhapathlen)//'/DGG.LHgrid' + elseif((lhainput .ge. 322) .and. (lhainput .le. 322)) then + q2min = 1.0d0 + q2max = 5.0d01 + ! lhaset = 322 + lhaname=lhapath(1:lhapathlen)//'/DGG.LHgrid' + elseif((lhainput .ge. 323) .and. (lhainput .le. 323)) then + q2min = 2.0d1 + q2max = 5.0d02 + ! lhaset = 323 + lhaname=lhapath(1:lhapathlen)//'/DGG.LHgrid' + elseif((lhainput .ge. 324) .and. (lhainput .le. 324)) then + q2min = 2.0d2 + q2max = 1.0d04 + ! lhaset = 324 + lhaname=lhapath(1:lhapathlen)//'/DGG.LHgrid' + else + write(lhaprint,5150) lhaset + stop + endif + ! LAC/GAL-G Family + elseif((lhainput .ge. 330) .and. (lhainput .le. 334)) then + q2min = 4.0d00 + q2max = 1.0d05 + xmin = 1.0d-04 + xmax = 0.9998d0 + lhaset = 330 + if((lhainput .ge. 330) .and. (lhainput .le. 332)) then + ! lhaset = 330 + lhaname=lhapath(1:lhapathlen)//'/LACG.LHgrid' + elseif((lhainput .ge. 333) .and. (lhainput .le. 333)) then + q2min = 1.0d00 + ! lhaset = 333 + lhaname=lhapath(1:lhapathlen)//'/LACG.LHgrid' + elseif((lhainput .ge. 334) .and. (lhainput .le. 334)) then + q2min = 4.0d00 + ! lhaset = 334 + lhaname=lhapath(1:lhapathlen)//'/LACG.LHgrid' + else + write(lhaprint,5150) lhaset + stop + endif + ! GSG/GSG96-G Family + elseif((lhainput .ge. 340) .and. (lhainput .le. 345)) then + q2min = 5.3d00 + q2max = 1.0d08 + xmin = 5.0d-04 + xmax = 0.9998d0 + if((lhainput .ge. 340) .and. (lhainput .le. 341)) then + lhaset = 340 + lhaname=lhapath(1:lhapathlen)//'/GSG1.LHgrid' + elseif((lhainput .ge. 342) .and. (lhainput .le. 343)) then + lhaset = 341 + lhaname=lhapath(1:lhapathlen)//'/GSG0.LHgrid' + elseif((lhainput .ge. 344) .and. (lhainput .le. 344)) then + lhaset = 344 + lhaname=lhapath(1:lhapathlen)//'/GSG961.LHgrid' + elseif((lhainput .ge. 345) .and. (lhainput .le. 345)) then + lhaset = 345 + lhaname=lhapath(1:lhapathlen)//'/GSG960.LHgrid' + else + write(lhaprint,5150) lhaset + stop + endif + ! GRV-G Family + elseif((lhainput .ge. 350) .and. (lhainput .le. 354)) then + q2min = 3.0d-1 + q2max = 1.0d06 + xmin = 1.0d-05 + xmax = 0.9998d0 + if((lhainput .ge. 350) .and. (lhainput .le. 352)) then + lhaset = 350 + lhaname=lhapath(1:lhapathlen)//'/GRVG1.LHgrid' + elseif((lhainput .ge. 353) .and. (lhainput .le. 353)) then + q2min = 2.5d-1 + lhaset = 352 + lhaname=lhapath(1:lhapathlen)//'/GRVG0.LHgrid' + elseif((lhainput .ge. 354) .and. (lhainput .le. 354)) then + q2min = 6.0d-1 + q2max = 5.0d04 + lhaset = 352 + lhaname=lhapath(1:lhapathlen)//'/GRVG0.LHgrid' + else + write(lhaprint,5150) lhaset + stop + endif + ! ACFGP-G Family + elseif((lhainput .ge. 360) .and. (lhainput .le. 363)) then + q2min = 2.0d00 + q2max = 5.5d05 + xmin = 1.37d-03 + xmax = 0.9998d0 + if((lhainput .ge. 360) .and. (lhainput .le. 363)) then + lhaset = 360 + lhaname=lhapath(1:lhapathlen)//'/ACFGPG.LHgrid' + else + write(lhaprint,5150) lhaset + stop + endif + ! WHIT-G Family + elseif((lhainput .ge. 380) .and. (lhainput .le. 386)) then + q2min = 4.0d00 + q2max = 2.5d03 + xmin = 1.0d-03 + xmax = 0.9998d0 + if((lhainput .ge. 380) .and. (lhainput .le. 386)) then + lhaset = 380 + lhaname=lhapath(1:lhapathlen)//'/WHITG.LHgrid' + else + write(lhaprint,5150) lhaset + stop + endif + ! SAS-G Family + elseif ((lhainput .ge. 390) .and. (lhainput .le. 398)) then + q2max = 5.0d04 + xmin = 1.0d-05 + xmax = 0.9998d0 + lhaset = 390 + if ((lhainput .ge. 390) .and. (lhainput .le. 392)) then + q2min = 3.6d-1 + ! lhaset = 390 + lhaname=lhapath(1:lhapathlen)//'/SASG.LHgrid' + elseif((lhainput .ge. 393) .and. (lhainput .le. 394)) then + q2min = 4.0d00 + ! lhaset = 393 + lhaname=lhapath(1:lhapathlen)//'/SASG.LHgrid' + elseif((lhainput .ge. 395) .and. (lhainput .le. 396)) then + q2min = 3.6d-1 + ! lhaset = 395 + lhaname=lhapath(1:lhapathlen)//'/SASG.LHgrid' + elseif((lhainput .ge. 397) .and. (lhainput .le. 398)) then + q2min = 4.0d00 + ! lhaset = 397 + lhaname=lhapath(1:lhapathlen)//'/SASG.LHgrid' + else + write(lhaprint,5150) lhaset + stop + endif + ! Unknown Family ?! Giving up + else + write(lhaprint,5150) lhaset + stop + endif + + lhamemb=lhainput-lhaset + ! Now work out if we have already called this set/member + iset = 0 + do j=1,nsets + if (lhaname.eq.lhanames(j).and. & + lhamemb.eq.lhamembers(j)) then + iset = j + endif + enddo + if (iset.eq.0) then + nsets=nsets+1 + if (nsets.gt.nmxset) then + if (LHASILENT.ne.1) then + print *, "WARNING: too many sets initialised" + print *,"overwriting from set 1 again" + endif + nsets = 1 + ! stop + endif + iset=nsets + lhanames(iset)=lhaname + lhanumbers(iset)=lhainput + lhamembers(iset)=lhamemb + xxmin(iset)=xmin + xxmax(iset)=xmax + qq2min(iset)=q2min + qq2max(iset)=q2max + call initpdfsetm(iset,lhaname) + call numberpdfm(iset,lhaallmem) + if(lhasilent .ne. 1) then + write(lhaprint,5151) + write(lhaprint,5152) lhaname + write(lhaprint,5153) lhaallmem + write(lhaprint,5154) + endif + if ((lhamemb.lt.0) .or. (lhamemb.gt.lhaallmem)) then + write(lhaprint,5155) lhamemb + write(lhaprint,5156) lhaallmem + stop + endif + + ! print *,'calling initpdf',lhamemb + ! print *,'calling initpdfm ',iset,lhaname,lhamemb + ! print *,'LHAGLUE .... initializing set,member ',iset,lhamemb + call initpdfm(iset,lhamemb) + endif + ! the rest is done every time pdfset is called + !print *,'setting nset to:',iset + call setnset(iset) + call setnmem(iset,lhamemb) + xmin = xxmin(iset) + xmax = xxmax(iset) + q2min=qq2min(iset) + q2max=qq2max(iset) + call GetLam4M(iset,LHAMEMB,qcdlha4) + call GetLam5M(iset,LHAMEMB,qcdlha5) + + QMZ = 91.1876D0 + alphasLHA = alphasPDFM(iset,QMZ) + if(lhasilent .ne. 1) write(lhaprint,5158) alphasLHA + + if(lhaparm(17).EQ.'LHAPDF') then + nptypepdfl = 1 ! Proton PDFs + nflpdfl = 4 + qcdl4 = qcdlha4 + qcdl5 = qcdlha5 + if (LHASILENT .NE. 1) write(lhaprint,5159) qcdl4, qcdl5 + else + nptypepdfl = 1 ! Proton PDFs + nflpdfl = 4 + alambda = 0.192d0 + qcdlha4 = alambda + qcdlha5 = alambda + if (parm(1).EQ.'NPTYPE') then ! PYTHIA + qcdl4 = alambda + qcdl5 = alambda + endif + endif + + + if(parm(1).EQ.'NPTYPE') then ! herwig + axmin = xmin + axmax = xmax + aq2min = q2min + aq2max = q2max + endif + + ! Formats for initialization information. +5150 format(1X,'WRONG LHAPDF set number =',I12,' given! STOP EXE!') +5151 format(1X,'==============================================') +5152 format(1X,'PDFset name ',A80) +5153 format(1X,'with ',I10,' members') +5154 format(1X,'==== initialized. ===========================') +5155 format(1X,'LHAPDF problem => YOU asked for member = ',I10) +5156 format(1X,'Valid range is: 0 - ',I10,' Execution stopped.') + !5157 format(1X,'Number of flavors for PDF is:',I4) +5158 format(1X,'Strong coupling at Mz for PDF is:',F9.5) +5159 format(1X,'Will use for PYTHIA QCDL4, QCDL5:',2F9.5) + + return +end subroutine pdfset + + +!******************************************************************** +! -- STRUCTA +! -- copy of PDFLIB to use the eks98 nuclear correction factors + +subroutine structa(x,q,a,upv,dnv,usea,dsea,str,chm,bot,top,glu) + implicit double precision (a-h,o-z) + character*20 lparm + call getlhaparm(15,lparm) + if(lparm.eq.'EPS08') then + call eps08(x,q,a,ruv,rdv,ru,rd,rs,rc,rb,rt,rg) + else if (lparm(1:5).eq.'EPS09') then + if (lparm.eq.'EPS09LO') then + iorder=1 + ipset=1 + else if (lparm.eq.'EPS09NLO') then + iorder=2 + ipset=1 + else if (lparm(1:8).eq.'EPS09LO,') then + iorder=1 + read(lparm(9:),*)ipset + else if (lparm(1:9).eq.'EPS09NLO,') then + iorder=2 + read(lparm(10:),*)ipset + else + iorder=2 + ipset=1 + endif + ia=a + call eps09(iorder,ipset,ia,x,q,ruv,rdv,ru,rd,rs,rc,rb,rg) + rt=1.0d0 + else + call eks98(x,q,a,ruv,rdv,ru,rd,rs,rc,rb,rt,rg) + endif + call structm(x,q,upv,dnv,usea,dsea,str,chm,bot,top,glu) + upv = ruv*upv + dnv = rdv*dnv + usea = ru*usea + dsea = rd*dsea + str = rs*str + chm = rc*chm + bot = rb*bot + top = rt*top + glu = rg*glu + return +end subroutine structa + + +!********************************************************************* +! STRUCTM +! Gives parton distributions according to the LHAPDF interface. +! Two evolution codes used: +! EVLCTEQ for CTEQ PDF sets +! QCDNUM for Other PDF sets +! +! Author: Dimitri Bourilkov bourilkov@mailaps.org +! +! v4.0 21-Mar-2005 Photon/pion/new p PDFs, updated for LHAPDF v4 +! v3.0 23-Jan-2004 +! +! interface to LHAPDF library +subroutine structm(dx,dq,upv,dnv,usea,dsea,str,chm,bot,top,glu) + ! double precision and integer declarations. + implicit double precision(a-h, o-z) + implicit integer(i-n) + ! Common blocks + include 'commonlhapdf.inc' + include 'commonlhasets.inc' + include 'commonlhacontrol.inc' + include 'commonlhaglsta.inc' + ! commonblocks. +! common/pydat1/mstu(200),paru(200),mstj(200),parj(200) +! save /pydat1/ + ! interface to lhapdflib. + double precision qcdlha4, qcdlha5 + integer nfllha + common/lhapdfr/qcdlha4, qcdlha5, nfllha + save /lhapdfr/ + integer lhaextrp + common/lhapdfe/lhaextrp + save /lhapdfe/ + ! interface to pdflib. + common/w50513/xmin,xmax,q2min,q2max + save /w50513/ + double precision xmin,xmax,q2min,q2max + ! local variables + double precision upv,dnv,usea,dsea,str,chm,bot,top,glu + double precision dx,dq,x,q,f(-6:6),photon,gluino + + x = dx + q = dq + q2 = q**2 + ! statistics + if(lhaparm(16).ne.'NOSTAT') then + totnum = totnum+1.d0 + if(x .lt. xmin) xminnum = xminnum+1.d0 + if(x .gt. xmax) xmaxnum = xmaxnum+1.d0 + if(q2 .lt. q2min) q2minnum = q2minnum+1.d0 + if(q2 .gt. q2max) q2maxnum = q2maxnum+1.d0 + endif + + ! range of validity e.g. 10^-6 < x < 1, q2min < q^2 extended by + ! freezing x*f(x,q2) at borders. + if(lhaextrp .ne. 1) then ! safe mode == "freeze" + xin=max(xmin,min(xmax,x)) + q=sqrt(max(0d0,q2min,min(q2max,q2))) + else ! adventurous mode == own risk ! + xin=x + endif + + call getnset(iset) + !print *,'calling evolvepdfm:',iset + + ! fix to allow STRUCTM to work for photon PDFs (Herwig does this) + ! set P2 = 0.0d0 and IP2 = 0 + if(lhanumbers(iset).ge.300.and.lhanumbers(iset).le.399) then + p2 = 0.0d0 + ip2 = 0 + call evolvepdfpm(iset,xin,q,p2,ip2,f) + else if (lhanumbers(iset).ge.20460.and.lhanumbers(iset).le.20462) then + call evolvepdfphotonm(iset,xin,q,f,photon) + else if (lhanumbers(iset).ge.10670.and.lhanumbers(iset).le.10677) then + call evolvepdfgluinom(iset,xin,q,f,gluino) + else + call evolvepdfm(iset,xin,q,f) + endif + glu = f(0) + dsea = f(-1) + dnv = f(1) - dsea + usea = f(-2) + upv = f(2) - usea + str = f(3) + chm = f(4) + bot = f(5) + top = f(6) + + return +end subroutine structm + + +!********************************************************************* +! STRUCTP +! Gives parton distributions according to the LHAPDF interface. +! Used for photons. +! +! v4.0 21-Mar-2005 Photon/pion/new p PDFs, updated for LHAPDF v4 +! +! Interface to LHAPDF library +subroutine structp(dx,dq2,p2,ip2,upv,dnv,usea,dsea,str,chm,bot,top,glu) + ! Double precision and integer declarations. + implicit double precision(a-h, o-z) + implicit integer(i-n) + ! Common blocks + include 'parmsetup.inc' + include 'commonlhapdf.inc' + include 'commonlhacontrol.inc' + include 'commonlhaglsta.inc' + ! Commonblocks. +! common/pydat1/mstu(200),paru(200),mstj(200),parj(200) +! save /pydat1/ + ! Interface to LHAPDFLIB. + double precision qcdlha4, qcdlha5 + integer nfllha + common/lhapdfr/qcdlha4, qcdlha5, nfllha + save /lhapdfr/ + integer lhaextrp + common/lhapdfe/lhaextrp + save /lhapdfe/ + ! Interface to PDFLIB. + common/w50513/xmin,xmax,q2min,q2max + save /w50513/ + double precision xmin,xmax,q2min,q2max + ! Local variables + double precision upv,dnv,usea,dsea,str,chm,bot,top,glu + double precision dx,dq2,q2,x,q,f(-6:6) + + x = dx + q2 = dq2 + ! Statistics + if(lhaparm(16).ne.'NOSTAT') then + totnup = totnup+1.d0 + if(x .lt. xmin) xminnup = xminnup+1.d0 + if(x .gt. xmax) xmaxnup = xmaxnup+1.d0 + if(q2 .lt. q2min) q2minnup = q2minnup+1.d0 + if(q2 .gt. q2max) q2maxnup = q2maxnup+1.d0 + endif + + ! Range of validity e.g. 10^-6 < x < 1, Q2MIN < Q^2 extended by + ! freezing x*f(x,Q2) at borders. + q = dsqrt(q2) + if(lhaextrp .ne. 1) then ! safe mode == "freeze" + xin=max(xmin,min(xmax,x)) + q=sqrt(max(0d0,q2min,min(q2max,q2))) + else ! adventurous mode == OWN RISK ! + xin=x + endif + call getnset(iset) + call evolvepdfpm(iset,xin,q,p2,ip2,f) + glu = f(0) + dsea = f(-1) + dnv = f(1) - dsea + usea = f(-2) + upv = f(2) - usea + str = f(3) + chm = f(4) + bot = f(5) + top = f(6) + return +end subroutine structp + + +!********************************************************************* +! PDFSTA +! For statistics ON structure functions (under/over-flows) +! +! Author: Dimitri Bourilkov bourilkov@mailaps.org +! +! +! first introduced in v4.0 28-Apr-2005 +! +subroutine pdfsta + ! Double precision and integer declarations. + implicit double precision(a-h, o-z) + implicit integer(i-n) + ! Common blocks + include 'commonlhaglsta.inc' + ! Interface to LHAPDFLIB. + + print * + print *,'===== PDFSTA statistics for PDF under/over-flows ====' + print * + print *,'====== STRUCTM statistics for nucleon/pion PDFs =====' + print * + print *,' total # of calls ',TOTNUM + if(totnum .gt. 0.d0) then + percbelow = 100.d0*xminnum/totnum + percabove = 100.d0*xmaxnum/totnum + print *,' X below PDF min ',xminnum,' or ',percbelow, ' %' + print *,' X above PDF max ',xmaxnum,' or ',percabove, ' %' + percbelow = 100.d0*q2minnum/totnum + percabove = 100.d0*q2maxnum/totnum + print *,' Q2 below PDF min ',q2minnum,' or ',percbelow, ' %' + print *,' Q2 above PDF max ',q2maxnum,' or ',percabove, ' %' + endif + print * + print *,'========= STRUCTP statistics for photon PDFs ========' + print * + print *,' total # of calls ',totnup + if(totnup .gt. 0.d0) then + percbelow = 100.d0*xminnup/totnup + percabove = 100.d0*xmaxnup/totnup + print *,' X below PDF min ',xminnup,' or ',percbelow, ' %' + print *,' X above PDF max ',xmaxnup,' or ',percabove, ' %' + percbelow = 100.d0*q2minnup/totnup + percabove = 100.d0*q2maxnup/totnup + print *,' Q2 below PDF min ',q2minnup,' or ',percbelow, ' %' + print *,' Q2 above PDF max ',q2maxnup,' or ',percabove, ' %' + endif + print * + return +end subroutine pdfsta + + +subroutine pftopdg(dx,dscale,dxpdf) + !include "pdf/expdp.inc" + double precision dx,dscale,dupv,ddnv,dusea,ddsea,dstr,dchm,dbot,dtop,dgl,dxpdf(-6:6) + ! Call STRUCTM in PDFLIB to get flavour content + call structm(dx,dscale,dupv,ddnv,dusea,ddsea,dstr,dchm,dbot,dtop,dgl) + ! Convert flavour convention of PDFLIB to PDG convention + dxpdf(0) = dgl + dxpdf(1) = ddnv + ddsea + dxpdf(2) = dupv + dusea + dxpdf(3) = dstr + dxpdf(4) = dchm + dxpdf(5) = dbot + dxpdf(6) = dtop + dxpdf(-1) = ddsea + dxpdf(-2) = dusea + dxpdf(-3) = dstr + dxpdf(-4) = dchm + dxpdf(-5) = dbot + dxpdf(-6) = dtop + return +end subroutine pftopdg diff --git a/LHAPDF/lhapdf-5.9.1/src/parameter.F b/LHAPDF/lhapdf-5.9.1/src/parameter.F new file mode 100644 index 00000000000..67549fca115 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/parameter.F @@ -0,0 +1,124 @@ +! -*- F90 -*- + + +subroutine numberPDF(noe) + implicit none + integer nset,noe + nset = 1 + call numberPDFM(nset,noe) + return +end subroutine numberPDF + + +subroutine listPDF(nset, imem, parm) + implicit none + include 'parmsetup.inc' + character*16 name(nmxset) + integer nmem(nmxset),ndef(nmxset) + common/NAME/name,nmem,ndef,mem + character*16 s1 + integer i,j,mem,imem,noe,nop,listN(nmxset),listP(nmxset),type + double precision parmL(nmxset,0:noemax,nopmax),parm(nopmax) + integer nset + save listN,listP,parmL +#ifdef NNPDF +! nnpdf variables + integer MXPDF + parameter(MXPDF=13) + integer NTOTPDF + parameter(NTOTPDF=5) + integer MXPAR + parameter(MXPAR=2e2) + integer MXL,MXN + parameter(MXL=5,MXN=10) + integer IPAR,IPDF,IDUM + integer NPAR(MXPDF) + integer MXREP + parameter(MXREP=1e3) + real*8 PARTR(MXPAR,0:MXREP,MXPDF) + real*8 ANORMTR(MXPDF,0:MXREP) + common/nnpdf10CPARTR/PARTR,ANORMTR +! +#endif + mem=imem + if (mem.gt.listN(nset)) then + write(*,*) 'Maximum number of PDFs in list exceeded: ', mem,' > ',listN + write(*,*) 'Returning most likely PDF' + mem=0 + endif + if (mem.lt.0) then + write(*,*) 'Negative PDF member requested: ', mem + write(*,*) 'Returning most likely PDF' + mem=0 + endif + do i=1,listP(nset) + parm(i)=parmL(nset,mem,i) + enddo + return + + entry nopPDF(nset,nop) + nop=listP(nset) + return + + entry numberPDFM(nset, noe) + if ( NAME(nset).eq.'MRSTgrid' .or. NAME(nset).eq.'MRST98grid' & + .or. NAME(nset).eq.'A02' .or. NAME(nset).eq.'A02M' & + .or. NAME(nset).eq.'ABKM09' .or. NAME(nset).eq.'ABM11' & + .or. NAME(nset).eq.'CTEQ5grid' .or. NAME(nset).eq.'CTEQ6grid' & + .or. NAME(nset).eq.'CTEQ65grid' .or. NAME(nset).eq.'CTEQ66grid' & + .or. NAME(nset).eq.'CTEQ65cgrid' .or. NAME(nset).eq.'CTEQ6ABgrid' & + .or. NAME(nset).eq.'SASG' .or. NAME(nset).eq.'GRVG' & + .or. NAME(nset).eq.'DOG' .or. NAME(nset).eq.'DGG' & + .or. NAME(nset).eq.'LACG' .or. NAME(nset).eq.'GSG' & + .or. NAME(nset).eq.'GSG96' .or. NAME(nset).eq.'ACFGP' & + .or. NAME(nset).eq.'WHITG' .or. NAME(nset).eq.'OWP' & + .or. NAME(nset).eq.'SMRSP' .or. NAME(nset).eq.'GRVP' & + .or. NAME(nset).eq.'ABFKWP' .or. NAME(nset).eq.'ZEUSGRID' & + .or. NAME(nset)(1:5).eq.'GJR08' .or. NAME(nset).eq.'NNPDFint' & + .or. NAME(nset).eq.'HKNgrid' & + .or. NAME(nset).eq.'CT12grid' & + !.or. NAME.eq.'H12000' & + !.or. NAME.eq.'GRV' & + ) then + noe = nmem(nset) + else + noe=listN(nset) + endif + return + + entry InitListPDF(nset) + type=-1 + read(1,*) s1,listN(nset),listP(nset) + !print *,s1,listN(nset),listP(nset) + if (index(s1,'list').eq.1) then + type=1 + do i=0,listN(nset) + read(1,*) (parmL(nset,i,j),j=1,listP(nset)) + !print *,i,(parmL(nset,i,j),j=1,listP(nset)) + enddo + !print *,parmL(nset,0,1) +! +#ifdef NNPDF + elseif (index(s1,'nnpar').eq.1) then + type=2 ! is type=2 ok? + + do i=0,listN(nset) + read(1,*)idum + if(idum.ne.i)write(*,*)"error in InitListPDF" + do ipdf = 1,listP(nset) + read(1,*) npar(ipdf) + read(1,*) anormtr(ipdf,i) + do ipar = 1,npar(ipdf) + read(1,*) partr(ipar,i,ipdf) + enddo + enddo + enddo +#endif + endif + if (type.lt.0) then + write(*,*) 'File description error:' + write(*,*) 'Unknown parameter list type ',s1 + stop + endif + return +end subroutine listPDF diff --git a/LHAPDF/lhapdf-5.9.1/src/parameter.f b/LHAPDF/lhapdf-5.9.1/src/parameter.f new file mode 100644 index 00000000000..67549fca115 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/parameter.f @@ -0,0 +1,124 @@ +! -*- F90 -*- + + +subroutine numberPDF(noe) + implicit none + integer nset,noe + nset = 1 + call numberPDFM(nset,noe) + return +end subroutine numberPDF + + +subroutine listPDF(nset, imem, parm) + implicit none + include 'parmsetup.inc' + character*16 name(nmxset) + integer nmem(nmxset),ndef(nmxset) + common/NAME/name,nmem,ndef,mem + character*16 s1 + integer i,j,mem,imem,noe,nop,listN(nmxset),listP(nmxset),type + double precision parmL(nmxset,0:noemax,nopmax),parm(nopmax) + integer nset + save listN,listP,parmL +#ifdef NNPDF +! nnpdf variables + integer MXPDF + parameter(MXPDF=13) + integer NTOTPDF + parameter(NTOTPDF=5) + integer MXPAR + parameter(MXPAR=2e2) + integer MXL,MXN + parameter(MXL=5,MXN=10) + integer IPAR,IPDF,IDUM + integer NPAR(MXPDF) + integer MXREP + parameter(MXREP=1e3) + real*8 PARTR(MXPAR,0:MXREP,MXPDF) + real*8 ANORMTR(MXPDF,0:MXREP) + common/nnpdf10CPARTR/PARTR,ANORMTR +! +#endif + mem=imem + if (mem.gt.listN(nset)) then + write(*,*) 'Maximum number of PDFs in list exceeded: ', mem,' > ',listN + write(*,*) 'Returning most likely PDF' + mem=0 + endif + if (mem.lt.0) then + write(*,*) 'Negative PDF member requested: ', mem + write(*,*) 'Returning most likely PDF' + mem=0 + endif + do i=1,listP(nset) + parm(i)=parmL(nset,mem,i) + enddo + return + + entry nopPDF(nset,nop) + nop=listP(nset) + return + + entry numberPDFM(nset, noe) + if ( NAME(nset).eq.'MRSTgrid' .or. NAME(nset).eq.'MRST98grid' & + .or. NAME(nset).eq.'A02' .or. NAME(nset).eq.'A02M' & + .or. NAME(nset).eq.'ABKM09' .or. NAME(nset).eq.'ABM11' & + .or. NAME(nset).eq.'CTEQ5grid' .or. NAME(nset).eq.'CTEQ6grid' & + .or. NAME(nset).eq.'CTEQ65grid' .or. NAME(nset).eq.'CTEQ66grid' & + .or. NAME(nset).eq.'CTEQ65cgrid' .or. NAME(nset).eq.'CTEQ6ABgrid' & + .or. NAME(nset).eq.'SASG' .or. NAME(nset).eq.'GRVG' & + .or. NAME(nset).eq.'DOG' .or. NAME(nset).eq.'DGG' & + .or. NAME(nset).eq.'LACG' .or. NAME(nset).eq.'GSG' & + .or. NAME(nset).eq.'GSG96' .or. NAME(nset).eq.'ACFGP' & + .or. NAME(nset).eq.'WHITG' .or. NAME(nset).eq.'OWP' & + .or. NAME(nset).eq.'SMRSP' .or. NAME(nset).eq.'GRVP' & + .or. NAME(nset).eq.'ABFKWP' .or. NAME(nset).eq.'ZEUSGRID' & + .or. NAME(nset)(1:5).eq.'GJR08' .or. NAME(nset).eq.'NNPDFint' & + .or. NAME(nset).eq.'HKNgrid' & + .or. NAME(nset).eq.'CT12grid' & + !.or. NAME.eq.'H12000' & + !.or. NAME.eq.'GRV' & + ) then + noe = nmem(nset) + else + noe=listN(nset) + endif + return + + entry InitListPDF(nset) + type=-1 + read(1,*) s1,listN(nset),listP(nset) + !print *,s1,listN(nset),listP(nset) + if (index(s1,'list').eq.1) then + type=1 + do i=0,listN(nset) + read(1,*) (parmL(nset,i,j),j=1,listP(nset)) + !print *,i,(parmL(nset,i,j),j=1,listP(nset)) + enddo + !print *,parmL(nset,0,1) +! +#ifdef NNPDF + elseif (index(s1,'nnpar').eq.1) then + type=2 ! is type=2 ok? + + do i=0,listN(nset) + read(1,*)idum + if(idum.ne.i)write(*,*)"error in InitListPDF" + do ipdf = 1,listP(nset) + read(1,*) npar(ipdf) + read(1,*) anormtr(ipdf,i) + do ipar = 1,npar(ipdf) + read(1,*) partr(ipar,i,ipdf) + enddo + enddo + enddo +#endif + endif + if (type.lt.0) then + write(*,*) 'File description error:' + write(*,*) 'Unknown parameter list type ',s1 + stop + endif + return +end subroutine listPDF diff --git a/LHAPDF/lhapdf-5.9.1/src/parmsetup.inc b/LHAPDF/lhapdf-5.9.1/src/parmsetup.inc new file mode 100644 index 00000000000..90ffe931e40 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/parmsetup.inc @@ -0,0 +1,16 @@ +! nopmax is the maximum number of PDF parameters one can use. +! noemax is the maximum number of PDF's in a list. +! npfmax is the maximum number of functional parameters +! nofmax is the maximum number of functionals +! linemax is the maximum number of lines in pdf description text +! +! When changing the parameters make sure the 'make' recompiles all +! affected *.f files +! + integer noemax,nopmax,npfmax,nofmax,linemax,nmxset + parameter (noemax=1000,nopmax=40,npfmax=10,nofmax=10,linemax=20) +! nmxset is the max number of sets that can be initialised at one time ---- added V5 + parameter (nmxset=3) + integer nmxgridx,nmxgridq + parameter (nmxgridx=200,nmxgridq=200) + diff --git a/LHAPDF/lhapdf-5.9.1/src/parmsetup.inc.in b/LHAPDF/lhapdf-5.9.1/src/parmsetup.inc.in new file mode 100644 index 00000000000..96df91b8045 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/parmsetup.inc.in @@ -0,0 +1,16 @@ +! nopmax is the maximum number of PDF parameters one can use. +! noemax is the maximum number of PDF's in a list. +! npfmax is the maximum number of functional parameters +! nofmax is the maximum number of functionals +! linemax is the maximum number of lines in pdf description text +! +! When changing the parameters make sure the 'make' recompiles all +! affected *.f files +! + integer noemax,nopmax,npfmax,nofmax,linemax,nmxset + parameter (noemax=1000,nopmax=40,npfmax=10,nofmax=10,linemax=20) +! nmxset is the max number of sets that can be initialised at one time ---- added V5 + parameter (nmxset=@NMXSET@) + integer nmxgridx,nmxgridq + parameter (nmxgridx=200,nmxgridq=200) + diff --git a/LHAPDF/lhapdf-5.9.1/src/uncertainties.f b/LHAPDF/lhapdf-5.9.1/src/uncertainties.f new file mode 100644 index 00000000000..9288c1de0fd --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/uncertainties.f @@ -0,0 +1,205 @@ +! -*- F90 -*- + +!-- 31/05/2012 by Graeme Watt . +!-- Calculation of PDF uncertainties and PDF correlations. +!-- +!-- Use formulae for PDF uncertainties and correlations in: +!-- G. Watt, JHEP 1109 (2011) 069 [arXiv:1106.5788 [hep-ph]]. +!-- Code should distinguish between NNPDF (Monte Carlo approach), +!-- Alekhin02/ABKM09/ABM11 (symmetric Hessian approach). Other +!-- PDF sets are assumed to use the asymmetric Hessian approach. +!-- List of subroutines in this file: +!-- GetMaxNumSets(MaxNumSets) +!-- GetPDFUncType(lMonteCarlo,lSymmetric) +!-- GetPDFUncTypeM(nset,lMonteCarlo,lSymmetric) +!-- GetPDFuncertainty(values,central,errplus,errminus,errsym) +!-- GetPDFuncertaintyM(nset,values,central,errplus,errminus,errsym) +!-- GetPDFcorrelation(valuesA,valuesB,correlation) +!-- GetPDFcorrelationM(nset,valuesA,valuesB,correlation) +!-- Input variables above are nset, values, valuesA, valuesB. +!-- Other arguments above are all output variables. + + +!-- Get flags indicating if Monte Carlo PDF set (NNPDF) and +!-- if should compute symmetric errors (NNPDF, Alekhin). + +subroutine GetPDFUncType(lMonteCarlo,lSymmetric) + implicit none + logical lMonteCarlo,lSymmetric + integer nset + nset = 1 + call GetPDFUncTypeM(nset,lMonteCarlo,lSymmetric) + return +end subroutine GetPDFUncType + +subroutine GetPDFUncTypeM(nset,lMonteCarlo,lSymmetric) + implicit none + include 'parmsetup.inc' + logical lMonteCarlo,lSymmetric + character*16 name(nmxset) + integer nset,nmem(nmxset),ndef(nmxset),mem + common/NAME/name,nmem,ndef,mem + if ((name(nset).eq.'NNPDF').or.(name(nset).eq.'NNPDFint').or. & + (name(nset).eq.'NNPDF20int').or.(name(nset).eq.'NNPDF20intqed')) then ! NNPDF Monte Carlo PDF sets + lMonteCarlo = .true. + lSymmetric = .true. + else if ((name(nset).eq.'A02M').or.(name(nset).eq.'ABKM09').or. & + (name(nset).eq.'ABM11')) then ! symmetric eigenvector PDF sets + lMonteCarlo = .false. + lSymmetric = .true. + else ! default: assume asymmetric Hessian eigenvector PDF sets + lMonteCarlo = .false. + lSymmetric = .false. + end if +end subroutine GetPDFUncTypeM + + +!-- Calculate the PDF uncertainty using the appropriate formula for +!-- either the Hessian or Monte Carlo approach given an array +!-- "values(0:nmem)". In the Monte Carlo approach, the uncertainty is +!-- given by the standard deviation, and the central (average) value +!-- is not necessarily "values(0)" for quantities with a non-linear +!-- dependence on PDFs. In the Hessian approach, the central value is +!-- the best-fit "values(0)" and the uncertainty is given by either +!-- the symmetric or asymmetric formula using eigenvector PDF sets. + +subroutine GetPDFuncertainty(values, & + & central,errplus,errminus,errsym) + implicit none + integer nset + double precision values(0:*),central,errplus,errminus,errsym + nset = 1 + call GetPDFuncertaintyM(nset,values, & + & central,errplus,errminus,errsym) + return +end subroutine GetPDFuncertainty + + +subroutine GetPDFuncertaintyM(nset,values, & + & central,errplus,errminus,errsym) + implicit none + integer nset,nmem,imem + double precision values(0:*),central,errplus,errminus,errsym + logical lMonteCarlo,lSymmetric + + call numberPDFM(nset,nmem) + call GetPDFUncTypeM(nset,lMonteCarlo,lSymmetric) + + central = 0.D0 ! central value + errplus = 0.D0 ! positive uncertainty + errminus = 0.D0 ! negative uncertainty + errsym = 0.D0 ! symmetrised uncertainty + + if (lMonteCarlo) then ! calculate average and standard deviation + + do imem = 1, nmem + central = central + values(imem) + errsym = errsym + values(imem)**2 + end do + central = central/nmem ! mean of values + errsym = errsym/nmem ! mean of squared values + errsym = nmem/(nmem-1.D0)*(errsym-central**2) + if (errsym.gt.0.D0) then + errsym = sqrt(errsym) + else + errsym = 0.D0 + end if + errplus = errsym + errminus = errsym + + else if (lSymmetric) then ! symmetric Hessian eigenvector PDF sets + + do imem = 1, nmem + errsym = errsym + (values(imem)-values(0))**2 + end do + errsym = sqrt(errsym) + errplus = errsym + errminus = errsym + central = values(0) + + else ! default: assume asymmetric Hessian eigenvector PDF sets + + !-- check that nmem is non-zero and even + if (nmem.ne.0.and.(mod(nmem,2).eq.0)) then + do imem = 1, nmem/2 ! sum over eigenvectors + errplus = errplus + max(0.D0, & + & values(2*imem-1)-values(0), & + & values(2*imem)-values(0))**2 + errminus = errminus + max(0.D0, & + & values(0)-values(2*imem-1), & + & values(0)-values(2*imem))**2 + errsym = errsym + (values(2*imem-1)-values(2*imem))**2 + end do + errplus = sqrt(errplus) + errminus = sqrt(errminus) + errsym = 0.5D0*sqrt(errsym) + end if + central = values(0) + + end if + + return +end subroutine GetPDFuncertaintyM + + +!-- Calculate the PDF correlation using the appropriate formula for +!-- either the Hessian or Monte Carlo approach given two arrays +!-- "valuesA(0:nmem)" and "valuesB(0:nmem)". The correlation can vary +!-- between -1 and +1 where values close to {-1,0,+1} mean that the two +!-- quantities A and B are {anticorrelated,uncorrelated,correlated}. + +subroutine GetPDFcorrelation(valuesA,valuesB,correlation) + implicit none + integer nset + double precision valuesA(0:*),valuesB(0:*),correlation + nset = 1 + call GetPDFcorrelationM(nset,valuesA,valuesB,correlation) + return +end subroutine GetPDFcorrelation + +subroutine GetPDFcorrelationM(nset,valuesA,valuesB,correlation) + implicit none + integer nset,nmem,imem + double precision valuesA(0:*),valuesB(0:*),correlation + double precision A0,Ap,Am,As,B0,Bp,Bm,Bs + logical lMonteCarlo,lSymmetric + + call numberPDFM(nset,nmem) + call GetPDFUncTypeM(nset,lMonteCarlo,lSymmetric) + + call GetPDFuncertaintyM(nset,valuesA,A0,Ap,Am,As) + call GetPDFuncertaintyM(nset,valuesB,B0,Bp,Bm,Bs) + + correlation = 0.D0 + + if (lMonteCarlo) then ! calculate average and standard deviation + + do imem = 1, nmem + correlation = correlation + valuesA(imem)*valuesB(imem) + end do + correlation = (correlation/nmem - A0*B0)/(As*Bs)*nmem/(nmem-1.D0) + + else if (lSymmetric) then ! symmetric Hessian eigenvector PDF sets + + do imem = 1, nmem + correlation = correlation + & + & (valuesA(imem)-A0)*(valuesB(imem)-B0) + end do + correlation = correlation/(As*Bs) + + else ! default: assume asymmetric Hessian eigenvector PDF sets + + !-- check that nmem is non-zero and even + if (nmem.ne.0.and.(mod(nmem,2).eq.0)) then + do imem = 1, nmem/2 ! sum over eigenvectors + correlation = correlation + & + & (valuesA(2*imem-1)-valuesA(2*imem)) * & + & (valuesB(2*imem-1)-valuesB(2*imem)) + end do + correlation = correlation/(4.D0*As*Bs) + end if + + end if + + return +end subroutine GetPDFcorrelationM diff --git a/LHAPDF/lhapdf-5.9.1/src/version.cxx b/LHAPDF/lhapdf-5.9.1/src/version.cxx new file mode 100644 index 00000000000..c9bb3785ec3 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/version.cxx @@ -0,0 +1,25 @@ +#include "LHAPDF/FortranWrappers.h" +#include "LHAPDF/LHAPDFConfig.h" +#include +#include +#include + +using namespace std; + +#ifndef LHAPDF_VERSION +#define LHAPDF_VERSION "5.x.x" +#endif + + +extern "C" { + + #define fgetlhapdfversion FC_FUNC(getlhapdfversion, GETLHAPDFVERSION) + void fgetlhapdfversion(char* fversion, int length) { + string version = LHAPDF_VERSION; + strncpy(fversion, version.c_str(), length); + for (size_t i = strlen(fversion); i < (unsigned) length; ++i) { + fversion[i] = ' '; + } + } + +} diff --git a/LHAPDF/lhapdf-5.9.1/src/wrapEVLCTEQ.f b/LHAPDF/lhapdf-5.9.1/src/wrapEVLCTEQ.f new file mode 100644 index 00000000000..5617aeb70c6 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/wrapEVLCTEQ.f @@ -0,0 +1,164 @@ +! -*- F90 -*- + + + subroutine EVLCTEQevolve(x,Q,f) + implicit none + include 'parmsetup.inc' + character*16 name(nmxset) + integer nmem(nmxset),ndef(nmxset),mmem + common/NAME/name,nmem,ndef,mmem + real*8 f(-6:6) + real*8 x,Q,xx,qq,up,dn,ubar,dbar,gluon,sbar,cbar,bbar,tbar,Blam + real*8 xmin,qmax,anx,anq,Q2fit,qini,Ahdn,ordi,anf,mass,pi,alfas + real*8 Q0,alfas0 + real*8 CtLhpardis,CtLhALPI,parmflavor,CtLhastolam + integer nflavor,Eorder,j,nx,nq + integer nset + data pi / 3.141592653589793d0 / + external parmflavor + save nflavor,xmin,qmax,anx,anq + +! + xx = x + qq = Q + up = xx*CtLhpardis(1,xx,qq) + dn = xx*CtLhpardis(2,xx,qq) + ubar = xx*CtLhpardis(-1,xx,qq) + dbar = xx*CtLhpardis(-2,xx,qq) + gluon= xx*CtLhpardis( 0,xx,qq) + + if(nflavor .ge. 3) then + sbar = xx*CtLhpardis(-3,xx,qq) + else + sbar = 0.d0 + endif + + if(nflavor .ge. 4) then + cbar = xx*CtLhpardis(-4,xx,qq) + else + cbar = 0.d0 + endif + + if(nflavor .ge. 5) then + bbar = xx*CtLhpardis(-5,xx,qq) + else + bbar = 0.d0 + endif + + if(nflavor .eq. 6) then + tbar = xx*CtLhpardis(-6,xx,qq) + else + tbar = 0.d0 + endif + + f(6) = tbar + f(5) = bbar + f(4) = cbar + f(3) = sbar + f(2) = up + f(1) = dn + f(0) = gluon + f(-1) = dbar + f(-2) = ubar + f(-3) = sbar + f(-4) = cbar + f(-5) = bbar + f(-6) = tbar +! + return +! + entry EVLCTEQread(nset) + call CtLhbldat1 + call CtLhbldat2 + read(1,*) xmin,qmax,nx,nq + anx=nx + anq=nq-1 + return +! + entry EVLCTEQalfa(alfas,Q) + alfas = pi*CtLhALPI(Q) + return +! + entry EVLCTEQinit(nset,Eorder,Q2fit) +! + Ahdn=1d0 + call CtLhParPdf(1,'IHDN',Ahdn,j) + call CtLhParPdf(1,'QMAX',qmax,j) + call CtLhParPdf(1,'XMIN',xmin,j) + call GetOrderAsM(nset,j) + ordi=j+1.0 + call CtLhParQcd(1,'ORDR',ordi,j) + call GetThresholdM(nset,4,mass) + call CtLhParQcd(1,'M4',mass,j) + call GetThresholdM(nset,5,mass) + call CtLhParQcd(1,'M5',mass,j) + mass=180d0 + call CtLhParQcd(1,'M6',mass,j) + call GetNfM(nset,j) + nflavor=j + Anf=nflavor + call CtLhParQcd(1,'NFL',Anf,j) + qini=sqrt(Q2fit) + call CtLhParPdf(1,'QINI',qini,j) + call CtLhEvlpar(1,'NFMX', Anf, j) + ordi=Eorder+1.0 + call CtLhParPdf(1,'IKNL',ordi,j) + return +! + entry EVLCTEQpdf(nset) + call GetOrderAsM(nset,j) + call GetAlfas(nset,alfas0,Q0) + Blam=CtLhastolam(alfas0,Q0,j+1,nflavor) + call CtLhSetLam (nflavor,Blam,j+1) + call CtLhParPdf(1,'NX',anx,j) + call CtLhParPdf(1,'NT',anq,j) + call CtLhEvolve (parmflavor,j) + if (j .ne. 0) then + write(*,*) 'EVLCTEQ Evolve Error code :',j + stop + endif + return +! + END +! + double precision function parmflavor(i,x) + implicit none + real*8 x,f(-6:6) + integer i,i0 + integer iset +! + call getnset(iset) + call parmPDF(iset,x,f) + i0=i + if (i.eq.-2) i0=-1 + if (i.eq.-1) i0=-2 + if (i.eq.1) i0=2 + if (i.eq.2) i0=1 + parmflavor=f(i0)/x + return +! + END + + function CtLhastolam(as,q,nloop,nf) + implicit double precision (a-h,o-z) + data pi / 3.141592653589793d0 / + xlp = nloop-1d0 + b = (33.0-2.0*nf)/pi/12.0 + bp = (153.0 - 19.0*nf) / pi / 2.0 / (33.0 - 2.0*nf) * xlp + t = 1.0/b/as +!----------------------------------------------------------- +! Solve the equation +! + 1 xlt = log(t) + ot = t +!----------------------------------------------------------- +! Solve the equation +! Value and Derivative of alfa with respect to t +! + as0 = 1/b/t - bp*xlt/(b*t)**2 + as1 = - 1/b/t**2 -bp/b**2*(1-2*xlt)/t**3 + t = (as-as0)/as1 + t + if(abs(ot-t)/ot.gt..00001)goto 1 + CtLhastolam = q/exp(t/2.0) + return + END diff --git a/LHAPDF/lhapdf-5.9.1/src/wrapNNPDF.f b/LHAPDF/lhapdf-5.9.1/src/wrapNNPDF.f new file mode 100644 index 00000000000..940a649dd70 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/wrapNNPDF.f @@ -0,0 +1,130 @@ +!******************************************************** +! +! wrapNNPDF.f: +! Routine called by LHAPDF package for the evolved PDF +! in a (x,Q) point as called by NNPDF.LHpdf file. +! +! In 'wrapevolve.f' the package calls: +! IF(NAME(NSET).EQ.'NNPDF') call NNPDFevolve(x,Q,f) +! IF(NAME(NSET).EQ.'NNPDF') call NNPDFread(nset) +! IF(NAME(NSET).EQ.'NNPDF') call NNPDFalfa(alfas,Q) +! IF(NAME(NSET).EQ.'NNPDF') call NNPDFinit(nset,Eorder,Q2fit) +! +! +!******************************************************** + + SUBROUTINE NNPDFevolve(x,Q,f) + IMPLICIT none +! + INCLUDE 'parmsetup.inc' + CHARACTER*16 name(nmxset) + INTEGER nmem(nmxset),ndef(nmxset),mmem + COMMON/NAME/name,nmem,ndef,mmem +! + INTEGER nset,pdfmem + REAL*8 f(-6:6) + REAL*8 x,Q +! + INTEGER order + REAL*8 alfas,alphaNNPDF,alfas0,q0 + REAL*8 Eorder,Q2fit,mass + REAL*8 pdfout(13) + REAL*8 check + REAL*8 pi + PARAMETER (pi = 3.1415926535897932385) +! + INTEGER i,nff + REAL*8 xpt +! + INTEGER ipt,imodev,ivfn,itmc + COMMON/nnpdf10EVFLAGS/ipt,imodev,ivfn,itmc + INTEGER ieval,niter,nmax + COMMON/nnpdf10ngrid/ ieval,niter,nmax + REAL*8 xmin,xm1,xm2,xmax + COMMON/nnpdf10GRID/xmin,xm1,xm2,xmax + REAL*8 epsevol + COMMON/nnpdf10evolacc/epsevol +! + REAL*8 qq,qq2,qth(4:6) + REAL*8 q20,q2 + COMMON/nnpdf10EVSCALE/q20,q2 + REAL*8 q2th(4:6),asref,q2ref + COMMON/nnpdf10vfns/q2th,asref,q2ref + REAL*8 as0,asc,asb,ast,asq + COMMON/nnpdf10AS/ as0,asc,asb,ast,asq +! + q2 = q**2. ! for the commons + qq2 = q**2. + qq = q + asq = alphaNNPDF(qq) + asq = asq / (4.*pi) +! + xpt = x + CALL lh_evolfactx(0,xpt) + CALL lh_pdfevolx(xpt,pdfout) + CALL lh_pdfevln2lha(pdfout,f) + DO i = -6,6,1 + f(i) = x * f(i) + ENDDO +! + RETURN + +!******************************************************** + + ENTRY NNPDFread(nset) +! +! Read evol params from NNPDF08.LHpdf + READ(1,*) ivfn,imodev,itmc,niter,xmin,xm1,xm2,xmax,epsevol +! + RETURN + +!******************************************************** + + ENTRY NNPDFalfa(alfas,Q) +! + QQ = Q + alfas = alphaNNPDF(QQ) +! + RETURN + +!******************************************************** + + ENTRY NNPDFinit(nset,Eorder,Q2fit) +! + CALL GetOrderPDFM(nset,order) + IPT = order +! + CALL GetQ2fitM(nset,Q2) + Q2fit = Q2 + Q20 = Q2 +! + call GetQmassM(nset,4,mass) + QTH(4) = mass + call GetQmassM(nset,5,mass) + QTH(5) = mass + call GetQmassM(nset,6,mass) + QTH(6) = mass + DO i = 4,6 + q2th(i) = qth(i)**2d0 + ENDDO +! + CALL GetAlfas(nset,alfas0,Q0) + asref = 0.119 + q2ref = q0**2d0 +! + RETURN + +!******************************************************** + + ENTRY NNPDFpdf(nset) +! + pdfmem = mmem + IF (pdfmem.LT.0) THEN + WRITE(*,*) 'NNPDF set:' + WRITE(*,*) 'PDF member out of range:' + WRITE(*,*) 'member = ',pdfmem + STOP + ENDIF + RETURN +! + END diff --git a/LHAPDF/lhapdf-5.9.1/src/wrapNNPDF20grid-lite.f b/LHAPDF/lhapdf-5.9.1/src/wrapNNPDF20grid-lite.f new file mode 100644 index 00000000000..04567922e06 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/wrapNNPDF20grid-lite.f @@ -0,0 +1,392 @@ +!*********************************************** +! +! +! wrapNNPDF20grid-lite.f +! Special low-memory version with only a single ffit .... +! Routine called by LHAPDF package for calculating +! the value of all xpdfs at x and Q from replica KREP +! in a (x,Q) point as called by NNPDF.LHgrid file. +! +! In 'wrapevolve.f' the package calls: +! IF(NAME(NSET).EQ.'NNPDF20int') call NNPDFINT20evolve(x,Q,f) +! IF(NAME(NSET).EQ.'NNPDF20int') call NNPDFINT20read(nset) +! IF(NAME(NSET).EQ.'NNPDF20int') call NNPDFINT20alfa(alfas,Q) +! IF(NAME(NSET).EQ.'NNPDF20int') call NNPDFINT20init(nset,Eorder,Q2fit)* +! +!*********************************************** + + subroutine NNPDFINT20evolve(XIN,QIN,XPDF) + IMPLICIT none +! + include 'parmsetup.inc' + character*16 name(nmxset) + character*80 line + character*512 setpath + integer nmem(nmxset),ndef(nmxset),mmem,mem + common/NAME/name,nmem,ndef,mmem + integer nset,iset,pdfmem + real*8 parm(nopmax) +! + double precision gridx(nmxgridx),gridq(nmxgridq) + integer ngridx,ngridq,jx,jq +! + INTEGER order + REAL*8 alfas,alphaNNPDF + REAL*8 Eorder,Q2fit,mass +! + INTEGER MXREP + PARAMETER(MXREP=nmxset-1) + INTEGER NREP + common/nnpdf20CNREP/NREP +! + INTEGER NX,NQ2,NPL + PARAMETER(NX=100,NQ2=50) + PARAMETER(NPL=5000) + INTEGER NXX,NQQ2 + REAL*8 Q2MIN,Q2MAX,XPDFMIN,XPDFMAX + REAL*8 XG(NX,nmxset),Q2G(NQ2,nmxset),XPDFEV(NX,NQ2,-6:6,0:MXREP) + INTEGER IX,IQ2 +! This common different from NNPDF1.X + common/nnpdf20CPDFGR/XPDFEV,XG,Q2G,IX,IQ2 + double precision XPDFMIN_INTER + parameter(XPDFMIN_INTER=1d-7) +! + INTEGER ipt,imodev,ivfn,itmc +! This common is the same as for NNPDF1.0 + COMMON/nnpdf10EVFLAGS/ipt,imodev,ivfn,itmc + REAL*8 q0,alfas0 + REAL*8 q20,qth(4:6) +! This common is the same as for NNPDF1.0 + COMMON/nnpdf10EVSCALE/q20,q2 + REAL*8 q2th(4:6),asref,q2ref +! This common is the same as for NNPDF1.0 + COMMON/nnpdf10vfns/q2th,asref,q2ref +! + INTEGER I,J,K + INTEGER IPDF,KREP + INTEGER IDUM,JDUM + REAL*8 X,XIN,Q,QIN,QAS,QQ,Q2,QQ2,XPDF(-6:6) + REAL*8 XCH + PARAMETER(XCH=1D-1) +! + integer m,n,nmax,mmax,minq,maxq,midq,maxx,minx,midx +! order of pol. interpolation + parameter(m=4,n=2) + parameter(nmax=1e3,mmax=1e3) + double precision dy,x1,x2,y,x1a(mmax),x2a(nmax),ya(mmax,nmax) + integer ix1a(m),ix2a(n) + +!-----------------newline------------ + character*512 filename + common/lhafilename/filename + double precision EPS_MC_set + parameter(EPS_MC_set=1d-7) +!-----------------newline------------ +! +! KREP = mmem +! always use the 0 element in the lite version + KREP = 0 + X = XIN + Q = QIN + +! Set correct scale + Q2=Q**2d0 + +! Check kinematic point is within allowed range + call getnset(iset) + call GetXminM(iset,KREP,XPDFMIN) + call GetXmaxM(iset,KREP,XPDFMAX) + call GetQ2maxM(iset,KREP,Q2MAX) + call GetQ2minM(iset,KREP,Q2MIN) +! + IF ( X.LT.XPDFMIN_INTER .OR. X.GT.XPDFMAX ) THEN + WRITE(6,2000) + 2000 FORMAT (2X,'PARTON INTERPOLATION: X OUT OF RANGE -- STOP') + write(6,*) "X= ",X," XMAX, XMIN = ",XPDFMAX,XPDFMIN_INTER + IF ( X.LT.XPDFMIN_INTER ) X = XPDFMIN_INTER + IF ( X.GT.XPDFMAX ) X = XPDFMAX +! call exit(-10) + ENDIF +! + IF ( Q2.LT.Q2MIN .OR. Q2.GT.Q2MAX ) THEN + WRITE(6,2001) + 2001 FORMAT (2X,'PARTON INTERPOLATION: Q2 OUT OF RANGE -- STOP') + write(6,*) "Q2 ,Q2MIN, Q2MAX = ",Q2,Q2MIN,Q2MAX + IF ( Q2.LT.Q2MIN ) Q2 = Q2MIN + IF ( Q2.GT.Q2MAX ) Q2 = Q2MAX +! call exit(-10) + ENDIF + +! FIND NEAREST POINTS IN THE GRID + MINX = 1 + MAXX = NX+1 + 10 CONTINUE + MIDX = (MINX+MAXX)/2 + IF(X.LT.XG(MIDX,iset)) THEN + MAXX=MIDX + ELSE + MINX=MIDX + END IF + IF((MAXX-MINX).GT.1) GO TO 10 + IX = MINX + + MINQ = 1 + MAXQ = NQ2+1 + 20 CONTINUE + MIDQ = (MINQ+MAXQ)/2 + IF(Q2.LT.Q2G(MIDQ,iset)) THEN + MAXQ=MIDQ + ELSE + MINQ=MIDQ + END IF + IF((MAXQ-MINQ).GT.1) GO TO 20 + IQ2 = MINQ + +! +! POLYNOMIAL INTERPOLATION +! +! uncomment for 3rd order interp. +! IF((IX+(M-1)/2).GT.NX) IX = NX - (M-1)/2 +! IF((IX-(M-1)/2).LT.1) IX = (M+1)/2 +! IDUM = 0 +! DO I = -(M-1)/2,(M-1)/2,1 +! IDUM = IDUM +1 +! IX1A(IDUM) = IX + I +! ENDDO +! IF((IQ2+(N-1)/2).GT.NQ2) IQ2 = NQ2 - (N-1)/2 +! IF((IQ2-(N-1)/2).LT.1) IQ2 = (N+1)/2 +! JDUM = 0 +! DO J = -(N-1)/2,(N-1)/2,1 +! JDUM = JDUM +1 +! IX2A(JDUM) = IQ2 + J +! ENDDO + +! Assign grid for interpolation. M, N -> order of polyN interpolation + do I=1,M + if(IX.ge.M/2.and.IX.le.(NX-M/2)) IX1A(I) = IX - M/2 + I + if(IX.lt.M/2) IX1A(I) = I + if(IX.gt.(NX-M/2)) IX1A(I) = (NX - M) + I + +! Check grids + if(IX1A(I).le.0.or.IX1A(I).gt.NX) then + write(6,*) "Error in grids! " + write(6,*) "I, IXIA(I) = ",I, IX1A(I) + call exit(-10) + endif + enddo + + do J=1,N + if(IQ2.ge.N/2.and.IQ2.le.(NQ2-N/2)) IX2A(J) = IQ2 - N/2 + J + if(IQ2.lt.N/2) IX2A(J) = J + if(IQ2.gt.(NQ2-N/2)) IX2A(J) = (NQ2 - N) + J +! Check grids + if(IX2A(J).le.0.or.IX2A(J).gt.NQ2) then + write(6,*) "Error in grids! " + write(6,*) "J, IXIA(J) = ",J,IX2A(J) + call exit(-10) + endif + enddo + +! Define points where to evaluate interpolation +! Choose between linear or logarithmic (x,Q2) interpolation + + IF(X.LT.XCH)THEN + X1=dlog(X) + ELSE + X1=X + ENDIF + X2=dlog(Q2) + + DO IPDF = -6,6,1 + +! Choose between linear or logarithmic (x,Q2) interpolation + + DO I=1,M + IF(X.LT.XCH)THEN + X1A(I)= dlog(XG(IX1A(I),iset)) + ELSE + X1A(I)= XG(IX1A(I),iset) + ENDIF + DO J=1,N + X2A(J) = dlog(Q2G(IX2A(J),iset)) + YA(I,J) = XPDFEV(IX1A(I),IX2A(J),IPDF,KREP+iset-1) + enddo + enddo + +! 2D polynomial interpolation + call lh_polin2(x1a,x2a,ya,m,n,x1,x2,y,dy) + XPDF(IPDF) = y + +!-----------------newline------------ +! Here we need a IF switch that only activates this +! when the _mc.LHgrid files are used +! +! PDF positivity for NLO MC PDFs + if(index(filename(1:len_trim(filename)),"_mc.LHgrid").gt.0) then + if( XPDF(IPDF).le.0d0 ) XPDF(IPDF)=EPS_MC_set + endif +!-----------------newline----------------------- + + enddo + + RETURN + +!******************************************************** + entry NNPDFINT20getgrid(nset,ngridx,ngridq,gridx,gridq) + do jx=1,nx + gridx(jx)=xg(jx,nset) + enddo + do jq=1,nq2 + gridq(jq)=q2g(jq,nset) + enddo + ngridx=nx + ngridq=nq2 + return +!******************************************************** + + ENTRY NNPDFINT20read(nset) +! + READ(1,*)nmem(nset),ndef(nset) + +! Set number of members + call setnmem(nset,nmem) + +! Read the grid in x + READ(1,*) nxx + IF(NXX.NE.NX)WRITE(*,*)"WARNING CHANGE NX ACCORDING TO .LHgrid" + DO ix = 1,nxx + READ(1,*) xg(ix,nset) + ENDDO + +! Read the grid in Q2 + READ(1,*) nqq2 + IF(NQQ2.NE.NQ2)WRITE(*,*)"WARNING CHANGE NQ2 ACCORDING TO .LHgrid" + READ(1,*) q2min + DO iq2 = 1,nqq2 + READ(1,*) q2g(iq2,nset) + ENDDO + +! Read the number of replicas + READ(1,*) NREP + +! Dummy read in to get to End (stream 1 is still open) + DO K=0,NREP + DO IX=1,NX + DO IQ2=1,NQ2 + READ(1,'(a)') line + ENDDO + ENDDO + ENDDO +! + RETURN + +!******************************************************** + + ENTRY NNPDFINT20alfa(alfas,QAS) +! + QQ = QAS + alfas = alphaNNPDF(QQ) +! + RETURN + +!******************************************************** + + ENTRY NNPDFINT20init(nset,Eorder,Q2fit) +! + IMODEV = 0 + IVFN = 1 + ITMC = 1 +! + CALL GetOrderPDFM(nset,order) + IPT = order +! + CALL GetQ2fitM(nset,QQ2) + Q2fit = QQ2 + Q20 = QQ2 +! + call GetQmassM(nset,4,mass) + QTH(4) = mass + call GetQmassM(nset,5,mass) + QTH(5) = mass + call GetQmassM(nset,6,mass) + QTH(6) = mass +! + DO i = 4,6 + q2th(i) = qth(i)**2d0 + ENDDO +! + ! added for filling Fparm->asref + call initEVOLVEpdf(nset,mmem) + CALL GetAlfas(nset,alfas0,Q0) + asref = alfas0 + q2ref = q0**2d0 +! + RETURN + +!******************************************************** +! + entry NNPDFINT20pdf(mem) +! have to reopen stream 1 + call getnset(iset) + call setnmem(iset,mem) + + call getsetpath(setpath) + + open(1,file=setpath(1:len_trim(setpath)),action='READ') + line = '' + do while (line(3:12).ne.'Evolution:'.or.len_trim(line).gt.15) + read(1,'(a)')line + enddo + read(1,'(a)')line + read(1,'(a)')line + + READ(1,*)nmem(iset),ndef(iset) + pdfmem = mem + IF (pdfmem.LT.0) THEN + WRITE(*,*) 'NNPDF set:' + WRITE(*,*) 'PDF member out of range:' + WRITE(*,*) 'member = ',pdfmem + STOP + ENDIF + +! Read the grid in x + READ(1,*) nxx + IF(NXX.NE.NX)WRITE(*,*)"WARNING CHANGE NX ACCORDING TO .LHgrid" + DO ix = 1,nxx + READ(1,*) xg(ix,iset) + ENDDO + +! Read the grid in Q2 + READ(1,*) nqq2 + IF(NQQ2.NE.NQ2)WRITE(*,*)"WARNING CHANGE NQ2 ACCORDING TO .LHgrid" + READ(1,*) q2min + DO iq2 = 1,nqq2 + READ(1,*) q2g(iq2,iset) + ENDDO + + READ(1,*) NREP + +! Dummy read up to the member requested the number of replicas + DO K=0,mem-1 + DO IX=1,NX + DO IQ2=1,NQ2 + READ(1,'(a)') line + ENDDO + ENDDO + ENDDO + + ! Read in the data of the requested member + DO IX=1,NX + DO IQ2=1,NQ2 + READ(1,*) ( xpdfev(ix,iq2,ipdf,0+iset-1), ipdf=-6,6,1 ) + ENDDO + ENDDO + + close(1) + RETURN +! + END + + +! THE ROUTINES FOR THE POLYNOMIAL INTERPOLATION ARE INSIDE +! THE wrapNNPDFgrid.f ROUTINE diff --git a/LHAPDF/lhapdf-5.9.1/src/wrapNNPDF20grid.f b/LHAPDF/lhapdf-5.9.1/src/wrapNNPDF20grid.f new file mode 100644 index 00000000000..589905e09cc --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/wrapNNPDF20grid.f @@ -0,0 +1,344 @@ +!*********************************************** +! +! +! wrapNNPDF20grid.f +! Routine called by LHAPDF package for calculating +! the value of all xpdfs at x and Q from replica KREP +! in a (x,Q) point as called by NNPDF.LHgrid file. +! +! In 'wrapevolve.f' the package calls: +! IF(NAME(NSET).EQ.'NNPDF20int') call NNPDFINT20evolve(x,Q,f) +! IF(NAME(NSET).EQ.'NNPDF20int') call NNPDFINT20read(nset) +! IF(NAME(NSET).EQ.'NNPDF20int') call NNPDFINT20alfa(alfas,Q) +! IF(NAME(NSET).EQ.'NNPDF20int') call NNPDFINT20init(nset,Eorder,Q2fit)* +! +!*********************************************** + + subroutine NNPDFINT20evolve(XIN,QIN,XPDF) + IMPLICIT none +! + include 'parmsetup.inc' + character*16 name(nmxset) + integer nmem(nmxset),ndef(nmxset),mmem + common/NAME/name,nmem,ndef,mmem + integer nset,iset,pdfmem + real*8 parm(nopmax) +! + double precision gridx(nmxgridx),gridq(nmxgridq) + integer ngridx,ngridq,jx,jq +! + INTEGER order + REAL*8 alfas,alphaNNPDF + REAL*8 Eorder,Q2fit,mass +! + INTEGER MXREP + PARAMETER(MXREP=1e3) + INTEGER NREP + common/nnpdf20CNREP/NREP +! + INTEGER NX,NXMAX,NQ2,NPL + PARAMETER(NX=100,NXMAX=100,NQ2=50) + PARAMETER(NPL=5000) + INTEGER NXX,NQQ2 + REAL*8 Q2MIN,Q2MAX,XPDFMIN,XPDFMAX + REAL*8 XG(NXMAX,nmxset),Q2G(NQ2,nmxset),XPDFEV(NXMAX,NQ2,-6:6,0:MXREP) + INTEGER IX,IQ2 +! This common different from NNPDF1.X +! common/nnpdf20CPDFGR/XPDFEV,XG,Q2G,IX,IQ2 + common/nnpdfallCPDFGR/XPDFEV,XG,Q2G,IX,IQ2 +! + INTEGER ipt,imodev,ivfn,itmc +! This common is the same as for NNPDF1.0 + COMMON/nnpdf10EVFLAGS/ipt,imodev,ivfn,itmc + REAL*8 q0,alfas0 + REAL*8 q20,qth(4:6) +! This common is the same as for NNPDF1.0 + COMMON/nnpdf10EVSCALE/q20,q2 + REAL*8 q2th(4:6),asref,q2ref +! This common is the same as for NNPDF1.0 + COMMON/nnpdf10vfns/q2th,asref,q2ref +! + INTEGER I,J,K + INTEGER IPDF,KREP + INTEGER IDUM,JDUM + REAL*8 X,XIN,Q,QIN,QAS,QQ,Q2,QQ2,XPDF(-6:6) + REAL*8 XCH + PARAMETER(XCH=1D-1) +! + integer m,n,nmax,mmax,minq,maxq,midq,maxx,minx,midx +! order of pol. interpolation + parameter(m=4,n=2) + parameter(nmax=1e3,mmax=1e3) + double precision dy,x1,x2,y,x1a(mmax),x2a(nmax),ya(mmax,nmax) + integer ix1a(m),ix2a(n) + integer offset + + double precision XPDFMIN_INTER + parameter(XPDFMIN_INTER=1d-7) + +!-----------------newline------------ + character*512 filename + common/lhafilename/filename + double precision EPS_MC_set + parameter(EPS_MC_set=1d-7) +!-----------------newline------------ + +! + KREP = mmem + X=XIN + Q=QIN + +! Set correct scale + Q2=Q**2d0 + + call getnset(iset) + offset = 101*(iset-1) + +! Check kinematic point is within allowed range + + call GetXminM(iset,KREP,XPDFMIN) + call GetXmaxM(iset,KREP,XPDFMAX) + call GetQ2maxM(iset,KREP,Q2MAX) + call GetQ2minM(iset,KREP,Q2MIN) +! + IF ( X.LT.XPDFMIN_INTER .OR. X.GT.XPDFMAX ) THEN + WRITE(6,2000) + 2000 FORMAT (2X,'PARTON INTERPOLATION: X OUT OF RANGE -- STOP') + write(6,*) "X= ",X," XMAX, XMIN = ",XPDFMAX,XPDFMIN_INTER + IF ( X.LT.XPDFMIN_INTER ) X = XPDFMIN_INTER + IF ( X.GT.XPDFMAX ) X = XPDFMAX + ENDIF +! + IF ( Q2.LT.Q2MIN .OR. Q2.GT.Q2MAX ) THEN + WRITE(6,2001) + 2001 FORMAT (2X,'PARTON INTERPOLATION: Q2 OUT OF RANGE -- STOP') + write(6,*) "Q2 ,Q2MIN, Q2MAX = ",Q2,Q2MIN,Q2MAX + if( Q2.LT.Q2MIN ) Q2 = Q2MIN + if( Q2.GT.Q2MAX ) Q2 = Q2MAX + ENDIF + +! FIND NEAREST POINTS IN THE GRID + MINX = 1 + MAXX = NX+1 + 10 CONTINUE + MIDX = (MINX+MAXX)/2 + IF(X.LT.XG(MIDX,iset)) THEN + MAXX=MIDX + ELSE + MINX=MIDX + END IF + IF((MAXX-MINX).GT.1) GO TO 10 + IX = MINX + + MINQ = 1 + MAXQ = NQ2+1 + 20 CONTINUE + MIDQ = (MINQ+MAXQ)/2 + IF(Q2.LT.Q2G(MIDQ,iset)) THEN + MAXQ=MIDQ + ELSE + MINQ=MIDQ + END IF + IF((MAXQ-MINQ).GT.1) GO TO 20 + IQ2 = MINQ + +! +! POLYNOMIAL INTERPOLATION +! +! uncomment for 3rd order interp. +! IF((IX+(M-1)/2).GT.NX) IX = NX - (M-1)/2 +! IF((IX-(M-1)/2).LT.1) IX = (M+1)/2 +! IDUM = 0 +! DO I = -(M-1)/2,(M-1)/2,1 +! IDUM = IDUM +1 +! IX1A(IDUM) = IX + I +! ENDDO +! IF((IQ2+(N-1)/2).GT.NQ2) IQ2 = NQ2 - (N-1)/2 +! IF((IQ2-(N-1)/2).LT.1) IQ2 = (N+1)/2 +! JDUM = 0 +! DO J = -(N-1)/2,(N-1)/2,1 +! JDUM = JDUM +1 +! IX2A(JDUM) = IQ2 + J +! ENDDO + +! Assign grid for interpolation. M, N -> order of polyN interpolation + do I=1,M + if(IX.ge.M/2.and.IX.le.(NX-M/2)) IX1A(I) = IX - M/2 + I + if(IX.lt.M/2) IX1A(I) = I + if(IX.gt.(NX-M/2)) IX1A(I) = (NX - M) + I + +! Check grids + if(IX1A(I).le.0.or.IX1A(I).gt.NX) then + write(6,*) "Error in grids! " + write(6,*) "I, IXIA(I) = ",I, IX1A(I) + call exit(-10) + endif + enddo + + do J=1,N + if(IQ2.ge.N/2.and.IQ2.le.(NQ2-N/2)) IX2A(J) = IQ2 - N/2 + J + if(IQ2.lt.N/2) IX2A(J) = J + if(IQ2.gt.(NQ2-N/2)) IX2A(J) = (NQ2 - N) + J +! Check grids + if(IX2A(J).le.0.or.IX2A(J).gt.NQ2) then + write(6,*) "Error in grids! " + write(6,*) "J, IXIA(J) = ",J,IX2A(J) + call exit(-10) + endif + enddo + +! Define points where to evaluate interpolation +! Choose between linear or logarithmic (x,Q2) interpolation + + IF(X.LT.XCH)THEN + X1=dlog(X) + ELSE + X1=X + ENDIF + X2=dlog(Q2) + + DO IPDF = -6,6,1 + +! Choose between linear or logarithmic (x,Q2) interpolation + + DO I=1,M + IF(X.LT.XCH)THEN + X1A(I)= dlog(XG(IX1A(I),iset)) + ELSE + X1A(I)= XG(IX1A(I),iset) + ENDIF + DO J=1,N + X2A(J) = dlog(Q2G(IX2A(J),iset)) + YA(I,J) = XPDFEV(IX1A(I),IX2A(J),IPDF,KREP+offset) + enddo + enddo + +! 2D polynomial interpolation + call lh_polin2(x1a,x2a,ya,m,n,x1,x2,y,dy) + XPDF(IPDF) = y + +!-----------------newline------------ +! Here we need a IF switch that only activates this +! when the _mc.LHgrid files are used +! +! PDF positivity for NLO MC PDFs + if(index(filename(1:len_trim(filename)),"_mc.LHgrid").gt.0) then + if( XPDF(IPDF).le.0d0 ) XPDF(IPDF)=EPS_MC_set + endif +!-----------------newline----------------------- + + enddo + + RETURN + +!******************************************************** + entry NNPDFINT20getgrid(nset,ngridx,ngridq,gridx,gridq) + do jx=1,nx + gridx(jx)=xg(jx,nset) + enddo + do jq=1,nq2 + gridq(jq)=q2g(jq,nset) + enddo + ngridx=nx + ngridq=nq2 + return +!******************************************************** + + + ENTRY NNPDFINT20read(nset) +! + READ(1,*)nmem(nset),ndef(nset) + +! Set number of members + call setnmem(nset,nmem) + +! Read the grid in x + READ(1,*) nxx + IF(NXX.NE.NX)WRITE(*,*)"WARNING CHANGE NX ACCORDING TO .LHgrid" + DO ix = 1,nxx + READ(1,*) xg(ix,nset) + ENDDO + +! Read the grid in Q2 + READ(1,*) nqq2 + IF(NQQ2.NE.NQ2)WRITE(*,*)"WARNING CHANGE NQ2 ACCORDING TO .LHgrid" + READ(1,*) q2min + DO iq2 = 1,nqq2 + READ(1,*) q2g(iq2,nset) + ENDDO + +! Read the number of replicas + READ(1,*) NREP + +! Read the evolved xpdf grid for each replica + offset = 101*(nset-1) + DO K=0,NREP + DO IX=1,NX + DO IQ2=1,NQ2 + READ(1,*) ( xpdfev(ix,iq2,ipdf,k+offset), ipdf=-6,6,1 ) + ENDDO + ENDDO + ENDDO +! + RETURN + +!******************************************************** + + ENTRY NNPDFINT20alfa(alfas,QAS) +! + QQ = QAS + alfas = alphaNNPDF(QQ) +! + RETURN + +!******************************************************** + + ENTRY NNPDFINT20init(nset,Eorder,Q2fit) +! + IMODEV = 0 + IVFN = 1 + ITMC = 1 +! + CALL GetOrderPDFM(nset,order) + IPT = order +! + CALL GetQ2fitM(nset,QQ2) + Q2fit = QQ2 + Q20 = QQ2 +! + call GetQmassM(nset,4,mass) + QTH(4) = mass + call GetQmassM(nset,5,mass) + QTH(5) = mass + call GetQmassM(nset,6,mass) + QTH(6) = mass +! + DO i = 4,6 + q2th(i) = qth(i)**2d0 + ENDDO +! + ! added for filling Fparm->asref + call initEVOLVEpdf(nset,mmem) + CALL GetAlfas(nset,alfas0,Q0) + asref = alfas0 + q2ref = q0**2d0 +! + RETURN + +!******************************************************** +! + entry NNPDFINT20pdf(nset) + pdfmem = nset + IF (pdfmem.LT.0) THEN + WRITE(*,*) 'NNPDF set:' + WRITE(*,*) 'PDF member out of range:' + WRITE(*,*) 'member = ',pdfmem + STOP + ENDIF + RETURN +! + END + + +! THE ROUTINES FOR THE POLYNOMIAL INTERPOLATION ARE INSIDE +! THE wrapNNPDFgrid.f ROUTINE diff --git a/LHAPDF/lhapdf-5.9.1/src/wrapNNPDF20qedgrid-lite.f b/LHAPDF/lhapdf-5.9.1/src/wrapNNPDF20qedgrid-lite.f new file mode 100644 index 00000000000..161881df5d8 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/wrapNNPDF20qedgrid-lite.f @@ -0,0 +1,388 @@ +!*********************************************** +! +! +! wrapNNPDF20qedgrid-lite.f +! Special low-memory version with only a single ffit .... +! Routine called by LHAPDF package for calculating +! the value of all xpdfs at x and Q from replica KREP +! in a (x,Q) point as called by NNPDF.LHgrid file. +! +! In 'wrapevolve.f' the package calls: +! IF(NAME(NSET).EQ.'NNPDF20intqed') call NNPDFINT20qedevolve(x,Q,f) +! IF(NAME(NSET).EQ.'NNPDF20intqed') call NNPDFINT20qedread(nset) +! IF(NAME(NSET).EQ.'NNPDF20intqed') call NNPDFINT20qedalfa(alfas,Q) +! IF(NAME(NSET).EQ.'NNPDF20intqed') call NNPDFINT20qedinit(nset,Eorder,Q2fit) +! +!*********************************************** + + subroutine NNPDFINT20qedevolve(XIN,QIN,XPDF,XPHOTON) + IMPLICIT none +! + include 'parmsetup.inc' + character*16 name(nmxset) + character*80 line + character*512 setpath + integer nmem(nmxset),ndef(nmxset),mmem,mem + common/NAME/name,nmem,ndef,mmem + integer nset,iset,pdfmem + real*8 parm(nopmax) +! + double precision gridx(nmxgridx),gridq(nmxgridq) + integer ngridx,ngridq,jx,jq +! + INTEGER order + REAL*8 alfas,alphaNNPDF + REAL*8 Eorder,Q2fit,mass +! + INTEGER MXREP + PARAMETER(MXREP=nmxset-1) + INTEGER NREP + common/nnpdf20CNREP/NREP +! + INTEGER NX,NQ2,NPL + PARAMETER(NX=100,NQ2=50) + PARAMETER(NPL=5000) + INTEGER NXX,NQQ2 + REAL*8 Q2MIN,Q2MAX,XPDFMIN,XPDFMAX + REAL*8 XG(NX,nmxset),Q2G(NQ2,nmxset),XPDFEV(NX,NQ2,-6:7,0:MXREP) + INTEGER IX,IQ2 +! This common different from NNPDF1.X +! common/nnpdf20CPDFGR/XPDFEV,XG,Q2G,IX,IQ2 + common/nnpdfallCPDFGR/XPDFEV,XG,Q2G,IX,IQ2 + double precision XPDFMIN_INTER + parameter(XPDFMIN_INTER=1d-7) +! + INTEGER ipt,imodev,ivfn,itmc +! This common is the same as for NNPDF1.0 + COMMON/nnpdf10EVFLAGS/ipt,imodev,ivfn,itmc + REAL*8 q0,alfas0 + REAL*8 q20,qth(4:6) +! This common is the same as for NNPDF1.0 + COMMON/nnpdf10EVSCALE/q20,q2 + REAL*8 q2th(4:6),asref,q2ref +! This common is the same as for NNPDF1.0 + COMMON/nnpdf10vfns/q2th,asref,q2ref +! + INTEGER I,J,K + INTEGER IPDF,KREP + INTEGER IDUM,JDUM + REAL*8 X,XIN,Q,QIN,QAS,QQ,Q2,QQ2,XPDF(-6:6),XPHOTON + REAL*8 XCH + PARAMETER(XCH=1D-1) +! + integer m,n,nmax,mmax,minq,maxq,midq,maxx,minx,midx +! order of pol. interpolation + parameter(m=4,n=2) + parameter(nmax=1e3,mmax=1e3) + double precision dy,x1,x2,y,x1a(mmax),x2a(nmax),ya(mmax,nmax) + integer ix1a(m),ix2a(n) +! +! always use the 0 element in the lite version + KREP = 0 + X = XIN + Q = QIN + +! Set correct scale + Q2=Q**2d0 + + call getnset(iset) + +! Check kinematic point is within allowed range + + call GetXminM(iset,KREP,XPDFMIN) + call GetXmaxM(iset,KREP,XPDFMAX) + call GetQ2maxM(iset,KREP,Q2MAX) + call GetQ2minM(iset,KREP,Q2MIN) +! + IF ( X.LT.XPDFMIN_INTER .OR. X.GT.XPDFMAX ) THEN + WRITE(6,2000) + 2000 FORMAT (2X,'PARTON INTERPOLATION: X OUT OF RANGE -- STOP') + write(6,*) "X= ",X," XMAX, XMIN = ",XPDFMAX,XPDFMIN + IF ( X.LT.XPDFMIN_INTER ) X = XPDFMIN_INTER + IF ( X.GT.XPDFMAX ) X = XPDFMAX + ENDIF +! + IF ( Q2.LT.Q2MIN .OR. Q2.GT.Q2MAX ) THEN + WRITE(6,2001) + 2001 FORMAT (2X,'PARTON INTERPOLATION: Q2 OUT OF RANGE -- STOP') + write(6,*) "Q2 ,Q2MIN, Q2MAX = ",Q2,Q2MIN,Q2MAX + IF ( Q2.LT.Q2MIN ) Q2 = Q2MIN + IF ( Q2.GT.Q2MAX ) Q2 = Q2MAX + ENDIF + +! FIND NEAREST POINTS IN THE GRID + MINX = 1 + MAXX = NX+1 + 10 CONTINUE + MIDX = (MINX+MAXX)/2 + IF(X.LT.XG(MIDX,iset)) THEN + MAXX=MIDX + ELSE + MINX=MIDX + END IF + IF((MAXX-MINX).GT.1) GO TO 10 + IX = MINX + + MINQ = 1 + MAXQ = NQ2+1 + 20 CONTINUE + MIDQ = (MINQ+MAXQ)/2 + IF(Q2.LT.Q2G(MIDQ,iset)) THEN + MAXQ=MIDQ + ELSE + MINQ=MIDQ + END IF + IF((MAXQ-MINQ).GT.1) GO TO 20 + IQ2 = MINQ + +! +! POLYNOMIAL INTERPOLATION +! +! uncomment for 3rd order interp. +! IF((IX+(M-1)/2).GT.NX) IX = NX - (M-1)/2 +! IF((IX-(M-1)/2).LT.1) IX = (M+1)/2 +! IDUM = 0 +! DO I = -(M-1)/2,(M-1)/2,1 +! IDUM = IDUM +1 +! IX1A(IDUM) = IX + I +! ENDDO +! IF((IQ2+(N-1)/2).GT.NQ2) IQ2 = NQ2 - (N-1)/2 +! IF((IQ2-(N-1)/2).LT.1) IQ2 = (N+1)/2 +! JDUM = 0 +! DO J = -(N-1)/2,(N-1)/2,1 +! JDUM = JDUM +1 +! IX2A(JDUM) = IQ2 + J +! ENDDO + +! Assign grid for interpolation. M, N -> order of polyN interpolation + do I=1,M + if(IX.ge.M/2.and.IX.le.(NX-M/2)) IX1A(I) = IX - M/2 + I + if(IX.lt.M/2) IX1A(I) = I + if(IX.gt.(NX-M/2)) IX1A(I) = (NX - M) + I + +! Check grids + if(IX1A(I).le.0.or.IX1A(I).gt.NX) then + write(6,*) "Error in grids! " + write(6,*) "I, IXIA(I) = ",I, IX1A(I) + call exit(-10) + endif + enddo + + do J=1,N + if(IQ2.ge.N/2.and.IQ2.le.(NQ2-N/2)) IX2A(J) = IQ2 - N/2 + J + if(IQ2.lt.N/2) IX2A(J) = J + if(IQ2.gt.(NQ2-N/2)) IX2A(J) = (NQ2 - N) + J +! Check grids + if(IX2A(J).le.0.or.IX2A(J).gt.NQ2) then + write(6,*) "Error in grids! " + write(6,*) "J, IXIA(J) = ",J,IX2A(J) + call exit(-10) + endif + enddo + +! Define points where to evaluate interpolation +! Choose between linear or logarithmic (x,Q2) interpolation + + IF(X.LT.XCH)THEN + X1=dlog(X) + ELSE + X1=X + ENDIF + X2=dlog(Q2) + + DO IPDF = -6,7,1 + +! Choose between linear or logarithmic (x,Q2) interpolation + + DO I=1,M + IF(X.LT.XCH)THEN + X1A(I)= dlog(XG(IX1A(I),iset)) + ELSE + X1A(I)= XG(IX1A(I),iset) + ENDIF + DO J=1,N + X2A(J) = dlog(Q2G(IX2A(J),iset)) + YA(I,J) = XPDFEV(IX1A(I),IX2A(J),IPDF,KREP+iset-1) + enddo + enddo + +! 2D polynomial interpolation + call lh_polin2(x1a,x2a,ya,m,n,x1,x2,y,dy) + + IF(IPDF.NE.7)THEN + XPDF(IPDF) = y + ELSE + XPHOTON = y + ENDIF + + enddo + + RETURN + +!******************************************************** + +!******************************************************** + entry NNPDFINT20qedgetgrid(nset,ngridx,ngridq,gridx,gridq) + do jx=1,nx + gridx(jx)=xg(jx,nset) + enddo + do jq=1,nq2 + gridq(jq)=q2g(jq,nset) + enddo + ngridx=nx + ngridq=nq2 + return +!******************************************************** + + + ENTRY NNPDFINT20qedread(nset) +! + READ(1,*)nmem(nset),ndef(nset) + +! Set number of members + call setnmem(nset,nmem) + +! Read the grid in x + READ(1,*) nxx + IF(NXX.NE.NX)WRITE(*,*)"WARNING CHANGE NX ACCORDING TO .LHgrid" + DO ix = 1,nxx + READ(1,*) xg(ix,nset) + ENDDO + +! Read the grid in Q2 + READ(1,*) nqq2 + IF(NQQ2.NE.NQ2)WRITE(*,*)"WARNING CHANGE NQ2 ACCORDING TO .LHgrid" + READ(1,*) q2min + DO iq2 = 1,nqq2 + READ(1,*) q2g(iq2,nset) + ENDDO + +! Read the number of replicas + READ(1,*) NREP + + +! Dummy read in to get to End (stream 1 is still open) + DO K=0,NREP + DO IX=1,NX + DO IQ2=1,NQ2 + READ(1,'(a)') line + ENDDO + ENDDO + ENDDO +! + RETURN + +!******************************************************** + + ENTRY NNPDFINT20qedalfa(alfas,QAS) +! + QQ = QAS + alfas = alphaNNPDF(QQ) +! + RETURN + +!******************************************************** + + ENTRY NNPDFINT20qedinit(nset,Eorder,Q2fit) +! + IMODEV = 0 + IVFN = 1 + ITMC = 1 +! + CALL GetOrderPDFM(nset,order) + IPT = order +! + CALL GetQ2fitM(nset,QQ2) + Q2fit = QQ2 + Q20 = QQ2 +! + call GetQmassM(nset,4,mass) + QTH(4) = mass + call GetQmassM(nset,5,mass) + QTH(5) = mass + call GetQmassM(nset,6,mass) + QTH(6) = mass +! + DO i = 4,6 + q2th(i) = qth(i)**2d0 + ENDDO +! + ! added for filling Fparm->asref + call initEVOLVEpdf(nset,mmem) + CALL GetAlfas(nset,alfas0,Q0) + asref = alfas0 + q2ref = q0**2d0 +! + RETURN + +!******************************************************** +! +! entry NNPDFINT20qedpdf(mem) + entry NNPDFINT20qedpdf(mem) +! have to reopen stream 1 + call getnset(iset) + call setnmem(iset,mem) + + call getsetpath(setpath) + + open(1,file=setpath(1:len_trim(setpath)),action='READ') + line = '' + do while (line(3:12).ne.'Evolution:'.or.len_trim(line).gt.15) + read(1,'(a)')line + enddo + read(1,'(a)')line + read(1,'(a)')line + + READ(1,*)nmem(iset),ndef(iset) + pdfmem = mem + IF (pdfmem.LT.0) THEN + WRITE(*,*) 'NNPDF set:' + WRITE(*,*) 'PDF member out of range:' + WRITE(*,*) 'member = ',pdfmem + STOP + ENDIF + +! Read the grid in x + READ(1,*) nxx + IF(NXX.NE.NX)WRITE(*,*)"WARNING CHANGE NX ACCORDING TO .LHgrid" + DO ix = 1,nxx + READ(1,*) xg(ix,iset) + ENDDO + +! Read the grid in Q2 + READ(1,*) nqq2 + IF(NQQ2.NE.NQ2)WRITE(*,*)"WARNING CHANGE NQ2 ACCORDING TO .LHgrid" + READ(1,*) q2min + DO iq2 = 1,nqq2 + READ(1,*) q2g(iq2,iset) + ENDDO + + READ(1,*) NREP + +! Dummy read up to the member requested the number of replicas + DO K=0,mem-1 + DO IX=1,NX + DO IQ2=1,NQ2 + READ(1,'(a)') line + ENDDO + ENDDO + ENDDO + + ! Read in the data of the requested member + DO IX=1,NX + DO IQ2=1,NQ2 + READ(1,*) ( xpdfev(ix,iq2,ipdf,0+iset-1), ipdf=-6,7,1 ) + ENDDO + ENDDO + + close(1) + + + RETURN +! + END + + +! THE ROUTINES FOR THE POLYNOMIAL INTERPOLATION ARE INSIDE +! THE wrapNNPDFgrid.f ROUTINE + diff --git a/LHAPDF/lhapdf-5.9.1/src/wrapNNPDF20qedgrid.f b/LHAPDF/lhapdf-5.9.1/src/wrapNNPDF20qedgrid.f new file mode 100644 index 00000000000..2335df91db4 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/wrapNNPDF20qedgrid.f @@ -0,0 +1,334 @@ +!*********************************************** +! +! +! wrapNNPDF20qedgrid.f +! Routine called by LHAPDF package for calculating +! the value of all xpdfs at x and Q from replica KREP +! in a (x,Q) point as called by NNPDF.LHgrid file. +! +! In 'wrapevolve.f' the package calls: +! IF(NAME(NSET).EQ.'NNPDF20intqed') call NNPDFINT20qedevolve(x,Q,f) +! IF(NAME(NSET).EQ.'NNPDF20intqed') call NNPDFINT20qedread(nset) +! IF(NAME(NSET).EQ.'NNPDF20intqed') call NNPDFINT20qedalfa(alfas,Q) +! IF(NAME(NSET).EQ.'NNPDF20intqed') call NNPDFINT20qedinit(nset,Eorder,Q2fit) +! +!*********************************************** + + subroutine NNPDFINT20qedevolve(XIN,QIN,XPDF,XPHOTON) + IMPLICIT none +! + include 'parmsetup.inc' + character*16 name(nmxset) + integer nmem(nmxset),ndef(nmxset),mmem + common/NAME/name,nmem,ndef,mmem + integer nset,iset,pdfmem + real*8 parm(nopmax) +! + double precision gridx(nmxgridx),gridq(nmxgridq) + integer ngridx,ngridq,jx,jq +! + INTEGER order + REAL*8 alfas,alphaNNPDF + REAL*8 Eorder,Q2fit,mass +! + INTEGER MXREP + PARAMETER(MXREP=1e2) + INTEGER NREP + common/nnpdf20CNREP/NREP +! + INTEGER NX,NXMAX,NQ2,NPL + PARAMETER(NX=100,NXMAX=100,NQ2=50) + PARAMETER(NPL=5000) + INTEGER NXX,NQQ2 + REAL*8 Q2MIN,Q2MAX,XPDFMIN,XPDFMAX + REAL*8 XG(NXMAX,nmxset),Q2G(NQ2,nmxset),XPDFEV(NXMAX,NQ2,-6:7,0:MXREP) + INTEGER IX,IQ2 +! This common different from NNPDF1.X +! common/nnpdf20CPDFGR/XPDFEV,XG,Q2G,IX,IQ2 + common/nnpdfallCPDFGR/XPDFEV,XG,Q2G,IX,IQ2 +! + INTEGER ipt,imodev,ivfn,itmc +! This common is the same as for NNPDF1.0 + COMMON/nnpdf10EVFLAGS/ipt,imodev,ivfn,itmc + REAL*8 q0,alfas0 + REAL*8 q20,qth(4:6) +! This common is the same as for NNPDF1.0 + COMMON/nnpdf10EVSCALE/q20,q2 + REAL*8 q2th(4:6),asref,q2ref +! This common is the same as for NNPDF1.0 + COMMON/nnpdf10vfns/q2th,asref,q2ref +! + INTEGER I,J,K + INTEGER IPDF,KREP + INTEGER IDUM,JDUM + REAL*8 X,XIN,Q,QIN,QAS,QQ,Q2,QQ2,XPDF(-6:6),XPHOTON + REAL*8 XCH + PARAMETER(XCH=1D-1) +! + integer m,n,nmax,mmax,minq,maxq,midq,maxx,minx,midx +! order of pol. interpolation + parameter(m=4,n=2) + parameter(nmax=1e3,mmax=1e3) + double precision dy,x1,x2,y,x1a(mmax),x2a(nmax),ya(mmax,nmax) + integer ix1a(m),ix2a(n) + integer offset + + double precision XPDFMIN_INTER + parameter(XPDFMIN_INTER=1d-7) +! + KREP = mmem + X=XIN + Q=QIN + +! Set correct scale + Q2=Q**2d0 + + call getnset(iset) + offset = 101*(iset-1) + +! Check kinematic point is within allowed range + + call GetXminM(iset,KREP,XPDFMIN) + call GetXmaxM(iset,KREP,XPDFMAX) + call GetQ2maxM(iset,KREP,Q2MAX) + call GetQ2minM(iset,KREP,Q2MIN) +! + IF ( X.LT.XPDFMIN_INTER .OR. X.GT.XPDFMAX ) THEN + WRITE(6,2000) + 2000 FORMAT (2X,'PARTON INTERPOLATION: X OUT OF RANGE -- STOP') + IF ( X.LT.XPDFMIN_INTER ) X = XPDFMIN_INTER + IF ( X.GT.XPDFMAX ) X = XPDFMAX + write(6,*) "X= ",X," XMAX, XMIN = ",XPDFMAX,XPDFMIN + ENDIF +! + IF ( Q2.LT.Q2MIN .OR. Q2.GT.Q2MAX ) THEN + WRITE(6,2001) + 2001 FORMAT (2X,'PARTON INTERPOLATION: Q2 OUT OF RANGE -- STOP') + write(6,*) "Q2 ,Q2MIN, Q2MAX = ",Q2,Q2MIN,Q2MAX + if( Q2.LT.Q2MIN ) Q2 = Q2MIN + if( Q2.GT.Q2MAX ) Q2 = Q2MAX + ENDIF + +! FIND NEAREST POINTS IN THE GRID + MINX = 1 + MAXX = NX+1 + 10 CONTINUE + MIDX = (MINX+MAXX)/2 + IF(X.LT.XG(MIDX,iset)) THEN + MAXX=MIDX + ELSE + MINX=MIDX + END IF + IF((MAXX-MINX).GT.1) GO TO 10 + IX = MINX + + MINQ = 1 + MAXQ = NQ2+1 + 20 CONTINUE + MIDQ = (MINQ+MAXQ)/2 + IF(Q2.LT.Q2G(MIDQ,iset)) THEN + MAXQ=MIDQ + ELSE + MINQ=MIDQ + END IF + IF((MAXQ-MINQ).GT.1) GO TO 20 + IQ2 = MINQ + +! +! POLYNOMIAL INTERPOLATION +! +! uncomment for 3rd order interp. +! IF((IX+(M-1)/2).GT.NX) IX = NX - (M-1)/2 +! IF((IX-(M-1)/2).LT.1) IX = (M+1)/2 +! IDUM = 0 +! DO I = -(M-1)/2,(M-1)/2,1 +! IDUM = IDUM +1 +! IX1A(IDUM) = IX + I +! ENDDO +! IF((IQ2+(N-1)/2).GT.NQ2) IQ2 = NQ2 - (N-1)/2 +! IF((IQ2-(N-1)/2).LT.1) IQ2 = (N+1)/2 +! JDUM = 0 +! DO J = -(N-1)/2,(N-1)/2,1 +! JDUM = JDUM +1 +! IX2A(JDUM) = IQ2 + J +! ENDDO + +! Assign grid for interpolation. M, N -> order of polyN interpolation + do I=1,M + if(IX.ge.M/2.and.IX.le.(NX-M/2)) IX1A(I) = IX - M/2 + I + if(IX.lt.M/2) IX1A(I) = I + if(IX.gt.(NX-M/2)) IX1A(I) = (NX - M) + I + +! Check grids + if(IX1A(I).le.0.or.IX1A(I).gt.NX) then + write(6,*) "Error in grids! " + write(6,*) "I, IXIA(I) = ",I, IX1A(I) + call exit(-10) + endif + enddo + + do J=1,N + if(IQ2.ge.N/2.and.IQ2.le.(NQ2-N/2)) IX2A(J) = IQ2 - N/2 + J + if(IQ2.lt.N/2) IX2A(J) = J + if(IQ2.gt.(NQ2-N/2)) IX2A(J) = (NQ2 - N) + J +! Check grids + if(IX2A(J).le.0.or.IX2A(J).gt.NQ2) then + write(6,*) "Error in grids! " + write(6,*) "J, IXIA(J) = ",J,IX2A(J) + call exit(-10) + endif + enddo + +! Define points where to evaluate interpolation +! Choose between linear or logarithmic (x,Q2) interpolation + + IF(X.LT.XCH)THEN + X1=dlog(X) + ELSE + X1=X + ENDIF + X2=dlog(Q2) + + DO IPDF = -6,7,1 + +! Choose between linear or logarithmic (x,Q2) interpolation + + DO I=1,M + IF(X.LT.XCH)THEN + X1A(I)= dlog(XG(IX1A(I),iset)) + ELSE + X1A(I)= XG(IX1A(I),iset) + ENDIF + DO J=1,N + X2A(J) = dlog(Q2G(IX2A(J),iset)) + YA(I,J) = XPDFEV(IX1A(I),IX2A(J),IPDF,KREP+offset) + enddo + enddo + +! 2D polynomial interpolation + call lh_polin2(x1a,x2a,ya,m,n,x1,x2,y,dy) + + IF(IPDF.NE.7)THEN + XPDF(IPDF) = y + ELSE + XPHOTON = y + ENDIF + + enddo + + RETURN + +!******************************************************** + +!******************************************************** + entry NNPDFINT20qedgetgrid(nset,ngridx,ngridq,gridx,gridq) + do jx=1,nx + gridx(jx)=xg(jx,nset) + enddo + do jq=1,nq2 + gridq(jq)=q2g(jq,nset) + enddo + ngridx=nx + ngridq=nq2 + return +!******************************************************** + + + ENTRY NNPDFINT20qedread(nset) +! + READ(1,*)nmem(nset),ndef(nset) + +! Set number of members + call setnmem(nset,nmem) + +! Read the grid in x + READ(1,*) nxx + IF(NXX.NE.NX)WRITE(*,*)"WARNING CHANGE NX ACCORDING TO .LHgrid" + DO ix = 1,nxx + READ(1,*) xg(ix,nset) + ENDDO + +! Read the grid in Q2 + READ(1,*) nqq2 + IF(NQQ2.NE.NQ2)WRITE(*,*)"WARNING CHANGE NQ2 ACCORDING TO .LHgrid" + READ(1,*) q2min + DO iq2 = 1,nqq2 + READ(1,*) q2g(iq2,nset) + ENDDO + +! Read the number of replicas + READ(1,*) NREP + +! Read the evolved xpdf grid for each replica + offset = 101*(nset-1) + DO K=0,NREP + DO IX=1,NX + DO IQ2=1,NQ2 + READ(1,*) ( xpdfev(ix,iq2,ipdf,k+offset), ipdf=-6,7,1 ) + ENDDO + ENDDO + ENDDO +! + RETURN + +!******************************************************** + + ENTRY NNPDFINT20qedalfa(alfas,QAS) +! + QQ = QAS + alfas = alphaNNPDF(QQ) +! + RETURN + +!******************************************************** + + ENTRY NNPDFINT20qedinit(nset,Eorder,Q2fit) +! + IMODEV = 0 + IVFN = 1 + ITMC = 1 +! + CALL GetOrderPDFM(nset,order) + IPT = order +! + CALL GetQ2fitM(nset,QQ2) + Q2fit = QQ2 + Q20 = QQ2 +! + call GetQmassM(nset,4,mass) + QTH(4) = mass + call GetQmassM(nset,5,mass) + QTH(5) = mass + call GetQmassM(nset,6,mass) + QTH(6) = mass +! + DO i = 4,6 + q2th(i) = qth(i)**2d0 + ENDDO +! + ! added for filling Fparm->asref + call initEVOLVEpdf(nset,mmem) + CALL GetAlfas(nset,alfas0,Q0) + asref = alfas0 + q2ref = q0**2d0 +! + RETURN + +!******************************************************** +! + entry NNPDFINT20qedpdf(nset) + pdfmem = nset + IF (pdfmem.LT.0) THEN + WRITE(*,*) 'NNPDF set:' + WRITE(*,*) 'PDF member out of range:' + WRITE(*,*) 'member = ',pdfmem + STOP + ENDIF + RETURN +! + END + + +! THE ROUTINES FOR THE POLYNOMIAL INTERPOLATION ARE INSIDE +! THE wrapNNPDFgrid.f ROUTINE + diff --git a/LHAPDF/lhapdf-5.9.1/src/wrapNNPDFgrid-lite.f b/LHAPDF/lhapdf-5.9.1/src/wrapNNPDFgrid-lite.f new file mode 100644 index 00000000000..028afe51391 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/wrapNNPDFgrid-lite.f @@ -0,0 +1,615 @@ +!*********************************************** +! +! +! wrapNNPDFgrid-lite.f +! Special low-memory version with only single fit .... +! Routine called by LHAPDF package for calculating +! the value of all xpdfs at x and Q from replica KREP +! in a (x,Q) point as called by NNPDF.LHgrid file. +! +! In 'wrapevolve.f' the package calls: +! IF(NAME(NSET).EQ.'NNPDFint') call NNPDFINTevolve(x,Q,f) +! IF(NAME(NSET).EQ.'NNPDFint') call NNPDFINTread(nset) +! IF(NAME(NSET).EQ.'NNPDFint') call NNPDFINTalfa(alfas,Q) +! IF(NAME(NSET).EQ.'NNPDFint') call NNPDFINTinit(nset,Eorder,Q2fit)* +! +!*********************************************** + + + subroutine NNPDFINTevolve(X,Q,XPDF) + IMPLICIT none +! + include 'parmsetup.inc' + character*16 name(nmxset) + character*80 line + character*512 setpath + integer nmem(nmxset),ndef(nmxset),mmem,mem + common/NAME/name,nmem,ndef,mmem + integer nset,iset,pdfmem + real*8 parm(nopmax) + real*8 tmp(13) +! + double precision gridx(nmxgridx),gridq(nmxgridq) + integer ngridx,ngridq,jx,jq +! + INTEGER order + REAL*8 alfas,alphaNNPDF + REAL*8 Eorder,Q2fit,mass +! + INTEGER MXREP + PARAMETER(MXREP=nmxset-1) + INTEGER NREP + common/nnpdf10CNREP/NREP +! + INTEGER NX,NQ2,NPL + PARAMETER(NX=60,NQ2=50) + PARAMETER(NPL=3000) + INTEGER NXX,NQQ2 + REAL*8 Q2MIN,Q2MAX,XPDFMIN,XPDFMAX + REAL*8 XG(NX,nmxset),Q2G(NQ2,nmxset),XPDFEV(NX,NQ2,-6:6,0:MXREP) + INTEGER IX,IQ2 + common/nnpdf10CPDFGR/XPDFEV,XG,Q2G,IX,IQ2 +! + INTEGER ipt,imodev,ivfn,itmc + COMMON/NNPDF10EVFLAGS/ipt,imodev,ivfn,itmc + REAL*8 q0,alfas0 + REAL*8 q20,qth(4:6) + COMMON/nnpdf10EVSCALE/q20,q2 + REAL*8 q2th(4:6),asref,q2ref + COMMON/nnpdf10vfns/q2th,asref,q2ref +! + INTEGER I,J,K + INTEGER IPDF,KREP,LH_JISEARCH,IINTERP + INTEGER IDUM,JDUM + REAL*8 X,Q,QQ,Q2,QQ2,XPDF(-6:6) + REAL*8 AXB(NX,NQ2,-6:6), BXB(NX,NQ2,-6:6) + REAL*8 CXB(NX,NQ2,-6:6),TQ,DX + REAL*8 XPDF1(-6:6),XPDF2(-6:6) + REAL*8 XCH + PARAMETER(XCH=1D-1) +! + integer m,n,nmax,mmax + ! order of pol. interpolation + parameter(m=4,n=4) + parameter(nmax=1e3,mmax=1e3) + double precision dy,x1,x2,y,x1a(mmax),x2a(nmax),ya(mmax,nmax) + integer ix1a(m),ix2a(n) +! +! +! KREP = mmem +! always use the 0 element in this lite version + KREP = 0 +! Set correct scale + Q2=Q**2d0 + + call getnset(iset) + +! Check kinematic point is within allowed range + + call GetXminM(iset,KREP,XPDFMIN) + call GetXmaxM(iset,KREP,XPDFMAX) + call GetQ2maxM(iset,KREP,Q2MAX) + call GetQ2minM(iset,KREP,Q2MIN) +! + IF ( X.LT.XPDFMIN .OR. X.GT.XPDFMAX ) THEN + WRITE(6,2000) + 2000 FORMAT (2X,'PARTON INTERPOLATION: X OUT OF RANGE -- STOP') + write(6,*) "X= ",X," XMAX, XMIN = ",XPDFMAX,XPDFMIN + ENDIF +! + IF ( Q2.LT.Q2MIN .OR. Q2.GT.Q2MAX ) THEN + WRITE(6,2001) + 2001 FORMAT (2X,'PARTON INTERPOLATION: Q2 OUT OF RANGE -- STOP') + write(6,*) "Q2 ,Q2MIN, Q2MAX = ",Q2,Q2MIN,Q2MAX + ENDIF + +! Select higher-order polynomial interpolation + + IINTERP = 1 +! + if(IINTERP.eq.0) then +! +! CUBIC SPLINE INTERPOLATION, LOG(Q2): LINEAR INTERPOLATION +! +! spline coefficients + DO IPDF = -6,6,1 + DO IQ2 = 1,NQ2 +! CALL LH_JSPLINE(AXB,BXB,CXB,IPDF,IQ2,KREP) + CALL LH_JSPLINE(AXB,BXB,CXB,IPDF,IQ2,KREP+iset-1) + ENDDO + ENDDO + +! Binary search of points in grid + IQ2 = LH_JISEARCH(NQ2,Q2G(1,iset),Q2) + IF (IQ2 .EQ. NQ2) IQ2 = NQ2-1 + IX = LH_JISEARCH(NX,XG(1,iset),X) + DX = X - XG(IX,iset) + +! Compute the values of xpdfs for two neighbouring values of Q2 +! using splines of order 3 + + DO IPDF = -6,6,1 + XPDF1(IPDF) = XPDFEV(IX,IQ2,IPDF,KREP+iset-1) & + & + DX*(AXB(IX,IQ2,IPDF) + DX*(BXB(IX,IQ2,IPDF) & + & + DX*CXB(IX,IQ2,IPDF)) ) + XPDF2(IPDF) = XPDFEV(IX,IQ2+1,IPDF,KREP+iset-1) & + & + DX*(AXB(IX,IQ2+1,IPDF) + DX*(BXB(IX,IQ2+1,IPDF) & + & + DX*CXB(IX,IQ2+1,IPDF)) ) + ENDDO + +! Linear interpolation in log Q2 + + TQ = (DLOG(Q2)-DLOG(Q2G(IQ2,iset))) & + & / (DLOG(Q2G(IQ2+1,iset))-DLOG(Q2G(IQ2,iset))) +! + DO IPDF = -6,6,1 + XPDF(IPDF) = (1.0D0-TQ)*XPDF1(IPDF) + TQ*XPDF2(IPDF) + ENDDO + + + elseif(IINTERP.eq.1) then +! + IQ2 = LH_JISEARCH(NQ2,Q2G(1,iset),Q2) + IF (IQ2 .EQ. NQ2) IQ2 = NQ2-1 + IX = LH_JISEARCH(NX,XG(1,iset),X) + +! Assign grid for interpolation. M, N -> order of polyN interpolatio + + do I=1,M + if(IX.ge.M/2.and.IX.le.(NX-M/2)) IX1A(I) = IX - M/2 + I + if(IX.lt.M/2) IX1A(I) = I + if(IX.gt.(NX-M/2)) IX1A(I) = (NX - M) + I + +! Check grids + if(IX1A(I).le.0.or.IX1A(I).gt.NX) then + write(6,*) "Error in grids" + write(6,*) "I, IXIA(I) = ",I, IX1A(I) + call exit(-10) + endif + enddo + + do J=1,N + if(IQ2.ge.N/2.and.IQ2.le.(NQ2-N/2)) IX2A(J) = IQ2 - N/2 + J + if(IQ2.lt.N/2) IX2A(J) = J + if(IQ2.gt.(NQ2-N/2)) IX2A(J) = (NQ2 - N) + J +! Check grids + if(IX2A(J).le.0.or.IX2A(J).gt.NQ2) then + write(6,*) "Error in grids" + write(6,*) "J, IXIA(J) = ",J,IX2A(J) + call exit(-10) + endif + enddo + +! uncomment for 3rd order interp. + +! IQ2 = LH_JISEARCH(NQ2,Q2G,Q2) +! IX = LH_JISEARCH(NX,XG,X) +! IF((IX+(M-1)/2).GT.NX) IX = NX - (M-1)/2 +! IF((IX-(M-1)/2).LT.1) IX = (M+1)/2 +! IDUM = 0 +! DO I = -(M-1)/2,(M-1)/2,1 +! IDUM = IDUM +1 +! IX1A(IDUM) = IX + I +! ENDDO + +! IF((IQ2+(N-1)/2).GT.NQ2) IQ2 = NQ2 - (N-1)/2 +! IF((IQ2-(N-1)/2).LT.1) IQ2 = (N+1)/2 + +! JDUM = 0 +! DO J = -(N-1)/2,(N-1)/2,1 +! JDUM = JDUM +1 +! IX2A(JDUM) = IQ2 + J +! ENDDO +! +! Define points where to evaluate interpolation +! Choose between linear or logarithmic (x,Q2) interpolation + + IF(X.LT.XCH)THEN + X1=dlog(X) + ELSE + X1=X + ENDIF + X2=dlog(Q2) + + DO IPDF = -6,6,1 + +! Choose between linear or logarithmic (x,Q2) interpolation + + DO I=1,M + IF(X.LT.XCH)THEN + X1A(I)= dlog(XG(IX1A(I),iset)) + ELSE + X1A(I)= XG(IX1A(I),iset) + ENDIF + DO J=1,N + X2A(J) = dlog(Q2G(IX2A(J),iset)) + YA(I,J) = XPDFEV(IX1A(I),IX2A(J),IPDF,KREP+iset-1) + enddo + enddo + +! 2D polynomial interpolation + call lh_polin2(x1a,x2a,ya,m,n,x1,x2,y,dy) + XPDF(IPDF) = y + + enddo + endif +! + RETURN + +!******************************************************** + entry NNPDFINTgetgrid(nset,ngridx,ngridq,gridx,gridq) + do jx=1,nx + gridx(jx)=xg(jx,nset) + enddo + do jq=1,nq2 + gridq(jq)=q2g(jq,nset) + enddo + ngridx=nx + ngridq=nq2 + return +!******************************************************** + + ENTRY NNPDFINTread(nset) +! + READ(1,*)nmem(nset),ndef(nset) + +! Set number of members + call setnmem(nset,nmem) + +! Read the grid in x + READ(1,*) nxx + IF(NXX.NE.NX)WRITE(*,*)"WARNING CHANGE NX ACCORDING TO .LHgrid" + DO ix = 1,nxx + READ(1,*) xg(ix,nset) + ENDDO + +! Read the grid in Q2 + READ(1,*) nqq2 + IF(NQQ2.NE.NQ2)WRITE(*,*)"WARNING CHANGE NQ2 ACCORDING TO .LHgrid" + READ(1,*) q2min + DO iq2 = 1,nqq2 + READ(1,*) q2g(iq2,nset) + ENDDO + +! Read the number of replicas + READ(1,*) NREP + +! - dummy read in to get to End: (stream 1 is still open) + DO K=0,NREP + DO IX=1,NX + DO IQ2=1,NQ2 + READ(1,'(a)') line + ENDDO + ENDDO + ENDDO +! + RETURN + +!******************************************************** + + ENTRY NNPDFINTalfa(alfas,Q) +! + QQ = Q + alfas = alphaNNPDF(QQ) +! + RETURN + +!******************************************************** + + ENTRY NNPDFINTinit(nset,Eorder,Q2fit) +! + IMODEV = 0 + IVFN = 1 + ITMC = 1 +! + CALL GetOrderPDFM(nset,order) + IPT = order +! + CALL GetQ2fitM(nset,QQ2) + Q2fit = QQ2 + Q20 = QQ2 +! + call GetQmassM(nset,4,mass) + QTH(4) = mass + call GetQmassM(nset,5,mass) + QTH(5) = mass + call GetQmassM(nset,6,mass) + QTH(6) = mass +! + DO i = 4,6 + q2th(i) = qth(i)**2d0 + ENDDO +! + ! added for filling Fparm->asref + call initEVOLVEpdf(nset,mmem) + CALL GetAlfas(nset,alfas0,Q0) + asref = alfas0 + q2ref = q0**2d0 +! + RETURN + +!******************************************************** +! + entry NNPDFINTpdf(mem) +! have to reopen stream 1 + call getnset(iset) + call setnmem(iset,mem) + + call getsetpath(setpath) + open(1,file=setpath(1:len_trim(setpath)),action='READ') + line = '' + + do while (line(3:12).ne.'Evolution:') + read(1,'(a)')line + enddo + read(1,'(a)')line + read(1,'(a)')line +! + READ(1,*)nmem(iset),ndef(iset) + pdfmem = mem + IF (pdfmem.LT.0) THEN + WRITE(*,*) 'NNPDF set:' + WRITE(*,*) 'PDF member out of range:' + WRITE(*,*) 'member = ',pdfmem + STOP + ENDIF + +! Read the grid in x + READ(1,*) nxx + IF(NXX.NE.NX)WRITE(*,*)"WARNING CHANGE NX ACCORDING TO .LHgrid" + DO ix = 1,nxx + READ(1,*) xg(ix,iset) + ENDDO + +! Read the grid in Q2 + READ(1,*) nqq2 + IF(NQQ2.NE.NQ2)WRITE(*,*)"WARNING CHANGE NQ2 ACCORDING TO .LHgrid" + READ(1,*) q2min + DO iq2 = 1,nqq2 + READ(1,*) q2g(iq2,iset) + ENDDO + +! Read the number of replicas + READ(1,*) NREP + +! - dummy read up rto the member requested + + DO K=0,mem-1 + DO IX=1,NX + DO IQ2=1,NQ2 + READ(1,'(a)') line + ENDDO + ENDDO + ENDDO + + +!- read in the data of the requested member + DO IX=1,NX + DO IQ2=1,NQ2 + READ(1,*) tmp + DO ipdf=-6,6,1 + xpdfev(ix,iq2,ipdf,iset-1) = tmp(ipdf+7) + ENDDO + ENDDO + ENDDO + +! + close(1) + RETURN + + END + + +!**************************************************************** +! +! CALCULATE THE COEFFICIENTS B,C,D IN A CUBIC SPLINE INTERPOLATION. +! INTERPOLATION SUBROUTINES ARE TAKEN FROM +! G.E. FORSYTHE, M.A. MALCOLM AND C.B. MOLER, +! COMPUTER METHODS FOR MATHEMATICAL COMPUTATIONS (PRENTICE-HALL, 1977). +! +! SUBROUTINE TAKEN FROM AAC GROUP (KUMANO et al.) +! +!******************************************************************* +! + SUBROUTINE LH_JSPLINE(B,C,D,I,J,KREP) + IMPLICIT none + include 'parmsetup.inc' +! + INTEGER MXREP + PARAMETER(MXREP=nmxset-1) + INTEGER NREP + common/nnpdf10CNREP/NREP +! + INTEGER NX,NQ2,NPL,IX,IQ2 + PARAMETER(NX=60,NQ2=50) + PARAMETER(NPL=3000) + REAL*8 XG(NX,nmxset),Q2G(NQ2,nmxset),XPDFEV(NX,NQ2,-6:6,0:MXREP) + common/nnpdf10CPDFGR/XPDFEV,XG,Q2G,IX,IQ2 +! + INTEGER I,J,NM1,K,IB,KREP + REAL*8 B,C,D,T + DIMENSION B(NX,NQ2,-6:6), C(NX,NQ2,-6:6), D(NX,NQ2,-6:6) + integer iset +! + call getnset(iset) + NM1=NX-1 + IF(NX.LT.2) RETURN + IF(NX.LT.3) GOTO 250 + D(1,J,I)=XG(2,iset)-XG(1,iset) + C(2,J,I)=(XPDFEV(2,J,I,KREP)-XPDFEV(1,J,I,KREP))/D(1,J,I) + DO 210 K=2,NM1 + D(K,J,I)=XG(K+1,iset)-XG(K,iset) + B(K,J,I)=2.0D0*(D(K-1,J,I)+D(K,J,I)) + C(K+1,J,I)=(XPDFEV(K+1,J,I,KREP)-XPDFEV(K,J,I,KREP))/D(K,J,I) + C(K,J,I)=C(K+1,J,I)-C(K,J,I) + 210 END DO + B(1,J,I)=-D(1,J,I) + B(NX,J,I)=-D(NX-1,J,I) + C(1,J,I)=0.0D0 + C(NX,J,I)=0.0D0 + IF(NX.EQ.3) GOTO 215 + C(1,J,I)=C(3,J,I)/(XG(4,iset)-XG(2,iset))-C(2,J,I)/(XG(3,iset)-XG(1,iset)) + C(NX,J,I)=C(NX-1,J,I)/(XG(NX,iset)-XG(NX-2,iset)) & + & -C(NX-2,J,I)/(XG(NX-1,iset)-XG(NX-3,iset)) + C(1,J,I)=C(1,J,I)*D(1,J,I)**2.0D0/(XG(4,iset)-XG(1,iset)) + C(NX,J,I)=-C(NX,J,I)*D(NX-1,J,I)**2.0D0/(XG(NX,iset)-XG(NX-3,iset)) + 215 CONTINUE + DO 220 K=2,NX + T=D(K-1,J,I)/B(K-1,J,I) + B(K,J,I)=B(K,J,I)-T*D(K-1,J,I) + C(K,J,I)=C(K,J,I)-T*C(K-1,J,I) + 220 END DO + C(NX,J,I)=C(NX,J,I)/B(NX,J,I) + DO 230 IB=1,NM1 + K=NX-IB + C(K,J,I)=(C(K,J,I)-D(K,J,I)*C(K+1,J,I))/B(K,J,I) + 230 END DO + B(NX,J,I)=(XPDFEV(NX,J,I,KREP)-XPDFEV(NM1,J,I,KREP))/D(NM1,J,I) & + & +D(NM1,J,I)*(C(NM1,J,I)+2.0D0*C(NX,J,I)) + DO 240 K=1,NM1 + B(K,J,I)=(XPDFEV(K+1,J,I,KREP)-XPDFEV(K,J,I,KREP))/D(K,J,I) & + & -D(K,J,I)*(C(K+1,J,I)+2.0D0*C(K,J,I)) + D(K,J,I)=(C(K+1,J,I)-C(K,J,I))/D(K,J,I) + C(K,J,I)=3.0D0*C(K,J,I) + 240 END DO + C(NX,J,I)=3.0D0*C(NX,J,I) + D(NX,J,I)=D(NX-1,J,I) + RETURN + 250 CONTINUE + B(1,J,I)=(XPDFEV(2,J,I,KREP)-XPDFEV(1,J,I,KREP))/(XG(2,iset)-XG(1,iset)) + C(1,J,I)=0.0D0 + D(1,J,I)=0.0D0 + B(2,J,I)=B(1,J,I) + C(2,J,I)=0.0D0 + D(2,J,I)=0.0D0 + RETURN + END +! +!*********************************************************************** +! THIS FUNCTION SEARCHES "I" WHICH SATISFIES THE RELATION +! X(I) <= Y < X(I+1) BY USING A BINARY SEARCH. +! +! FUNCTION TAKEN FROM AAC GROUP (KUMANO et al.) +!*********************************************************************** + + INTEGER FUNCTION LH_JISEARCH(N,X,Y) +! + IMPLICIT REAL*8(A-H,O-Z) +! Dynamical memory allocation + REAL*8 X(*) +! + MIN=1 + MAX=N+1 +! + 10 CONTINUE + MID=(MIN+MAX)/2 + IF(Y.LT.X(MID)) THEN + MAX=MID + ELSE + MIN=MID + END IF + IF((MAX-MIN).GT.1) GOTO 10 +! + LH_JISEARCH=MIN +! + RETURN + END + +!**************************************************** +! +! polin2.f +! +! 2D interpolation of arbitrary polinomial order +! Uses polint +! Given arrays x1a(1:m) and x2a(1:n) of independent variables, +! and an m by n array of function values ya(1:m,1:n) tabulated +! at the grid points defined by x1a,x2a; and given values x1,x2 +! of the independent variable, this routine returns +! an interpolated function value y with error dy +! +! Taken from NR fortran +! +!**************************************************** + + subroutine lh_polin2(x1a,x2a,ya,m,n,x1,x2,y,dy) + implicit none +! + integer m,n,nmax,mmax + integer j,k + parameter(nmax=1e3,mmax=1e3) + + real*8 dy,x1,x2,y,x1a(mmax),x2a(nmax),ya(mmax,nmax) + real*8 ymtmp(nmax),yntmp(nmax) + + do j=1,m + do k=1,n + yntmp(k)=ya(j,k) + enddo + call lh_polint(x2a,yntmp,n,x2,ymtmp(j),dy) + enddo + call lh_polint(x1a,ymtmp,m,x1,y,dy) +! + return + END + +!********************************************** +! +! polint.f +! +! Order N polynomial interpolation using Lagrange's formula +! as descrived in Numerical Recipees: +! Given arrays xa and ya each of length n, and given a value +! x, this routine returns a value y and an error estimate dy. +! If P(x) is the polynomial of degree N-1 such that +! P(xa_i)=ya_i,i=1,...,n, then the returned value is y=P(x) +! The algorithm used is Neville's algorithm +! +!****************************************************** + + subroutine LH_POLINT(xa,ya,n,x,y,dy) + implicit none +! + integer n,NMAX +! Largest anticipated value of n + parameter(nmax=1e3) + real*8 dy,x,y,xa(nmax),ya(nmax) + integer i,m,ns + real*8 den,dif,dift,ho,hp,w,c(nmax),d(nmax) + ns=1 + dif=abs(x-xa(1)) + do 11 i=1,n + dift=abs(x-xa(i)) + if(dift.lt.dif) then + ns=i + dif=dift + endif + c(i)=ya(i) + d(i)=ya(i) + 11 enddo + y=ya(ns) + ns=ns-1 + do m=1,n-1 + do i=1,n-m + ho=xa(i)-x + hp=xa(i+m)-x + w=c(i+1)-d(i) + den=ho-hp + if(den.eq.0) then + write(*,*)'failure in polint' + stop + endif + den=w/den + d(i)=hp*den + c(i)=ho*den + enddo + if(2*ns.lt.(n-m)) then + dy=c(ns+1) + else + dy=d(ns) + ns=ns-1 + endif + y=y+dy + enddo + + return + END diff --git a/LHAPDF/lhapdf-5.9.1/src/wrapNNPDFgrid.f b/LHAPDF/lhapdf-5.9.1/src/wrapNNPDFgrid.f new file mode 100644 index 00000000000..37ce040e0a2 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/wrapNNPDFgrid.f @@ -0,0 +1,562 @@ +!*********************************************** +! +! +! wrapNNPDFgrid.f +! Routine called by LHAPDF package for calculating +! the value of all xpdfs at x and Q from replica KREP +! in a (x,Q) point as called by NNPDF.LHgrid file. +! +! In 'wrapevolve.f' the package calls: +! IF(NAME(NSET).EQ.'NNPDFint') call NNPDFINTevolve(x,Q,f) +! IF(NAME(NSET).EQ.'NNPDFint') call NNPDFINTread(nset) +! IF(NAME(NSET).EQ.'NNPDFint') call NNPDFINTalfa(alfas,Q) +! IF(NAME(NSET).EQ.'NNPDFint') call NNPDFINTinit(nset,Eorder,Q2fit)* +! +!*********************************************** + + + subroutine NNPDFINTevolve(X,Q,XPDF) + IMPLICIT none +! + include 'parmsetup.inc' + character*16 name(nmxset) + integer nmem(nmxset),ndef(nmxset),mmem + common/NAME/name,nmem,ndef,mmem + integer nset,iset,pdfmem + real*8 parm(nopmax) + real*8 tmp(13) +! + double precision gridx(nmxgridx),gridq(nmxgridq) + integer ngridx,ngridq,jx,jq +! + INTEGER order + REAL*8 alfas,alphaNNPDF + REAL*8 Eorder,Q2fit,mass +! + INTEGER MXREP + PARAMETER(MXREP=1e3) + INTEGER NREP + common/nnpdf10CNREP/NREP +! + INTEGER NX,NXMAX,NQ2,NPL + PARAMETER(NX=60,NXMAX=100,NQ2=50) + PARAMETER(NPL=3000) + INTEGER NXX,NQQ2 + REAL*8 Q2MIN,Q2MAX,XPDFMIN,XPDFMAX + REAL*8 XG(NXMAX,nmxset),Q2G(NQ2,nmxset),XPDFEV(NXMAX,NQ2,-6:6,0:MXREP) + INTEGER IX,IQ2 +! common/nnpdf10CPDFGR/XPDFEV,XG,Q2G,IX,IQ2 + common/nnpdfallCPDFGR/XPDFEV,XG,Q2G,IX,IQ2 +! + INTEGER ipt,imodev,ivfn,itmc + COMMON/NNPDF10EVFLAGS/ipt,imodev,ivfn,itmc + REAL*8 q0,alfas0 + REAL*8 q20,qth(4:6) + COMMON/nnpdf10EVSCALE/q20,q2 + REAL*8 q2th(4:6),asref,q2ref + COMMON/nnpdf10vfns/q2th,asref,q2ref +! + INTEGER I,J,K + INTEGER IPDF,KREP,LH_JISEARCH,IINTERP + INTEGER IDUM,JDUM + REAL*8 X,Q,QQ,Q2,QQ2,XPDF(-6:6) + REAL*8 AXB(NX,NQ2,-6:6), BXB(NX,NQ2,-6:6) + REAL*8 CXB(NX,NQ2,-6:6),TQ,DX + REAL*8 XPDF1(-6:6),XPDF2(-6:6) + REAL*8 XCH + PARAMETER(XCH=1D-1) +! + integer m,n,nmax,mmax + ! order of pol. interpolation + parameter(m=4,n=4) + parameter(nmax=1e3,mmax=1e3) + double precision dy,x1,x2,y,x1a(mmax),x2a(nmax),ya(mmax,nmax) + integer ix1a(m),ix2a(n) + integer offset +! + KREP = mmem + +! Set correct scale + Q2=Q**2d0 + +! Check kinematic point is within allowed range + + call getnset(iset) + offset = 101*(iset-1) + + call GetXminM(iset,KREP,XPDFMIN) + call GetXmaxM(iset,KREP,XPDFMAX) + call GetQ2maxM(iset,KREP,Q2MAX) + call GetQ2minM(iset,KREP,Q2MIN) +! + IF ( X.LT.XPDFMIN .OR. X.GT.XPDFMAX ) THEN + WRITE(6,2000) + 2000 FORMAT (2X,'PARTON INTERPOLATION: X OUT OF RANGE -- STOP') + write(6,*) "X= ",X," XMAX, XMIN = ",XPDFMAX,XPDFMIN + ENDIF +! + IF ( Q2.LT.Q2MIN .OR. Q2.GT.Q2MAX ) THEN + WRITE(6,2001) + 2001 FORMAT (2X,'PARTON INTERPOLATION: Q2 OUT OF RANGE -- STOP') + write(6,*) "Q2 ,Q2MIN, Q2MAX = ",Q2,Q2MIN,Q2MAX + ENDIF + +! Select higher-order polynomial interpolation + + IINTERP = 1 +! + if(IINTERP.eq.0) then +! +! CUBIC SPLINE INTERPOLATION, LOG(Q2): LINEAR INTERPOLATION +! +! spline coefficients + DO IPDF = -6,6,1 + DO IQ2 = 1,NQ2 + CALL LH_JSPLINE(AXB,BXB,CXB,IPDF,IQ2,KREP+offset) + ENDDO + ENDDO + +! Binary search of points in grid + IQ2 = LH_JISEARCH(NQ2,Q2G(1,iset),Q2) + IF (IQ2 .EQ. NQ2) IQ2 = NQ2-1 + IX = LH_JISEARCH(NX,XG(1,iset),X) + DX = X - XG(IX,iset) + +! Compute the values of xpdfs for two neighbouring values of Q2 +! using splines of order 3 + + DO IPDF = -6,6,1 + XPDF1(IPDF) = XPDFEV(IX,IQ2,IPDF,KREP+offset) & + & + DX*(AXB(IX,IQ2,IPDF) + DX*(BXB(IX,IQ2,IPDF) & + & + DX*CXB(IX,IQ2,IPDF)) ) + XPDF2(IPDF) = XPDFEV(IX,IQ2+1,IPDF,KREP+offset) & + & + DX*(AXB(IX,IQ2+1,IPDF) + DX*(BXB(IX,IQ2+1,IPDF) & + & + DX*CXB(IX,IQ2+1,IPDF)) ) + ENDDO + +! Linear interpolation in log Q2 + + TQ = (DLOG(Q2)-DLOG(Q2G(IQ2,iset))) & + & / (DLOG(Q2G(IQ2+1,iset))-DLOG(Q2G(IQ2,iset))) +! + DO IPDF = -6,6,1 + XPDF(IPDF) = (1.0D0-TQ)*XPDF1(IPDF) + TQ*XPDF2(IPDF) + ENDDO + + + elseif(IINTERP.eq.1) then +! + IQ2 = LH_JISEARCH(NQ2,Q2G(1,iset),Q2) + IF (IQ2 .EQ. NQ2) IQ2 = NQ2-1 + IX = LH_JISEARCH(NX,XG(1,iset),X) + +! Assign grid for interpolation. M, N -> order of polyN interpolatio + + do I=1,M + if(IX.ge.M/2.and.IX.le.(NX-M/2)) IX1A(I) = IX - M/2 + I + if(IX.lt.M/2) IX1A(I) = I + if(IX.gt.(NX-M/2)) IX1A(I) = (NX - M) + I + +! Check grids + if(IX1A(I).le.0.or.IX1A(I).gt.NX) then + write(6,*) "Error in grids" + write(6,*) "I, IXIA(I) = ",I, IX1A(I) + call exit(-10) + endif + enddo + + do J=1,N + if(IQ2.ge.N/2.and.IQ2.le.(NQ2-N/2)) IX2A(J) = IQ2 - N/2 + J + if(IQ2.lt.N/2) IX2A(J) = J + if(IQ2.gt.(NQ2-N/2)) IX2A(J) = (NQ2 - N) + J +! Check grids + if(IX2A(J).le.0.or.IX2A(J).gt.NQ2) then + write(6,*) "Error in grids" + write(6,*) "J, IXIA(J) = ",J,IX2A(J) + call exit(-10) + endif + enddo + +! uncomment for 3rd order interp. + +! IQ2 = LH_JISEARCH(NQ2,Q2G,Q2) +! IX = LH_JISEARCH(NX,XG,X) +! IF((IX+(M-1)/2).GT.NX) IX = NX - (M-1)/2 +! IF((IX-(M-1)/2).LT.1) IX = (M+1)/2 +! IDUM = 0 +! DO I = -(M-1)/2,(M-1)/2,1 +! IDUM = IDUM +1 +! IX1A(IDUM) = IX + I +! ENDDO + +! IF((IQ2+(N-1)/2).GT.NQ2) IQ2 = NQ2 - (N-1)/2 +! IF((IQ2-(N-1)/2).LT.1) IQ2 = (N+1)/2 + +! JDUM = 0 +! DO J = -(N-1)/2,(N-1)/2,1 +! JDUM = JDUM +1 +! IX2A(JDUM) = IQ2 + J +! ENDDO +! +! Define points where to evaluate interpolation +! Choose between linear or logarithmic (x,Q2) interpolation + + IF(X.LT.XCH)THEN + X1=dlog(X) + ELSE + X1=X + ENDIF + X2=dlog(Q2) + + DO IPDF = -6,6,1 + +! Choose between linear or logarithmic (x,Q2) interpolation + DO I=1,M + IF(X.LT.XCH)THEN + X1A(I)= dlog(XG(IX1A(I),iset)) + ELSE + X1A(I)= XG(IX1A(I),iset) + ENDIF + DO J=1,N + X2A(J) = dlog(Q2G(IX2A(J),iset)) + YA(I,J) = XPDFEV(IX1A(I),IX2A(J),IPDF,KREP+offset) + enddo + enddo + +! 2D polynomial interpolation + call lh_polin2(x1a,x2a,ya,m,n,x1,x2,y,dy) + XPDF(IPDF) = y + + enddo + endif +! + RETURN + +!******************************************************** + entry NNPDFINTgetgrid(nset,ngridx,ngridq,gridx,gridq) + do jx=1,nx + gridx(jx)=xg(jx,nset) + enddo + do jq=1,nq2 + gridq(jq)=q2g(jq,nset) + enddo + ngridx=nx + ngridq=nq2 + return +!******************************************************** + + ENTRY NNPDFINTread(nset) +! + READ(1,*)nmem(nset),ndef(nset) + +! Set number of members + call setnmem(nset,nmem) + +! Read the grid in x + READ(1,*) nxx + IF(NXX.NE.NX)WRITE(*,*)"WARNING CHANGE NX ACCORDING TO .LHgrid" + DO ix = 1,nxx + READ(1,*) xg(ix,nset) + ENDDO + +! Read the grid in Q2 + READ(1,*) nqq2 + IF(NQQ2.NE.NQ2)WRITE(*,*)"WARNING CHANGE NQ2 ACCORDING TO .LHgrid" + READ(1,*) q2min + DO iq2 = 1,nqq2 + READ(1,*) q2g(iq2,nset) + ENDDO + +! Read the number of replicas + READ(1,*) NREP + +! Read the evolved xpdf grid for each replica + offset = 101*(nset-1) + DO K=0,NREP + DO IX=1,NX + DO IQ2=1,NQ2 + READ(1,*) tmp +! write (*,*) ix,iq2,ipdf,k,tmp(7) + DO ipdf=-6,6,1 + xpdfev(ix,iq2,ipdf,k+offset) = tmp(ipdf+7) + ENDDO + ENDDO + ENDDO + ENDDO +! + RETURN + +!******************************************************** + + ENTRY NNPDFINTalfa(alfas,Q) +! + QQ = Q + alfas = alphaNNPDF(QQ) +! + RETURN + +!******************************************************** + + ENTRY NNPDFINTinit(nset,Eorder,Q2fit) +! + IMODEV = 0 + IVFN = 1 + ITMC = 1 +! + CALL GetOrderPDFM(nset,order) + IPT = order +! + CALL GetQ2fitM(nset,QQ2) + Q2fit = QQ2 + Q20 = QQ2 +! + call GetQmassM(nset,4,mass) + QTH(4) = mass + call GetQmassM(nset,5,mass) + QTH(5) = mass + call GetQmassM(nset,6,mass) + QTH(6) = mass +! + DO i = 4,6 + q2th(i) = qth(i)**2d0 + ENDDO +! + ! added for filling Fparm->asref + call initEVOLVEpdf(nset,mmem) + CALL GetAlfas(nset,alfas0,Q0) + asref = alfas0 + q2ref = q0**2d0 +! + RETURN + +!******************************************************** +! + entry NNPDFINTpdf(nset) + pdfmem = nset + IF (pdfmem.LT.0) THEN + WRITE(*,*) 'NNPDF set:' + WRITE(*,*) 'PDF member out of range:' + WRITE(*,*) 'member = ',pdfmem + STOP + ENDIF + RETURN +! + END + + +!**************************************************************** +! +! CALCULATE THE COEFFICIENTS B,C,D IN A CUBIC SPLINE INTERPOLATION. +! INTERPOLATION SUBROUTINES ARE TAKEN FROM +! G.E. FORSYTHE, M.A. MALCOLM AND C.B. MOLER, +! COMPUTER METHODS FOR MATHEMATICAL COMPUTATIONS (PRENTICE-HALL, 1977). +! +! SUBROUTINE TAKEN FROM AAC GROUP (KUMANO et al.) +! +!******************************************************************* +! + SUBROUTINE LH_JSPLINE(B,C,D,I,J,KREP) + IMPLICIT none +! + include 'parmsetup.inc' + INTEGER MXREP + PARAMETER(MXREP=1e3) + INTEGER NREP + common/nnpdf10CNREP/NREP +! + INTEGER NX,NXMAX,NQ2,NPL,IX,IQ2 + PARAMETER(NX=60,NXMAX=100,NQ2=50) + PARAMETER(NPL=3000) + REAL*8 XG(NXMAX,nmxset),Q2G(NQ2,nmxset),XPDFEV(NXMAX,NQ2,-6:6,0:MXREP) +! common/nnpdf10CPDFGR/XPDFEV,XG,Q2G,IX,IQ2 + common/nnpdfallCPDFGR/XPDFEV,XG,Q2G,IX,IQ2 +! + INTEGER I,J,NM1,K,IB,KREP + REAL*8 B,C,D,T + DIMENSION B(NX,NQ2,-6:6), C(NX,NQ2,-6:6), D(NX,NQ2,-6:6) + integer iset +! + call getnset(iset) + + NM1=NX-1 + IF(NX.LT.2) RETURN + IF(NX.LT.3) GOTO 250 + D(1,J,I)=XG(2,iset)-XG(1,iset) + C(2,J,I)=(XPDFEV(2,J,I,KREP)-XPDFEV(1,J,I,KREP))/D(1,J,I) + DO 210 K=2,NM1 + D(K,J,I)=XG(K+1,iset)-XG(K,iset) + B(K,J,I)=2.0D0*(D(K-1,J,I)+D(K,J,I)) + C(K+1,J,I)=(XPDFEV(K+1,J,I,KREP)-XPDFEV(K,J,I,KREP))/D(K,J,I) + C(K,J,I)=C(K+1,J,I)-C(K,J,I) + 210 END DO + B(1,J,I)=-D(1,J,I) + B(NX,J,I)=-D(NX-1,J,I) + C(1,J,I)=0.0D0 + C(NX,J,I)=0.0D0 + IF(NX.EQ.3) GOTO 215 + C(1,J,I)=C(3,J,I)/(XG(4,iset)-XG(2,iset))-C(2,J,I)/(XG(3,iset)-XG(1,iset)) + C(NX,J,I)=C(NX-1,J,I)/(XG(NX,iset)-XG(NX-2,iset)) & + & -C(NX-2,J,I)/(XG(NX-1,iset)-XG(NX-3,iset)) + C(1,J,I)=C(1,J,I)*D(1,J,I)**2.0D0/(XG(4,iset)-XG(1,iset)) + C(NX,J,I)=-C(NX,J,I)*D(NX-1,J,I)**2.0D0/(XG(NX,iset)-XG(NX-3,iset)) + 215 CONTINUE + DO 220 K=2,NX + T=D(K-1,J,I)/B(K-1,J,I) + B(K,J,I)=B(K,J,I)-T*D(K-1,J,I) + C(K,J,I)=C(K,J,I)-T*C(K-1,J,I) + 220 END DO + C(NX,J,I)=C(NX,J,I)/B(NX,J,I) + DO 230 IB=1,NM1 + K=NX-IB + C(K,J,I)=(C(K,J,I)-D(K,J,I)*C(K+1,J,I))/B(K,J,I) + 230 END DO + B(NX,J,I)=(XPDFEV(NX,J,I,KREP)-XPDFEV(NM1,J,I,KREP))/D(NM1,J,I) & + & +D(NM1,J,I)*(C(NM1,J,I)+2.0D0*C(NX,J,I)) + DO 240 K=1,NM1 + B(K,J,I)=(XPDFEV(K+1,J,I,KREP)-XPDFEV(K,J,I,KREP))/D(K,J,I) & + & -D(K,J,I)*(C(K+1,J,I)+2.0D0*C(K,J,I)) + D(K,J,I)=(C(K+1,J,I)-C(K,J,I))/D(K,J,I) + C(K,J,I)=3.0D0*C(K,J,I) + 240 END DO + C(NX,J,I)=3.0D0*C(NX,J,I) + D(NX,J,I)=D(NX-1,J,I) + RETURN + 250 CONTINUE + B(1,J,I)=(XPDFEV(2,J,I,KREP)-XPDFEV(1,J,I,KREP))/(XG(2,iset)-XG(1,iset)) + C(1,J,I)=0.0D0 + D(1,J,I)=0.0D0 + B(2,J,I)=B(1,J,I) + C(2,J,I)=0.0D0 + D(2,J,I)=0.0D0 + RETURN + END +! +!*********************************************************************** +! THIS FUNCTION SEARCHES "I" WHICH SATISFIES THE RELATION +! X(I) <= Y < X(I+1) BY USING A BINARY SEARCH. +! +! FUNCTION TAKEN FROM AAC GROUP (KUMANO et al.) +!*********************************************************************** + + INTEGER FUNCTION LH_JISEARCH(N,X,Y) +! + IMPLICIT REAL*8(A-H,O-Z) +! Dynamical memory allocation + REAL*8 X(*) +! + MIN=1 + MAX=N+1 +! + + 10 CONTINUE + MID=(MIN+MAX)/2 + IF(Y.LT.X(MID)) THEN + MAX=MID + ELSE + MIN=MID + END IF + IF((MAX-MIN).GT.1) GOTO 10 +! + LH_JISEARCH=MIN +! + RETURN + END + +!**************************************************** +! +! polin2.f +! +! 2D interpolation of arbitrary polinomial order +! Uses polint +! Given arrays x1a(1:m) and x2a(1:n) of independent variables, +! and an m by n array of function values ya(1:m,1:n) tabulated +! at the grid points defined by x1a,x2a; and given values x1,x2 +! of the independent variable, this routine returns +! an interpolated function value y with error dy +! +! Taken from NR fortran +! +!**************************************************** + + subroutine lh_polin2(x1a,x2a,ya,m,n,x1,x2,y,dy) + implicit none +! + integer m,n,nmax,mmax + integer j,k + parameter(nmax=1e3,mmax=1e3) + + real*8 dy,x1,x2,y,x1a(mmax),x2a(nmax),ya(mmax,nmax) + real*8 ymtmp(nmax),yntmp(nmax) + + do j=1,m + do k=1,n + yntmp(k)=ya(j,k) + enddo + call lh_polint(x2a,yntmp,n,x2,ymtmp(j),dy) + enddo + call lh_polint(x1a,ymtmp,m,x1,y,dy) +! + return + END + +!********************************************** +! +! polint.f +! +! Order N polynomial interpolation using Lagrange's formula +! as descrived in Numerical Recipees: +! Given arrays xa and ya each of length n, and given a value +! x, this routine returns a value y and an error estimate dy. +! If P(x) is the polynomial of degree N-1 such that +! P(xa_i)=ya_i,i=1,...,n, then the returned value is y=P(x) +! The algorithm used is Neville's algorithm +! +!****************************************************** + + subroutine LH_POLINT(xa,ya,n,x,y,dy) + implicit none +! + integer n,NMAX +! Largest anticipated value of n + parameter(nmax=1e3) + real*8 dy,x,y,xa(nmax),ya(nmax) + integer i,m,ns + real*8 den,dif,dift,ho,hp,w,c(nmax),d(nmax) + ns=1 + dif=abs(x-xa(1)) + do 11 i=1,n + dift=abs(x-xa(i)) + if(dift.lt.dif) then + ns=i + dif=dift + endif + c(i)=ya(i) + d(i)=ya(i) + 11 enddo + y=ya(ns) + ns=ns-1 + do m=1,n-1 + do i=1,n-m + ho=xa(i)-x + hp=xa(i+m)-x + w=c(i+1)-d(i) + den=ho-hp + if(den.eq.0) then + write(*,*)'failure in polint' + stop + endif + den=w/den + d(i)=hp*den + c(i)=ho*den + enddo + if(2*ns.lt.(n-m)) then + dy=c(ns+1) + else + dy=d(ns) + ns=ns-1 + endif + y=y+dy + enddo + + return + END diff --git a/LHAPDF/lhapdf-5.9.1/src/wrapQCDNUM.F b/LHAPDF/lhapdf-5.9.1/src/wrapQCDNUM.F new file mode 100644 index 00000000000..80534fef749 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/wrapQCDNUM.F @@ -0,0 +1,362 @@ +! -*- F90 -*- + + + subroutine QCDNUMevolve(x,Q,pdf) + implicit none + character*64 gridname + character*16 s1,dummy + integer Eorder,index + real*8 x,Q,Qlam,Q2,Q2fit,alfas0,scale0,alfas + real*8 mc,mc2,mb,mb2,mt,mt2,tc,tc2,tb,tb2 + real*8 singlet,dm,um,dp,up,sp,ub,db,sb,cb,bb,bp,cp,gl,xx + real*8 QALFAS,QPDFXQ,XFROMIX + real*8 f(-6:6),pdf(-6:6) + integer iq0,iqc,iqb,nf,nf0,qnerr,NFLGET,iflag,ix,i,IQFROMQ + integer nx,nq + integer nset,iset,isetlast + data isetlast/-1/ + real*8 xmin,xmax,qmin,qmax,S + save iq0,iqc,iqb,nf0,mc2,mb2,tc2,tb2,mt2 + save nx,xmin,xmax,nq,qmin,qmax,gridname,isetlast +! + call getnset(iset) +! fix 14.7.2006 to speed up sue of QCDNUM + if(iset.ne.isetlast) then + call get_pdfqcd(iset) + isetlast = iset + endif +! + Q2=Q*Q + nf=5 + if (Q2.lt.tb2) nf=4 + if (Q2.lt.tc2) nf=3 + pdf(0)=QPDFXQ('GLUON' ,x,Q2,iflag) + singlet=QPDFXQ('SINGLET',x,Q2,iflag) + dm= QPDFXQ('DM',x,Q2,IFLAG) + um= QPDFXQ('UM',x,Q2,IFLAG) + dp= QPDFXQ('DP',x,Q2,IFLAG) + up= QPDFXQ('UP',x,Q2,IFLAG) + sp= QPDFXQ('SP',x,Q2,IFLAG) + ub=0.5d0*(up-um+singlet/dble(nf)) + db=0.5d0*(dp-dm+singlet/dble(nf)) + sb=0.5d0*(sp+singlet/dble(nf)) + cb=0.d0 + if (nf.ge.4) then + cp= QPDFXQ('CP',X,Q2,IFLAG) + cb=0.5d0*(cp+singlet/dble(nf)) + end if + bb=0.d0 + if (nf.ge.5) then + bp= QPDFXQ('BP',X,Q2,IFLAG) + bb=0.5d0*(bp+singlet/dble(nf)) + end if + + pdf(1)=dm+db + pdf(2)=um+ub + pdf(3)=sb + pdf(4)=cb + pdf(5)=bb + pdf(6)=0d0 + pdf(-1)=db + pdf(-2)=ub + pdf(-3)=sb + pdf(-4)=cb + pdf(-5)=bb + pdf(-6)=0d0 + return +! + entry QCDNUMalfa(alfas,Q) + Q2=Q*Q + nf=6 + if (Q2.lt.mt2) nf=5 + if (Q2.lt.mb2) nf=4 + if (Q2.lt.mc2) nf=3 + alfas=QALFAS(Q2,Qlam,nf,iflag) + return +! + entry QCDNUMread(nset) +! read(1,*) s1 +! print *,s1 +! gridname='large.grid' +! nx=400 +! xmin=1d-6 +! xmax=1d0 +! nq=112 +! qmin=1d0 +! qmax=1d10 +! read(1,*) dummy +! else + read(1,*) gridname,nx,xmin,xmax,nq,qmin,qmax +!* endif +! iset = nset + return +! + entry QCDNUMinit(nset,Eorder,Q2fit) + call qninit + call QNISET('ORDER',Eorder+1) + call grxdef(nx,xmin) + call grqdef(nq,qmin,qmax) + call grqinp(Q2fit,1) + call getQMassM(nset,4,mc) + mc2=mc*mc + CALL QNRSET('CMASS',mc) + CALL QNRSET('MCALF',mc) + call getThresholdM(nset,4,tc) + tc2=tc*tc + call GRQINP(tc2,1) + CALL GRQINP(tc2-1.0d-4,1) + call getQMassM(nset,5,mb) + mb2=mb*mb + CALL QNRSET('BMASS',mb) + CALL QNRSET('MBALF',mb) + call getThresholdM(nset,5,tb) + tb2=tb*tb + call GRQINP(tb2,1) + CALL GRQINP(tb2-1.0d-4,1) + call getQMassM(nset,6,mt) + mt2=mt*mt + CALL QNRSET('TMASS',mt) + CALL QNRSET('MTALF',mt) + call qthres(tc2,tb2) + iq0=IQFROMQ(Q2fit) + iqc=IQFROMQ(tc2) + iqb=IQFROMQ(tb2) + nf0= NFLGET(iq0) +! print *,nf0 + CALL QNBOOK(2,'dm') + CALL QNBOOK(3,'um') + CALL QNBOOK(4,'dp') + CALL QNBOOK(5,'up') + CALL QNBOOK(6,'sp') + CALL QNBOOK(7,'cp') + CALL QNBOOK(8,'bp') + CALL QNLSET('W1ANA',.TRUE.) + CALL QNLSET('W2NUM',.TRUE.) + CALL QNLSET('W2STF',.FALSE.) + if (index(gridname,'none').eq.1) then + call qnfilw(0,0) + else + qnerr=-1 + open(unit=2,status='old',file=gridname, & + & form='unformatted',err=1) + call QNREAD(2,1,qnerr) + 1 close(2) + if (qnerr.ne.0) then + write(*,*) 'Grid file problem: ',gridname + if (qnerr.lt.0) then + write(*,*) 'Grid file does not exist' + write(*,*) 'Calculating and creating grid file' + call qnfilw(0,0) + open(unit=2,status='unknown',file=gridname, & + & form='unformatted') + call QNDUMP(2) + close(2) + else + write(*,*) 'Existing grid file is inconsistent' + if (qnerr.eq.1) & + & write(*,*) 'Defined grid different' + if (qnerr.eq.2) & + & write(*,*) 'Heavy quark weight table different' + if (qnerr.eq.3) & + & write(*,*) 'Charm mass different' + if (qnerr.eq.4) & + & write(*,*) 'Bottom mass different' + stop + endif + endif + endif + return +! + entry QCDNUMpdf(nset) +! print *,'entering QCDNUMpdf',nset + call GetAlfas(nset,alfas0,scale0) +! print *,alfas0,scale0 + Q2=scale0*scale0 + CALL QNRSET('ALFAS',alfas0) + CALL QNRSET('ALFQ0',Q2) + DO ix = 1,nx + xx = XFROMIX(ix) +! print *,'calling parmPDF',ix + call parmPDF(nset,xx,f) +! if(ix.lt.6) print *,nset,xx,f + singlet=0.d0 + do i=1,nf0 + singlet=singlet+f(i)+f(-i) +! print *,i,singlet + end do + gl=f(0) + dm=f(1)-f(-1) + um=f(2)-f(-2) + dp=f(1)+f(-1)-singlet/dble(nf0) + up=f(2)+f(-2)-singlet/dble(nf0) + sp=f(3)+f(-3)-singlet/dble(nf0) +! print *,'calling qpnset sg...',ix,iq0,singlet + CALL QNPSET('SINGLET',ix,iq0,singlet) +! print *,'calling qpnset gl...',ix,iq0,gl + CALL QNPSET('GLUON',ix,iq0,gl) +! print *,'calling qpnset dm...',ix,iq0,dm + CALL QNPSET('DM',ix,iq0,DM) +! print *,'calling qpnset um...',ix,iq0,um + CALL QNPSET('UM',ix,iq0,UM) +! print *,'calling qpnset dp...',ix,iq0,dp + CALL QNPSET('DP',ix,iq0,DP) +! print *,'calling qpnset up...',ix,iq0,up + CALL QNPSET('UP',ix,iq0,UP) +! print *,'calling qpnset sp...',ix,iq0,sp + CALL QNPSET('SP',ix,iq0,SP) + ENDDO +! print *,'calling evols...' + CALL EVOLSG(iq0,1,nq) +! print *,'calling evols dm...' + CALL EVOLNM('DM',iq0,1,nq) +! print *,'calling evols um...' + CALL EVOLNM('UM',iq0,1,nq) +! print *,'calling evols dp...',iq0,iqc,iqb,nq + CALL EVLSEA('dp',iq0,iqc,iqb,nq) +! print *,'calling evols up...' + CALL EVLSEA('up',iq0,iqc,iqb,nq) +! print *,'calling evols sp...' + CALL EVLSEA('sp',iq0,iqc,iqb,nq) + +! print *,'calling evols - heavy...' + +!-- Heavy quark evolution + + CALL EVOLCP('cp',iqc,iqb,nq) + CALL EVOLBP('bp',iqb,nq) +! + call getnset(iset) + call save_pdfqcd(iset) + return +! + END + subroutine EVLSEA(name,IQ0,IQC,IQB,NQGRI) + implicit none + + CHARACTER*(*) name + integer iq0,iqc,iqb,nqgri + real*8 f34,f45,f43,f54,factor + parameter(f34=1.d0/12.d0,f45=1.d0/20.d0,f43=-1.d0/12.d0, & + & f54=-1.d0/20.d0) + + + If(IQ0.le.IQC)then + CAll EVPLUS(name,IQ0,1,IQC) + CALL QADDSI(name,IQC,f34) + CAll EVPLUS(name,IQC,IQC,IQB) + CALL QADDSI(name,IQB,f45) + CAll EVPLUS(name,IQB,IQB,NQGRI) + else if(IQ0.gt.IQC.and.IQ0.le.IQB)then + CAll EVPLUS(name,IQ0,IQC,IQB) + CALL QADDSI(name,IQC,f43) + CAll EVPLUS(name,IQC,1,IQC) + CALL QADDSI(name,IQC,f34) + CALL QADDSI(name,IQB,f45) + CAll EVPLUS(name,IQB,IQB,NQGRI) + else if(IQ0.gt.IQB)then + CAll EVPLUS(name,IQ0,IQB,NQGRI) + CALL QADDSI(name,IQB,f54) + CAll EVPLUS(name,IQB,IQC,IQB) + CALL QADDSI(name,IQB,f45) + CALL QADDSI(name,IQC,f43) + CAll EVPLUS(name,IQC,1,IQC) + CALL QADDSI(name,IQC,f34) + end if + + END + + + subroutine EVOLCP(name,IQC,IQB,NQGRI) + implicit none + + CHARACTER*(*) name + integer iq0,iqc,iqb,nqgri + real*8 f4,f45 + parameter(f4=-1.d0/4.d0,f45=1.d0/20.d0) + +! +! First set to zero to avoid adding -1/4Singl at each iteration +! + + CAll QNPNUL(name) + CALL QADDSI(name,IQC,f4) + CAll EVPLUS(name,IQC,IQC,IQB) + CALL QADDSI(name,IQB,f45) + CAll EVPLUS(name,IQB,IQB,NQGRI) + + END + + subroutine EVOLBP(name,IQB,NQGRI) + implicit none + + CHARACTER*(*) name + integer iqb,nqgri + real*8 f5 + parameter(f5=-1.d0/5.d0) + +! +! First set to zero to avoid adding -1/5Singl at each iteration +! + + CAll QNPNUL(name) + CALL QADDSI(name,IQB,f5) + CAll EVPLUS(name,IQB,IQB,NQGRI) + + END +! +! routine to swap in/out the array PDFQCD(MXX,MQ2,0:10) in QCDNUM as req +! by nset +! + subroutine get_pdfqcd(nset) +! + IMPLICIT DOUBLE PRECISION (A-H,O-Z) +! + include 'parmsetup.inc' +! +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) +! + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) +! + real*8 PDFSAV(MXX,MQ2,0:10,nmxset) + save PDFSAV +! + do k=0,10 + do j=1,mq2 + do i=1,mxx + PDFQCD(i,j,k)=PDFSAV(i,j,k,nset) + enddo + enddo + enddo +! + return +! + entry save_pdfqcd(nset) +! + do k=0,10 + do j=1,mq2 + do i=1,mxx + PDFSAV(i,j,k,nset)=PDFQCD(i,j,k) + enddo + enddo + enddo +! + return + END diff --git a/LHAPDF/lhapdf-5.9.1/src/wrapQCDNUM.f b/LHAPDF/lhapdf-5.9.1/src/wrapQCDNUM.f new file mode 100644 index 00000000000..80534fef749 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/wrapQCDNUM.f @@ -0,0 +1,362 @@ +! -*- F90 -*- + + + subroutine QCDNUMevolve(x,Q,pdf) + implicit none + character*64 gridname + character*16 s1,dummy + integer Eorder,index + real*8 x,Q,Qlam,Q2,Q2fit,alfas0,scale0,alfas + real*8 mc,mc2,mb,mb2,mt,mt2,tc,tc2,tb,tb2 + real*8 singlet,dm,um,dp,up,sp,ub,db,sb,cb,bb,bp,cp,gl,xx + real*8 QALFAS,QPDFXQ,XFROMIX + real*8 f(-6:6),pdf(-6:6) + integer iq0,iqc,iqb,nf,nf0,qnerr,NFLGET,iflag,ix,i,IQFROMQ + integer nx,nq + integer nset,iset,isetlast + data isetlast/-1/ + real*8 xmin,xmax,qmin,qmax,S + save iq0,iqc,iqb,nf0,mc2,mb2,tc2,tb2,mt2 + save nx,xmin,xmax,nq,qmin,qmax,gridname,isetlast +! + call getnset(iset) +! fix 14.7.2006 to speed up sue of QCDNUM + if(iset.ne.isetlast) then + call get_pdfqcd(iset) + isetlast = iset + endif +! + Q2=Q*Q + nf=5 + if (Q2.lt.tb2) nf=4 + if (Q2.lt.tc2) nf=3 + pdf(0)=QPDFXQ('GLUON' ,x,Q2,iflag) + singlet=QPDFXQ('SINGLET',x,Q2,iflag) + dm= QPDFXQ('DM',x,Q2,IFLAG) + um= QPDFXQ('UM',x,Q2,IFLAG) + dp= QPDFXQ('DP',x,Q2,IFLAG) + up= QPDFXQ('UP',x,Q2,IFLAG) + sp= QPDFXQ('SP',x,Q2,IFLAG) + ub=0.5d0*(up-um+singlet/dble(nf)) + db=0.5d0*(dp-dm+singlet/dble(nf)) + sb=0.5d0*(sp+singlet/dble(nf)) + cb=0.d0 + if (nf.ge.4) then + cp= QPDFXQ('CP',X,Q2,IFLAG) + cb=0.5d0*(cp+singlet/dble(nf)) + end if + bb=0.d0 + if (nf.ge.5) then + bp= QPDFXQ('BP',X,Q2,IFLAG) + bb=0.5d0*(bp+singlet/dble(nf)) + end if + + pdf(1)=dm+db + pdf(2)=um+ub + pdf(3)=sb + pdf(4)=cb + pdf(5)=bb + pdf(6)=0d0 + pdf(-1)=db + pdf(-2)=ub + pdf(-3)=sb + pdf(-4)=cb + pdf(-5)=bb + pdf(-6)=0d0 + return +! + entry QCDNUMalfa(alfas,Q) + Q2=Q*Q + nf=6 + if (Q2.lt.mt2) nf=5 + if (Q2.lt.mb2) nf=4 + if (Q2.lt.mc2) nf=3 + alfas=QALFAS(Q2,Qlam,nf,iflag) + return +! + entry QCDNUMread(nset) +! read(1,*) s1 +! print *,s1 +! gridname='large.grid' +! nx=400 +! xmin=1d-6 +! xmax=1d0 +! nq=112 +! qmin=1d0 +! qmax=1d10 +! read(1,*) dummy +! else + read(1,*) gridname,nx,xmin,xmax,nq,qmin,qmax +!* endif +! iset = nset + return +! + entry QCDNUMinit(nset,Eorder,Q2fit) + call qninit + call QNISET('ORDER',Eorder+1) + call grxdef(nx,xmin) + call grqdef(nq,qmin,qmax) + call grqinp(Q2fit,1) + call getQMassM(nset,4,mc) + mc2=mc*mc + CALL QNRSET('CMASS',mc) + CALL QNRSET('MCALF',mc) + call getThresholdM(nset,4,tc) + tc2=tc*tc + call GRQINP(tc2,1) + CALL GRQINP(tc2-1.0d-4,1) + call getQMassM(nset,5,mb) + mb2=mb*mb + CALL QNRSET('BMASS',mb) + CALL QNRSET('MBALF',mb) + call getThresholdM(nset,5,tb) + tb2=tb*tb + call GRQINP(tb2,1) + CALL GRQINP(tb2-1.0d-4,1) + call getQMassM(nset,6,mt) + mt2=mt*mt + CALL QNRSET('TMASS',mt) + CALL QNRSET('MTALF',mt) + call qthres(tc2,tb2) + iq0=IQFROMQ(Q2fit) + iqc=IQFROMQ(tc2) + iqb=IQFROMQ(tb2) + nf0= NFLGET(iq0) +! print *,nf0 + CALL QNBOOK(2,'dm') + CALL QNBOOK(3,'um') + CALL QNBOOK(4,'dp') + CALL QNBOOK(5,'up') + CALL QNBOOK(6,'sp') + CALL QNBOOK(7,'cp') + CALL QNBOOK(8,'bp') + CALL QNLSET('W1ANA',.TRUE.) + CALL QNLSET('W2NUM',.TRUE.) + CALL QNLSET('W2STF',.FALSE.) + if (index(gridname,'none').eq.1) then + call qnfilw(0,0) + else + qnerr=-1 + open(unit=2,status='old',file=gridname, & + & form='unformatted',err=1) + call QNREAD(2,1,qnerr) + 1 close(2) + if (qnerr.ne.0) then + write(*,*) 'Grid file problem: ',gridname + if (qnerr.lt.0) then + write(*,*) 'Grid file does not exist' + write(*,*) 'Calculating and creating grid file' + call qnfilw(0,0) + open(unit=2,status='unknown',file=gridname, & + & form='unformatted') + call QNDUMP(2) + close(2) + else + write(*,*) 'Existing grid file is inconsistent' + if (qnerr.eq.1) & + & write(*,*) 'Defined grid different' + if (qnerr.eq.2) & + & write(*,*) 'Heavy quark weight table different' + if (qnerr.eq.3) & + & write(*,*) 'Charm mass different' + if (qnerr.eq.4) & + & write(*,*) 'Bottom mass different' + stop + endif + endif + endif + return +! + entry QCDNUMpdf(nset) +! print *,'entering QCDNUMpdf',nset + call GetAlfas(nset,alfas0,scale0) +! print *,alfas0,scale0 + Q2=scale0*scale0 + CALL QNRSET('ALFAS',alfas0) + CALL QNRSET('ALFQ0',Q2) + DO ix = 1,nx + xx = XFROMIX(ix) +! print *,'calling parmPDF',ix + call parmPDF(nset,xx,f) +! if(ix.lt.6) print *,nset,xx,f + singlet=0.d0 + do i=1,nf0 + singlet=singlet+f(i)+f(-i) +! print *,i,singlet + end do + gl=f(0) + dm=f(1)-f(-1) + um=f(2)-f(-2) + dp=f(1)+f(-1)-singlet/dble(nf0) + up=f(2)+f(-2)-singlet/dble(nf0) + sp=f(3)+f(-3)-singlet/dble(nf0) +! print *,'calling qpnset sg...',ix,iq0,singlet + CALL QNPSET('SINGLET',ix,iq0,singlet) +! print *,'calling qpnset gl...',ix,iq0,gl + CALL QNPSET('GLUON',ix,iq0,gl) +! print *,'calling qpnset dm...',ix,iq0,dm + CALL QNPSET('DM',ix,iq0,DM) +! print *,'calling qpnset um...',ix,iq0,um + CALL QNPSET('UM',ix,iq0,UM) +! print *,'calling qpnset dp...',ix,iq0,dp + CALL QNPSET('DP',ix,iq0,DP) +! print *,'calling qpnset up...',ix,iq0,up + CALL QNPSET('UP',ix,iq0,UP) +! print *,'calling qpnset sp...',ix,iq0,sp + CALL QNPSET('SP',ix,iq0,SP) + ENDDO +! print *,'calling evols...' + CALL EVOLSG(iq0,1,nq) +! print *,'calling evols dm...' + CALL EVOLNM('DM',iq0,1,nq) +! print *,'calling evols um...' + CALL EVOLNM('UM',iq0,1,nq) +! print *,'calling evols dp...',iq0,iqc,iqb,nq + CALL EVLSEA('dp',iq0,iqc,iqb,nq) +! print *,'calling evols up...' + CALL EVLSEA('up',iq0,iqc,iqb,nq) +! print *,'calling evols sp...' + CALL EVLSEA('sp',iq0,iqc,iqb,nq) + +! print *,'calling evols - heavy...' + +!-- Heavy quark evolution + + CALL EVOLCP('cp',iqc,iqb,nq) + CALL EVOLBP('bp',iqb,nq) +! + call getnset(iset) + call save_pdfqcd(iset) + return +! + END + subroutine EVLSEA(name,IQ0,IQC,IQB,NQGRI) + implicit none + + CHARACTER*(*) name + integer iq0,iqc,iqb,nqgri + real*8 f34,f45,f43,f54,factor + parameter(f34=1.d0/12.d0,f45=1.d0/20.d0,f43=-1.d0/12.d0, & + & f54=-1.d0/20.d0) + + + If(IQ0.le.IQC)then + CAll EVPLUS(name,IQ0,1,IQC) + CALL QADDSI(name,IQC,f34) + CAll EVPLUS(name,IQC,IQC,IQB) + CALL QADDSI(name,IQB,f45) + CAll EVPLUS(name,IQB,IQB,NQGRI) + else if(IQ0.gt.IQC.and.IQ0.le.IQB)then + CAll EVPLUS(name,IQ0,IQC,IQB) + CALL QADDSI(name,IQC,f43) + CAll EVPLUS(name,IQC,1,IQC) + CALL QADDSI(name,IQC,f34) + CALL QADDSI(name,IQB,f45) + CAll EVPLUS(name,IQB,IQB,NQGRI) + else if(IQ0.gt.IQB)then + CAll EVPLUS(name,IQ0,IQB,NQGRI) + CALL QADDSI(name,IQB,f54) + CAll EVPLUS(name,IQB,IQC,IQB) + CALL QADDSI(name,IQB,f45) + CALL QADDSI(name,IQC,f43) + CAll EVPLUS(name,IQC,1,IQC) + CALL QADDSI(name,IQC,f34) + end if + + END + + + subroutine EVOLCP(name,IQC,IQB,NQGRI) + implicit none + + CHARACTER*(*) name + integer iq0,iqc,iqb,nqgri + real*8 f4,f45 + parameter(f4=-1.d0/4.d0,f45=1.d0/20.d0) + +! +! First set to zero to avoid adding -1/4Singl at each iteration +! + + CAll QNPNUL(name) + CALL QADDSI(name,IQC,f4) + CAll EVPLUS(name,IQC,IQC,IQB) + CALL QADDSI(name,IQB,f45) + CAll EVPLUS(name,IQB,IQB,NQGRI) + + END + + subroutine EVOLBP(name,IQB,NQGRI) + implicit none + + CHARACTER*(*) name + integer iqb,nqgri + real*8 f5 + parameter(f5=-1.d0/5.d0) + +! +! First set to zero to avoid adding -1/5Singl at each iteration +! + + CAll QNPNUL(name) + CALL QADDSI(name,IQB,f5) + CAll EVPLUS(name,IQB,IQB,NQGRI) + + END +! +! routine to swap in/out the array PDFQCD(MXX,MQ2,0:10) in QCDNUM as req +! by nset +! + subroutine get_pdfqcd(nset) +! + IMPLICIT DOUBLE PRECISION (A-H,O-Z) +! + include 'parmsetup.inc' +! +#ifndef HERA + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 120 ) +#else + PARAMETER ( MXX = 410 ) + PARAMETER ( MQ2 = 205 ) +#endif +!-- Do not set the following parameter to zero! + PARAMETER ( NDFMAX = 20) +! + COMMON/QCPASS/ & + &ALPHA0, Q0ALFA, ASLAST, QALAST, & + &ALFASQ(MQ2), ALFAPQ(MQ2), ALFA2Q(MQ2), & + &DELUP(MQ2), DELDN(MQ2), PDFQCD(MXX,MQ2,0:10), & + &FNSQCD(MXX,MQ2),DNSQCD(MXX,MQ2), & + &FSIQCD(MXX,MQ2),DSIQCD(MXX,MQ2), & + &FGLQCD(MXX,MQ2),DGGQCD(MXX,MQ2), & + &FSTORE(MXX,MQ2,31:30+NDFMAX),IDFAST(7,30),NDFAST, & + &MARKFF(MXX,MQ2),MARKFH(MXX,MQ2),MARKQQ(MQ2), & + &ISTFID(31:30+NDFMAX),IPDFID(31:30+NDFMAX),IEALFA(MQ2), & + &IQL_LAST(10),IQ0_LAST(10),IQH_LAST(10) +! + real*8 PDFSAV(MXX,MQ2,0:10,nmxset) + save PDFSAV +! + do k=0,10 + do j=1,mq2 + do i=1,mxx + PDFQCD(i,j,k)=PDFSAV(i,j,k,nset) + enddo + enddo + enddo +! + return +! + entry save_pdfqcd(nset) +! + do k=0,10 + do j=1,mq2 + do i=1,mxx + PDFSAV(i,j,k,nset)=PDFQCD(i,j,k) + enddo + enddo + enddo +! + return + END diff --git a/LHAPDF/lhapdf-5.9.1/src/wrapQCDNUM3.f b/LHAPDF/lhapdf-5.9.1/src/wrapQCDNUM3.f new file mode 100644 index 00000000000..db256babe50 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/wrapQCDNUM3.f @@ -0,0 +1,176 @@ +! -*- F90 -*- + + + subroutine QCDNUM3evolve(x,Q,pdf) + implicit none + character*64 gridname + character*16 s1,dummy + integer Eorder,index + real*8 x,Q,Qlam,Q2,Q2fit,alfas0,scale0,alfas + real*8 mc,mc2,mb,mb2,mt,mt2,tc,tc2,tb,tb2 + real*8 singlet,dm,um,dp,up,sp,ub,db,sb,cb,bb,bp,cp,gl,xx + real*8 QALFAS,QPDFXQ,XFROMIX + real*8 f(-6:6),pdf(-6:6) + integer iq0,iqc,iqb,nf,nf0,qnerr,NFLGET,iflag,ix,i,IQFROMQ + integer nx,nq + integer nset,iset,isetlast + data isetlast/-1/ + real*8 xmin,xmax,qmin,qmax,S + save iq0,iqc,iqb,nf0,mc2,mb2,tc2,tb2,mt2 + save nx,xmin,xmax,nq,qmin,qmax,gridname +! + call getnset(iset) + if (iset.ne.isetlast) then + call get_pdfqcd(iset) + isetlast = iset + endif +! + Q2=Q*Q + nf=3 + pdf(0)=QPDFXQ('GLUON' ,x,Q2,iflag) + singlet=QPDFXQ('SINGLET',x,Q2,iflag) + dm= QPDFXQ('DM',x,Q2,IFLAG) + um= QPDFXQ('UM',x,Q2,IFLAG) + dp= QPDFXQ('DP',x,Q2,IFLAG) + up= QPDFXQ('UP',x,Q2,IFLAG) + sp= QPDFXQ('SP',x,Q2,IFLAG) + ub=0.5d0*(up-um+singlet/dble(nf)) + db=0.5d0*(dp-dm+singlet/dble(nf)) + sb=0.5d0*(sp+singlet/dble(nf)) + + pdf(1)=dm+db + pdf(2)=um+ub + pdf(3)=sb + pdf(4)=0d0 + pdf(5)=0d0 + pdf(6)=0d0 + pdf(-1)=db + pdf(-2)=ub + pdf(-3)=sb + pdf(-4)=0d0 + pdf(-5)=0d0 + pdf(-6)=0d0 + return +! + entry QCDNUM3alfa(alfas,Q) + Q2=Q*Q + nf=3 + alfas=QALFAS(Q2,Qlam,nf,iflag) + return +! + entry QCDNUM3read(nset) +! read(1,*) s1 +! print *,s1 +! gridname='large.grid' +! nx=400 +! xmin=1d-6 +! xmax=1d0 +! nq=112 +! qmin=1d0 +! qmax=1d10 +! read(1,*) dummy +! else + read(1,*) gridname,nx,xmin,xmax,nq,qmin,qmax +!* endif +! iset = nset + return +! + entry QCDNUM3init(nset,Eorder,Q2fit) + call qninit + call QNISET('ORDER',Eorder+1) + call grxdef(nx,xmin) + call grqdef(nq,qmin,qmax) + call grqinp(Q2fit,1) + iq0=IQFROMQ(Q2fit) +! nf0= NFLGET(iq0) + nf0=3 + CALL QNBOOK(2,'dm') + CALL QNBOOK(3,'um') + CALL QNBOOK(4,'dp') + CALL QNBOOK(5,'up') + CALL QNBOOK(6,'sp') + CALL QNLSET('W1ANA',.TRUE.) + CALL QNLSET('W2NUM',.TRUE.) + CALL QNLSET('W2STF',.FALSE.) + call qthres(1d10,2d10) + if (index(gridname,'none').eq.1) then + call qnfilw(0,0) + else + qnerr=-1 + open(unit=2,status='old',file=gridname, & + & form='unformatted',err=1) + call QNREAD(2,1,qnerr) + 1 close(2) + if (qnerr.ne.0) then + write(*,*) 'Grid file problem: ',gridname + if (qnerr.lt.0) then + write(*,*) 'Grid file does not exist' + write(*,*) 'Calculating and creating grid file' + call qnfilw(0,0) + open(unit=2,status='unknown',file=gridname, & + & form='unformatted') + call QNDUMP(2) + close(2) + else + write(*,*) 'Existing grid file is inconsistent' + if (qnerr.eq.1) & + & write(*,*) 'Defined grid different' + if (qnerr.eq.2) & + & write(*,*) 'Heavy quark weight table different' + if (qnerr.eq.3) & + & write(*,*) 'Charm mass different' + if (qnerr.eq.4) & + & write(*,*) 'Bottom mass different' + stop + endif + endif + endif + return +! + entry QCDNUM3pdf(nset) +! print *,'entering QCDNUMpdf',nset + call GetAlfas(nset,alfas0,scale0) +! print *,alfas0,scale0 + Q2=scale0*scale0 + CALL QNRSET('ALFAS',alfas0) + CALL QNRSET('ALFQ0',Q2) + DO ix = 1,nx + xx = XFROMIX(ix) +! print *,'calling parmPDF',ix + call parmPDF(nset,xx,f) +! if(ix.lt.6) print *,nset,xx,f + singlet=0.d0 + do i=1,nf0 + singlet=singlet+f(i)+f(-i) +! print *,i,singlet + end do + gl=f(0) + dm=f(1)-f(-1) + um=f(2)-f(-2) + dp=f(1)+f(-1)-singlet/dble(nf0) + up=f(2)+f(-2)-singlet/dble(nf0) + sp=f(3)+f(-3)-singlet/dble(nf0) + CALL QNPSET('SINGLET',ix,iq0,singlet) + CALL QNPSET('GLUON',ix,iq0,gl) + CALL QNPSET('DM',ix,iq0,DM) + CALL QNPSET('UM',ix,iq0,UM) + CALL QNPSET('DP',ix,iq0,DP) + CALL QNPSET('UP',ix,iq0,UP) + CALL QNPSET('SP',ix,iq0,SP) + ENDDO + CALL EVOLSG(iq0,1,nq) + CALL EVOLNM('DM',iq0,1,nq) + CALL EVOLNM('UM',iq0,1,nq) +! +! CALL EVPLUS('DP',iq0,1,nq) +! CALL EVPLUS('UP',iq0,1,nq) +! CALL EVPLUS('SP',iq0,1,nq) + CALL EVOLNP('DP',iq0,1,nq) + CALL EVOLNP('UP',iq0,1,nq) + CALL EVOLNP('SP',iq0,1,nq) +! + call getnset(iset) + call save_pdfqcd(iset) + return +! + END diff --git a/LHAPDF/lhapdf-5.9.1/src/wrapQCDNUM4.f b/LHAPDF/lhapdf-5.9.1/src/wrapQCDNUM4.f new file mode 100644 index 00000000000..3a0be23dd83 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/wrapQCDNUM4.f @@ -0,0 +1,240 @@ +! -*- F90 -*- + + + subroutine QCDNUM4evolve(x,Q,pdf) + implicit none + character*64 gridname + character*16 s1,dummy + integer Eorder,index + real*8 x,Q,Qlam,Q2,Q2fit,alfas0,scale0,alfas + real*8 mc,mc2,mb,mb2,mt,mt2,tc,tc2,tb,tb2 + real*8 singlet,dm,um,dp,up,sp,ub,db,sb,cb,bb,bp,cp,gl,xx + real*8 QALFAS,QPDFXQ,XFROMIX + real*8 f(-6:6),pdf(-6:6) + integer iq0,iqc,iqb,nf,nf0,qnerr,NFLGET,iflag,ix,i,IQFROMQ + integer nx,nq + integer nset,iset,isetlast + data isetlast/-1/ + real*8 xmin,xmax,qmin,qmax,S + save iq0,iqc,iqb,nf0,mc2,mb2,tc2,tb2,mt2 + save nx,xmin,xmax,nq,qmin,qmax,gridname +! +! print *,'QCDNUM4evolve' + call getnset(iset) + if (iset.ne.isetlast) then + call get_pdfqcd(iset) + isetlast = iset + endif +! + Q2=Q*Q + nf=4 + if (Q2.lt.tc2) nf=3 + pdf(0)=QPDFXQ('GLUON' ,x,Q2,iflag) + singlet=QPDFXQ('SINGLET',x,Q2,iflag) + dm= QPDFXQ('DM',x,Q2,IFLAG) + um= QPDFXQ('UM',x,Q2,IFLAG) + dp= QPDFXQ('DP',x,Q2,IFLAG) + up= QPDFXQ('UP',x,Q2,IFLAG) + sp= QPDFXQ('SP',x,Q2,IFLAG) + ub=0.5d0*(up-um+singlet/dble(nf)) + db=0.5d0*(dp-dm+singlet/dble(nf)) + sb=0.5d0*(sp+singlet/dble(nf)) + cb=0.d0 + if (nf.ge.4) then + cp= QPDFXQ('CP',X,Q2,IFLAG) + cb=0.5d0*(cp+singlet/dble(nf)) + end if + + pdf(1)=dm+db + pdf(2)=um+ub + pdf(3)=sb + pdf(4)=cb + pdf(5)=0d0 + pdf(6)=0d0 + pdf(-1)=db + pdf(-2)=ub + pdf(-3)=sb + pdf(-4)=cb + pdf(-5)=0d0 + pdf(-6)=0d0 + return +! + entry QCDNUM4alfa(alfas,Q) + Q2=Q*Q + nf=4 + if (Q2.lt.mc2) nf=3 + alfas=QALFAS(Q2,Qlam,nf,iflag) + return +! + entry QCDNUM4read(nset) +! read(1,*) s1 +! print *,s1 +! gridname='large.grid' +! nx=400 +! xmin=1d-6 +! xmax=1d0 +! nq=112 +! qmin=1d0 +! qmax=1d10 +! read(1,*) dummy +! else + read(1,*) gridname,nx,xmin,xmax,nq,qmin,qmax +!* endif +! iset = nset + return +! + entry QCDNUM4init(nset,Eorder,Q2fit) + call qninit + call QNISET('ORDER',Eorder+1) + call grxdef(nx,xmin) + call grqdef(nq,qmin,qmax) + call grqinp(Q2fit,1) + call getQMassM(nset,4,mc) + mc2=mc*mc +! print *,mc + CALL QNRSET('CMASS',mc) + CALL QNRSET('MCALF',mc) + call getThresholdM(nset,4,tc) + tc2=tc*tc + call GRQINP(tc2,1) + CALL GRQINP(tc2-1.0d-4,1) +! print *,'setting iq0',Q2fit + call qthres(tc2,2d10) + iq0=IQFROMQ(Q2fit) + iqc=IQFROMQ(tc2) + nf0= NFLGET(iq0) +! print *,iq0,iqc,nf0,q2fit,tc2 +! nf0=3 +! print *,nf0 + CALL QNBOOK(2,'dm') + CALL QNBOOK(3,'um') + CALL QNBOOK(4,'dp') + CALL QNBOOK(5,'up') + CALL QNBOOK(6,'sp') + CALL QNBOOK(7,'cp') + CALL QNLSET('W1ANA',.TRUE.) + CALL QNLSET('W2NUM',.TRUE.) + CALL QNLSET('W2STF',.FALSE.) + if (index(gridname,'none').eq.1) then + call qnfilw(0,0) + else + qnerr=-1 + open(unit=2,status='old',file=gridname, & + & form='unformatted',err=1) + call QNREAD(2,1,qnerr) + 1 close(2) + if (qnerr.ne.0) then + write(*,*) 'Grid file problem: ',gridname + if (qnerr.lt.0) then + write(*,*) 'Grid file does not exist' + write(*,*) 'Calculating and creating grid file' + call qnfilw(0,0) + open(unit=2,status='unknown',file=gridname, & + & form='unformatted') + call QNDUMP(2) + close(2) + else + write(*,*) 'Existing grid file is inconsistent' + if (qnerr.eq.1) & + & write(*,*) 'Defined grid different' + if (qnerr.eq.2) & + & write(*,*) 'Heavy quark weight table different' + if (qnerr.eq.3) & + & write(*,*) 'Charm mass different' + if (qnerr.eq.4) & + & write(*,*) 'Bottom mass different' + stop + endif + endif + endif + return +! + entry QCDNUM4pdf(nset) +! print *,'entering QCDNUMpdf',nset + call GetAlfas(nset,alfas0,scale0) +! print *,alfas0,scale0 + Q2=scale0*scale0 + CALL QNRSET('ALFAS',alfas0) + CALL QNRSET('ALFQ0',Q2) + DO ix = 1,nx + xx = XFROMIX(ix) +! print *,'calling parmPDF',ix + call parmPDF(nset,xx,f) +! if(ix.lt.6) print *,nset,xx,f + singlet=0.d0 + do i=1,nf0 + singlet=singlet+f(i)+f(-i) +! print *,i,singlet + end do + gl=f(0) + dm=f(1)-f(-1) + um=f(2)-f(-2) + dp=f(1)+f(-1)-singlet/dble(nf0) + up=f(2)+f(-2)-singlet/dble(nf0) + sp=f(3)+f(-3)-singlet/dble(nf0) +! print *,ix,iq0 + CALL QNPSET('SINGLET',ix,iq0,singlet) + CALL QNPSET('GLUON',ix,iq0,gl) + CALL QNPSET('DM',ix,iq0,DM) + CALL QNPSET('UM',ix,iq0,UM) + CALL QNPSET('DP',ix,iq0,DP) + CALL QNPSET('UP',ix,iq0,UP) + CALL QNPSET('SP',ix,iq0,SP) + ENDDO + CALL EVOLSG(iq0,1,nq) + CALL EVOLNM('DM',iq0,1,nq) + CALL EVOLNM('UM',iq0,1,nq) + CALL EVLSEA4('dp',iq0,iqc,nq) + CALL EVLSEA4('up',iq0,iqc,nq) + CALL EVLSEA4('sp',iq0,iqc,nq) + +! print *,'calling evols - heavy...' + +!-- Heavy quark evolution + + CALL EVOLCP4('cp',iqc,nq) +! + call getnset(iset) + call save_pdfqcd(iset) + return +! + END + subroutine EVLSEA4(name,IQ0,IQC,NQGRI) + implicit none + + CHARACTER*(*) name + integer iq0,iqc,nqgri + real*8 f34,f45,f43,f54,factor + parameter(f34=1.d0/12.d0,f43=-1.d0/12.d0) + +! print *,iq0,iqc,nqgri + If(IQ0.le.IQC)then + CAll EVPLUS(name,IQ0,1,IQC) + CALL QADDSI(name,IQC,f34) + CAll EVPLUS(name,IQC,IQC,NQGRI) + else if(IQ0.gt.IQC)then + CAll EVPLUS(name,IQ0,IQC,NQGRI) + CALL QADDSI(name,IQC,f43) + CAll EVPLUS(name,IQC,1,IQC) + end if + + END + + + subroutine EVOLCP4(name,IQC,NQGRI) + implicit none + + CHARACTER*(*) name + integer iq0,iqc,nqgri + real*8 f4 + parameter(f4=-1.d0/4.d0) + +! +! First set to zero to avoid adding -1/4Singl at each iteration +! + + CAll QNPNUL(name) + CALL QADDSI(name,IQC,f4) + CAll EVPLUS(name,IQC,IQC,NQGRI) + + END diff --git a/LHAPDF/lhapdf-5.9.1/src/wrapUSER.f b/LHAPDF/lhapdf-5.9.1/src/wrapUSER.f new file mode 100644 index 00000000000..2b130e6d8e7 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/wrapUSER.f @@ -0,0 +1,25 @@ +! -*- F90 -*- + + + subroutine USERevolve(x,Q,f) + implicit none + integer nset + real*8 f(-6:6) + real*8 x,Q + real*8 alfas + real*8 Eorder,Q2fit + return +! + entry USERread(nset) + return +! + entry USERalfa(alfas,Q) + return +! + entry USERinit(nset,Eorder,Q2fit) + return +! + entry USERpdf(nset) + return +! + END diff --git a/LHAPDF/lhapdf-5.9.1/src/wrapXNN.f b/LHAPDF/lhapdf-5.9.1/src/wrapXNN.f new file mode 100644 index 00000000000..3528cd8880e --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/wrapXNN.f @@ -0,0 +1,184 @@ +!*********************************************************************** +! Initial parameterization: NN (simplified wrt our code) +!*********************************************************************** + + subroutine LH_PDFIN(X,PDFTMP) + implicit none +! + INCLUDE 'parmsetup.inc' + CHARACTER*16 name(nmxset) + INTEGER nmem(nmxset),ndef(nmxset),mmem + COMMON/NAME/name,nmem,ndef,mmem +! + INTEGER KREP + integer MXREP + parameter(MXREP=1e3) + integer MXPDF + parameter(MXPDF=13) + !# pdfs parametrized with NN + integer NTOTPDF + parameter(NTOTPDF=5) + integer MXPAR + parameter(MXPAR=2e2) +! + integer JPDF + REAL*8 X + REAL*8 PDFTMP(MXPDF),PDFFLV(NTOTPDF) +! +! Warnings + + KREP = MMEM + if(X.gt.1d0) then + write(6,*) "X = ",X + write(6,*) 'X greater than 1 in pdfin routine !' + call exit(-10) + elseif(X.le.0d0) then + write(6,*) "X = ",X + write(6,*) 'X less or equal 0 in pdfin routine !' + call exit(-10) + endif +! +! Neural network parton distributions + do JPDF=1,NTOTPDF + call LH_NNPDF(X,JPDF,KREP,PDFFLV(JPDF)) + enddo + call LH_PDFINPAR2EVLN(PDFFLV,PDFTMP) +! + return + END + +!*********************************************************************** +! those commons might be changed depending on those put in inputPDF. +!*********************************************************************** + + subroutine LH_NNPDF(X,JPDF,KREP,PDFNET) + implicit none +! + integer KREP + integer MXREP + parameter(MXREP=1e3) + integer MXPDF + parameter(MXPDF=13) + !# pdfs parametrized with NN + integer NTOTPDF + parameter(NTOTPDF=5) + integer MXPAR + parameter(MXPAR=2e2) +! + !NN basic parameters + integer MXL,MXN + parameter(MXL=5,MXN=10) +! + ! NN architecture + integer TNL(NTOTPDF),NEU(MXL,NTOTPDF) + REAL*8 XNOR(2,NTOTPDF),PDFNOR(2,NTOTPDF) + REAL*8 PDFEXP(2,NTOTPDF) + REAL*8 PDFDELTA(NTOTPDF) + REAL*8 XDELTALIN(NTOTPDF),XDELTALOG(NTOTPDF) + common/nnpdf10CNNARC/PDFEXP,PDFNOR,PDFDELTA,XDELTALIN & + & ,XDELTALOG,XNOR,NEU,TNL +! + real*8 PARTR(MXPAR,0:MXREP,MXPDF) + real*8 ANORMTR(MXPDF,0:MXREP) + common/nnpdf10CPARTR/PARTR,ANORMTR +! + INTEGER ipdf,JPDF,NTMP(MXL),L + REAL*8 PDFOUT,X + REAL*8 XNNIN(MXN),XNNOUT,XNN(MXN,MXL) + REAL*8 PDFNET +! +! Temporary array of neuron number + do L=1,TNL(JPDF) + NTMP(L)=NEU(L,JPDF) + enddo +! + do IPDF=1,NTOTPDF +! Evaluate fixed coefficients used in the normalizaion of NN + XDELTALIN(IPDF)=1.d0/(XNOR(2,IPDF)-XNOR(1,IPDF))*0.8d0 + XDELTALOG(IPDF)=1.d0/dlog(XNOR(2,IPDF)/XNOR(1,IPDF))*0.8d0 + PDFDELTA(IPDF)=(PDFNOR(2,IPDF)-PDFNOR(1,IPDF))/0.8d0 + enddo +! + XNNIN(1)=(X-XNOR(1,JPDF))*XDELTALIN(JPDF)+0.1d0 + XNNIN(2)=dlog(X/XNOR(1,JPDF))*XDELTALOG(JPDF)+0.1d0 +! +! Call neural network routine +! + call LH_NNOUT(XNNIN,TNL(JPDF),NTMP,PARTR(1,KREP,JPDF),XNN,XNNOUT) +! +! Output normalization: the delta is defined in pdfcreate.f +! + PDFOUT=PDFNOR(1,JPDF)+(XNNOUT - 0.1d0)*PDFDELTA(JPDF) +! +! Preprocessing exponents +! + PDFNET=((1.-x)**PDFEXP(1,JPDF))*PDFOUT*x**(-PDFEXP(2,JPDF)) +! +! PDF normalization factor (fixed in some cases by sum rules) +! + PDFNET= ANORMTR(JPDF,KREP) * PDFNET +! + return + END +! +! file: NNSUB.f --> It evaluates NN output +! + subroutine LH_NNOUT(xnnin,tnl,n,PAR,xnn,xnnout) + implicit none +! + integer MXL,MXN + parameter(MXL=5,MXN=10) + integer MXPAR + parameter(MXPAR=2e2) +! + integer tnl,n,l,i,ii,j + REAL*8 xnnin,xnnout,xnn,LH_G,h + dimension n(mxl) + dimension xnnin(mxn) + dimension xnn(mxn,mxl) +! + REAL*8 PAR(mxpar) + integer IPAR +! + IPAR=0 + do ii=1,n(1) + xnn(ii,1)=xnnin(ii) + enddo + do l=1,tnl-1 + xnn(n(l)+1,l)=1d0 + enddo + + do l=2,tnl-1 + do i=1,n(l) + h=0. + do j=1,n(l-1)+1 + IPAR=IPAR+1 + h=h+PAR(IPAR)*xnn(j,l-1) + enddo + xnn(i,l)=LH_G(h) + enddo + enddo + do i=1,n(tnl) + h=0. + do j=1,n(l-1)+1 + IPAR=IPAR+1 + h=h+PAR(IPAR)*xnn(j,l-1) + enddo + xnn(i,tnl)=h + enddo + + xnnout=xnn(1,tnl) + + return + END +! +! Neural network activation function +! + function LH_g(x) + implicit none + REAL*8 LH_g,x +! + LH_g=1./(1.+DExp(-x)) +! + return + END diff --git a/LHAPDF/lhapdf-5.9.1/src/wrapa02m-lite.f b/LHAPDF/lhapdf-5.9.1/src/wrapa02m-lite.f new file mode 100644 index 00000000000..1ae4feebe82 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/wrapa02m-lite.f @@ -0,0 +1,297 @@ +! -*- F90 -*- + + + subroutine A02Mevolve(xb,Q,fset) + implicit none + include 'parmsetup.inc' + integer npdf,npar,kschem,i,k,n,m,kx,nxbb + integer nxb,nq,np,nvar,pdfmem,imem,nvar2 +! parameter(nxb=99,nq=20,np=9,nvar=17) + parameter(nxb=99,nq=20,np=9,nvar=0,nvar2=17) + integer nexp(0:np) + data nexp / 0, 3, 4, 5, 5, 5, 5, 5, 5, 5 / + character*16 name(nmxset) + character*80 line + character*512 setpath + integer nmem(nmxset),ndef(nmxset),mem + common/NAME/name,nmem,ndef,mem + double precision gridx(nmxgridx),gridq(nmxgridq) + integer ngridx,ngridq,jx,jq +! integer iset,iimem +! common/SET/iset,iimem + integer nset,iset,ii + real*8 f(0:nvar,nxb,nq+1,0:np),xx(nxb) + real*8 fsp(nxb),bs(nxb),cs(nxb),ds(nxb) + real*8 bsp(0:nvar,nxb,nq+1,0:np),csp(0:nvar,nxb,nq+1,0:np) & + & ,dsp(0:nvar,nxb,nq+1,0:np) + real*8 x1,xd,del,dels,delx,delx1,xlog1 + real*8 pdfs(0:np),fset(-6:6),alfas + real*8 x,Q,xb,q2,xmin,xmax,qsq,qsqmin,qsqmax,b,ss + real*8 aa,f0,fp,fm + data xmin,xmax,qsqmin,qsqmax/1d-7,1d0,0.8d0,2d8/ + + save f,npdf,npar,pdfmem,dels,delx,x1,delx1,xlog1,nxbb,xx & + &,fsp,bsp,csp,dsp +! save + + q2=Q*Q + if(q2.lt.qsqmin.or.q2.gt.qsqmax) print 99,q2 + if(xb.lt.xmin.or.xb.gt.xmax) print 98,x + 99 format(' WARNING: Q^2 VALUE IS OUT OF RANGE ') + 98 format(' WARNING: X VALUE IS OUT OF RANGE ') + + x=max(xb,xmin) + x=min(x,xmax) + qsq=max(q2,qsqmin) + qsq=min(qsq,qsqmax) + + if (x.gt.x1) then + xd=(1d0-x1)**2-(1d0-x)**2 + n=int(xd/delx1)+nxbb + else + xd=dlog(x)-xlog1 + n=nxbb+int(xd/DELX)-1 + end if + aa=x-xx(n) + + ss=dlog(dlog(qsq/0.04d0))-dlog(dlog(qsqmin/0.04d0)) + m=int(ss/dels)+1 + b=ss/dels-dble(m)+1.d0 + +! k=pdfmem + k=0 + + do i=0,npdf + f0=f(k,n,m,i) + aa*bsp(k,n,m,i) + aa**2*csp(k,n,m,i) & + & + aa**3*dsp(k,n,m,i) + fp=f(k,n,m+1,i) + aa*bsp(k,n,m+1,i) + aa**2*csp(k,n,m+1,i) & + & + aa**3*dsp(k,n,m+1,i) + if (m.ge.2) then + fm=f(k,n,m-1,i) + aa*bsp(k,n,m-1,i) + aa**2*csp(k,n,m-1,i) & + & +aa**3*dsp(k,n,m-1,i) + pdfs(i)=fm*b*(b-1d0)/2d0 + f0*(1d0-b**2) + fp*b*(b+1d0)/2d0 + else + pdfs(i)= f0*(1d0-b) + fp*b + end if + pdfs(i) = pdfs(i)*(1d0-x)**dble(nexp(i)) + end do + + fset(-6)=pdfs(9) + fset(-5)=pdfs(8) + fset(-4)=pdfs(7) + fset(-3)=pdfs(5) +!--reversed mrs 7/7/04 due + fset(-1)=pdfs(6) + fset(-2)=pdfs(4) + fset(0)=pdfs(3) +!--reversed mrs 7/7/04 due + fset(2)=pdfs(1)+pdfs(4) + fset(1)=pdfs(2)+pdfs(6) + fset(3)=pdfs(5) + fset(4)=pdfs(7) + fset(5)=pdfs(8) + fset(6)=pdfs(9) + return +! + entry A02Malfa(alfas,Q) + q2=Q*Q + if(q2.lt.qsqmin.or.q2.gt.qsqmax) print 99,q2 + qsq=max(q2,qsqmin) + qsq=min(qsq,qsqmax) + + ss=log(log(qsq/0.04))-log(log(qsqmin/0.04)) + m=int(ss/dels)+1 + b=ss/dels-m+1 + + k=pdfmem + alfas=(1d0-b)*f(0,1,m,0)+b*f(0,1,m+1,0) + return +! + entry A02Mgetgrid(nset,ngridx,ngridq,gridx,gridq) + + ngridx=nxb + do jx=1,nxb + gridx(jx)=xx(jx) + enddo + + ngridq=nq + do jq=1,ngridq + gridq(jq)= 0.04*exp(exp( & + & log(log(qsqmin/0.04))+(float(jq-1)/19)*( log(log(qsqmax/0.04))-log(log(qsqmin/0.04)) ) & + & )) + enddo + + return + entry A02Mread(nset) +! following fix because members are 0-nvar +! nmem = nvar + 1 + + nmem(nset) = nvar2 + ndef(nset) = 0 +! - dummy read in to get to End: (stream 1 is still open) + read(1,*) npdf + npar=nvar2 + do k=0,npar + do n=1,nxb-1 + do m=1,nq + read(1,*) (f(k,n,m,i),i=0,npdf) + enddo + enddo + enddo + + return +! + entry A02Minit + + dels=(dlog(dlog(qsqmax/0.04d0))- & + & dlog(dlog(qsqmin/0.04d0)))/dble(nq-1) + + + return +! + entry A02Mpdf(imem) + pdfmem=imem + if ((pdfmem.lt.0).or.(pdfmem.gt.npar)) then + write(*,*) 'A02M PDF set:' + write(*,*) 'PDF member out of range:' + write(*,*) 'member = ',pdfmem,' member range = (0,',npar,')' + stop + endif + + call getnset(iset) + nmem(iset) = nvar2 + ndef(iset) = 0 + +! have to reopen stream 1 + call getsetpath(setpath) + open(1,file=setpath(1:len_trim(setpath)),action='READ') + line = '' + do while (line(2:11).ne.'Evolution:') + read(1,'(a)') line + enddo + read(1,'(a)'),line + read(1,'(a)'),line + + + read(1,*) npdf +! print *,'number of members',npdf + npar=nvar2 + do k=0,imem-1 + do n=1,nxb-1 + do m=1,nq + read(1,*) (f(0,n,m,i),i=0,npdf) + enddo + enddo + enddo + + do n=1,nxb-1 + do m=1,nq + read(1,*) (f(0,n,m,i),i=0,npdf) + enddo + enddo + + + nxbb=nxb/2 + x1=0.3d0 + xlog1=dlog(x1) + delx=(dlog(x1)-dlog(xmin))/dble(nxbb-1) + DELX1=(1.d0-x1)**2/dble(nxbb+1) + +!...X GRID + do kx=1,nxbb + xx(kx)=dexp(dlog(xmin)+delx*dble(kx-1)) + end do + do kx=nxbb+1,nxb-1 + xx(kx)=1.d0-dsqrt(dabs((1.d0-x1)**2-delx1*dble(kx-nxbb))) + end do + xx(nxb)=1d0 + + do i=0,npdf + do m=1,nq + if (i.ne.0) then + f(0,nxb,m,i)=0d0 + else + f(0,nxb,m,i)=f(0,nxb-1,m,i) + end if + do n=1,nxb-1 + f(0,n,m,i)=f(0,n,m,i)/(1d0-xx(n))**nexp(i) + end do + do n=1,nxb + fsp(n)=f(0,n,m,i) + end do + call a02mspline (nxb,xx,fsp,bs,cs,ds) + do n=1,nxb + bsp(0,n,m,i)=bs(n) + csp(0,n,m,i)=cs(n) + dsp(0,n,m,i)=ds(n) + end do + end do + end do + close(1) + return + + END + +! --------------------------------------------------------------------- + SUBROUTINE A02MSPLINE(N,X,Y,B,C,D) +! --------------------------------------------------------------------- +! CALCULATE THE COEFFICIENTS B,C,D IN A CUBIC SPLINE INTERPOLATION. +! INTERPOLATION SUBROUTINES ARE TAKEN FROM +! G.E. FORSYTHE, M.A. MALCOLM AND C.B. MOLER, +! COMPUTER METHODS FOR MATHEMATICAL COMPUTATIONS (PRENTICE-HALL, 1977). +! + IMPLICIT REAL*8(A-H,O-Z) + + DIMENSION X(N), Y(N), B(N), C(N), D(N) +! + NM1=N-1 + IF(N.LT.2) RETURN + IF(N.LT.3) GOTO 250 + D(1)=X(2)-X(1) + C(2)=(Y(2)-Y(1))/D(1) + DO 210 K=2,NM1 + D(K)=X(K+1)-X(K) + B(K)=2.0D0*(D(K-1)+D(K)) + C(K+1)=(Y(K+1)-Y(K))/D(K) + C(K)=C(K+1)-C(K) + 210 END DO + B(1)=-D(1) + B(N)=-D(N-1) + C(1)=0.0D0 + C(N)=0.0D0 + IF(N.EQ.3) GOTO 215 + C(1)=C(3)/(X(4)-X(2))-C(2)/(X(3)-X(1)) + C(N)=C(N-1)/(X(N)-X(N-2))-C(N-2)/(X(N-1)-X(N-3)) + C(1)=C(1)*D(1)**2.0D0/(X(4)-X(1)) + C(N)=-C(N)*D(N-1)**2.0D0/(X(N)-X(N-3)) + 215 CONTINUE + DO 220 K=2,N + T=D(K-1)/B(K-1) + B(K)=B(K)-T*D(K-1) + C(K)=C(K)-T*C(K-1) + 220 END DO + C(N)=C(N)/B(N) + DO 230 IB=1,NM1 + K=N-IB + C(K)=(C(K)-D(K)*C(K+1))/B(K) + 230 END DO + B(N)=(Y(N)-Y(NM1))/D(NM1) & + & +D(NM1)*(C(NM1)+2.0D0*C(N)) + DO 240 K=1,NM1 + B(K)=(Y(K+1)-Y(K))/D(K) & + & -D(K)*(C(K+1)+2.0D0*C(K)) + D(K)=(C(K+1)-C(K))/D(K) + C(K)=3.0D0*C(K) + 240 END DO + C(N)=3.0D0*C(N) + D(N)=D(N-1) + RETURN + 250 CONTINUE + B(1)=(Y(2)-Y(1))/(X(2)-X(1)) + C(1)=0.0D0 + D(1)=0.0D0 + B(2)=B(1) + C(2)=0.0D0 + D(2)=0.0D0 + RETURN + END diff --git a/LHAPDF/lhapdf-5.9.1/src/wrapa02m.f b/LHAPDF/lhapdf-5.9.1/src/wrapa02m.f new file mode 100644 index 00000000000..7e6192a5c0d --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/wrapa02m.f @@ -0,0 +1,265 @@ +! -*- F90 -*- + + + subroutine A02Mevolve(xb,Q,fset) + implicit none + include 'parmsetup.inc' + integer npdf,npar,kschem,i,k,n,m,kx,nxbb + integer nxb,nq,np,nvar,pdfmem,imem + parameter(nxb=99,nq=20,np=9,nvar=17) + integer nexp(0:np) + data nexp / 0, 3, 4, 5, 5, 5, 5, 5, 5, 5 / + character*16 name(nmxset) + integer nmem(nmxset),ndef(nmxset),mem + common/NAME/name,nmem,ndef,mem + double precision gridx(nmxgridx),gridq(nmxgridq) + integer ngridx,ngridq,jx,jq +! integer iset,iimem +! common/SET/iset,iimem + integer nset + real*8 f(0:nvar,nxb,nq+1,0:np),xx(nxb) + real*8 fsp(nxb),bs(nxb),cs(nxb),ds(nxb) + real*8 bsp(0:nvar,nxb,nq+1,0:np),csp(0:nvar,nxb,nq+1,0:np) & + & ,dsp(0:nvar,nxb,nq+1,0:np) + real*8 x1,xd,del,dels,delx,delx1,xlog1 + real*8 pdfs(0:np),fset(-6:6),alfas + real*8 x,Q,xb,q2,xmin,xmax,qsq,qsqmin,qsqmax,b,ss + real*8 aa,f0,fp,fm + data xmin,xmax,qsqmin,qsqmax/1d-7,1d0,0.8d0,2d8/ + + save f,npdf,npar,pdfmem,dels,delx,x1,delx1,xlog1,nxbb,xx & + &,fsp,bsp,csp,dsp +! save + + q2=Q*Q + if(q2.lt.qsqmin.or.q2.gt.qsqmax) print 99,q2 + if(xb.lt.xmin.or.xb.gt.xmax) print 98,x + 99 format(' WARNING: Q^2 VALUE IS OUT OF RANGE ') + 98 format(' WARNING: X VALUE IS OUT OF RANGE ') + + x=max(xb,xmin) + x=min(x,xmax) + qsq=max(q2,qsqmin) + qsq=min(qsq,qsqmax) + + if (x.gt.x1) then + xd=(1d0-x1)**2-(1d0-x)**2 + n=int(xd/delx1)+nxbb + else + xd=dlog(x)-xlog1 + n=nxbb+int(xd/DELX)-1 + end if + aa=x-xx(n) + + ss=dlog(dlog(qsq/0.04d0))-dlog(dlog(qsqmin/0.04d0)) + m=int(ss/dels)+1 + b=ss/dels-dble(m)+1.d0 + + k=pdfmem + + do i=0,npdf + f0=f(k,n,m,i) + aa*bsp(k,n,m,i) + aa**2*csp(k,n,m,i) & + & + aa**3*dsp(k,n,m,i) + fp=f(k,n,m+1,i) + aa*bsp(k,n,m+1,i) + aa**2*csp(k,n,m+1,i) & + & + aa**3*dsp(k,n,m+1,i) + if (m.ge.2) then + fm=f(k,n,m-1,i) + aa*bsp(k,n,m-1,i) + aa**2*csp(k,n,m-1,i) & + & +aa**3*dsp(k,n,m-1,i) + pdfs(i)=fm*b*(b-1d0)/2d0 + f0*(1d0-b**2) + fp*b*(b+1d0)/2d0 + else + pdfs(i)= f0*(1d0-b) + fp*b + end if + pdfs(i) = pdfs(i)*(1d0-x)**dble(nexp(i)) + end do + + fset(-6)=pdfs(9) + fset(-5)=pdfs(8) + fset(-4)=pdfs(7) + fset(-3)=pdfs(5) +!--reversed mrs 7/7/04 due + fset(-1)=pdfs(6) + fset(-2)=pdfs(4) + fset(0)=pdfs(3) +!--reversed mrs 7/7/04 due + fset(2)=pdfs(1)+pdfs(4) + fset(1)=pdfs(2)+pdfs(6) + fset(3)=pdfs(5) + fset(4)=pdfs(7) + fset(5)=pdfs(8) + fset(6)=pdfs(9) + return +! + entry A02Malfa(alfas,Q) + q2=Q*Q + if(q2.lt.qsqmin.or.q2.gt.qsqmax) print 99,q2 + qsq=max(q2,qsqmin) + qsq=min(qsq,qsqmax) + + ss=log(log(qsq/0.04))-log(log(qsqmin/0.04)) + m=int(ss/dels)+1 + b=ss/dels-m+1 + + k=pdfmem + alfas=(1d0-b)*f(k,1,m,0)+b*f(k,1,m+1,0) + return +! + entry A02Mgetgrid(nset,ngridx,ngridq,gridx,gridq) + + ngridx=nxb + do jx=1,nxb + gridx(jx)=xx(jx) + enddo + + ngridq=nq + do jq=1,ngridq + gridq(jq)= 0.04*exp(exp( & + & log(log(qsqmin/0.04))+(float(jq-1)/19)*( log(log(qsqmax/0.04))-log(log(qsqmin/0.04)) ) & + & )) + enddo + + return + + entry A02Mread(nset) +! following fix because members are 0-nvar +! nmem = nvar + 1 + + nmem(nset) = nvar + ndef(nset) = 0 + + + read(1,*) npdf +! print *,'number of members',npdf + npar=nvar + do k=0,npar + do n=1,nxb-1 + do m=1,nq + read(1,*) (f(k,n,m,i),i=0,npdf) +! print 100,(f(k,n,m,i),i=0,npdf) + enddo + enddo + enddo + 100 format (13f11.5) + + nxbb=nxb/2 + x1=0.3d0 + xlog1=dlog(x1) + delx=(dlog(x1)-dlog(xmin))/dble(nxbb-1) + DELX1=(1.d0-x1)**2/dble(nxbb+1) + +!...X GRID + do kx=1,nxbb + xx(kx)=dexp(dlog(xmin)+delx*dble(kx-1)) + end do + do kx=nxbb+1,nxb-1 + xx(kx)=1.d0-dsqrt(dabs((1.d0-x1)**2-delx1*dble(kx-nxbb))) + end do + xx(nxb)=1d0 + + do k=0,npar + do i=0,npdf + do m=1,nq + if (i.ne.0) then + f(k,nxb,m,i)=0d0 + else + f(k,nxb,m,i)=f(k,nxb-1,m,i) + end if + do n=1,nxb-1 + f(k,n,m,i)=f(k,n,m,i)/(1d0-xx(n))**nexp(i) + end do + do n=1,nxb + fsp(n)=f(k,n,m,i) + end do + call a02mspline (nxb,xx,fsp,bs,cs,ds) + do n=1,nxb + bsp(k,n,m,i)=bs(n) + csp(k,n,m,i)=cs(n) + dsp(k,n,m,i)=ds(n) + end do + end do + end do + end do + + return +! + entry A02Minit + + dels=(dlog(dlog(qsqmax/0.04d0))- & + & dlog(dlog(qsqmin/0.04d0)))/dble(nq-1) + + + return +! + entry A02Mpdf(imem) + pdfmem=imem + if ((pdfmem.lt.0).or.(pdfmem.gt.npar)) then + write(*,*) 'A02M PDF set:' + write(*,*) 'PDF member out of range:' + write(*,*) 'member = ',pdfmem,' member range = (0,',npar,')' + stop + endif + return + END + +! --------------------------------------------------------------------- + SUBROUTINE A02MSPLINE(N,X,Y,B,C,D) +! --------------------------------------------------------------------- +! CALCULATE THE COEFFICIENTS B,C,D IN A CUBIC SPLINE INTERPOLATION. +! INTERPOLATION SUBROUTINES ARE TAKEN FROM +! G.E. FORSYTHE, M.A. MALCOLM AND C.B. MOLER, +! COMPUTER METHODS FOR MATHEMATICAL COMPUTATIONS (PRENTICE-HALL, 1977). +! + IMPLICIT REAL*8(A-H,O-Z) + + DIMENSION X(N), Y(N), B(N), C(N), D(N) +! + NM1=N-1 + IF(N.LT.2) RETURN + IF(N.LT.3) GOTO 250 + D(1)=X(2)-X(1) + C(2)=(Y(2)-Y(1))/D(1) + DO 210 K=2,NM1 + D(K)=X(K+1)-X(K) + B(K)=2.0D0*(D(K-1)+D(K)) + C(K+1)=(Y(K+1)-Y(K))/D(K) + C(K)=C(K+1)-C(K) + 210 END DO + B(1)=-D(1) + B(N)=-D(N-1) + C(1)=0.0D0 + C(N)=0.0D0 + IF(N.EQ.3) GOTO 215 + C(1)=C(3)/(X(4)-X(2))-C(2)/(X(3)-X(1)) + C(N)=C(N-1)/(X(N)-X(N-2))-C(N-2)/(X(N-1)-X(N-3)) + C(1)=C(1)*D(1)**2.0D0/(X(4)-X(1)) + C(N)=-C(N)*D(N-1)**2.0D0/(X(N)-X(N-3)) + 215 CONTINUE + DO 220 K=2,N + T=D(K-1)/B(K-1) + B(K)=B(K)-T*D(K-1) + C(K)=C(K)-T*C(K-1) + 220 END DO + C(N)=C(N)/B(N) + DO 230 IB=1,NM1 + K=N-IB + C(K)=(C(K)-D(K)*C(K+1))/B(K) + 230 END DO + B(N)=(Y(N)-Y(NM1))/D(NM1) & + & +D(NM1)*(C(NM1)+2.0D0*C(N)) + DO 240 K=1,NM1 + B(K)=(Y(K+1)-Y(K))/D(K) & + & -D(K)*(C(K+1)+2.0D0*C(K)) + D(K)=(C(K+1)-C(K))/D(K) + C(K)=3.0D0*C(K) + 240 END DO + C(N)=3.0D0*C(N) + D(N)=D(N-1) + RETURN + 250 CONTINUE + B(1)=(Y(2)-Y(1))/(X(2)-X(1)) + C(1)=0.0D0 + D(1)=0.0D0 + B(2)=B(1) + C(2)=0.0D0 + D(2)=0.0D0 + RETURN + END diff --git a/LHAPDF/lhapdf-5.9.1/src/wrapabfkwpi.f b/LHAPDF/lhapdf-5.9.1/src/wrapabfkwpi.f new file mode 100644 index 00000000000..76f66f6461f --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/wrapabfkwpi.f @@ -0,0 +1,277 @@ +! -*- F90 -*- + + + subroutine ABFKWPevolve(xin,qin,pdf) + include 'parmsetup.inc' + PARAMETER(NX=50) + PARAMETER(NQ=19) + real*8 xin,qin,pdf(-6:6),xval(45),qcdl4,qcdl5 + real*8 upv,dnv,usea,dsea,str,chm,bot,top,glu + real*8 calcpi(8,20,25,3),calcpio(8,20,25),parpi(40,3) + common /ABFKWP/ CALCPI,CALCPIO,PARPI,lastmem + character*16 name(nmxset) + integer nmem(nmxset),ndef(nmxset),mmem + common/NAME/name,nmem,ndef,mmem + integer nset + save + + iimem = imem + if(iimem.eq.0) iimem = 1 + if(iimem.le.3) then + call ABFKWxx(iimem,xin,qin,upv,dnv,usea,dsea, str,chm,glu) + endif + + + pdf(-6)= 0.0d0 + pdf(6)= 0.0d0 + pdf(-5)= 0.0d0 + pdf(5 )= 0.0d0 + pdf(-4)= chm + pdf(4 )= chm + pdf(-3)= str + pdf(3 )= str + pdf(-2)= usea + pdf(2 )= upv+usea + pdf(-1)= dsea + pdf(1 )= dnv+dsea + pdf(0 )= glu + + return +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + entry ABFKWPread(nset) + read(1,*)nmem(nset),ndef(nset) +! print *,nmem,ndef + lastmem = -999 + do j=1,3 + read(1,*)(parpi(k,j),k=1,4) + read(1,*)(parpi(k,j),k=5,8) + read(1,*)(parpi(k,j),k=9,12) + read(1,*)(parpi(k,j),k=13,16) + read(1,*)(parpi(k,j),k=17,20) + read(1,*)(parpi(k,j),k=21,24) + read(1,*)(parpi(k,j),k=25,28) + read(1,*)(parpi(k,j),k=29,32) + read(1,*)(parpi(k,j),k=33,36) + read(1,*)(parpi(k,j),k=37,40) + do l=1,25 + do k=1,20 + read(1,*)(CALCPI(m,k,l,j),m=1,4) + read(1,*)(CALCPI(m,k,l,j),m=5,8) + enddo + enddo + enddo + return +! +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + entry ABFKWPalfa(alfas,qalfa) + call getnset(iset) + call GetOrderAsM(iset,iord) + call Getlam4M(iset,imem,qcdl4) + call Getlam5M(iset,imem,qcdl5) + call aspdflib(alfas,Qalfa,iord,qcdl5) + return +! +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + entry ABFKWPinit(Eorder,Q2fit) + return +! +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + entry ABFKWPpdf(mem) + imem = mem + return +! + 1000 format(5e13.5) + END +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +! +! $Id: wrapabfkwpi.f 443 2009-02-10 15:39:06Z buckley $ +! +! $Log$ +! Revision 1.2 2005/10/07 15:15:05 whalley +! Changes to most files for V5 - multiset initializations +! +! Revision 1.1.1.1 2005/05/06 14:54:43 whalley +! Initial CVS import of the LHAPDF code and data sets +! +! Revision 1.1.1.2 1996/10/30 08:27:26 cernlib +! Version 7.04 +! +! Revision 1.1.1.1 1996/04/12 15:28:53 plothow +! Version 7.01 +! +! + SUBROUTINE ABFKWxx(imem,DX,DQ,DUPV,DDNV,DUSEA,DDSEA,DSTR,DCHM,DGL) + double precision & + & PARPI(40,3),CALCPI(8,20,25,3),CALCPIO(8,20,25),ZEROD, & + & DX,DQ,DUPV,DDNV,DUSEA,DDSEA,DSTR,DCHM,DGL + REAL X, Q, UPV, DNV, USEA, DSEA, STR, CHM, GL + + common /ABFKWP/CALCPI,CALCPIO,PARPI,lastmem + +! COMMON/W5051Ixx/CALCPIO + REAL XPDF(7) + DATA ZEROD/0.D0/ +!---------------------------------------------------------------------- + DATA ISTART/0/ + SAVE ISTART,OWLAM2,Q02PI +! + if(imem.ne.lastmem) then + istart = 0 + lastmem = imem + endif + IF (ISTART.EQ.0) THEN + ISTART=1 + DO 11 K=1,25 + DO 11 I=1,20 + DO 11 M=1,8 + 11 CALCPIO(M,I,K) = CALCPI(M,I,K,imem) + OWLAM=PARPI(1,imem) + OWLAM2=OWLAM**2 + Q02PI=PARPI(39,imem) + Q2MAX=PARPI(40,imem) + ENDIF +! +! the conventions are : q(1)=x*u, q(2)=x*d, q(3)=x*str, q(4)=x*usea, +! q(5)=x*dsea, q(6)=x*charm, q(7)=x*gluon +! + X = DX + Q = DQ + Q2 = Q*Q + IDQ2=2 + SB=0. + IF((Q2-Q02PI).LE.0) THEN + GOTO 1 + ELSE + GOTO 2 + ENDIF + 2 IF((IDQ2-1).LE.0) THEN + GOTO 1 + ELSE + GOTO 3 + ENDIF + 3 SB= LOG( LOG( MAX(Q02PI,Q2)/OWLAM2)/ LOG(Q02PI/OWLAM2)) + 1 CALL AURPIx(1,0,X,SB,XPDF(1)) + CALL AURPIx(2,0,X,SB,XPDF(2)) + CALL AURPIx(3,0,X,SB,XPDF(3)) + CALL AURPIx(4,0,X,SB,XPDF(4)) + CALL AURPIx(5,0,X,SB,XPDF(5)) + CALL AURPIx(8,0,X,SB,XPDF(6)) + CALL AURPIx(7,0,X,SB,XPDF(7)) +! + DUPV=XPDF(1) - XPDF(4) + DDNV=XPDF(2) - XPDF(5) + DUSEA=XPDF(4) + DDSEA=XPDF(5) + DSTR=XPDF(3) + DCHM=XPDF(6) + DGL =XPDF(7) +! + RETURN + END +!============================================================== +! +! $Id: wrapabfkwpi.f 443 2009-02-10 15:39:06Z buckley $ +! +! $Log$ +! Revision 1.2 2005/10/07 15:15:05 whalley +! Changes to most files for V5 - multiset initializations +! +! Revision 1.1.1.1 2005/05/06 14:54:43 whalley +! Initial CVS import of the LHAPDF code and data sets +! +! Revision 1.1.1.2 1996/10/30 08:27:36 cernlib +! Version 7.04 +! +! Revision 1.1.1.1 1996/04/12 15:29:03 plothow +! Version 7.01 +! +! +! + SUBROUTINE AURPIx(I,NDRV,X,S,ANS) + double precision & + & CALCPI(8,20,25,3),CALCPIO(8,20,25),parpi(40,3) + common /ABFKWP/CALCPI,CALCPIO,parpi,lastmem +! COMMON/W5051I4/CALCPIO + REAL F1(25),F2(25) + DATA DELTA/.10/ + ANS=0. + IF(X.GT.0.9985) RETURN + IF(I.EQ.3.AND.X.GT.0.95) RETURN + IF(I.EQ.8.AND.X.GT.0.95) RETURN + IS=S/DELTA+1 + IS1=IS+1 + DO 1 L=1,25 + KL=L+NDRV*25 + F1(L)=CALCPIO(I,IS,KL) + F2(L)=CALCPIO(I,IS1,KL) + 1 END DO + A1=AUGETFV(X,F1) + A2=AUGETFV(X,F2) + S1=(IS-1)*DELTA + S2=S1+DELTA + ANS=A1*(S-S2)/(S1-S2)+A2*(S-S1)/(S2-S1) + RETURN + END +!=============================================================== +! +! $Id: wrapabfkwpi.f 443 2009-02-10 15:39:06Z buckley $ +! +! $Log$ +! Revision 1.2 2005/10/07 15:15:05 whalley +! Changes to most files for V5 - multiset initializations +! +! Revision 1.1.1.1 2005/05/06 14:54:43 whalley +! Initial CVS import of the LHAPDF code and data sets +! +! Revision 1.1.1.2 1996/10/30 08:27:34 cernlib +! Version 7.04 +! +! Revision 1.1.1.1 1996/04/12 15:29:02 plothow +! Version 7.01 +! +! +! + FUNCTION AUGETFV(X,FVL) +! LOGARITHMIC INTERPOLATOR - WATCH OUT FOR NEGATIVE +! FUNCTIONS AND/OR X VALUES OUTSIDE THE RANGE 0 TO 1. +! NOTE: DIMENSION OF FVL IS OVERWRITTEN BY VALUE USED +! IN MAIN ROUTINE. + DIMENSION FVL(25),XGRID(25) + DATA NX,XGRID/25,.001,.002,.004,.008,.016,.032,.064,.1,.15, & + &.2,.25,.3,.35,.4,.45,.5,.55,.6,.65,.7,.75,.8,.85,.9,.95/ + AUGETFV=0. + DO 1 I=1,NX + IF(X.LT.XGRID(I)) GOTO 2 + 1 END DO + 2 I=I-1 + IF(I.EQ.0) THEN + I=I+1 + ELSE IF(I.GT.23) THEN + I=23 + ENDIF + J=I+1 + K=J+1 + AXI= LOG(XGRID(I)) + BXI= LOG(1.-XGRID(I)) + AXJ= LOG(XGRID(J)) + BXJ= LOG(1.-XGRID(J)) + AXK= LOG(XGRID(K)) + BXK= LOG(1.-XGRID(K)) + FI= LOG(ABS(FVL(I)) +1.E-15) + FJ= LOG(ABS(FVL(J)) +1.E-16) + FK= LOG(ABS(FVL(K)) +1.E-17) + DET=AXI*(BXJ-BXK)+AXJ*(BXK-BXI)+AXK*(BXI-BXJ) + ALOGA=(FI*(AXJ*BXK-AXK*BXJ)+FJ*(AXK*BXI-AXI*BXK)+FK*(AXI*BXJ-AXJ* & + & BXI))/DET + ALPHA=(FI*(BXJ-BXK)+FJ*(BXK-BXI)+FK*(BXI-BXJ))/DET + BETA=(FI*(AXK-AXJ)+FJ*(AXI-AXK)+FK*(AXJ-AXI))/DET + IF(ABS(ALPHA).GT.99..OR.ABS(BETA).GT.99..OR.ABS(ALOGA).GT.99.) & + &RETURN +! IF(ALPHA.GT.50..OR.BETA.GT.50.) THEN +! WRITE(6,2001) X,FVL +! 2001 FORMAT(8E12.4) +! WRITE(6,2001) ALPHA,BETA,ALOGA,DET +! ENDIF + AUGETFV=EXP(ALOGA)*X**ALPHA*(1.-X)**BETA + RETURN + END diff --git a/LHAPDF/lhapdf-5.9.1/src/wrapabkm09-lite.f b/LHAPDF/lhapdf-5.9.1/src/wrapabkm09-lite.f new file mode 100644 index 00000000000..e15e066f06f --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/wrapabkm09-lite.f @@ -0,0 +1,371 @@ + subroutine ABKM09evolve(xb,Q,fset) + implicit none + include 'parmsetup.inc' + integer npdf,npar,kschem,i,k,n,m,kx,nxbb + integer nxb,nq,np,nvar,pdfmem,imem,nvar2 + parameter(nxb=99,nq=20,np=9,nvar=0,nvar2=25) + character*16 name(nmxset) + character*80 line + character*512 setpath + integer nmem(nmxset),ndef(nmxset),mem + common/NAME/name,nmem,ndef,mem + double precision gridx(nmxgridx),gridq(nmxgridq) + integer ngridx,ngridq,jx,jq +! integer iset,iimem +! common/SET/iset,iimem + integer nset,iset + real*8 f(0:nvar,nxb,nq+1,0:np),xx(nxb) + real*8 fsp(nxb),bs(nxb),cs(nxb),ds(nxb) + real*8 bsp(0:nvar,nxb,nq+1,0:np),csp(0:nvar,nxb,nq+1,0:np) & + & ,dsp(0:nvar,nxb,nq+1,0:np) + real*8 x1,xd,del,dels,delx,delx1,xlog1 + real*8 pdfs(0:np),fset(-6:6),alfas + real*8 x,Q,xb,q2,xmin,xmax,qsq,qsqmin,qsqmax,b,ss + real*8 aa,f0,fp,fm + real*8 pdfs0(0:np),pdfsp(0:np),pdfsm(0:np),q2plus,q2minus,q2zero + real*8 q2mat,delq2,f2p,f2pp,aq2,bq2,cq2 + integer ios + data xmin,xmax,qsqmin,qsqmax/1d-7,1d0,0.8d0,2d8/ + data q2mat /1d0/ + + save f,npdf,npar,pdfmem,dels,delx,x1,delx1,xlog1,nxbb,xx & + &,fsp,bsp,csp,dsp +! save + + q2=Q*Q + if(q2.gt.qsqmax) print 99,q2 + if(xb.lt.xmin.or.xb.gt.xmax) print 98,xb + + 99 format(' WARNING: Q^2 VALUE IS OUT OF RANGE ',g12.3) + 98 format(' WARNING: X VALUE IS OUT OF RANGE ',g12.3) + + x=max(xb,xmin) + x=min(x,xmax) + qsq=min(q2,qsqmax) + + if (x.gt.x1) then + xd=(1d0-x1)**2-(1d0-x)**2 + n=int(xd/delx1)+nxbb + else + xd=dlog(x)-xlog1 + n=nxbb+int(xd/DELX)-1 + end if + aa=x-xx(n) + + !k=pdfmem + k=0 + + if (qsq.ge.q2mat) then + ss=dlog(dlog(qsq/0.04d0))-dlog(dlog(qsqmin/0.04d0)) + m=int(ss/dels)+1 + b=ss/dels-dble(m)+1.d0 + + do i=1,npdf + f0=f(k,n,m,i) + aa*bsp(k,n,m,i) + aa**2*csp(k,n,m,i) & + & + aa**3*dsp(k,n,m,i) + fp=f(k,n,m+1,i) + aa*bsp(k,n,m+1,i) + aa**2*csp(k,n,m+1,i) & + & + aa**3*dsp(k,n,m+1,i) + if (m.ge.2) then + fm=f(k,n,m-1,i) + aa*bsp(k,n,m-1,i) + aa**2*csp(k,n,m-1,i) & + & +aa**3*dsp(k,n,m-1,i) + pdfs(i)=fm*b*(b-1d0)/2d0 + f0*(1d0-b**2) + fp*b*(b+1d0)/2d0 + else + pdfs(i)= f0*(1d0-b) + fp*b + end if + end do + else + delq2=q2mat*0.1 + + do i=1,npdf + + q2plus=q2mat+delq2 + ss=dlog(dlog(q2plus/0.04d0))-dlog(dlog(qsqmin/0.04d0)) + m=int(ss/dels)+1 + b=ss/dels-dble(m)+1.d0 + + f0=f(k,n,m,i) + aa*bsp(k,n,m,i) + aa**2*csp(k,n,m,i) & + & + aa**3*dsp(k,n,m,i) + fp=f(k,n,m+1,i) + aa*bsp(k,n,m+1,i) + aa**2*csp(k,n,m+1,i) & + & + aa**3*dsp(k,n,m+1,i) + if (m.ge.2) then + fm=f(k,n,m-1,i) + aa*bsp(k,n,m-1,i) + aa**2*csp(k,n,m-1,i) & + & +aa**3*dsp(k,n,m-1,i) + pdfsp(i)=fm*b*(b-1d0)/2d0 + f0*(1d0-b**2) + fp*b*(b+1d0)/2d0 + else + pdfsp(i)= f0*(1d0-b) + fp*b + end if + + q2minus=q2mat-delq2 + ss=dlog(dlog(q2minus/0.04d0))-dlog(dlog(qsqmin/0.04d0)) + m=int(ss/dels)+1 + b=ss/dels-dble(m)+1.d0 + + f0=f(k,n,m,i) + aa*bsp(k,n,m,i) + aa**2*csp(k,n,m,i) & + & + aa**3*dsp(k,n,m,i) + fp=f(k,n,m+1,i) + aa*bsp(k,n,m+1,i) + aa**2*csp(k,n,m+1,i) & + & + aa**3*dsp(k,n,m+1,i) + if (m.ge.2) then + fm=f(k,n,m-1,i) + aa*bsp(k,n,m-1,i) + aa**2*csp(k,n,m-1,i) & + & +aa**3*dsp(k,n,m-1,i) + pdfsm(i)=fm*b*(b-1d0)/2d0 + f0*(1d0-b**2) + fp*b*(b+1d0)/2d0 + else + pdfsm(i)= f0*(1d0-b) + fp*b + end if + + q2zero=q2mat + ss=dlog(dlog(q2zero/0.04d0))-dlog(dlog(qsqmin/0.04d0)) + m=int(ss/dels)+1 + b=ss/dels-dble(m)+1.d0 + + f0=f(k,n,m,i) + aa*bsp(k,n,m,i) + aa**2*csp(k,n,m,i) & + & + aa**3*dsp(k,n,m,i) + fp=f(k,n,m+1,i) + aa*bsp(k,n,m+1,i) + aa**2*csp(k,n,m+1,i) & + & + aa**3*dsp(k,n,m+1,i) + if (m.ge.2) then + fm=f(k,n,m-1,i) + aa*bsp(k,n,m-1,i) + aa**2*csp(k,n,m-1,i) & + & +aa**3*dsp(k,n,m-1,i) + pdfs0(i)=fm*b*(b-1d0)/2d0 + f0*(1d0-b**2) + fp*b*(b+1d0)/2d0 + else + pdfs0(i)= f0*(1d0-b) + fp*b + end if + + f2p=(pdfsp(i)-pdfsm(i))/2./delq2 + f2pp=(pdfsp(i)+pdfsm(i)-2*pdfs0(i))/delq2**2 + cq2=(f2pp*q2mat**2-2*f2p*q2mat+2*pdfs0(i))/2/q2mat**3 + bq2=f2pp/2.-3*cq2*q2mat + aq2=f2p-2*bq2*q2mat-3*cq2*q2mat**2 + pdfs(i)=aq2*q2 + bq2*q2**2 + cq2*q2**3 +! print *,i,xb,q2,aq2,bq2,cq2 + end do + end if + + fset(-6)=pdfs(9) + fset(-5)=pdfs(8) + fset(-4)=pdfs(7) + fset(-3)=pdfs(5) +!--reversed mrs 7/7/04 due + fset(-1)=pdfs(6) + fset(-2)=pdfs(4) + fset(0)=pdfs(3) +!--reversed mrs 7/7/04 due + fset(2)=pdfs(1)+pdfs(4) + fset(1)=pdfs(2)+pdfs(6) + fset(3)=pdfs(5) + fset(4)=pdfs(7) + fset(5)=pdfs(8) + fset(6)=pdfs(9) + return +! + entry ABKM09alfa(alfas,Q) + q2=Q*Q + if(q2.gt.qsqmax) print 99,q2 + qsq=max(q2,q2mat) + qsq=min(qsq,qsqmax) + + ss=log(log(qsq/0.04))-log(log(qsqmin/0.04)) + m=int(ss/dels)+1 + b=ss/dels-m+1 + + k=pdfmem + + if (m.ge.2) then + fm=f(k,1,m-1,0) + fp=f(k,1,m+1,0) + f0=f(k,1,m,0) + alfas=fm*b*(b-1d0)/2d0 + f0*(1d0-b**2) + fp*b*(b+1d0)/2d0 + else + alfas= f0*(1d0-b) + fp*b + end if + + return +! + entry ABKM09getgrid(nset,ngridx,ngridq,gridx,gridq) + + ngridx=nxb + do jx=1,nxb + gridx(jx)=xx(jx) + enddo + + ngridq=nq + do jq=1,ngridq + gridq(jq)= 0.04*exp(exp( & + & log(log(qsqmin/0.04))+(float(jq-1)/19)*( log(log(qsqmax/0.04))-log(log(qsqmin/0.04)) ) & + & )) + enddo + + return + entry ABKM09read(nset) +! following fix because members are 0-nvar +! nmem = nvar + 1 + + nmem(nset) = nvar + ndef(nset) = 0 + +! - dummy read in to get to End: (stream 1 is still open) + read(1,fmt="(i2,i2)") npdf,npar +! print *,'number of members',npdf,npar + if (npar.eq.0) npar=nvar2 + + do k=0,npar + do n=1,nxb-1 + do m=1,nq + read(1,*) (f(k,n,m,i),i=0,npdf) +! print 100,k,n,m,i,(f(k,n,m,i),i=0,npdf) + enddo + enddo + enddo + 100 format (4i4,13f11.5) + + return +! + entry ABKM09init + + dels=(dlog(dlog(qsqmax/0.04d0))- & + & dlog(dlog(qsqmin/0.04d0)))/dble(nq-1) + + + return +! + entry ABKM09pdf(imem) + pdfmem=imem + if ((pdfmem.lt.0).or.(pdfmem.gt.npar)) then + write(*,*) 'ABKM09 PDF set:' + write(*,*) 'PDF member out of range:' + write(*,*) 'member = ',pdfmem,' member range = (0,',npar,')' + stop + endif + + call getnset(iset) + nmem(iset) = npar + ndef(iset) = 0 + +! have to reopen stream 1 + call getsetpath(setpath) + open(1,file=setpath(1:len_trim(setpath)),action='READ') + line = '' + do while (line(2:11).ne.'Evolution:') + read(1,'(a)') line + enddo + + read(1,'(a)'),line + read(1,'(a)'),line + + read(1,fmt="(i2,i2)") npdf,npar + if (npar.eq.0) npar=nvar2 + + do k=0,imem-1 + do n=1,nxb-1 + do m=1,nq + read(1,*) (f(0,n,m,i),i=0,npdf) + enddo + enddo + enddo + + do n=1,nxb-1 + do m=1,nq + read(1,*) (f(0,n,m,i),i=0,npdf) + enddo + enddo + + nxbb=nxb/2 + x1=0.3d0 + xlog1=dlog(x1) + delx=(dlog(x1)-dlog(xmin))/dble(nxbb-1) + DELX1=(1.d0-x1)**2/dble(nxbb+1) + +!...X GRID + do kx=1,nxbb + xx(kx)=dexp(dlog(xmin)+delx*dble(kx-1)) + end do + do kx=nxbb+1,nxb-1 + xx(kx)=1.d0-dsqrt(dabs((1.d0-x1)**2-delx1*dble(kx-nxbb))) + end do + xx(nxb)=1d0 + + do i=0,npdf + do m=1,nq + if (i.ne.0) then + f(0,nxb,m,i)=0d0 + else + f(0,nxb,m,i)=f(0,nxb-1,m,i) + end if + do n=1,nxb-1 + end do + do n=1,nxb + fsp(n)=f(0,n,m,i) + end do + call ABKM09spline (nxb,xx,fsp,bs,cs,ds) + do n=1,nxb + bsp(0,n,m,i)=bs(n) + csp(0,n,m,i)=cs(n) + dsp(0,n,m,i)=ds(n) + end do + end do + end do + close(1) + return + end + +! --------------------------------------------------------------------- + SUBROUTINE ABKM09SPLINE(N,X,Y,B,C,D) +! --------------------------------------------------------------------- +! CALCULATE THE COEFFICIENTS B,C,D IN A CUBIC SPLINE INTERPOLATION. +! INTERPOLATION SUBROUTINES ARE TAKEN FROM +! G.E. FORSYTHE, M.A. MALCOLM AND C.B. MOLER, +! COMPUTER METHODS FOR MATHEMATICAL COMPUTATIONS (PRENTICE-HALL, 1977). +! + IMPLICIT REAL*8(A-H,O-Z) + + DIMENSION X(N), Y(N), B(N), C(N), D(N) +! + NM1=N-1 + IF(N.LT.2) RETURN + IF(N.LT.3) GO TO 250 + D(1)=X(2)-X(1) + C(2)=(Y(2)-Y(1))/D(1) + DO 210 K=2,NM1 + D(K)=X(K+1)-X(K) + B(K)=2.0D0*(D(K-1)+D(K)) + C(K+1)=(Y(K+1)-Y(K))/D(K) + C(K)=C(K+1)-C(K) + 210 CONTINUE + B(1)=-D(1) + B(N)=-D(N-1) + C(1)=0.0D0 + C(N)=0.0D0 + IF(N.EQ.3) GO TO 215 + C(1)=C(3)/(X(4)-X(2))-C(2)/(X(3)-X(1)) + C(N)=C(N-1)/(X(N)-X(N-2))-C(N-2)/(X(N-1)-X(N-3)) + C(1)=C(1)*D(1)**2.0D0/(X(4)-X(1)) + C(N)=-C(N)*D(N-1)**2.0D0/(X(N)-X(N-3)) + 215 CONTINUE + DO 220 K=2,N + T=D(K-1)/B(K-1) + B(K)=B(K)-T*D(K-1) + C(K)=C(K)-T*C(K-1) + 220 CONTINUE + C(N)=C(N)/B(N) + DO 230 IB=1,NM1 + K=N-IB + C(K)=(C(K)-D(K)*C(K+1))/B(K) + 230 CONTINUE + B(N)=(Y(N)-Y(NM1))/D(NM1) & + & +D(NM1)*(C(NM1)+2.0D0*C(N)) + DO 240 K=1,NM1 + B(K)=(Y(K+1)-Y(K))/D(K) & + & -D(K)*(C(K+1)+2.0D0*C(K)) + D(K)=(C(K+1)-C(K))/D(K) + C(K)=3.0D0*C(K) + 240 CONTINUE + C(N)=3.0D0*C(N) + D(N)=D(N-1) + RETURN + 250 CONTINUE + B(1)=(Y(2)-Y(1))/(X(2)-X(1)) + C(1)=0.0D0 + D(1)=0.0D0 + B(2)=B(1) + C(2)=0.0D0 + D(2)=0.0D0 + RETURN + END diff --git a/LHAPDF/lhapdf-5.9.1/src/wrapabkm09.f b/LHAPDF/lhapdf-5.9.1/src/wrapabkm09.f new file mode 100644 index 00000000000..69ddce2e581 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/wrapabkm09.f @@ -0,0 +1,335 @@ + subroutine ABKM09evolve(xb,Q,fset) + implicit none + include 'parmsetup.inc' + integer npdf,npar,kschem,i,k,n,m,kx,nxbb + integer nxb,nq,np,nvar,nvar2,pdfmem,imem + parameter(nxb=99,nq=20,np=9,nvar=30,nvar2=25) + character*16 name(nmxset) + integer nmem(nmxset),ndef(nmxset),mem + common/NAME/name,nmem,ndef,mem + double precision gridx(nmxgridx),gridq(nmxgridq) + integer ngridx,ngridq,jx,jq +! integer iset,iimem +! common/SET/iset,iimem + integer nset + real*8 f(0:nvar,nxb,nq+1,0:np),xx(nxb) + real*8 fsp(nxb),bs(nxb),cs(nxb),ds(nxb) + real*8 bsp(0:nvar,nxb,nq+1,0:np),csp(0:nvar,nxb,nq+1,0:np) & + & ,dsp(0:nvar,nxb,nq+1,0:np) + real*8 x1,xd,del,dels,delx,delx1,xlog1 + real*8 pdfs(0:np),fset(-6:6),alfas + real*8 x,Q,xb,q2,xmin,xmax,qsq,qsqmin,qsqmax,b,ss + real*8 aa,f0,fp,fm + real*8 pdfs0(0:np),pdfsp(0:np),pdfsm(0:np),q2plus,q2minus,q2zero + real*8 q2mat,delq2,f2p,f2pp,aq2,bq2,cq2 + data xmin,xmax,qsqmin,qsqmax/1d-7,1d0,0.8d0,2d8/ + data q2mat /1d0/ + + save f,npdf,npar,pdfmem,dels,delx,x1,delx1,xlog1,nxbb,xx & + &,fsp,bsp,csp,dsp +! save + + q2=Q*Q + if(q2.gt.qsqmax) print 99,q2 + if(xb.lt.xmin.or.xb.gt.xmax) print 98,xb + + 99 format(' WARNING: Q^2 VALUE IS OUT OF RANGE ',g12.3) + 98 format(' WARNING: X VALUE IS OUT OF RANGE ',g12.3) + + x=max(xb,xmin) + x=min(x,xmax) + qsq=min(q2,qsqmax) + + if (x.gt.x1) then + xd=(1d0-x1)**2-(1d0-x)**2 + n=int(xd/delx1)+nxbb + else + xd=dlog(x)-xlog1 + n=nxbb+int(xd/DELX)-1 + end if + aa=x-xx(n) + + k=pdfmem + + if (qsq.ge.q2mat) then + ss=dlog(dlog(qsq/0.04d0))-dlog(dlog(qsqmin/0.04d0)) + m=int(ss/dels)+1 + b=ss/dels-dble(m)+1.d0 + + do i=1,npdf + f0=f(k,n,m,i) + aa*bsp(k,n,m,i) + aa**2*csp(k,n,m,i) & + & + aa**3*dsp(k,n,m,i) + fp=f(k,n,m+1,i) + aa*bsp(k,n,m+1,i) + aa**2*csp(k,n,m+1,i) & + & + aa**3*dsp(k,n,m+1,i) + if (m.ge.2) then + fm=f(k,n,m-1,i) + aa*bsp(k,n,m-1,i) + aa**2*csp(k,n,m-1,i) & + & +aa**3*dsp(k,n,m-1,i) + pdfs(i)=fm*b*(b-1d0)/2d0 + f0*(1d0-b**2) + fp*b*(b+1d0)/2d0 + else + pdfs(i)= f0*(1d0-b) + fp*b + end if + end do + else + delq2=q2mat*0.1 + + do i=1,npdf + + q2plus=q2mat+delq2 + ss=dlog(dlog(q2plus/0.04d0))-dlog(dlog(qsqmin/0.04d0)) + m=int(ss/dels)+1 + b=ss/dels-dble(m)+1.d0 + + f0=f(k,n,m,i) + aa*bsp(k,n,m,i) + aa**2*csp(k,n,m,i) & + & + aa**3*dsp(k,n,m,i) + fp=f(k,n,m+1,i) + aa*bsp(k,n,m+1,i) + aa**2*csp(k,n,m+1,i) & + & + aa**3*dsp(k,n,m+1,i) + if (m.ge.2) then + fm=f(k,n,m-1,i) + aa*bsp(k,n,m-1,i) + aa**2*csp(k,n,m-1,i) & + & +aa**3*dsp(k,n,m-1,i) + pdfsp(i)=fm*b*(b-1d0)/2d0 + f0*(1d0-b**2) + fp*b*(b+1d0)/2d0 + else + pdfsp(i)= f0*(1d0-b) + fp*b + end if + + q2minus=q2mat-delq2 + ss=dlog(dlog(q2minus/0.04d0))-dlog(dlog(qsqmin/0.04d0)) + m=int(ss/dels)+1 + b=ss/dels-dble(m)+1.d0 + + f0=f(k,n,m,i) + aa*bsp(k,n,m,i) + aa**2*csp(k,n,m,i) & + & + aa**3*dsp(k,n,m,i) + fp=f(k,n,m+1,i) + aa*bsp(k,n,m+1,i) + aa**2*csp(k,n,m+1,i) & + & + aa**3*dsp(k,n,m+1,i) + if (m.ge.2) then + fm=f(k,n,m-1,i) + aa*bsp(k,n,m-1,i) + aa**2*csp(k,n,m-1,i) & + & +aa**3*dsp(k,n,m-1,i) + pdfsm(i)=fm*b*(b-1d0)/2d0 + f0*(1d0-b**2) + fp*b*(b+1d0)/2d0 + else + pdfsm(i)= f0*(1d0-b) + fp*b + end if + + q2zero=q2mat + ss=dlog(dlog(q2zero/0.04d0))-dlog(dlog(qsqmin/0.04d0)) + m=int(ss/dels)+1 + b=ss/dels-dble(m)+1.d0 + + f0=f(k,n,m,i) + aa*bsp(k,n,m,i) + aa**2*csp(k,n,m,i) & + & + aa**3*dsp(k,n,m,i) + fp=f(k,n,m+1,i) + aa*bsp(k,n,m+1,i) + aa**2*csp(k,n,m+1,i) & + & + aa**3*dsp(k,n,m+1,i) + if (m.ge.2) then + fm=f(k,n,m-1,i) + aa*bsp(k,n,m-1,i) + aa**2*csp(k,n,m-1,i) & + & +aa**3*dsp(k,n,m-1,i) + pdfs0(i)=fm*b*(b-1d0)/2d0 + f0*(1d0-b**2) + fp*b*(b+1d0)/2d0 + else + pdfs0(i)= f0*(1d0-b) + fp*b + end if + + f2p=(pdfsp(i)-pdfsm(i))/2./delq2 + f2pp=(pdfsp(i)+pdfsm(i)-2*pdfs0(i))/delq2**2 + cq2=(f2pp*q2mat**2-2*f2p*q2mat+2*pdfs0(i))/2/q2mat**3 + bq2=f2pp/2.-3*cq2*q2mat + aq2=f2p-2*bq2*q2mat-3*cq2*q2mat**2 + pdfs(i)=aq2*q2 + bq2*q2**2 + cq2*q2**3 + end do + end if + + fset(-6)=pdfs(9) + fset(-5)=pdfs(8) + fset(-4)=pdfs(7) + fset(-3)=pdfs(5) +!--reversed mrs 7/7/04 due + fset(-1)=pdfs(6) + fset(-2)=pdfs(4) + fset(0)=pdfs(3) +!--reversed mrs 7/7/04 due + fset(2)=pdfs(1)+pdfs(4) + fset(1)=pdfs(2)+pdfs(6) + fset(3)=pdfs(5) + fset(4)=pdfs(7) + fset(5)=pdfs(8) + fset(6)=pdfs(9) + return +! + entry ABKM09alfa(alfas,Q) + q2=Q*Q + if(q2.gt.qsqmax) print 99,q2 + qsq=max(q2,q2mat) + qsq=min(qsq,qsqmax) + + ss=log(log(qsq/0.04))-log(log(qsqmin/0.04)) + m=int(ss/dels)+1 + b=ss/dels-m+1 + + k=pdfmem + + if (m.ge.2) then + fm=f(k,1,m-1,0) + fp=f(k,1,m+1,0) + f0=f(k,1,m,0) + alfas=fm*b*(b-1d0)/2d0 + f0*(1d0-b**2) + fp*b*(b+1d0)/2d0 + else + alfas= f0*(1d0-b) + fp*b + end if + + return +! + entry ABKM09getgrid(nset,ngridx,ngridq,gridx,gridq) + + ngridx=nxb + do jx=1,nxb + gridx(jx)=xx(jx) + enddo + + ngridq=nq + do jq=1,ngridq + gridq(jq)= 0.04*exp(exp( & + & log(log(qsqmin/0.04))+(float(jq-1)/19)*( log(log(qsqmax/0.04))-log(log(qsqmin/0.04)) ) & + & )) + enddo + + return + + entry ABKM09read(nset) +! following fix because members are 0-nvar +! nmem = nvar + 1 + + read(1,fmt="(i2,i2)") npdf,npar + if (npar.eq.0) npar=nvar2 + + nmem(nset) = npar + ndef(nset) = 0 + + !print *,'number of members',npdf + do k=0,npar + do n=1,nxb-1 + do m=1,nq + read(1,*) (f(k,n,m,i),i=0,npdf) +! print 100,(f(k,n,m,i),i=0,npdf) + enddo + enddo + enddo + 100 format (13f11.5) + + nxbb=nxb/2 + x1=0.3d0 + xlog1=dlog(x1) + delx=(dlog(x1)-dlog(xmin))/dble(nxbb-1) + DELX1=(1.d0-x1)**2/dble(nxbb+1) + +!...X GRID + do kx=1,nxbb + xx(kx)=dexp(dlog(xmin)+delx*dble(kx-1)) + end do + do kx=nxbb+1,nxb-1 + xx(kx)=1.d0-dsqrt(dabs((1.d0-x1)**2-delx1*dble(kx-nxbb))) + end do + xx(nxb)=1d0 + + do k=0,npar + do i=0,npdf + do m=1,nq + if (i.ne.0) then + f(k,nxb,m,i)=0d0 + else + f(k,nxb,m,i)=f(k,nxb-1,m,i) + end if + do n=1,nxb-1 + end do + do n=1,nxb + fsp(n)=f(k,n,m,i) + end do + call ABKM09spline (nxb,xx,fsp,bs,cs,ds) + do n=1,nxb + bsp(k,n,m,i)=bs(n) + csp(k,n,m,i)=cs(n) + dsp(k,n,m,i)=ds(n) + end do + end do + end do + end do + + return +! + entry ABKM09init + + dels=(dlog(dlog(qsqmax/0.04d0))- & + & dlog(dlog(qsqmin/0.04d0)))/dble(nq-1) + + + return +! + entry ABKM09pdf(imem) + pdfmem=imem + if ((pdfmem.lt.0).or.(pdfmem.gt.npar)) then + write(*,*) 'ABKM09 PDF set:' + write(*,*) 'PDF member out of range:' + write(*,*) 'member = ',pdfmem,' member range = (0,',npar,')' + stop + endif + return + end + +! --------------------------------------------------------------------- + SUBROUTINE ABKM09SPLINE(N,X,Y,B,C,D) +! --------------------------------------------------------------------- +! CALCULATE THE COEFFICIENTS B,C,D IN A CUBIC SPLINE INTERPOLATION. +! INTERPOLATION SUBROUTINES ARE TAKEN FROM +! G.E. FORSYTHE, M.A. MALCOLM AND C.B. MOLER, +! COMPUTER METHODS FOR MATHEMATICAL COMPUTATIONS (PRENTICE-HALL, 1977). +! + IMPLICIT REAL*8(A-H,O-Z) + + DIMENSION X(N), Y(N), B(N), C(N), D(N) +! + NM1=N-1 + IF(N.LT.2) RETURN + IF(N.LT.3) GO TO 250 + D(1)=X(2)-X(1) + C(2)=(Y(2)-Y(1))/D(1) + DO 210 K=2,NM1 + D(K)=X(K+1)-X(K) + B(K)=2.0D0*(D(K-1)+D(K)) + C(K+1)=(Y(K+1)-Y(K))/D(K) + C(K)=C(K+1)-C(K) + 210 CONTINUE + B(1)=-D(1) + B(N)=-D(N-1) + C(1)=0.0D0 + C(N)=0.0D0 + IF(N.EQ.3) GO TO 215 + C(1)=C(3)/(X(4)-X(2))-C(2)/(X(3)-X(1)) + C(N)=C(N-1)/(X(N)-X(N-2))-C(N-2)/(X(N-1)-X(N-3)) + C(1)=C(1)*D(1)**2.0D0/(X(4)-X(1)) + C(N)=-C(N)*D(N-1)**2.0D0/(X(N)-X(N-3)) + 215 CONTINUE + DO 220 K=2,N + T=D(K-1)/B(K-1) + B(K)=B(K)-T*D(K-1) + C(K)=C(K)-T*C(K-1) + 220 CONTINUE + C(N)=C(N)/B(N) + DO 230 IB=1,NM1 + K=N-IB + C(K)=(C(K)-D(K)*C(K+1))/B(K) + 230 CONTINUE + B(N)=(Y(N)-Y(NM1))/D(NM1) & + & +D(NM1)*(C(NM1)+2.0D0*C(N)) + DO 240 K=1,NM1 + B(K)=(Y(K+1)-Y(K))/D(K) & + & -D(K)*(C(K+1)+2.0D0*C(K)) + D(K)=(C(K+1)-C(K))/D(K) + C(K)=3.0D0*C(K) + 240 CONTINUE + C(N)=3.0D0*C(N) + D(N)=D(N-1) + RETURN + 250 CONTINUE + B(1)=(Y(2)-Y(1))/(X(2)-X(1)) + C(1)=0.0D0 + D(1)=0.0D0 + B(2)=B(1) + C(2)=0.0D0 + D(2)=0.0D0 + RETURN + END diff --git a/LHAPDF/lhapdf-5.9.1/src/wrapabm11-lite.f b/LHAPDF/lhapdf-5.9.1/src/wrapabm11-lite.f new file mode 100644 index 00000000000..15827588f97 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/wrapabm11-lite.f @@ -0,0 +1,406 @@ + subroutine ABM11evolve(xb,Q,fset) + implicit none + include 'parmsetup.inc' + integer npdf,npar,kschem,i,k,kk,n,m,kx,nxbb,nxb1,nxb2 + integer nxb,nq,np,nvar,pdfmem,imem,nvar2 + parameter(nxb=99,nq=20,np=9,nvar=0,nvar2=25) + character*16 name(nmxset) + character*80 line + character*512 setpath + integer nmem(nmxset),ndef(nmxset),mem + common/NAME/name,nmem,ndef,mem + double precision gridx(nmxgridx),gridq(nmxgridq) + integer ngridx,ngridq,jx,jq +! integer iset,iimem +! common/SET/iset,iimem + integer nset,iset + real*8 f(0:nvar,nxb,nq+1,0:np),xx(nxb) + real*8 fsp(nxb),bs(nxb),cs(nxb),ds(nxb) + real*8 bsp(0:nvar,nxb,nq+1,0:np),csp(0:nvar,nxb,nq+1,0:np) & + & ,dsp(0:nvar,nxb,nq+1,0:np) + real*8 x1,xd,del,dels,delx,delx1,xlog1 + real*8 pdfs(0:np),fset(-6:6),alfas + real*8 x,Q,xb,q2,xmin,xmax,xmax1,qsq,qsqmin,qsqmax,b,ss + real*8 aa,f0,fp,fm + real*8 pdfs0(0:np),pdfsp(0:np),pdfsm(0:np),q2plus,q2minus,q2zero + real*8 q2mat,delq2,f2p,f2pp,aq2,bq2,cq2 + integer ios + data xmin,xmax,qsqmin,qsqmax/1d-7,1d0,0.8d0,2d8/ + data q2mat /1d0/ + + save f,npdf,npar,pdfmem,dels,delx,x1,delx1,xlog1,nxbb,xx & + &,fsp,bsp,csp,dsp,nxb1,nxb2,xmax1 +! save + + q2=Q*Q + if(q2.gt.qsqmax) print 99,q2 + if(xb.lt.xmin.or.xb.gt.xmax) print 98,xb + + 99 format(' WARNING: Q^2 VALUE IS OUT OF RANGE ',g12.3) + 98 format(' WARNING: X VALUE IS OUT OF RANGE ',g12.3) + + x=max(xb,xmin) + x=min(x,xmax) + qsq=min(q2,qsqmax) + +! if (x.gt.x1) then +! xd=(1d0-x1)**2-(1d0-x)**2 +! n=int(xd/delx1)+nxbb +! else +! xd=dlog(x)-xlog1 +! n=nxbb+int(xd/DELX)-1 +! end if + + do n=1,nxb-1 + if (x.lt.xx(n+1)) goto 300 + end do + 300 aa=x-xx(n) + +! print *,x,xx(n),xx(n+1),aa + !k=pdfmem + k=0 + + if (qsq.ge.q2mat) then + ss=dlog(dlog(qsq/0.04d0))-dlog(dlog(qsqmin/0.04d0)) + m=int(ss/dels)+1 + b=ss/dels-dble(m)+1.d0 + + do i=1,npdf + f0=f(k,n,m,i) + aa*bsp(k,n,m,i) + aa**2*csp(k,n,m,i) & + & + aa**3*dsp(k,n,m,i) + fp=f(k,n,m+1,i) + aa*bsp(k,n,m+1,i) + aa**2*csp(k,n,m+1,i) & + & + aa**3*dsp(k,n,m+1,i) + if (m.ge.2) then + fm=f(k,n,m-1,i) + aa*bsp(k,n,m-1,i) + aa**2*csp(k,n,m-1,i) & + & +aa**3*dsp(k,n,m-1,i) + pdfs(i)=fm*b*(b-1d0)/2d0 + f0*(1d0-b**2) + fp*b*(b+1d0)/2d0 + else + pdfs(i)= f0*(1d0-b) + fp*b + end if + end do + else + delq2=q2mat*0.1 + + do i=1,npdf + + q2plus=q2mat+delq2 + ss=dlog(dlog(q2plus/0.04d0))-dlog(dlog(qsqmin/0.04d0)) + m=int(ss/dels)+1 + b=ss/dels-dble(m)+1.d0 + + f0=f(k,n,m,i) + aa*bsp(k,n,m,i) + aa**2*csp(k,n,m,i) & + & + aa**3*dsp(k,n,m,i) + fp=f(k,n,m+1,i) + aa*bsp(k,n,m+1,i) + aa**2*csp(k,n,m+1,i) & + & + aa**3*dsp(k,n,m+1,i) + if (m.ge.2) then + fm=f(k,n,m-1,i) + aa*bsp(k,n,m-1,i) + aa**2*csp(k,n,m-1,i) & + & +aa**3*dsp(k,n,m-1,i) + pdfsp(i)=fm*b*(b-1d0)/2d0 + f0*(1d0-b**2) + fp*b*(b+1d0)/2d0 + else + pdfsp(i)= f0*(1d0-b) + fp*b + end if + + q2minus=q2mat-delq2 + ss=dlog(dlog(q2minus/0.04d0))-dlog(dlog(qsqmin/0.04d0)) + m=int(ss/dels)+1 + b=ss/dels-dble(m)+1.d0 + + f0=f(k,n,m,i) + aa*bsp(k,n,m,i) + aa**2*csp(k,n,m,i) & + & + aa**3*dsp(k,n,m,i) + fp=f(k,n,m+1,i) + aa*bsp(k,n,m+1,i) + aa**2*csp(k,n,m+1,i) & + & + aa**3*dsp(k,n,m+1,i) + if (m.ge.2) then + fm=f(k,n,m-1,i) + aa*bsp(k,n,m-1,i) + aa**2*csp(k,n,m-1,i) & + & +aa**3*dsp(k,n,m-1,i) + pdfsm(i)=fm*b*(b-1d0)/2d0 + f0*(1d0-b**2) + fp*b*(b+1d0)/2d0 + else + pdfsm(i)= f0*(1d0-b) + fp*b + end if + + q2zero=q2mat + ss=dlog(dlog(q2zero/0.04d0))-dlog(dlog(qsqmin/0.04d0)) + m=int(ss/dels)+1 + b=ss/dels-dble(m)+1.d0 + + f0=f(k,n,m,i) + aa*bsp(k,n,m,i) + aa**2*csp(k,n,m,i) & + & + aa**3*dsp(k,n,m,i) + fp=f(k,n,m+1,i) + aa*bsp(k,n,m+1,i) + aa**2*csp(k,n,m+1,i) & + & + aa**3*dsp(k,n,m+1,i) + if (m.ge.2) then + fm=f(k,n,m-1,i) + aa*bsp(k,n,m-1,i) + aa**2*csp(k,n,m-1,i) & + & +aa**3*dsp(k,n,m-1,i) + pdfs0(i)=fm*b*(b-1d0)/2d0 + f0*(1d0-b**2) + fp*b*(b+1d0)/2d0 + else + pdfs0(i)= f0*(1d0-b) + fp*b + end if + + f2p=(pdfsp(i)-pdfsm(i))/2./delq2 + f2pp=(pdfsp(i)+pdfsm(i)-2*pdfs0(i))/delq2**2 + cq2=(f2pp*q2mat**2-2*f2p*q2mat+2*pdfs0(i))/2/q2mat**3 + bq2=f2pp/2.-3*cq2*q2mat + aq2=f2p-2*bq2*q2mat-3*cq2*q2mat**2 + pdfs(i)=aq2*q2 + bq2*q2**2 + cq2*q2**3 +! print *,i,xb,q2,aq2,bq2,cq2 + end do + end if + +! fset(-6)=pdfs(9) +! fset(-5)=pdfs(8) +! fset(-4)=pdfs(7) + fset(-3)=pdfs(5) +!--reversed mrs 7/7/04 due + fset(-1)=pdfs(6) + fset(-2)=pdfs(4) + fset(0)=pdfs(3) +!--reversed mrs 7/7/04 due + fset(2)=pdfs(1)+pdfs(4) + fset(1)=pdfs(2)+pdfs(6) + fset(3)=pdfs(5) +! fset(4)=pdfs(7) +! fset(5)=pdfs(8) +! fset(6)=pdfs(9) + + do kk=7,npdf + fset(kk-3)=pdfs(kk) + fset(-kk+3)=pdfs(kk) + end do + do kk=npdf+1,9 + fset(kk-3)=0. + fset(-kk+3)=0. + end do + + return +! + entry ABM11alfa(alfas,Q) + q2=Q*Q + if(q2.gt.qsqmax) print 99,q2 + qsq=max(q2,q2mat) + qsq=min(qsq,qsqmax) + + ss=log(log(qsq/0.04))-log(log(qsqmin/0.04)) + m=int(ss/dels)+1 + b=ss/dels-m+1 + + k=pdfmem + + fp=f(k,1,m+1,0) + f0=f(k,1,m,0) + if (m.ge.2) then + fm=f(k,1,m-1,0) + alfas=fm*b*(b-1d0)/2d0 + f0*(1d0-b**2) + fp*b*(b+1d0)/2d0 + else + alfas= f0*(1d0-b) + fp*b + end if + +! print *,q2,q2mat,m,alfas + + + return +! + entry ABM11getgrid(nset,ngridx,ngridq,gridx,gridq) + + ngridx=nxb + do jx=1,nxb + gridx(jx)=xx(jx) + enddo + + ngridq=nq + do jq=1,ngridq + gridq(jq)= 0.04*exp(exp( & + & log(log(qsqmin/0.04))+(float(jq-1)/19)*( log(log(qsqmax/0.04))-log(log(qsqmin/0.04)) ) & + & )) + enddo + + return +! + entry ABM11read(nset) +! following fix because members are 0-nvar +! nmem = nvar + 1 + + nmem(nset) = nvar + ndef(nset) = 0 + +! - dummy read in to get to End: (stream 1 is still open) + read(1,fmt="(i2,i2)") npdf,npar +! print *,'number of members',npdf,npar + if (npar.eq.0) npar=nvar2 + + do k=0,npar + do n=1,nxb-1 + do m=1,nq + read(1,*) (f(k,n,m,i),i=0,npdf) +! print 100,k,n,m,i,(f(k,n,m,i),i=0,npdf) + enddo + enddo + enddo + 100 format (4i4,13f11.5) + + return +! + entry ABM11init + + dels=(dlog(dlog(qsqmax/0.04d0))- & + & dlog(dlog(qsqmin/0.04d0)))/dble(nq-1) + + + return +! + entry ABM11pdf(imem) + pdfmem=imem + if ((pdfmem.lt.0).or.(pdfmem.gt.npar)) then + write(*,*) 'ABM11 PDF set:' + write(*,*) 'PDF member out of range:' + write(*,*) 'member = ',pdfmem,' member range = (0,',npar,')' + stop + endif + + call getnset(iset) + nmem(iset) = npar + ndef(iset) = 0 + +! have to reopen stream 1 + call getsetpath(setpath) + open(1,file=setpath(1:len_trim(setpath)),action='READ') + line = '' + do while (line(2:11).ne.'Evolution:') + read(1,'(a)') line + enddo + + read(1,'(a)'),line + read(1,'(a)'),line + + read(1,fmt="(i2,i2)") npdf,npar + if (npar.eq.0) npar=nvar2 + + do k=0,imem-1 + do n=1,nxb-1 + do m=1,nq + read(1,*) (f(0,n,m,i),i=0,npdf) + enddo + enddo + enddo + + do n=1,nxb-1 + do m=1,nq + read(1,*) (f(0,n,m,i),i=0,npdf) + enddo + enddo + +!...X GRID + + nxb1=30 + nxb2=nxb-nxb1 + x1=0.3d0 + xmax1=0.99d0 + delx=(log(x1)-log(xmin))/(nxb1-1) + DELX1=(log(1-xmax1)-log(1-x1))/(nxb2-1) + + do kx=1,nxb1 + xx(kx)=exp(log(xmin)+delx*(kx-1)) + end do + + do kx=nxb-1,nxb1,-1 + xx(kx)=1-exp(log(1-xmax1)+delx1*(kx+1-nxb)) + end do + +! nxbb=nxb/2 +! x1=0.3d0 +! xlog1=dlog(x1) +! delx=(dlog(x1)-dlog(xmin))/dble(nxbb-1) +! DELX1=(1.d0-x1)**2/dble(nxbb+1) +! do kx=1,nxbb +! xx(kx)=dexp(dlog(xmin)+delx*dble(kx-1)) +! end do +! do kx=nxbb+1,nxb-1 +! xx(kx)=1.d0-dsqrt(dabs((1.d0-x1)**2-delx1*dble(kx-nxbb))) +! end do + + xx(nxb)=1d0 + + do i=0,npdf + do m=1,nq + if (i.ne.0) then + f(0,nxb,m,i)=0d0 + else + f(0,nxb,m,i)=f(0,nxb-1,m,i) + end if + do n=1,nxb-1 + end do + do n=1,nxb + fsp(n)=f(0,n,m,i) + end do + call ABM11spline (nxb,xx,fsp,bs,cs,ds) + do n=1,nxb + bsp(0,n,m,i)=bs(n) + csp(0,n,m,i)=cs(n) + dsp(0,n,m,i)=ds(n) + end do + end do + end do + close(1) + return + end + +! --------------------------------------------------------------------- + SUBROUTINE ABM11SPLINE(N,X,Y,B,C,D) +! --------------------------------------------------------------------- +! CALCULATE THE COEFFICIENTS B,C,D IN A CUBIC SPLINE INTERPOLATION. +! INTERPOLATION SUBROUTINES ARE TAKEN FROM +! G.E. FORSYTHE, M.A. MALCOLM AND C.B. MOLER, +! COMPUTER METHODS FOR MATHEMATICAL COMPUTATIONS (PRENTICE-HALL, 1977). +! + IMPLICIT REAL*8(A-H,O-Z) + + DIMENSION X(N), Y(N), B(N), C(N), D(N) +! + NM1=N-1 + IF(N.LT.2) RETURN + IF(N.LT.3) GO TO 250 + D(1)=X(2)-X(1) + C(2)=(Y(2)-Y(1))/D(1) + DO 210 K=2,NM1 + D(K)=X(K+1)-X(K) + B(K)=2.0D0*(D(K-1)+D(K)) + C(K+1)=(Y(K+1)-Y(K))/D(K) + C(K)=C(K+1)-C(K) + 210 CONTINUE + B(1)=-D(1) + B(N)=-D(N-1) + C(1)=0.0D0 + C(N)=0.0D0 + IF(N.EQ.3) GO TO 215 + C(1)=C(3)/(X(4)-X(2))-C(2)/(X(3)-X(1)) + C(N)=C(N-1)/(X(N)-X(N-2))-C(N-2)/(X(N-1)-X(N-3)) + C(1)=C(1)*D(1)**2.0D0/(X(4)-X(1)) + C(N)=-C(N)*D(N-1)**2.0D0/(X(N)-X(N-3)) + 215 CONTINUE + DO 220 K=2,N + T=D(K-1)/B(K-1) + B(K)=B(K)-T*D(K-1) + C(K)=C(K)-T*C(K-1) + 220 CONTINUE + C(N)=C(N)/B(N) + DO 230 IB=1,NM1 + K=N-IB + C(K)=(C(K)-D(K)*C(K+1))/B(K) + 230 CONTINUE + B(N)=(Y(N)-Y(NM1))/D(NM1) & + & +D(NM1)*(C(NM1)+2.0D0*C(N)) + DO 240 K=1,NM1 + B(K)=(Y(K+1)-Y(K))/D(K) & + & -D(K)*(C(K+1)+2.0D0*C(K)) + D(K)=(C(K+1)-C(K))/D(K) + C(K)=3.0D0*C(K) + 240 CONTINUE + C(N)=3.0D0*C(N) + D(N)=D(N-1) + RETURN + 250 CONTINUE + B(1)=(Y(2)-Y(1))/(X(2)-X(1)) + C(1)=0.0D0 + D(1)=0.0D0 + B(2)=B(1) + C(2)=0.0D0 + D(2)=0.0D0 + RETURN + END diff --git a/LHAPDF/lhapdf-5.9.1/src/wrapabm11.f b/LHAPDF/lhapdf-5.9.1/src/wrapabm11.f new file mode 100644 index 00000000000..89497dd9dba --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/wrapabm11.f @@ -0,0 +1,366 @@ + subroutine ABM11evolve(xb,Q,fset) + implicit none + include 'parmsetup.inc' + integer npdf,npar,kschem,i,k,n,m,kx,nxbb,nxb1,nxb2,kk + integer nxb,nq,np,nvar,nvar2,pdfmem,imem + parameter(nxb=99,nq=20,np=9,nvar=30,nvar2=25) + character*16 name(nmxset) + integer nmem(nmxset),ndef(nmxset),mem + common/NAME/name,nmem,ndef,mem + double precision gridx(nmxgridx),gridq(nmxgridq) + integer ngridx,ngridq,jx,jq +! integer iset,iimem +! common/SET/iset,iimem + integer nset + real*8 f(0:nvar,nxb,nq+1,0:np),xx(nxb) + real*8 fsp(nxb),bs(nxb),cs(nxb),ds(nxb) + real*8 bsp(0:nvar,nxb,nq+1,0:np),csp(0:nvar,nxb,nq+1,0:np) & + & ,dsp(0:nvar,nxb,nq+1,0:np) + real*8 x1,xd,del,dels,delx,delx1,xlog1 + real*8 pdfs(0:np),fset(-6:6),alfas + real*8 x,Q,xb,q2,xmin,xmax,xmax1,qsq,qsqmin,qsqmax,b,ss + real*8 aa,f0,fp,fm + real*8 pdfs0(0:np),pdfsp(0:np),pdfsm(0:np),q2plus,q2minus,q2zero + real*8 q2mat,delq2,f2p,f2pp,aq2,bq2,cq2 + data xmin,xmax,qsqmin,qsqmax/1d-7,1d0,0.8d0,2d8/ + data q2mat /1d0/ + + save f,npdf,npar,pdfmem,dels,delx,x1,delx1,xlog1,nxbb,xx & + &,fsp,bsp,csp,dsp,xmax1 +! save + + q2=Q*Q + if(q2.gt.qsqmax) print 99,q2 + if(xb.lt.xmin.or.xb.gt.xmax) print 98,xb + + 99 format(' WARNING: Q^2 VALUE IS OUT OF RANGE ',g12.3) + 98 format(' WARNING: X VALUE IS OUT OF RANGE ',g12.3) + + x=max(xb,xmin) + x=min(x,xmax) + qsq=min(q2,qsqmax) + +! if (x.gt.x1) then +! xd=(1d0-x1)**2-(1d0-x)**2 +! n=int(xd/delx1)+nxbb +! else +! xd=dlog(x)-xlog1 +! n=nxbb+int(xd/DELX)-1 +! end if + + do n=1,nxb-1 + if (x.lt.xx(n+1)) goto 300 + end do + 300 aa=x-xx(n) + + k=pdfmem + + if (qsq.ge.q2mat) then + ss=dlog(dlog(qsq/0.04d0))-dlog(dlog(qsqmin/0.04d0)) + m=int(ss/dels)+1 + b=ss/dels-dble(m)+1.d0 + + do i=1,npdf + f0=f(k,n,m,i) + aa*bsp(k,n,m,i) + aa**2*csp(k,n,m,i) & + & + aa**3*dsp(k,n,m,i) + fp=f(k,n,m+1,i) + aa*bsp(k,n,m+1,i) + aa**2*csp(k,n,m+1,i) & + & + aa**3*dsp(k,n,m+1,i) + if (m.ge.2) then + fm=f(k,n,m-1,i) + aa*bsp(k,n,m-1,i) + aa**2*csp(k,n,m-1,i) & + & +aa**3*dsp(k,n,m-1,i) + pdfs(i)=fm*b*(b-1d0)/2d0 + f0*(1d0-b**2) + fp*b*(b+1d0)/2d0 + else + pdfs(i)= f0*(1d0-b) + fp*b + end if + end do + else + delq2=q2mat*0.1 + + do i=1,npdf + + q2plus=q2mat+delq2 + ss=dlog(dlog(q2plus/0.04d0))-dlog(dlog(qsqmin/0.04d0)) + m=int(ss/dels)+1 + b=ss/dels-dble(m)+1.d0 + + f0=f(k,n,m,i) + aa*bsp(k,n,m,i) + aa**2*csp(k,n,m,i) & + & + aa**3*dsp(k,n,m,i) + fp=f(k,n,m+1,i) + aa*bsp(k,n,m+1,i) + aa**2*csp(k,n,m+1,i) & + & + aa**3*dsp(k,n,m+1,i) + if (m.ge.2) then + fm=f(k,n,m-1,i) + aa*bsp(k,n,m-1,i) + aa**2*csp(k,n,m-1,i) & + & +aa**3*dsp(k,n,m-1,i) + pdfsp(i)=fm*b*(b-1d0)/2d0 + f0*(1d0-b**2) + fp*b*(b+1d0)/2d0 + else + pdfsp(i)= f0*(1d0-b) + fp*b + end if + + q2minus=q2mat-delq2 + ss=dlog(dlog(q2minus/0.04d0))-dlog(dlog(qsqmin/0.04d0)) + m=int(ss/dels)+1 + b=ss/dels-dble(m)+1.d0 + + f0=f(k,n,m,i) + aa*bsp(k,n,m,i) + aa**2*csp(k,n,m,i) & + & + aa**3*dsp(k,n,m,i) + fp=f(k,n,m+1,i) + aa*bsp(k,n,m+1,i) + aa**2*csp(k,n,m+1,i) & + & + aa**3*dsp(k,n,m+1,i) + if (m.ge.2) then + fm=f(k,n,m-1,i) + aa*bsp(k,n,m-1,i) + aa**2*csp(k,n,m-1,i) & + & +aa**3*dsp(k,n,m-1,i) + pdfsm(i)=fm*b*(b-1d0)/2d0 + f0*(1d0-b**2) + fp*b*(b+1d0)/2d0 + else + pdfsm(i)= f0*(1d0-b) + fp*b + end if + + q2zero=q2mat + ss=dlog(dlog(q2zero/0.04d0))-dlog(dlog(qsqmin/0.04d0)) + m=int(ss/dels)+1 + b=ss/dels-dble(m)+1.d0 + + f0=f(k,n,m,i) + aa*bsp(k,n,m,i) + aa**2*csp(k,n,m,i) & + & + aa**3*dsp(k,n,m,i) + fp=f(k,n,m+1,i) + aa*bsp(k,n,m+1,i) + aa**2*csp(k,n,m+1,i) & + & + aa**3*dsp(k,n,m+1,i) + if (m.ge.2) then + fm=f(k,n,m-1,i) + aa*bsp(k,n,m-1,i) + aa**2*csp(k,n,m-1,i) & + & +aa**3*dsp(k,n,m-1,i) + pdfs0(i)=fm*b*(b-1d0)/2d0 + f0*(1d0-b**2) + fp*b*(b+1d0)/2d0 + else + pdfs0(i)= f0*(1d0-b) + fp*b + end if + + f2p=(pdfsp(i)-pdfsm(i))/2./delq2 + f2pp=(pdfsp(i)+pdfsm(i)-2*pdfs0(i))/delq2**2 + cq2=(f2pp*q2mat**2-2*f2p*q2mat+2*pdfs0(i))/2/q2mat**3 + bq2=f2pp/2.-3*cq2*q2mat + aq2=f2p-2*bq2*q2mat-3*cq2*q2mat**2 + pdfs(i)=aq2*q2 + bq2*q2**2 + cq2*q2**3 + end do + end if + +! fset(-6)=pdfs(9) +! fset(-5)=pdfs(8) +! fset(-4)=pdfs(7) + fset(-3)=pdfs(5) +!--reversed mrs 7/7/04 due + fset(-1)=pdfs(6) + fset(-2)=pdfs(4) + fset(0)=pdfs(3) +!--reversed mrs 7/7/04 due + fset(2)=pdfs(1)+pdfs(4) + fset(1)=pdfs(2)+pdfs(6) + fset(3)=pdfs(5) +! fset(4)=pdfs(7) +! fset(5)=pdfs(8) +! fset(6)=pdfs(9) + + do kk=7,npdf + fset(kk-3)=pdfs(kk) + fset(-kk+3)=pdfs(kk) + end do + do kk=npdf+1,9 + fset(kk-3)=0. + fset(-kk+3)=0. + end do + + return +! + entry ABM11alfa(alfas,Q) + q2=Q*Q + if(q2.gt.qsqmax) print 99,q2 + qsq=max(q2,q2mat) + qsq=min(qsq,qsqmax) + + ss=log(log(qsq/0.04))-log(log(qsqmin/0.04)) + m=int(ss/dels)+1 + b=ss/dels-m+1 + + k=pdfmem + + fp=f(k,1,m+1,0) + f0=f(k,1,m,0) + if (m.ge.2) then + fm=f(k,1,m-1,0) + alfas=fm*b*(b-1d0)/2d0 + f0*(1d0-b**2) + fp*b*(b+1d0)/2d0 + else + alfas= f0*(1d0-b) + fp*b + end if + + return +! + entry ABM11getgrid(nset,ngridx,ngridq,gridx,gridq) + + ngridx=nxb + do jx=1,nxb + gridx(jx)=xx(jx) + enddo + + ngridq=nq + do jq=1,ngridq + gridq(jq)= 0.04*exp(exp( & + & log(log(qsqmin/0.04))+(float(jq-1)/19)*( log(log(qsqmax/0.04))-log(log(qsqmin/0.04)) ) & + & )) + enddo + + return + + entry ABM11read(nset) +! following fix because members are 0-nvar +! nmem = nvar + 1 + + read(1,fmt="(i2,i2)") npdf,npar + if (npar.eq.0) npar=nvar + + nmem(nset) = npar + ndef(nset) = 0 + + !print *,'number of members',npdf + do k=0,npar + do n=1,nxb-1 + do m=1,nq + read(1,*) (f(k,n,m,i),i=0,npdf) +! print 100,(f(k,n,m,i),i=0,npdf) + enddo + enddo + enddo + 100 format (13f11.5) + +!...X GRID + + nxb1=30 + nxb2=nxb-nxb1 + x1=0.3d0 + xmax1=0.99d0 + delx=(log(x1)-log(xmin))/(nxb1-1) + DELX1=(log(1-xmax1)-log(1-x1))/(nxb2-1) + + do kx=1,nxb1 + xx(kx)=exp(log(xmin)+delx*(kx-1)) + end do + + do kx=nxb-1,nxb1,-1 + xx(kx)=1-exp(log(1-xmax1)+delx1*(kx+1-nxb)) + end do + +! nxbb=nxb/2 +! x1=0.3d0 +! xlog1=dlog(x1) +! delx=(dlog(x1)-dlog(xmin))/dble(nxbb-1) +! DELX1=(1.d0-x1)**2/dble(nxbb+1) +! do kx=1,nxbb +! xx(kx)=dexp(dlog(xmin)+delx*dble(kx-1)) +! end do +! do kx=nxbb+1,nxb-1 +! xx(kx)=1.d0-dsqrt(dabs((1.d0-x1)**2-delx1*dble(kx-nxbb))) +! end do + + + xx(nxb)=1d0 + + do k=0,npar + do i=0,npdf + do m=1,nq + if (i.ne.0) then + f(k,nxb,m,i)=0d0 + else + f(k,nxb,m,i)=f(k,nxb-1,m,i) + end if + do n=1,nxb-1 + end do + do n=1,nxb + fsp(n)=f(k,n,m,i) + end do + call ABM11spline (nxb,xx,fsp,bs,cs,ds) + do n=1,nxb + bsp(k,n,m,i)=bs(n) + csp(k,n,m,i)=cs(n) + dsp(k,n,m,i)=ds(n) + end do + end do + end do + end do + + return +! + entry ABM11init + + dels=(dlog(dlog(qsqmax/0.04d0))- & + & dlog(dlog(qsqmin/0.04d0)))/dble(nq-1) + + + return +! + entry ABM11pdf(imem) + pdfmem=imem + if ((pdfmem.lt.0).or.(pdfmem.gt.npar)) then + write(*,*) 'ABM11 PDF set:' + write(*,*) 'PDF member out of range:' + write(*,*) 'member = ',pdfmem,' member range = (0,',npar,')' + stop + endif + return + end + +! --------------------------------------------------------------------- + SUBROUTINE ABM11SPLINE(N,X,Y,B,C,D) +! --------------------------------------------------------------------- +! CALCULATE THE COEFFICIENTS B,C,D IN A CUBIC SPLINE INTERPOLATION. +! INTERPOLATION SUBROUTINES ARE TAKEN FROM +! G.E. FORSYTHE, M.A. MALCOLM AND C.B. MOLER, +! COMPUTER METHODS FOR MATHEMATICAL COMPUTATIONS (PRENTICE-HALL, 1977). +! + IMPLICIT REAL*8(A-H,O-Z) + + DIMENSION X(N), Y(N), B(N), C(N), D(N) +! + NM1=N-1 + IF(N.LT.2) RETURN + IF(N.LT.3) GO TO 250 + D(1)=X(2)-X(1) + C(2)=(Y(2)-Y(1))/D(1) + DO 210 K=2,NM1 + D(K)=X(K+1)-X(K) + B(K)=2.0D0*(D(K-1)+D(K)) + C(K+1)=(Y(K+1)-Y(K))/D(K) + C(K)=C(K+1)-C(K) + 210 CONTINUE + B(1)=-D(1) + B(N)=-D(N-1) + C(1)=0.0D0 + C(N)=0.0D0 + IF(N.EQ.3) GO TO 215 + C(1)=C(3)/(X(4)-X(2))-C(2)/(X(3)-X(1)) + C(N)=C(N-1)/(X(N)-X(N-2))-C(N-2)/(X(N-1)-X(N-3)) + C(1)=C(1)*D(1)**2.0D0/(X(4)-X(1)) + C(N)=-C(N)*D(N-1)**2.0D0/(X(N)-X(N-3)) + 215 CONTINUE + DO 220 K=2,N + T=D(K-1)/B(K-1) + B(K)=B(K)-T*D(K-1) + C(K)=C(K)-T*C(K-1) + 220 CONTINUE + C(N)=C(N)/B(N) + DO 230 IB=1,NM1 + K=N-IB + C(K)=(C(K)-D(K)*C(K+1))/B(K) + 230 CONTINUE + B(N)=(Y(N)-Y(NM1))/D(NM1) & + & +D(NM1)*(C(NM1)+2.0D0*C(N)) + DO 240 K=1,NM1 + B(K)=(Y(K+1)-Y(K))/D(K) & + & -D(K)*(C(K+1)+2.0D0*C(K)) + D(K)=(C(K+1)-C(K))/D(K) + C(K)=3.0D0*C(K) + 240 CONTINUE + C(N)=3.0D0*C(N) + D(N)=D(N-1) + RETURN + 250 CONTINUE + B(1)=(Y(2)-Y(1))/(X(2)-X(1)) + C(1)=0.0D0 + D(1)=0.0D0 + B(2)=B(1) + C(2)=0.0D0 + D(2)=0.0D0 + RETURN + END diff --git a/LHAPDF/lhapdf-5.9.1/src/wrapacfgpg.f b/LHAPDF/lhapdf-5.9.1/src/wrapacfgpg.f new file mode 100644 index 00000000000..3a34495bb42 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/wrapacfgpg.f @@ -0,0 +1,744 @@ +! -*- F90 -*- + + + subroutine ACFGPevolvep(xin,qin,p2in,ip2in,pdf) + include 'parmsetup.inc' + real*8 xin,qin,q2in,p2in,pdf(-6:6),xval(45),qcdl4,qcdl5 + real*8 upv,dnv,usea,dsea,str,chm,bot,top,glu + real*4 par,par2,calc,celc + common/acfgp/PAR(30,3),CALC(8,20,32,3),PAR2(30),CELC(8,20,32) + character*16 name(nmxset) + integer nmem(nmxset),ndef(nmxset),mmem + common/NAME/name,nmem,ndef,mmem + integer nset + + save + + if(imem.eq.1) then + call ACFGP1(xin,qin,upv,dnv,usea,dsea,str,chm,glu) + + elseif(imem.eq.2) then + call ACFGP2(xin,qin,upv,dnv,usea,dsea,str,chm,glu) + + elseif(imem.eq.3.or.imem.eq.0) then + call SFAFG1(xin,qin,upv,dnv,usea,dsea,str,chm,glu) + + else + CONTINUE + endif + + pdf(-6)= 0.0d0 + pdf(6)= 0.0d0 + pdf(-5)= 0.0d0 + pdf(5 )= 0.0d0 + pdf(-4)= chm + pdf(4 )= chm + pdf(-3)= str + pdf(3 )= str + pdf(-2)= usea + pdf(2 )= upv + pdf(-1)= dsea + pdf(1 )= dnv + pdf(0 )= glu + + return +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + entry ACFGPread(nset) + read(1,*)nmem(nset),ndef(nset) + do iset = 1,3 + read(1,*)(par(j,iset),j=1,4) + read(1,*)(par(j,iset),j=5,8) + read(1,*)(par(j,iset),j=9,12) + read(1,*)(par(j,iset),j=13,16) + read(1,*)(par(j,iset),j=17,20) + read(1,*)(par(j,iset),j=21,24) + read(1,*)(par(j,iset),j=25,28) + read(1,*)(par(j,iset),j=29,30) + do j=1,32 + do k=1,20 + read(1,*)(calc(i,k,j,iset),i=1,4) + read(1,*)(calc(i,k,j,iset),i=5,8) + enddo + enddo + enddo +! last one + read(1,*)(par2(j),j=1,4) + read(1,*)(par2(j),j=5,8) + read(1,*)(par2(j),j=9,12) + read(1,*)(par2(j),j=13,16) + read(1,*)(par2(j),j=17,20) + read(1,*)(par2(j),j=21,24) + read(1,*)(par2(j),j=25,28) + read(1,*)(par2(j),j=29,30) + do j=1,32 + do k=1,20 + read(1,*)(celc(i,k,j),i=1,4) + read(1,*)(celc(i,k,j),i=5,8) + enddo + enddo + + return + + +! +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + entry ACFGPalfa(alfas,qalfa) + call getnset(iset) + call GetOrderAsM(iset,iord) + call Getlam4M(iset,imem,qcdl4) + call Getlam5M(iset,imem,qcdl5) + call aspdflib(alfas,Qalfa,iord,qcdl5) + + return +! +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + entry ACFGPinit(Eorder,Q2fit) + return +! +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + entry ACFGPpdf(mem) + imem = mem + return +! + 1000 format(5e13.5) + END +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + SUBROUTINE ACFGP1(DX,DQ,DUV,DDV,DUB,DDB,DSB,DCB,DGL) +! +! INTERPOLATION PROGRAM WHICH INTERPOLATES THE GRID "DATAGA" AND GIV +! QUARK AND GLUON DISTRIBUTIONS IN THE REAL PHOTON, AS FUNCTIONS OF +! +! THE Q2-EVOLUTION IS PERFORMED WITH BLL AP-EQUATIONS AND NF=4. A MA +! CHARM DISTRIBUTION (BORROWED FROM GLUCK AND REYA) IS ALSO AVAILABL +! +! THE BOUNDARY CONDITIONS ARE SUCH THAT THE DISTRIBUTION FUNCTIONS A +! BY A VDM "ANSATZ" AT Q2=.25 GEV**2. +! +! THE PROGRAM WORKS FOR 2. GEV**2 < Q2 <5.5E+5 AND .00137 < X < . +! +! THE DISTRIBUTIONS ARE CALCULATED IN THE MSBAR FACTORIZATION SCHEME +! +! THE VALUE OF LAMBDA-MSB IS 200 MEV +! +! THE OUTPUT IS WRITTEN IN THE FILE 'FILEOUT': +! X*U=X*U(X,Q2) +! X*D= ... +! X*S= ... +! X*C= ... (MASSLESS CHARM WITH C( +! X*CM= ... (MASSIVE CHARM WITH MC=1.5 +! X*GLU=GLUON(X,Q2)*X +! +! +! F2 = PHOTON STRUCTURE FUNCTION WITHOUT CHARM +! F2C= " " " WITH MASSIVE CHARM +! + double precision & + & DX,DQ,DUV,DDV,DUB,DDB,DSB,DCB,DBB,DGL + REAL X, Q, UV, DV, UB, DB, SB, CB, BB, GL + REAL Q2 + common/acfgp/PAR(30,3),CALC(8,20,32,3),PAR2(30),CELC(8,20,32) + DIMENSION XPDF(7),CALCO(8,20,32) + COMMON/W5051I7/CALCO + EXTERNAL AFCPLU + DATA ZERO/0.0/ +!---------------------------------------------------------------------- + DATA ISTART/0/ + SAVE ISTART,OWLAM2,Q02,FLAV, /W5051I7/ +! + IF (ISTART.EQ.0) THEN + ISTART=1 + DO 10 K=1,32 + DO 10 I=1,20 + DO 10 M=1,8 + 10 CALCO(M,I,K) = CALC(M,I,K,1) + OWLAM=PAR(1,1) + OWLAM2=OWLAM**2 + Q02=PAR(30,1) + FLAV=PAR(25,1) + DELTA=PAR(29,1) + CALL WATE32 + ENDIF +! + X = DX + Q = DQ + Q2 = Q*Q + IDQ2=2 + SB=0. + IF((Q2-Q02).LE.0) THEN + GOTO 1 + ELSE + GOTO 2 + ENDIF + 2 IF((IDQ2-1).LE.0) THEN + GOTO 1 + ELSE + GOTO 3 + ENDIF + 3 SB= LOG( LOG( MAX(Q02,Q2)/OWLAM2)/ LOG(Q02/OWLAM2)) + 1 CONTINUE + CALL AURGAM(8,0,X,SB,XPDF(7)) + CALL AURGAM(7,0,X,SB,SING) + CALL AURGAM(4,0,X,SB,DPLUSNS) + CALL AURGAM(3,0,X,SB,CPLUSNS) + CALL AURGAM(5,0,X,SB,UPLUSNS) + CALL AURGAM(6,0,X,SB,SPLUSNS) + XPDF(3) = CPLUSNS + XPDF(4) = DPLUSNS + XPDF(5) = UPLUSNS + XPDF(6) = SPLUSNS + XPDF(1) = SING +! + ADD = XPDF(1)/FLAV + UPLUS=XPDF(5)+ADD + DPLUS=-XPDF(4)+ADD + SPLUS=-XPDF(6)+ADD + CPLUS=-XPDF(3)+ADD + UB=UPLUS*0.5 + UV=UB + DB=DPLUS*0.5 + DV=DB + SB=SPLUS*0.5 + CB=CPLUS*0.5 + SING=XPDF(1) + GLU=XPDF(7) + GL=GLU +! + DUV=MAX(ZERO,UV) + DDV=MAX(ZERO,DV) + DUB=MAX(ZERO,UB) + DDB=MAX(ZERO,DB) + DSB=MAX(ZERO,SB) + DCB=MAX(ZERO,CB) + DGL=MAX(ZERO,GL) +! + RETURN + END +!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + SUBROUTINE ACFGP2(DX,DQ,DUV,DDV,DUB,DDB,DSB,DCB,DGL) +! +! INTERPOLATION PROGRAM WHICH INTERPOLATES THE GRID "DATAGA" AND GIV +! QUARK AND GLUON DISTRIBUTIONS IN THE REAL PHOTON, AS FUNCTIONS OF +! +! THE Q2-EVOLUTION IS PERFORMED WITH BLL AP-EQUATIONS AND NF=4. A MA +! CHARM DISTRIBUTION (BORROWED FROM GLUCK AND REYA) IS ALSO AVAILABL +! +! THE BOUNDARY CONDITIONS ARE SUCH THAT THE DISTRIBUTION FUNCTIONS A +! BY A VDM "ANSATZ" AT Q2=.25 GEV**2. +! +! THE PROGRAM WORKS FOR 2. GEV**2 < Q2 <5.5E+5 AND .00137 < X < . +! +! THE DISTRIBUTIONS ARE CALCULATED IN THE MSBAR FACTORIZATION SCHEME +! +! THE VALUE OF LAMBDA-MSB IS 200 MEV +! +! THE OUTPUT IS WRITTEN IN THE FILE 'FILEOUT': +! X*U=X*U(X,Q2) +! X*D= ... +! X*S= ... +! X*C= ... (MASSLESS CHARM WITH C( +! X*CM= ... (MASSIVE CHARM WITH MC=1.5 +! X*GLU=GLUON(X,Q2)*X +! +! +! F2 = PHOTON STRUCTURE FUNCTION WITHOUT CHARM +! F2C= " " " WITH MASSIVE CHARM +! + double precision & + & DX,DQ,DUV,DDV,DUB,DDB,DSB,DCB,DBB,DGL + REAL X, Q, UV, DV, UB, DB, SB, CB, BB, GL + REAL Q2 + common/acfgp/PAR(30,3),CALC(8,20,32,3),PAR2(30),CELC(8,20,32) + DIMENSION XPDF(7),CALCO(8,20,32) + COMMON/W5051I7/CALCO + EXTERNAL AFCPLU + DATA ZERO/0.0/ +!---------------------------------------------------------------------- + DATA ISTART/0/ + SAVE ISTART,OWLAM2,Q02,FLAV, /W5051I7/ +! + IF (ISTART.EQ.0) THEN + ISTART=1 + DO 10 K=1,32 + DO 10 I=1,20 + DO 10 M=1,8 + 10 CALCO(M,I,K) = CALC(M,I,K,2) + OWLAM=PAR(1,2) + OWLAM2=OWLAM**2 + Q02=PAR(30,2) + FLAV=PAR(25,2) + DELTA=PAR(29,2) + CALL WATE32 + ENDIF +! + X = DX + Q = DQ + Q2 = Q*Q + IDQ2=2 + SB=0. + IF((Q2-Q02).LE.0) THEN + GOTO 1 + ELSE + GOTO 2 + ENDIF + 2 IF((IDQ2-1).LE.0) THEN + GOTO 1 + ELSE + GOTO 3 + ENDIF + 3 SB= LOG( LOG( MAX(Q02,Q2)/OWLAM2)/ LOG(Q02/OWLAM2)) + 1 CONTINUE + CALL AURGAM(8,0,X,SB,XPDF(7)) + CALL AURGAM(7,0,X,SB,SING) + CALL AURGAM(4,0,X,SB,DPLUSNS) + CALL AURGAM(3,0,X,SB,CPLUSNS) + CALL AURGAM(5,0,X,SB,UPLUSNS) + CALL AURGAM(6,0,X,SB,SPLUSNS) + XPDF(3) = CPLUSNS + XPDF(4) = DPLUSNS + XPDF(5) = UPLUSNS + XPDF(6) = SPLUSNS + XPDF(1) = SING +! + ADD = XPDF(1)/FLAV + UPLUS=XPDF(5)+ADD + DPLUS=-XPDF(4)+ADD + SPLUS=-XPDF(6)+ADD + CPLUS=-XPDF(3)+ADD + UB=UPLUS*0.5 + UV=UB + DB=DPLUS*0.5 + DV=DB + SB=SPLUS*0.5 + CB=CPLUS*0.5 + SING=XPDF(1) + GLU=XPDF(7) + GL=GLU +!... get parton density with massive charm + CPLUM=AFCPLU(X,Q2) + CB=CPLUM*0.5 +! + DUV=MAX(ZERO,UV) + DDV=MAX(ZERO,DV) + DUB=MAX(ZERO,UB) + DDB=MAX(ZERO,DB) + DSB=MAX(ZERO,SB) + DCB=MAX(ZERO,CB) + DGL=MAX(ZERO,GL) +! + RETURN + END +!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + SUBROUTINE SFAFG1(DX,DQ,DUV,DDV,DUB,DDB,DSB,DCB,DGL) +! +!*********************************************************************** +! ( 1st of February 1994) +! This is an interpolation program which reads the files GRPOL and +! GRVDM and gives the quark and gluon distributions in real photon +! as functions of x and Q**2. +! +! The Q**2 evolution is a BLL evolution (MSbar scheme) with Nf=4 +! and LAMBDA(MSbar)=.200 Gev. +! +! A massless charm distribution is generated for Q**2 > 2 Gev**2. +! +! The distributions are the sum of a pointlike part (PL) and of a +! Vdm part (VDM): +! dist=PL + KA*VDM +! KA is a factor which can be adjusted ( the default value is KA=1.0 +! The file GRPOL contains the pointlike part of the distributions. +! The file GRVDM contains the vdm part (A precise definition of this +! latter is given in the paper "PARTON DISTRIBUTIONS IN THE PHOTON", +! Preprint LPTHE Orsay 93-37, by P.Aurenche,M.Fontannaz and J.Ph.Gui +! +! The output of the program is written in the file GETOUT with the +! following conventions +! UPLUS=x(u+ubar) +! DPLUS=x(d+dbar) +! SPLUS=x(s+sbar) +! CPLUS=x(c+cbar) +! SING =UPLUS+DPLUS+SPLUS+CPLUS +! GLU =x*g +! +! The interpolation is valid for 2. < Q**2 < 5.5E+5 Gev**2, +! and for .0015< x < .99 +! +! The program also gives the structure function F2: +! F2 = q*Cq + g*Cg + Cgam +! Cq and Cg are the Wilson coeficients and Cgam is the direct term. +! +! Although the charm quark evolution is massless, the direct term +! Cgam includes the effects due to the charm quark mass. The charm +! quark threshold is therefore correctly described at the lowest +! ordre in alphastrong (Details are given in the preprint). +! +! +!*********************************************************************** +! + double precision & + & DX,DQ,DUV,DDV,DUB,DDB,DSB,DCB,DBB,DGL + REAL X, Q, UV, DV, UB, DB, SB, CB, BB, GL + REAL Q2 + DIMENSION XPDF(7) + common/acfgp/PAR(30,3),CALC(8,20,32,3),PAR2(30),CELC(8,20,32) + DIMENSION CALCO(8,20,32) + DIMENSION CELCO(8,20,32) + COMMON/W5051IA/CALCO + COMMON/W5051IB/CELCO + EXTERNAL AFCPLU + DATA ZERO/0.0/ +!---------------------------------------------------------------------- + DATA ISTART/0/ + SAVE ISTART,OWLAM2,Q02,FLAV,KA, /W5051IA/, /W5051IB/ +! + IF (ISTART.EQ.0) THEN + ISTART=1 + DO 10 K=1,32 + DO 10 I=1,20 + DO 10 M=1,8 + CALCO(M,I,K) = CALC(M,I,K,3) + 10 CELCO(M,I,K) = CELC(M,I,K) + OWLAM=PAR(1,3) + OWLAM2=OWLAM**2 + Q02=PAR(30,3) + FLAV=PAR(25,3) + DELTA=PAR(29,3) + CALL WATE32 + KA=1.0 + ENDIF +! + X = DX + Q = DQ + Q2 = Q*Q + IDQ2=2 + SB=0. + IF((Q2-Q02).LE.0) THEN + GOTO 1 + ELSE + GOTO 2 + ENDIF + 2 IF((IDQ2-1).LE.0) THEN + GOTO 1 + ELSE + GOTO 3 + ENDIF + 3 SB= LOG( LOG( MAX(Q02,Q2)/OWLAM2)/ LOG(Q02/OWLAM2)) + 1 CONTINUE + CALL AFGINT(8,0,X,SB,XPDF(7)) + CALL AFGINT(7,0,X,SB,SING) + CALL AFGINT(4,0,X,SB,DPLUSNS) + CALL AFGINT(3,0,X,SB,CPLUSNS) + CALL AFGINT(5,0,X,SB,UPLUSNS) + CALL AFGINT(6,0,X,SB,SPLUSNS) + XPDF(3) = CPLUSNS + XPDF(4) = DPLUSNS + XPDF(5) = UPLUSNS + XPDF(6) = SPLUSNS + XPDF(1) = SING +! + ADD = XPDF(1)/FLAV + UPLUS= XPDF(5)+ADD + DPLUS=-XPDF(4)+ADD + SPLUS=-XPDF(6)+ADD + CPLUS=-XPDF(3)+ADD + SING=XPDF(1) + GLU=XPDF(7) + GL=GLU +! + CALL AFGIN2(8,0,X,SB,XPDF(7)) + CALL AFGIN2(7,0,X,SB,SING) + CALL AFGIN2(4,0,X,SB,DPLUSNS) + CALL AFGIN2(3,0,X,SB,CPLUSNS) + CALL AFGIN2(5,0,X,SB,UPLUSNS) + CALL AFGIN2(6,0,X,SB,SPLUSNS) + XPDF(3) = CPLUSNS + XPDF(4) = DPLUSNS + XPDF(5) = UPLUSNS + XPDF(6) = SPLUSNS + XPDF(1) = SING +! + ADD2 = XPDF(1)/FLAV + UPLU2= XPDF(5)+ADD2 + DPLU2=-XPDF(4)+ADD2 + SPLU2=-XPDF(6)+ADD2 + CPLU2=-XPDF(3)+ADD2 + SING2=XPDF(1) + GLU2=XPDF(7) + UB=UPLUS+UPLU2*KA + UB=UB/2.0 + UV=UB + DB=DPLUS+DPLU2*KA + DB=DB/2.0 + DV=DB + SB=SPLUS+SPLU2*KA + SB=SB/2.0 + CB=CPLUS+CPLU2*KA + CB=CB/2.0 + SING=SING+SING2*KA + GL=GLU+GLU2*KA +! + DUV=MAX(ZERO,UV) + DDV=MAX(ZERO,DV) + DUB=MAX(ZERO,UB) + DDB=MAX(ZERO,DB) + DSB=MAX(ZERO,SB) + DCB=MAX(ZERO,CB) + DGL=MAX(ZERO,GL) +! + RETURN + END +!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + SUBROUTINE WATE32 +! 32 POINT GAUSSIAN QUADRATURE ROUTINE + double precision & + & X(16),W(16) + double precision & + & XI(32),WI(32),XX(33) + COMMON/W5051I9/XI,WI,XX,NTERMS + NTERMS=32 + X(1)=0.048307665687738316235D0 + X(2)=0.144471961582796493485D0 + X(3)=0.239287362252137074545D0 + X(4)=0.331868602282127649780D0 + X(5)=0.421351276130635345364D0 + X(6)=0.506899908932229390024D0 + X(7)=0.587715757240762329041D0 + X(8)=0.663044266930215200975D0 + X(9)=0.732182118740289680387D0 + X(10)=0.794483795967942406963D0 + X(11)=0.849367613732569970134D0 + X(12)=0.896321155766052123965D0 + X(13)=0.934906075937739689171D0 + X(14)=0.964762255587506430774D0 + X(15)=0.985611511545268335400D0 + X(16)=0.997263861849481563545D0 + W(1)=0.096540088514727800567D0 + W(2)=0.095638720079274859419D0 + W(3)=0.093844399080804565639D0 + W(4)=0.091173878695763884713D0 + W(5)=0.087652093004403811143D0 + W(6)=0.083311924226946755222D0 + W(7)=0.078193895787070306472D0 + W(8)=0.072345794108848506225D0 + W(9)=0.065822222776361846838D0 + W(10)=0.058684093478535547145D0 + W(11)=0.050998059262376176196D0 + W(12)=0.042835898022226680657D0 + W(13)=0.034273862913021433103D0 + W(14)=0.025392065309262059456D0 + W(15)=0.016274394730905670605D0 + W(16)=0.007018610009470096600D0 + NTERMH = NTERMS/2 + DO 1 I=1,NTERMH + XI(I)=-X(17-I) + WI(I)=W(17-I) + XI(I+16)=X(I) + WI(I+16)=W(I) + 1 END DO + DO 2 I=1,NTERMS + 2 XX(I)=0.5D0*(XI(I)+1.0D0) + XX(33)=1.0D0 + RETURN + END +!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + SUBROUTINE AURGAM(I,NDRV,X,S,ANS) + DIMENSION F1(32),F2(32),F3(32) + DIMENSION AF(3),AS(3) + DIMENSION CALCO(8,20,32) + COMMON/W5051I7/CALCO + DATA DELTA/0.8000E-01/ + ANS=0. + IF(X.GT.0.9985) RETURN + N=3 + IS=S/DELTA+1 + IF(IS.GE.17) IS=17 + IS1=IS+1 + IS2=IS1+1 + DO 1 L=1,32 + KL=L+32*NDRV + F1(L)=CALCO(I,IS,KL) + F2(L)=CALCO(I,IS1,KL) + F3(L)=CALCO(I,IS2,KL) + 1 END DO + AF(1)=AFGETFV(X,F1) + AF(2)=AFGETFV(X,F2) + AF(3)=AFGETFV(X,F3) + AS(1)=(IS-1)*DELTA + AS(2)=AS(1)+DELTA + AS(3)=AS(2)+DELTA + CALL AFPOLIN(AS,AF,N,S,AANS,DY) + ANS=AANS + RETURN + END +!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + SUBROUTINE AFGINT(I,NDRV,X,S,ANS) + DIMENSION F1(32),F2(32),F3(32) + DIMENSION AF(3),AS(3) + DIMENSION CALCO(8,20,32) + COMMON/W5051IA/CALCO + DATA DELTA/0.8000E-01/ + ANS=0. + IF(X.GT.0.9985) RETURN + N=3 + IS=S/DELTA+1 +! IF(IS.GE.17) IS=17 + IS1=IS+1 + IS2=IS1+1 + DO 1 L=1,32 + KL=L+32*NDRV + F1(L)=CALCO(I,IS,KL) + F2(L)=CALCO(I,IS1,KL) + F3(L)=CALCO(I,IS2,KL) + 1 END DO + AF(1)=AFGETFV(X,F1) + AF(2)=AFGETFV(X,F2) + AF(3)=AFGETFV(X,F3) + AS(1)=(IS-1)*DELTA + AS(2)=AS(1)+DELTA + AS(3)=AS(2)+DELTA + CALL AFPOLIN(AS,AF,N,S,AANS,DY) + ANS=AANS + RETURN + END +!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + SUBROUTINE AFGIN2(I,NDRV,X,S,ANS) + DIMENSION F1(32),F2(32),F3(32) + DIMENSION AF(3),AS(3) + DIMENSION CELCO(8,20,32) + COMMON/W5051IB/CELCO + DATA DELTA/0.8000E-01/ + ANS=0. + IF(X.GT.0.9985) RETURN + N=3 + IS=S/DELTA+1 +! IF(IS.GE.17) IS=17 + IS1=IS+1 + IS2=IS1+1 + DO 1 L=1,32 + KL=L+32*NDRV + F1(L)=CELCO(I,IS,KL) + F2(L)=CELCO(I,IS1,KL) + F3(L)=CELCO(I,IS2,KL) + 1 END DO + AF(1)=AFGETFV(X,F1) + AF(2)=AFGETFV(X,F2) + AF(3)=AFGETFV(X,F3) + AS(1)=(IS-1)*DELTA + AS(2)=AS(1)+DELTA + AS(3)=AS(2)+DELTA + CALL AFPOLIN(AS,AF,N,S,AANS,DY) + ANS=AANS + RETURN + END +!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + FUNCTION AFCPLU(X,Q2) + CMS=1.5**2 + BETS=1-4.*CMS*X/(1.-X)/Q2 + IF(BETS.LE..0) THEN + AFCPLU=.0 + RETURN + ENDIF + BETA=SQRT(BETS) + CPLU=(8.*X*(1.-X)-1.-4.*CMS*X*(1.-X)/Q2)*BETA + CAU=X**2+(1.-X)**2+4.*CMS*X*(1.-3.*X)/Q2-8.*CMS**2*X**2/Q2**2 + CPLU=CPLU+CAU* LOG((1.+BETA)/(1.-BETA)) + AFCPLU=3.*(4./9.)*CPLU*X/(3.1415*137.) + 1 RETURN + END +!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + FUNCTION AFGETFV(X,FVL) +! NOUVEAU PROGRAMME D'INTERPOLATION UTILISANT UNE ROUTINE DE MATH. RECI + DIMENSION FVL(32) + double precision & + & XI(32),WI(32),XX(33) + COMMON/W5051I9/XI,WI,XX,NTERMS + DIMENSION A(4),B(4) + N=4 + EPS=1.E-7 + XAM=XX(1)-EPS + XAP=XX(1)+EPS +! IF(X.LT.XAM) PRINT*,' X = ',X + IF(X.GT.XAM.AND.X.LT.XAP) GOTO 50 + GOTO 80 + 50 Y=FVL(1) + GOTO 77 + 80 IF(X.LT.XX(2)) GOTO 51 + IF(X.GT.XX(30)) GOTO 61 + DO 1 I=3,30 + IF(X.GT.XX(I)) GOTO 1 + A(1)=XX(I-2) + A(2)=XX(I-1) + A(3)=XX(I) + A(4)=XX(I+1) + B(1)=FVL(I-2) + B(2)=FVL(I-1) + B(3)=FVL(I) + B(4)=FVL(I+1) + GOTO 70 + 1 CONTINUE + 61 A(1)=XX(29) + A(2)=XX(30) + A(3)=XX(31) + A(4)=XX(32) + B(1)=FVL(29) + B(2)=FVL(30) + B(3)=FVL(31) + B(4)=FVL(32) + GOTO 70 + 51 A(1)=XX(1) + A(2)=XX(2) + A(3)=XX(3) + A(4)=XX(4) + B(1)=FVL(1) + B(2)=FVL(2) + B(3)=FVL(3) + B(4)=FVL(4) +! 70 IF(X.GT..2.AND.X.LT..8) THEN +! CALL AFPOLIN(A,B,N,X,Y,DY) +! ELSE +! CALL AFRATIN(A,B,N,X,Y,DY) +! ENDIF + 70 CONTINUE + CALL AFPOLIN(A,B,N,X,Y,DY) + 77 AFGETFV=Y + RETURN + END +!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + SUBROUTINE AFPOLIN(XA,YA,N,X,Y,DY) + PARAMETER (NMAX=10) + DIMENSION XA(NMAX),YA(NMAX),C(NMAX),D(NMAX) + Y=0. + IF(N.GT.NMAX) RETURN + NS=1 + DIF=ABS(X-XA(1)) + DO 11 I=1,N + DIFT=ABS(X-XA(I)) + IF (DIFT.LT.DIF) THEN + NS=I + DIF=DIFT + ENDIF + C(I)=YA(I) + D(I)=YA(I) + 11 END DO + Y=YA(NS) + NS=NS-1 + DO 13 M=1,N-1 + DO 12 I=1,N-M + HO=XA(I)-X + HP=XA(I+M)-X + W=C(I+1)-D(I) + DEN=HO-HP +! IF(DEN.EQ.0.)PAUSE + DEN=W/DEN + D(I)=HP*DEN + C(I)=HO*DEN + 12 CONTINUE + IF (2*NS.LT.N-M)THEN + DY=C(NS+1) + ELSE + DY=D(NS) + NS=NS-1 + ENDIF + Y=Y+DY + 13 END DO + RETURN + END diff --git a/LHAPDF/lhapdf-5.9.1/src/wrapct12.f b/LHAPDF/lhapdf-5.9.1/src/wrapct12.f new file mode 100644 index 00000000000..a1e11c5d8cd --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/wrapct12.f @@ -0,0 +1,576 @@ +! -*- F90 -*- + + + subroutine CT12evolve(x,Q,pdf) + implicit real*8(a-h,o-z) + include 'parmsetup.inc' + character*16 name(nmxset) + integer nmem(nmxset),ndef(nmxset),mmem + common/NAME/name,nmem,ndef,mmem + double precision gridx(nmxgridx),gridq(nmxgridq) + integer ngridx,ngridq,jx,jq + real*8 pdf(-6:6) + integer nset + Character Line*80 + PARAMETER (MXX = 204, MXQ = 40, MXF = 6, MaxVal=4, nhess = 52) + PARAMETER (MXPQX = (MXF+1+MaxVal) * MXQ * MXX) + Common & + & / CTPar1nhess12 / & + & Al(nmxset), QV(0:MXX,nmxset), XV(0:MXX,nmxset),TV(0:MXQ,nmxset), & + & UPD(0:nhess,MXPQX,nmxset), AlsCTEQ(0:MXQ,nmxset) & + & / CtqPar2 / Nx(nmxset), Nt(nmxset), NfMx(nmxset) & + & / XQrange / Qini(nmxset), Qmax(nmxset), Xmin(nmxset) & + & / QCDtable / Alambda(nmxset), Nfl(nmxset), Iorder(nmxset) & + & / Masstbl / Amass(6,nmxset) + + common/masses_LHA/cMass(nmxset),bMass(nmxset),tMass(nmxset) + + data pi / 3.141592653589793d0 / + save +! + call getnset(iset) + call getnmem(iset,imem) + + + U = X * CtLhCT12Pdf(imem,1,X,Q) + D = X * CtLhCT12Pdf(imem,2,X,Q) + USEA = X * CtLhCT12Pdf(imem,-1,X,Q) + DSEA = X * CtLhCT12Pdf(imem,-2,X,Q) + STR = X * CtLhCT12Pdf(imem,-3,X,Q) + CHM = X * CtLhCT12Pdf(imem,-4,X,Q) + BOT = X * CtLhCT12Pdf(imem,-5,X,Q) + GLU = X * CtLhCT12Pdf(imem,0,X,Q) +! + pdf(0) = glu + pdf(1) = d + pdf(-1) = dsea + pdf(2) = u + pdf(-2) = usea + pdf(3) = str + pdf(-3) = str + pdf(4) = chm + pdf(-4) = chm + pdf(5) = bot + pdf(-5) = bot + pdf(6) = 0.0d0 + pdf(-6) = 0.0d0 + return +! + entry CT12getgrid(nset,ngridx,ngridq,gridx,gridq) + do jx=0,nx(nset) + gridx(jx+1)=xv(jx,nset) + enddo + do jq=0,nt(nset) + gridq(jq+1)=qv(jq,nset)*qv(jq,nset) + enddo + ngridx=nx(nset) + ngridq=nt(nset) + return +! + entry CT12read(nset) + call CtLhbldat1 + call CtLhbldat2 + + call LHCT12set + + !*** nmem+1=number of member + read(1,*)nmem(nset),ndef(nset) + if(nmem(nset) .gt. nhess) then + print *,'fatal error: nmem=',nmem(nset),' > nhess=',nhess + stop + endif + + MxVal = 2 + Read (1, '(A)') Line + Read (1, '(A)') Line + + if(Line(1:11) .eq. ' ipk, Ordr') then + ipdsformat = 10 + Read(1, *) ipk, Dr, QQalfa, alfaQ, (Amass(I,nset),I=1,6) + Iorder(nset) = Nint(Dr) + Read(1, '(A)') Line + if(Line(1:7) .eq. ' IMASS' ) then + ipdsformat = 11 + read(1, *) aimass, fswitch, N0, N0, N0, Nfmx(nset), MxVal + else + Read (1, *) N0, N0, N0, NfMx(nset), MxVal + endif + else + ipdsformat = 6 + Read (1, *) Dr, Fl, Al(nset), (Amass(I,nset),I=1,6) + Iorder(nset) = Nint(Dr) + Nfmx(nset) = Nint(Fl) + Alambda(nset) = Al(nset) + Read (1, '(A)') Line + Read (1, *) N0, N0, N0, NfMx(nset), N0, N0 + endif + + cMass(nset) = Amass(4,nset) + bMass(nset) = Amass(5,nset) + tMass(nset) = Amass(6,nset) + Read (1, '(A)') Line + Read (1, *) NX(nset), NT(nset), N0, NG, N0 + if(NG.gt.0) Read(1,'(A)') (line, i=1,NG+1) + Read (1, '(A)') Line + if(ipdsformat.eq.11) then + Read (1, *) & + & QINI(nset), QMAX(nset), (QV(I,nset),TV(I,nset),AlsCTEQ(I,nset), I =0, NT(nset)) + qbase1=QV(1,nset)/Exp(Exp(Tv(1,nset))) + qbase2=QV(NT(nset),nset)/Exp(Exp(Tv(NT(nset),nset))) + if(abs(qbase1-qbase2).gt.1e-5) then + print *,'something wrong with qbase' + print *,'qbase1, qbase2=',qbase1,qbase2 + stop + else + Al(nset)=(qbase1+qbase2)/2.0d0 + Alambda(nset) = Al(nset) + endif + else + Read (1, *) & + & QINI(nset), QMAX(nset), (aa,TV(I,nset), I =0, NT(nset)) + endif + Read (1, '(A)') Line + Read (1, *) XMIN(nset), aa, (XV(I,nset), I =1, NX(nset)) + XV(0,nset)=0D0 +! +! Since quark = anti-quark for nfl>2 at this stage, +! we Read out only the non-redundent data points +! No of flavors = NfMx (sea) + 1 (gluon) + 2 (valence) + + + Nblk = (NX(nset)+1) * (NT(nset)+1) + Npts = Nblk * (NfMx(nset)+1+MxVal) + + !*** new version: allows nm + do ihess = 0,nmem(nset) + + Read (1, '(A)') Line + Read (1, '(A)') Line + Read (1, *, IOSTAT=IRET) (UPD(ihess,I,nset), I=1,Npts) + + enddo + return +! +! + entry CT12alfa(alfas,Qalfa) + if(ipdsformat.eq.11) then + alfas = CtLhCT12Alphas(Qalfa) + else + alfas = pi*CtLhALPI(Qalfa) + endif + return +! + entry CT12init(Eorder,Q2fit) + return +! + entry CT12pdf(mem) +! imem = mem + call getnset(iset) + call setnmem(iset,mem) + return +! + END + + subroutine LHCT12set + Implicit Double Precision (A-H,O-Z) + common /CT12co/ xlast, qlast, nxsave + nxsave = -1000 + xlast = -2. + qlast = -2. + return + END + +!======================================================================= + Function CtLhPartonX12 (imem,IPRTN, XX, QQ) +! Given the parton distribution function in the array U in +! COMMON / PEVLDT / , this routine interpolates to find +! the parton distribution at an arbitray point in x and q. +! + Implicit Double Precision (A-H,O-Z) + + include 'parmsetup.inc' + PARAMETER (MXX = 204, MXQ = 40, MXF = 6, MaxVal=4, nhess = 52) + PARAMETER (MXPQX = (MXF+1+MaxVal) * MXQ * MXX) + + Common & + & / CTPar1nhess12 / & + & Al(nmxset), QV(0:MXX,nmxset), XV(0:MXX,nmxset), TV(0:MXQ,nmxset), & + & UPD(0:nhess,MXPQX,nmxset), AlsCTEQ(0:MXQ,nmxset) & + & / CtqPar2 / Nx(nmxset), Nt(nmxset), NfMx(nmxset) & + & / XQrange / Qini(nmxset), Qmax(nmxset), Xmin(nmxset) + common /CT12co/ xlast,qlast, nxsave + + parameter(nqvec = 4) + + Dimension fvec(4), fij(4) + Dimension xvpow(0:mxx) + Data OneP / 1.00001 / + !**** choice of interpolation variable + Data xpow / 0.3d0 / + Save xvpow + Data ixprint,iqprint/0,0/ + save ixprint,iqprint + + save jq, jx, JLx, JLq, ss, sy2, sy3, s23, ty2, ty3 + save const1 , const2, const3, const4, const5, const6 + save tt, t13, t12, t23, t34 , t24, tmp1, tmp2, tdet + + call getnset(iset) + call getnmem(iset,imem) + +! store the powers used for interpolation on first call... + if(nx(iset) .ne. nxsave) then + nxsave = nx(iset) + xvpow(0) = 0.D0 + do i = 1, nx(iset) + xvpow(i) = xv(i,iset)**xpow + enddo + endif + + X = XX + Q = QQ + + if((x.lt.xmin(iset)).or.(x.gt.1.d0)) then + ixprint=ixprint+1 + if(ixprint.lt.11) print 98,x + if(ixprint.eq.10) print *, & + & 'more warning messages like the last suppressed.' + endif + 98 format(' WARNING: X=',e12.5,' OUT OF RANGE') + if((q.lt.qini(iset)).or.(q.gt.qmax(iset))) then + iqprint=iqprint+1 + if(iqprint.lt.11) print 99,q + if(iqprint.eq.10) print *, & + & 'more warning messages like the last suppressed.' + endif + 99 format(' WARNING: Q=',e12.5,' OUT OF RANGE') + +! skip the initialization in x if same as in the previous call. + if(x .eq. xlast) goto 100 + xlast = x + +! ------------- find lower end of interval containing x, i.e., +! get jx such that xv(jx) .le. x .le. xv(jx+1)... + JLx = -1 + JU = Nx(iset)+1 + 11 If (JU-JLx .GT. 1) Then + JM = (JU+JLx) / 2 + If (X .Ge. XV(JM,iset)) Then + JLx = JM + Else + JU = JM + Endif + Goto 11 + Endif +! Ix 0 1 2 Jx JLx Nx-2 Nx +! |---|---|---|...|---|-x-|---|...|---|---| +! x 0 Xmin x 1 +! + If (JLx .LE. -1) Then + Print '(A,1pE12.4)','Severe error: x <= 0 in CtLhPartonX12 x=',x + Stop + ElseIf (JLx .Eq. 0) Then + Jx = 0 + Elseif (JLx .LE. Nx(iset)-2) Then + +! For interior points, keep x in the middle, as shown abo + Jx = JLx - 1 + Elseif (JLx.Eq.Nx(iset)-1 .or. x.LT.OneP) Then + +! We tolerate a slight over-shoot of one (OneP=1.00001) +! perhaps due to roundoff or whatever, but not more than th +! Keep at least 4 points >= Jx + Jx = JLx - 2 + Else + Print '(A,1pE12.4)','Severe error: x > 1 in CtLhPartonX12 x=',x + Stop + Endif +! ---------- Note: JLx uniquely identifies the x-bin; Jx does n + +! This is the variable to be interpolated in + ss = x**xpow + + If (JLx.Ge.2 .and. JLx.Le.Nx(iset)-2) Then + +! initiation work for "interior bins": store the lattice points in s + svec1 = xvpow(jx) + svec2 = xvpow(jx+1) + svec3 = xvpow(jx+2) + svec4 = xvpow(jx+3) + + s12 = svec1 - svec2 + s13 = svec1 - svec3 + s23 = svec2 - svec3 + s24 = svec2 - svec4 + s34 = svec3 - svec4 + + sy2 = ss - svec2 + sy3 = ss - svec3 + +! constants needed for interpolating in s at fixed t lattice points... + const1 = s13/s23 + const2 = s12/s23 + const3 = s34/s23 + const4 = s24/s23 + s1213 = s12 + s13 + s2434 = s24 + s34 + sdet = s12*s34 - s1213*s2434 + tmp = sy2*sy3/sdet + const5 = (s34*sy2-s2434*sy3)*tmp/s12 + const6 = (s1213*sy2-s12*sy3)*tmp/s34 + + EndIf + + 100 continue + +! skip the initialization in q if same as in the previous call. + if(q .eq. qlast) goto 110 + qlast = q + + tt = log(log(Q/Al(iset))) + +! --------------Now find lower end of interval containing Q, i.e +! get jq such that qv(jq) .le. q .le. qv(jq+1). + JLq = -1 + JU = NT(iset)+1 + 12 If (JU-JLq .GT. 1) Then + JM = (JU+JLq) / 2 + If (tt .GE. TV(JM,iset)) Then + JLq = JM + Else + JU = JM + Endif + Goto 12 + Endif + + If (JLq .LE. 0) Then + Jq = 0 + Elseif (JLq .LE. Nt(iset)-2) Then +! keep q in the middle, as shown above + Jq = JLq - 1 + Else +! JLq .GE. Nt-1 case: Keep at least 4 points >= + Jq = Nt(iset) - 3 + + Endif +! This is the interpolation variable i + + If (JLq.GE.1 .and. JLq.LE.Nt(iset)-2) Then +! store the lattice points in t.. + tvec1 = Tv(jq,iset) + tvec2 = Tv(jq+1,iset) + tvec3 = Tv(jq+2,iset) + tvec4 = Tv(jq+3,iset) + + t12 = tvec1 - tvec2 + t13 = tvec1 - tvec3 + t23 = tvec2 - tvec3 + t24 = tvec2 - tvec4 + t34 = tvec3 - tvec4 + + ty2 = tt - tvec2 + ty3 = tt - tvec3 + + tmp1 = t12 + t13 + tmp2 = t24 + t34 + + tdet = t12*t34 - tmp1*tmp2 + + EndIf + + 110 continue + +! get the pdf function values at the lattice points... +! In this code, we store 10 flavors: u,ubar,d,dbar,s,sbar,c,cbar,b=bbar, +! hence Iprtn=5 (b) is obtained from -5 (bbar) + + If (Iprtn .GE. 5) Then + Ip = - Iprtn + Else + Ip = Iprtn + EndIf + jtmp = ((Ip + NfMx(iset))*(NT(iset)+1)+(jq-1))*(NX(iset)+1)+jx+1 + + Do it = 1, nqvec + + J1 = jtmp + it*(NX(iset)+1) + + If (Jx .Eq. 0) Then +! For the first 4 x points, interpolate x^2*f(x +! This applies to the two lowest bins JLx = 0, +! We cannot put the JLx.eq.1 bin into the "interior" section +! (as we do for q), since Upd(J1) is undefined + fij(1) = 0 + fij(2) = Upd(imem,J1+1,iset) * XV(1,iset)**2 + fij(3) = Upd(imem,J1+2,iset) * XV(2,iset)**2 + fij(4) = Upd(imem,J1+3,iset) * XV(3,iset)**2 +! +! Use CtLhPolint which allows x to be anywhere w.r.t. th + + Call CtLhPolint4(XVpow(0), Fij(1), 4, ss, Fx, Dfx) + + If (x .GT. 0D0) fvec(it) = Fx / x**2 +! Pdf is undefined for x.eq + ElseIf (JLx .Eq. Nx(iset)-1) Then +! This is the highest x b + +!** fix allow 4 consecutive elements with iset... mrw 19.9.2005 + fij(1) = Upd(imem,j1,iset) + fij(2) = Upd(imem,j1+1,iset) + fij(3) = Upd(imem,j1+2,iset) + fij(4) = Upd(imem,j1+3,iset) + Call CtLhPolint4 (XVpow(Nx(iset)-3), Fij(1), 4, ss, Fx, Dfx) + + fvec(it) = Fx + + Else + +! for all interior points, use Jon's in-line function +! This applied to (JLx.Ge.2 .and. JLx.Le.Nx-2) +! (This is cubic spline interpolation, as used by cteq; it was +! changed to polint in previous Durham releases (jcp).) + sf2 = Upd(imem,J1+1,iset) + sf3 = Upd(imem,J1+2,iset) + + Fvec(it) = (const5*(Upd(imem,J1,iset) & + & - sf2*const1 + sf3*const2) & + & + const6*(Upd(imem,J1+3,iset) & + & + sf2*const3 - sf3*const4) & + & + sf2*sy3 - sf3*sy2) / s23 + + Endif + + enddo +! We now have the four values Fvec(1:4 +! interpolate in t... + + If (JLq .LE. 0) Then +! 1st Q-bin, as well as extrapolation to lower Q + Call CtLhPolint4(TV(0,iset), Fvec(1), 4, tt, ff, Dfq) + + ElseIf (JLq .GE. Nt(iset)-1) Then +! Last Q-bin, as well as extrapolation to higher + Call CtLhPolint4(TV(Nt(iset)-3,iset), Fvec(1), 4, tt, ff, Dfq) + Else +! Interrior bins : (JLq.GE.1 .and. JLq.LE.Nt-2) +! which include JLq.Eq.1 and JLq.Eq.Nt-2, since Upd is defined for +! the full range QV(0:Nt) (in contrast to XV) + tf2 = fvec(2) + tf3 = fvec(3) + + g1 = ( tf2*t13 - tf3*t12) / t23 + g4 = (-tf2*t34 + tf3*t24) / t23 + + h00 = ((t34*ty2-tmp2*ty3)*(fvec(1)-g1)/t12 & + & + (tmp1*ty2-t12*ty3)*(fvec(4)-g4)/t34) + + ff = (h00*ty2*ty3/tdet + tf2*ty3 - tf3*ty2) / t23 + EndIf + + CtLhPartonX12 = ff + + Return + END +!======================================================================= + Function CtLhCt12Pdf (imem,Iparton, X, Q) + Implicit Double Precision (A-H,O-Z) + include 'parmsetup.inc' + Logical Warn + Common & + & / CtqPar2 / Nx(nmxset), Nt(nmxset), NfMx(nmxset) & + & / QCDtable / Alambda(nmxset), Nfl(nmxset), Iorder(nmxset) + + Data Warn /.true./ + save Warn + + call getnset(iset) + If (X .lt. 0D0 .or. X .gt. 1D0) Then + Print *, 'X out of range in CtLhCt12Pdf: ', X + Stop + Endif + If (Q .lt. Alambda(iset)) Then + Print *, 'Q out of range in CtLhCt12Pdf: ', Q + Stop + Endif + +! added to force pdf = 0.0 at x=1.0 exactly - mrw + if(x .eq. 1.0d0) then + CtLhCt12Pdf = 0.0d0 + return + endif +! + If ((Iparton .lt. -NfMx(iset) .or. Iparton .gt. NfMx(iset))) Then + If (Warn) Then +! put a warning for calling extra flavor. + Warn = .false. + Print *, 'Warning: Iparton out of range in CtLhCt12Pdf: ' & + & , Iparton + Endif + CtLhCt12Pdf = 0D0 + Return + Endif + + CtLhCt12Pdf = CtLhPartonX12 (imem,Iparton, X, Q) + if(CtLhCt12Pdf.lt.0.D0) CtLhCt12Pdf = 0.D0 + + Return + +! ******************** +!=========================================================================== + END + Function CtLhCT12Alphas (QQ) + + Implicit Double Precision (A-H,O-Z) + include 'parmsetup.inc' + + PARAMETER (MXX = 204, MXQ = 40, MXF = 6, MaxVal=4, nhess = 52) + PARAMETER (MXPQX = (MXF+1+MaxVal) * MXQ * MXX) + double precision Alsout + + Common & + & / CTPar1nhess12 / & + & Al(nmxset), QV(0:MXX,nmxset), XV(0:MXX,nmxset),TV(0:MXQ,nmxset), & + & UPD(0:nhess,MXPQX,nmxset), AlsCTEQ(0:MXQ,nmxset) & + & / CtqPar2 / Nx(nmxset), Nt(nmxset), NfMx(nmxset) & + & / XQrange / Qini(nmxset), Qmax(nmxset), Xmin(nmxset) + + + Data Q, JQ /-1D0, 0/ + save + + call getnset(iset) + call getnmem(iset,imem) + Q = QQ + tt = log(log(Q/Al(iset))) + +! -------------- Find lower end of interval containing Q, i.e., +! get jq such that qv(jq) .le. q .le. qv(jq+1)... + JLq = -1 + JU = NT(iset)+1 + 13 If (JU-JLq .GT. 1) Then + JM = (JU+JLq) / 2 + If (tt .GE. TV(JM,iset)) Then + JLq = JM + Else + JU = JM + Endif + Goto 13 + Endif + + If (JLq .LE. 0) Then + Jq = 0 + Elseif (JLq .LE. Nt(iset)-2) Then +! keep q in the middle, as shown above + Jq = JLq - 1 + Else +! JLq .GE. Nt-1 case: Keep at least 4 points >= Jq. + Jq = Nt(iset) - 3 + + Endif +! This is the interpolation variable in Q + Call CtLhPolint4 (TV(jq,iset), AlsCTEQ(jq,iset),4,tt,Alsout,Dfq) + CtLhCT12Alphas = Alsout + Return +! ******************** + End +!====================================================================== diff --git a/LHAPDF/lhapdf-5.9.1/src/wrapcteq5.f b/LHAPDF/lhapdf-5.9.1/src/wrapcteq5.f new file mode 100644 index 00000000000..d6f641813a1 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/wrapcteq5.f @@ -0,0 +1,263 @@ +! -*- F90 -*- + + + subroutine CTEQ5evolve(x,Q,pdf) + implicit real*8(a-h,o-z) + include 'parmsetup.inc' + character*16 name(nmxset) + integer nmem(nmxset),ndef(nmxset),mmem + common/NAME/name,nmem,ndef,mmem + integer nset + double precision gridx(nmxgridx),gridq(nmxgridq) + integer ngridx,ngridq,jx,jq + real*8 pdf(-6:6) + Character Line*80 + PARAMETER (MXX = 105, MXQ = 25, MXF = 6) + PARAMETER (MXPQX = (MXF *2 +2) * MXQ * MXX) + PARAMETER (M= 2, M1 = M + 1) + Common & + & / CtqPar1 / & + & Al5(nmxset), XV5(0:MXX,nmxset), QL5(0:MXQ,nmxset), & + & UPD5(MXPQX,nmxset) & + & / CtqPar2 / Nx(nmxset), Nt(nmxset), NfMx(nmxset) & + & / XQrange / Qini(nmxset), Qmax(nmxset), Xmin(nmxset) & + & / QCDtable / Alambda(nmxset), Nfl(nmxset), Iorder(nmxset) & + & / Masstbl / Amass(6,nmxset) + data pi / 3.141592653589793d0 / + save +! + U = X * CtLhCtq5Pdf(1,X,Q) + D = X * CtLhCtq5Pdf(2,X,Q) + USEA = X * CtLhCtq5Pdf(-1,X,Q) + DSEA = X * CtLhCtq5Pdf(-2,X,Q) + STR = X * CtLhCtq5Pdf(3,X,Q) + CHM = X * CtLhCtq5Pdf(4,X,Q) + BOT = X * CtLhCtq5Pdf(5,X,Q) + GLU = X * CtLhCtq5Pdf(0,X,Q) + UPV=U-USEA + DNV=D-DSEA +! + pdf(0) = glu + pdf(1) = dnv+dsea + pdf(-1) = dsea + pdf(2) = upv+usea + pdf(-2) = usea + pdf(3) = str + pdf(-3) = str + pdf(4) = chm + pdf(-4) = chm + pdf(5) = bot + pdf(-5) = bot + pdf(6) = 0.0d0 + pdf(-6) = 0.0d0 + + return +! + entry CTEQ5getgrid(nset,ngridx,ngridq,gridx,gridq) + do jx=0,nx(nset) + gridx(jx+1)=xv5(jx,nset) + enddo + do jq=0,nt(nset) + qtemp = Al5(nset)*exp(ql5(jq,nset)) + gridq(jq+1)=qtemp*qtemp + enddo + ngridx=nx(nset) + ngridq=nt(nset) + return + + entry CTEQ5read(nset) + + call CtLhbldat1 + call CtLhbldat2 + + read(1,*)nmem(nset),ndef(nset) + Read (1, '(A)') Line + Read (1, '(A)') Line + Read (1, *) Dr, Fl, Al5(nset), (Amass(I,nset),I=1,6) + Iorder(nset) = Nint(Dr) + Nfl(nset) = Nint(Fl) + Alambda(nset) = Al5(nset) + + Read (1, '(A)') Line + Read (1, *) NX(nset), NT(nset), NfMx(nset) + + Read (1, '(A)') Line + Read (1, *) QINI(nset), QMAX(nset), (QL5(I,nset), I =0, NT(nset)) + + Read (1, '(A)') Line + Read (1, *) XMIN(nset), (XV5(I,nset), I =0, NX(nset)) + + Do 11 Iq = 0, NT(nset) + QL5(Iq,nset) = Log (QL5(Iq,nset) /Al5(nset)) + 11 Continue +! +! Since quark = anti-quark for nfl>2 at this stage, +! we Read out only the non-redundent data points +! No of flavors = NfMx (sea) + 1 (gluon) + 2 (valence) + + Nblk = (NX(nset)+1) * (NT(nset)+1) + Npts = Nblk * (NfMx(nset)+3) + + Read (1, '(A)') Line + Read (1, *, IOSTAT=IRET) (UPD5(I,nset), I=1,Npts) + Return +! + + entry CTEQ5alfa(alfas,Qalfa) + + alfas = pi*CtLhALPI(Qalfa) + + return +! + entry CTEQ5init(Eorder,Q2fit) + + return +! + !error corrected (jcp) + entry CTEQ5pdf(mem) +! imem = mem + call getnset(iset) + call setnmem(iset,mem) + return +! + END + + FUNCTION CtLhPartonX5 (IPRTN, X, Q) +! +! Given the parton distribution function in the array UPD in +! COMMON / CtqPar1 / , this routine fetches u(fl, x, q) at any value o +! x and q using Mth-order polynomial interpolation for x and Ln(Q/Lamb +! + IMPLICIT DOUBLE PRECISION (A-H, O-Z) +! + include 'parmsetup.inc' + PARAMETER (MXX = 105, MXQ = 25, MXF = 6) + PARAMETER (MXPQX = (MXF *2 +2) * MXQ * MXX) + PARAMETER (M= 2, M1 = M + 1) +! + Common & + & / CtqPar1 / Al5(nmxset), XV5(0:MXX,nmxset), QL5(0:MXQ,nmxset), & + & UPD5(MXPQX,nmxset) & + & / CtqPar2 / Nx(nmxset), Nt(nmxset), NfMx(nmxset) & + & / XQrange / Qini(nmxset), Qmax(nmxset), Xmin(nmxset) +! + Dimension Fq(M1), Df(M1) + +! note, this routine doesn't have the features of not recalculating +! the x or q point values if they have not changed since the last call. +! that makes it slower than cteq6, but since cteq5 is already obsolete, +! speed is not so important for it. + + call getnset(iset) + +! Work with Log (Q) + QG = LOG (Q/AL5(iset)) + +! Find lower end of interval containing X + JL = -1 + JU = Nx(iset)+1 + 11 If (JU-JL .GT. 1) Then + JM = (JU+JL) / 2 + If (X .GT. XV5(JM,iset)) Then + JL = JM + Else + JU = JM + Endif + Goto 11 + Endif + + Jx = JL - (M-1)/2 +! crude treatment if outside the defined interval. + If (Jx .LT. 0) then + Jx = 0 + Elseif (Jx .GT. Nx(iset)-M) Then + Jx = Nx(iset) - M + Endif +! Find the interval where Q lies + JL = -1 + JU = NT(iset)+1 + 12 If (JU-JL .GT. 1) Then + JM = (JU+JL) / 2 + If (QG .GT. QL5(JM,iset)) Then + JL = JM + Else + JU = JM + Endif + Goto 12 + Endif + + Jq = JL - (M-1)/2 + If (Jq .LT. 0) Then + Jq = 0 +! If (Q .lt. Qini) Print '(A, 2(1pE12.4))', +! > ' WARNING: Q << Qini, extrapolation used; Q,Qini=',Q,Qini + Elseif (Jq .GT. Nt(iset)-M) Then + Jq = Nt(iset) - M +! If (Q .gt. Qmax) Print '(A, 2(1pE12.4))', +! > ' WARNING: Q > Qmax, extrapolation used; Q, Qmax =', Q, Qmax + Endif + + If (Iprtn .GE. 3) Then + Ip = - Iprtn + Else + Ip = Iprtn + EndIf +! Find the off-set in the linear array Upd + JFL = Ip + NfMx(iset) + J0 = (JFL * (NT(iset)+1) + Jq) * (NX(iset)+1) + Jx +! +! Now interpolate in x for M1 + Do 21 Iq = 1, M1 + J1 = J0 + (Nx(iset)+1)*(Iq-1) + 1 + Call CtLhPolint3 & + & (XV5(Jx,iset), Upd5(J1,iset), M1, X, Fq(Iq), Df(Iq)) + 21 Continue +! Finish off by interpolating i + Call CtLhPolint3 (QL5(Jq,iset), Fq(1), M1, QG, Ftmp, Ddf) + + CtLhPartonX5 = Ftmp +! + RETURN + +! **************************** + END + + Function CtLhCtq5Pdf (Iparton, X, Q) + Implicit Double Precision (A-H,O-Z) + include 'parmsetup.inc' + Logical Warn + Common & + & / CtqPar2 / Nx(nmxset), Nt(nmxset), NfMx(nmxset) & + & / QCDtable / Alambda(nmxset), Nfl(nmxset), Iorder(nmxset) + + Data Warn /.true./ + save Warn + + call getnset(iset) + + If (X .lt. 0D0 .or. X .gt. 1D0) Then + Print *, 'X out of range in CtLhCtq5Pdf: ', X + Stop + Endif + If (Q .lt. Alambda(iset)) Then + Print *, 'Q out of range in CtLhCtq5Pdf: ', Q + Stop + Endif + If ((Iparton .lt. -NfMx(iset) .or. Iparton .gt. NfMx(iset))) Then + If (Warn) Then +! put a warning for calling extra flavor. + Warn = .false. + Print *, 'Warning: Iparton out of range in CtLhCtq5Pdf: ' & + & , Iparton + Endif + CtLhCtq5Pdf = 0D0 + Return + Endif + + CtLhCtq5Pdf = CtLhPartonX5 (Iparton, X, Q) + if(CtLhCtq5Pdf.lt.0.D0) CtLhCtq5Pdf = 0.D0 + + Return + +! ******************** + END diff --git a/LHAPDF/lhapdf-5.9.1/src/wrapcteq6-lite.f b/LHAPDF/lhapdf-5.9.1/src/wrapcteq6-lite.f new file mode 100644 index 00000000000..5845ae855eb --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/wrapcteq6-lite.f @@ -0,0 +1,511 @@ +! -*- F90 -*- + + + subroutine CTEQ6evolve(x,Q,pdf) + implicit real*8(a-h,o-z) + include 'parmsetup.inc' + character*16 name(nmxset) + character*512 setpath + integer nmem(nmxset),ndef(nmxset),mmem + common/NAME/name,nmem,ndef,mmem + double precision gridx(nmxgridx),gridq(nmxgridq) + integer ngridx,ngridq,jx,jq + real*8 pdf(-6:6) + integer nset + Character Line*80 + PARAMETER (MXX = 96, MXQ = 20, MXF = 5, nhess = 0) + PARAMETER (MXPQX = (MXF + 3) * MXQ * MXX) + Common & + & / CtqPar1nhess / & + & Al(nmxset), XV(0:MXX,nmxset), TV(0:MXQ,nmxset), & + & UPD(0:nhess,MXPQX,nmxset) & + & / CtqPar2 / Nx(nmxset), Nt(nmxset), NfMx(nmxset) & + & / XQrange / Qini(nmxset), Qmax(nmxset), Xmin(nmxset) & + & / QCDtable / Alambda(nmxset), Nfl(nmxset), Iorder(nmxset) & + & / Masstbl / Amass(6,nmxset) + common/masses_LHA/cMass(nmxset),bMass(nmxset),tMass(nmxset) + data pi / 3.141592653589793d0 / + save +! + call getnset(iset) + call getnmem(iset,imem) +! + U = X * CtLhCtq6Pdf(0,1,X,Q) + D = X * CtLhCtq6Pdf(0,2,X,Q) + USEA = X * CtLhCtq6Pdf(0,-1,X,Q) + DSEA = X * CtLhCtq6Pdf(0,-2,X,Q) + STR = X * CtLhCtq6Pdf(0,3,X,Q) + CHM = X * CtLhCtq6Pdf(0,4,X,Q) + BOT = X * CtLhCtq6Pdf(0,5,X,Q) + GLU = X * CtLhCtq6Pdf(0,0,X,Q) +! + pdf(0) = glu + pdf(1) = d + pdf(-1) = dsea + pdf(2) = u + pdf(-2) = usea + pdf(3) = str + pdf(-3) = str + pdf(4) = chm + pdf(-4) = chm + pdf(5) = bot + pdf(-5) = bot + pdf(6) = 0.0d0 + pdf(-6) = 0.0d0 + + return +! + entry CTEQ6getgrid(nset,ngridx,ngridq,gridx,gridq) + do jx=0,nx(nset) + gridx(jx+1)=xv(jx,nset) + enddo + do jq=0,nt(nset) + qtemp= Alambda(nset)*dexp(dexp(tv(jq,nset))) + gridq(jq+1)= qtemp*qtemp + + enddo + ngridx=nx(nset) + ngridq=nt(nset) + return + + entry CTEQ6read(nset) + + call CtLhbldat1 + call CtLhbldat2 + + call LHct6set + !*** nmem+1=number of member + read(1,*)nmem(nset),ndef(nset) +! if(nmem(nset) .gt. nhess) then +! print *,'fatal error: nmem=',nmem(nset),' > nhess=',nhess +! stop +! endif + Read (1, '(A)') Line + Read (1, '(A)') Line + Read (1, *) Dr, Fl, Al(nset), (Amass(I,nset),I=1,6) + Iorder(nset) = Nint(Dr) + Nfl(nset) = Nint(Fl) + Alambda(nset) = Al(nset) + + cMass(nset) = Amass(4,nset) + bMass(nset) = Amass(5,nset) + tMass(nset) = Amass(6,nset) + + Read (1, '(A)') Line + Read (1, *) NX(nset), NT(nset), NfMx(nset) + + Read (1, '(A)') Line + Read (1, *) & + & QINI(nset), QMAX(nset), (TV(I,nset), I =0, NT(nset)) + + Read (1, '(A)') Line + Read (1, *) XMIN(nset), (XV(I,nset), I =0, NX(nset)) + + Do 11 Iq = 0, NT(nset) + TV(Iq,nset) = Log(Log (TV(Iq,nset) /Al(nset))) + 11 Continue +! +! Since quark = anti-quark for nfl>2 at this stage, +! we Read out only the non-redundent data points +! No of flavors = NfMx (sea) + 1 (gluon) + 2 (valence) + + Nblk = (NX(nset)+1) * (NT(nset)+1) + Npts = Nblk * (NfMx(nset)+3) + + !*** new version: allows nm + do ihess = 0,nmem(nset) + + Read (1, '(A)') Line + Read (1, '(A)') Line + Read (1, *, IOSTAT=IRET) (UPD(ihess,I,nset), I=1,Npts) + + enddo + return +! + entry CTEQ6alfa(alfas,Qalfa) + alfas = pi*CtLhALPI(Qalfa) + return +! + entry CTEQ6init(Eorder,Q2fit) + + return +! + entry CTEQ6pdf(mem) +! imem = mem + call getnset(iset) + call setnmem(iset,mem) + +! have to reopen stream 1 + call getsetpath(setpath) + open(1,file=setpath(1:len_trim(setpath)),action='READ') + + line = '' + do while (line(1:3).ne.'==>') + read(1,'(a)'),line + enddo +! - backspace by one record + backspace(1) +! - dummy read up to the member requested + do n=0,mem-1 + read(1,'(a)'),line + read(1,'(a)'),line + Read (1, *, IOSTAT=IRET) (UPD(0,I,iset), I=1,Npts) + enddo +!- read in the data of the requested member + Read (1, '(A)') Line + Read (1, '(A)') Line + Read (1, *, IOSTAT=IRET) (UPD(0,I,iset), I=1,Npts) + close(1) + return +! + END + + subroutine LHct6set + Implicit Double Precision (A-H,O-Z) + common /ctq6co/ xlast, qlast, nxsave + nxsave = -1000 + xlast = -2. + qlast = -2. + return + END + +!======================================================================= + Function CtLhPartonX6 (imem,IPRTN, XX, QQ) +! Given the parton distribution function in the array U in +! COMMON / PEVLDT / , this routine interpolates to find +! the parton distribution at an arbitray point in x and q. +! + Implicit Double Precision (A-H,O-Z) + + include 'parmsetup.inc' + Parameter (MXX = 96, MXQ = 20, MXF = 5, nhess = 0) + Parameter (MXQX= MXQ * MXX, MXPQX = MXQX * (MXF+3)) + + Common & + & / CtqPar1nhess / & + & Al(nmxset), XV(0:MXX,nmxset), TV(0:MXQ,nmxset), & + & UPD(0:nhess,MXPQX,nmxset) & + & / CtqPar2 / Nx(nmxset), Nt(nmxset), NfMx(nmxset) & + & / XQrange / Qini(nmxset), Qmax(nmxset), Xmin(nmxset) + + common /ctq6co/ xlast, qlast, nxsave + parameter(nqvec = 4) + + Dimension fvec(4), fij(4) + Dimension xvpow(0:mxx) + Data OneP / 1.00001 / + !**** choice of interpolation variable + Data xpow / 0.3d0 / + Save xvpow + Data ixprint,iqprint/0,0/ + save ixprint,iqprint + + save jq, jx, JLx, JLq, ss, sy2, sy3, s23, ty2, ty3 + save const1 , const2, const3, const4, const5, const6 + save tt, t13, t12, t23, t34 , t24, tmp1, tmp2, tdet + + + call getnset(iset) +! call getnmem(iset,imem) + +! store the powers used for interpolation on first call... + if(nx(iset).ne. nxsave) then + nxsave = nx(iset) + xvpow(0) = 0.D0 + do i = 1, nx(iset) + xvpow(i) = xv(i,iset)**xpow + enddo + endif + + X = XX + Q = QQ + + if((x.lt.xmin(iset)).or.(x.gt.1.d0)) then + ixprint=ixprint+1 + if(ixprint.lt.11) print 98,x + if(ixprint.eq.10) print *, & + & 'more warning messages like the last suppressed.' + endif + 98 format(' WARNING: X=',e12.5,' OUT OF RANGE') + if((q.lt.qini(iset)).or.(q.gt.qmax(iset))) then + iqprint=iqprint+1 + if(iqprint.lt.11) print 99,q + if(iqprint.eq.10) print *, & + & 'more warning messages like the last suppressed.' + endif + 99 format(' WARNING: Q=',e12.5,' OUT OF RANGE') + +! skip the initialization in x if same as in the previous call. + if(x .eq. xlast) goto 100 + xlast = x + +! ------------- find lower end of interval containing x, i.e., +! get jx such that xv(jx) .le. x .le. xv(jx+1)... + JLx = -1 + JU = Nx(iset)+1 + 11 If (JU-JLx .GT. 1) Then + JM = (JU+JLx) / 2 + If (X .Ge. XV(JM,iset)) Then + JLx = JM + Else + JU = JM + Endif + Goto 11 + Endif +! Ix 0 1 2 Jx JLx Nx-2 Nx +! |---|---|---|...|---|-x-|---|...|---|---| +! x 0 Xmin x 1 +! + If (JLx .LE. -1) Then + Print '(A,1pE12.4)','Severe error: x <= 0 in CtLhPartonX6 x=',x + Stop + ElseIf (JLx .Eq. 0) Then + Jx = 0 + Elseif (JLx .LE. Nx(iset)-2) Then + +! For interior points, keep x in the middle, as shown abo + Jx = JLx - 1 + Elseif (JLx.Eq.Nx(iset)-1 .or. x.LT.OneP) Then + +! We tolerate a slight over-shoot of one (OneP=1.00001) +! perhaps due to roundoff or whatever, but not more than th +! Keep at least 4 points >= Jx + Jx = JLx - 2 + Else + Print '(A,1pE12.4)','Severe error: x > 1 in CtLhPartonX6 x=',x + Stop + Endif +! ---------- Note: JLx uniquely identifies the x-bin; Jx does n + +! This is the variable to be interpolated in + ss = x**xpow + + If (JLx.Ge.2 .and. JLx.Le.Nx(iset)-2) Then + +! initiation work for "interior bins": store the lattice points in s + svec1 = xvpow(jx) + svec2 = xvpow(jx+1) + svec3 = xvpow(jx+2) + svec4 = xvpow(jx+3) + + s12 = svec1 - svec2 + s13 = svec1 - svec3 + s23 = svec2 - svec3 + s24 = svec2 - svec4 + s34 = svec3 - svec4 + + sy2 = ss - svec2 + sy3 = ss - svec3 + +! constants needed for interpolating in s at fixed t lattice points... + const1 = s13/s23 + const2 = s12/s23 + const3 = s34/s23 + const4 = s24/s23 + s1213 = s12 + s13 + s2434 = s24 + s34 + sdet = s12*s34 - s1213*s2434 + tmp = sy2*sy3/sdet + const5 = (s34*sy2-s2434*sy3)*tmp/s12 + const6 = (s1213*sy2-s12*sy3)*tmp/s34 + + EndIf + + 100 continue + +! skip the initialization in q if same as in the previous call. + if(q .eq. qlast) goto 110 + qlast = q + + tt = log(log(Q/Al(iset))) + +! --------------Now find lower end of interval containing Q, i.e +! get jq such that qv(jq) .le. q .le. qv(jq+1). + JLq = -1 + JU = NT(iset)+1 + 12 If (JU-JLq .GT. 1) Then + JM = (JU+JLq) / 2 + If (tt .GE. TV(JM,iset)) Then + JLq = JM + Else + JU = JM + Endif + Goto 12 + Endif + + If (JLq .LE. 0) Then + Jq = 0 + Elseif (JLq .LE. Nt(iset)-2) Then +! keep q in the middle, as shown above + Jq = JLq - 1 + Else +! JLq .GE. Nt-1 case: Keep at least 4 points >= + Jq = Nt(iset) - 3 + + Endif +! This is the interpolation variable i + + If (JLq.GE.1 .and. JLq.LE.Nt(iset)-2) Then +! store the lattice points in t.. + tvec1 = Tv(jq,iset) + tvec2 = Tv(jq+1,iset) + tvec3 = Tv(jq+2,iset) + tvec4 = Tv(jq+3,iset) + + t12 = tvec1 - tvec2 + t13 = tvec1 - tvec3 + t23 = tvec2 - tvec3 + t24 = tvec2 - tvec4 + t34 = tvec3 - tvec4 + + ty2 = tt - tvec2 + ty3 = tt - tvec3 + + tmp1 = t12 + t13 + tmp2 = t24 + t34 + + tdet = t12*t34 - tmp1*tmp2 + + EndIf + + 110 continue + +! get the pdf function values at the lattice points... +! In this code, we store 8 flavors: u,ubar,d,dbar,s=sbar,c=cbar,b=bbar,g +! hence Iprtn=3,4,5 (s,c,b) are obtained from -3,-4,-5 (sbar,cbar,bbar) + + If (Iprtn .GE. 3) Then + Ip = - Iprtn + Else + Ip = Iprtn + EndIf + jtmp = ((Ip + NfMx(iset))*(NT(iset)+1)+(jq-1))*(NX(iset)+1)+jx+1 + + Do it = 1, nqvec + + J1 = jtmp + it*(NX(iset)+1) + + If (Jx .Eq. 0) Then +! For the first 4 x points, interpolate x^2*f(x +! This applies to the two lowest bins JLx = 0, +! We cannot put the JLx.eq.1 bin into the "interior" section +! (as we do for q), since Upd(J1) is undefined + fij(1) = 0 + fij(2) = Upd(imem,J1+1,iset) * XV(1,iset)**2 + fij(3) = Upd(imem,J1+2,iset) * XV(2,iset)**2 + fij(4) = Upd(imem,J1+3,iset) * XV(3,iset)**2 +! +! Use CtLhPolint which allows x to be anywhere w.r.t. th + + Call CtLhPolint4(XVpow(0), Fij(1), 4, ss, Fx, Dfx) + + If (x .GT. 0D0) Fvec(it) = Fx / x**2 +! Pdf is undefined for x.eq + ElseIf (JLx .Eq. Nx(iset)-1) Then +! This is the highest x b + +!** fix allow 4 consecutive elements with imem... mrw 19.9.2005 + fij(1) = Upd(imem,j1,iset) + fij(2) = Upd(imem,j1+1,iset) + fij(3) = Upd(imem,j1+2,iset) + fij(4) = Upd(imem,j1+3,iset) + Call CtLhPolint4 (XVpow(Nx(iset)-3), Fij(1), 4, ss, Fx, Dfx) + + Fvec(it) = Fx + + Else + +! for all interior points, use Jon's in-line function +! This applied to (JLx.Ge.2 .and. JLx.Le.Nx-2) +! (This is cubic spline interpolation, as used by cteq; it was +! changed to polint in previous Durham releases (jcp).) + sf2 = Upd(imem,J1+1,iset) + sf3 = Upd(imem,J1+2,iset) + + Fvec(it) = (const5*(Upd(imem,J1,iset) & + & - sf2*const1 + sf3*const2) & + & + const6*(Upd(imem,J1+3,iset) & + & + sf2*const3 - sf3*const4) & + & + sf2*sy3 - sf3*sy2) / s23 + + Endif + + enddo +! We now have the four values Fvec(1:4 +! interpolate in t... + + If (JLq .LE. 0) Then +! 1st Q-bin, as well as extrapolation to lower Q + Call CtLhPolint4(TV(0,iset), Fvec(1), 4, tt, ff, Dfq) + + ElseIf (JLq .GE. Nt(iset)-1) Then +! Last Q-bin, as well as extrapolation to higher + Call CtLhPolint4(TV(Nt(iset)-3,iset), Fvec(1), 4, tt, ff, Dfq) + Else +! Interrior bins : (JLq.GE.1 .and. JLq.LE.Nt-2) +! which include JLq.Eq.1 and JLq.Eq.Nt-2, since Upd is defined for +! the full range QV(0:Nt) (in contrast to XV) + tf2 = fvec(2) + tf3 = fvec(3) + + g1 = ( tf2*t13 - tf3*t12) / t23 + g4 = (-tf2*t34 + tf3*t24) / t23 + + h00 = ((t34*ty2-tmp2*ty3)*(fvec(1)-g1)/t12 & + & + (tmp1*ty2-t12*ty3)*(fvec(4)-g4)/t34) + + ff = (h00*ty2*ty3/tdet + tf2*ty3 - tf3*ty2) / t23 + EndIf + + CtLhPartonX6 = ff + + Return +! ******************** + END +!======================================================================= + Function CtLhCtq6Pdf (imem,Iparton, X, Q) + Implicit Double Precision (A-H,O-Z) + include 'parmsetup.inc' + Logical Warn + Common & + & / CtqPar2 / Nx(nmxset), Nt(nmxset), NfMx(nmxset) & + & / QCDtable / Alambda(nmxset), Nfl(nmxset), Iorder(nmxset) + + Data Warn /.true./ + save Warn + + call getnset(iset) + + If (X .lt. 0D0 .or. X .gt. 1D0) Then + Print *, 'X out of range in CtLhCtq6Pdf: ', X + Stop + Endif + If (Q .lt. Alambda(iset)) Then + Print *, 'Q out of range in CtLhCtq6Pdf: ', Q + Stop + Endif + +! added to force pdf = 0.0 at x=1.0 exactly - mrw + if(x .eq. 1.0d0) then + CtLhCtq6Pdf = 0.0d0 + return + endif +! + If ((Iparton .lt. -NfMx(iset) .or. Iparton .gt. NfMx(iset))) Then + If (Warn) Then +! put a warning for calling extra flavor. + Warn = .false. + Print *, 'Warning: Iparton out of range in CtLhCtq6Pdf: ' & + & , Iparton + Endif + CtLhCtq6Pdf = 0D0 + Return + Endif + + CtLhCtq6Pdf = CtLhPartonX6 (imem,Iparton, X, Q) + if(CtLhCtq6Pdf.lt.0.D0) CtLhCtq6Pdf = 0.D0 + + Return + +! ******************** + END diff --git a/LHAPDF/lhapdf-5.9.1/src/wrapcteq6.f b/LHAPDF/lhapdf-5.9.1/src/wrapcteq6.f new file mode 100644 index 00000000000..85b5f2c488b --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/wrapcteq6.f @@ -0,0 +1,488 @@ +! -*- F90 -*- + + + subroutine CTEQ6evolve(x,Q,pdf) + implicit real*8(a-h,o-z) + include 'parmsetup.inc' + character*16 name(nmxset) + integer nmem(nmxset),ndef(nmxset),mmem + common/NAME/name,nmem,ndef,mmem + double precision gridx(nmxgridx),gridq(nmxgridq) + integer ngridx,ngridq,jx,jq + real*8 pdf(-6:6) + integer nset + Character Line*80 + PARAMETER (MXX = 96, MXQ = 20, MXF = 5, nhess = 40) + PARAMETER (MXPQX = (MXF + 3) * MXQ * MXX) + Common & + & / CtqPar1nhess / & + & Al(nmxset), XV(0:MXX,nmxset), TV(0:MXQ,nmxset), & + & UPD(0:nhess,MXPQX,nmxset) & + & / CtqPar2 / Nx(nmxset), Nt(nmxset), NfMx(nmxset) & + & / XQrange / Qini(nmxset), Qmax(nmxset), Xmin(nmxset) & + & / QCDtable / Alambda(nmxset), Nfl(nmxset), Iorder(nmxset) & + & / Masstbl / Amass(6,nmxset) + common/masses_LHA/cMass(nmxset),bMass(nmxset),tMass(nmxset) + data pi / 3.141592653589793d0 / + save +! + call getnset(iset) + call getnmem(iset,imem) +! + U = X * CtLhCtq6Pdf(imem,1,X,Q) + D = X * CtLhCtq6Pdf(imem,2,X,Q) + USEA = X * CtLhCtq6Pdf(imem,-1,X,Q) + DSEA = X * CtLhCtq6Pdf(imem,-2,X,Q) + STR = X * CtLhCtq6Pdf(imem,3,X,Q) + CHM = X * CtLhCtq6Pdf(imem,4,X,Q) + BOT = X * CtLhCtq6Pdf(imem,5,X,Q) + GLU = X * CtLhCtq6Pdf(imem,0,X,Q) +! + pdf(0) = glu + pdf(1) = d + pdf(-1) = dsea + pdf(2) = u + pdf(-2) = usea + pdf(3) = str + pdf(-3) = str + pdf(4) = chm + pdf(-4) = chm + pdf(5) = bot + pdf(-5) = bot + pdf(6) = 0.0d0 + pdf(-6) = 0.0d0 + + return +! + entry CTEQ6getgrid(nset,ngridx,ngridq,gridx,gridq) + do jx=0,nx(nset) + gridx(jx+1)=xv(jx,nset) + enddo + do jq=0,nt(nset) + qtemp= Alambda(nset)*dexp(dexp(tv(jq,nset))) + gridq(jq+1)= qtemp*qtemp + + enddo + ngridx=nx(nset) + ngridq=nt(nset) + return + + entry CTEQ6read(nset) + + call CtLhbldat1 + call CtLhbldat2 + + call LHct6set + !*** nmem+1=number of member + read(1,*)nmem(nset),ndef(nset) + if(nmem(nset) .gt. nhess) then + print *,'fatal error: nmem=',nmem(nset),' > nhess=',nhess + stop + endif + Read (1, '(A)') Line + Read (1, '(A)') Line + Read (1, *) Dr, Fl, Al(nset), (Amass(I,nset),I=1,6) + Iorder(nset) = Nint(Dr) + Nfl(nset) = Nint(Fl) + Alambda(nset) = Al(nset) + + cMass(nset) = Amass(4,nset) + bMass(nset) = Amass(5,nset) + tMass(nset) = Amass(6,nset) + + Read (1, '(A)') Line + Read (1, *) NX(nset), NT(nset), NfMx(nset) + + Read (1, '(A)') Line + Read (1, *) & + & QINI(nset), QMAX(nset), (TV(I,nset), I =0, NT(nset)) + + Read (1, '(A)') Line + Read (1, *) XMIN(nset), (XV(I,nset), I =0, NX(nset)) + + Do 11 Iq = 0, NT(nset) + TV(Iq,nset) = Log(Log (TV(Iq,nset) /Al(nset))) + 11 Continue +! +! Since quark = anti-quark for nfl>2 at this stage, +! we Read out only the non-redundent data points +! No of flavors = NfMx (sea) + 1 (gluon) + 2 (valence) + + Nblk = (NX(nset)+1) * (NT(nset)+1) + Npts = Nblk * (NfMx(nset)+3) + + !*** new version: allows nm + do ihess = 0,nmem(nset) + + Read (1, '(A)') Line + Read (1, '(A)') Line + Read (1, *, IOSTAT=IRET) (UPD(ihess,I,nset), I=1,Npts) + + enddo + return +! + entry CTEQ6alfa(alfas,Qalfa) + alfas = pi*CtLhALPI(Qalfa) + return +! + entry CTEQ6init(Eorder,Q2fit) + + return +! + entry CTEQ6pdf(mem) +! imem = mem + call getnset(iset) + call setnmem(iset,mem) + return +! + END + + subroutine LHct6set + Implicit Double Precision (A-H,O-Z) + common /ctq6co/ xlast, qlast, nxsave + nxsave = -1000 + xlast = -2. + qlast = -2. + return + END + +!======================================================================= + Function CtLhPartonX6 (imem,IPRTN, XX, QQ) +! Given the parton distribution function in the array U in +! COMMON / PEVLDT / , this routine interpolates to find +! the parton distribution at an arbitray point in x and q. +! + Implicit Double Precision (A-H,O-Z) + + include 'parmsetup.inc' + Parameter (MXX = 96, MXQ = 20, MXF = 5, nhess = 40) + Parameter (MXQX= MXQ * MXX, MXPQX = MXQX * (MXF+3)) + + Common & + & / CtqPar1nhess / & + & Al(nmxset), XV(0:MXX,nmxset), TV(0:MXQ,nmxset), & + & UPD(0:nhess,MXPQX,nmxset) & + & / CtqPar2 / Nx(nmxset), Nt(nmxset), NfMx(nmxset) & + & / XQrange / Qini(nmxset), Qmax(nmxset), Xmin(nmxset) + + common /ctq6co/ xlast, qlast, nxsave + parameter(nqvec = 4) + + Dimension fvec(4), fij(4) + Dimension xvpow(0:mxx) + Data OneP / 1.00001 / + !**** choice of interpolation variable + Data xpow / 0.3d0 / + Save xvpow + Data ixprint,iqprint/0,0/ + save ixprint,iqprint + + save jq, jx, JLx, JLq, ss, sy2, sy3, s23, ty2, ty3 + save const1 , const2, const3, const4, const5, const6 + save tt, t13, t12, t23, t34 , t24, tmp1, tmp2, tdet + + + call getnset(iset) + call getnmem(iset,imem) + +! store the powers used for interpolation on first call... + if(nx(iset).ne. nxsave) then + nxsave = nx(iset) + xvpow(0) = 0.D0 + do i = 1, nx(iset) + xvpow(i) = xv(i,iset)**xpow + enddo + endif + + X = XX + Q = QQ + + if((x.lt.xmin(iset)).or.(x.gt.1.d0)) then + ixprint=ixprint+1 + if(ixprint.lt.11) print 98,x + if(ixprint.eq.10) print *, & + & 'more warning messages like the last suppressed.' + endif + 98 format(' WARNING: X=',e12.5,' OUT OF RANGE') + if((q.lt.qini(iset)).or.(q.gt.qmax(iset))) then + iqprint=iqprint+1 + if(iqprint.lt.11) print 99,q + if(iqprint.eq.10) print *, & + & 'more warning messages like the last suppressed.' + endif + 99 format(' WARNING: Q=',e12.5,' OUT OF RANGE') + +! skip the initialization in x if same as in the previous call. + if(x .eq. xlast) goto 100 + xlast = x + +! ------------- find lower end of interval containing x, i.e., +! get jx such that xv(jx) .le. x .le. xv(jx+1)... + JLx = -1 + JU = Nx(iset)+1 + 11 If (JU-JLx .GT. 1) Then + JM = (JU+JLx) / 2 + If (X .Ge. XV(JM,iset)) Then + JLx = JM + Else + JU = JM + Endif + Goto 11 + Endif +! Ix 0 1 2 Jx JLx Nx-2 Nx +! |---|---|---|...|---|-x-|---|...|---|---| +! x 0 Xmin x 1 +! + If (JLx .LE. -1) Then + Print '(A,1pE12.4)','Severe error: x <= 0 in CtLhPartonX6 x=',x + Stop + ElseIf (JLx .Eq. 0) Then + Jx = 0 + Elseif (JLx .LE. Nx(iset)-2) Then + +! For interior points, keep x in the middle, as shown abo + Jx = JLx - 1 + Elseif (JLx.Eq.Nx(iset)-1 .or. x.LT.OneP) Then + +! We tolerate a slight over-shoot of one (OneP=1.00001) +! perhaps due to roundoff or whatever, but not more than th +! Keep at least 4 points >= Jx + Jx = JLx - 2 + Else + Print '(A,1pE12.4)','Severe error: x > 1 in CtLhPartonX6 x=',x + Stop + Endif +! ---------- Note: JLx uniquely identifies the x-bin; Jx does n + +! This is the variable to be interpolated in + ss = x**xpow + + If (JLx.Ge.2 .and. JLx.Le.Nx(iset)-2) Then + +! initiation work for "interior bins": store the lattice points in s + svec1 = xvpow(jx) + svec2 = xvpow(jx+1) + svec3 = xvpow(jx+2) + svec4 = xvpow(jx+3) + + s12 = svec1 - svec2 + s13 = svec1 - svec3 + s23 = svec2 - svec3 + s24 = svec2 - svec4 + s34 = svec3 - svec4 + + sy2 = ss - svec2 + sy3 = ss - svec3 + +! constants needed for interpolating in s at fixed t lattice points... + const1 = s13/s23 + const2 = s12/s23 + const3 = s34/s23 + const4 = s24/s23 + s1213 = s12 + s13 + s2434 = s24 + s34 + sdet = s12*s34 - s1213*s2434 + tmp = sy2*sy3/sdet + const5 = (s34*sy2-s2434*sy3)*tmp/s12 + const6 = (s1213*sy2-s12*sy3)*tmp/s34 + + EndIf + + 100 continue + +! skip the initialization in q if same as in the previous call. + if(q .eq. qlast) goto 110 + qlast = q + + tt = log(log(Q/Al(iset))) + +! --------------Now find lower end of interval containing Q, i.e +! get jq such that qv(jq) .le. q .le. qv(jq+1). + JLq = -1 + JU = NT(iset)+1 + 12 If (JU-JLq .GT. 1) Then + JM = (JU+JLq) / 2 + If (tt .GE. TV(JM,iset)) Then + JLq = JM + Else + JU = JM + Endif + Goto 12 + Endif + + If (JLq .LE. 0) Then + Jq = 0 + Elseif (JLq .LE. Nt(iset)-2) Then +! keep q in the middle, as shown above + Jq = JLq - 1 + Else +! JLq .GE. Nt-1 case: Keep at least 4 points >= + Jq = Nt(iset) - 3 + + Endif +! This is the interpolation variable i + + If (JLq.GE.1 .and. JLq.LE.Nt(iset)-2) Then +! store the lattice points in t.. + tvec1 = Tv(jq,iset) + tvec2 = Tv(jq+1,iset) + tvec3 = Tv(jq+2,iset) + tvec4 = Tv(jq+3,iset) + + t12 = tvec1 - tvec2 + t13 = tvec1 - tvec3 + t23 = tvec2 - tvec3 + t24 = tvec2 - tvec4 + t34 = tvec3 - tvec4 + + ty2 = tt - tvec2 + ty3 = tt - tvec3 + + tmp1 = t12 + t13 + tmp2 = t24 + t34 + + tdet = t12*t34 - tmp1*tmp2 + + EndIf + + 110 continue + +! get the pdf function values at the lattice points... +! In this code, we store 8 flavors: u,ubar,d,dbar,s=sbar,c=cbar,b=bbar,g +! hence Iprtn=3,4,5 (s,c,b) are obtained from -3,-4,-5 (sbar,cbar,bbar) + + If (Iprtn .GE. 3) Then + Ip = - Iprtn + Else + Ip = Iprtn + EndIf + jtmp = ((Ip + NfMx(iset))*(NT(iset)+1)+(jq-1))*(NX(iset)+1)+jx+1 + + Do it = 1, nqvec + + J1 = jtmp + it*(NX(iset)+1) + + If (Jx .Eq. 0) Then +! For the first 4 x points, interpolate x^2*f(x +! This applies to the two lowest bins JLx = 0, +! We cannot put the JLx.eq.1 bin into the "interior" section +! (as we do for q), since Upd(J1) is undefined + fij(1) = 0 + fij(2) = Upd(imem,J1+1,iset) * XV(1,iset)**2 + fij(3) = Upd(imem,J1+2,iset) * XV(2,iset)**2 + fij(4) = Upd(imem,J1+3,iset) * XV(3,iset)**2 +! +! Use CtLhPolint which allows x to be anywhere w.r.t. th + + Call CtLhPolint4(XVpow(0), Fij(1), 4, ss, Fx, Dfx) + + If (x .GT. 0D0) Fvec(it) = Fx / x**2 +! Pdf is undefined for x.eq + ElseIf (JLx .Eq. Nx(iset)-1) Then +! This is the highest x b + +!** fix allow 4 consecutive elements with imem... mrw 19.9.2005 + fij(1) = Upd(imem,j1,iset) + fij(2) = Upd(imem,j1+1,iset) + fij(3) = Upd(imem,j1+2,iset) + fij(4) = Upd(imem,j1+3,iset) + Call CtLhPolint4 (XVpow(Nx(iset)-3), Fij(1), 4, ss, Fx, Dfx) + + Fvec(it) = Fx + + Else + +! for all interior points, use Jon's in-line function +! This applied to (JLx.Ge.2 .and. JLx.Le.Nx-2) +! (This is cubic spline interpolation, as used by cteq; it was +! changed to polint in previous Durham releases (jcp).) + sf2 = Upd(imem,J1+1,iset) + sf3 = Upd(imem,J1+2,iset) + + Fvec(it) = (const5*(Upd(imem,J1,iset) & + & - sf2*const1 + sf3*const2) & + & + const6*(Upd(imem,J1+3,iset) & + & + sf2*const3 - sf3*const4) & + & + sf2*sy3 - sf3*sy2) / s23 + + Endif + + enddo +! We now have the four values Fvec(1:4 +! interpolate in t... + + If (JLq .LE. 0) Then +! 1st Q-bin, as well as extrapolation to lower Q + Call CtLhPolint4(TV(0,iset), Fvec(1), 4, tt, ff, Dfq) + + ElseIf (JLq .GE. Nt(iset)-1) Then +! Last Q-bin, as well as extrapolation to higher + Call CtLhPolint4(TV(Nt(iset)-3,iset), Fvec(1), 4, tt, ff, Dfq) + Else +! Interrior bins : (JLq.GE.1 .and. JLq.LE.Nt-2) +! which include JLq.Eq.1 and JLq.Eq.Nt-2, since Upd is defined for +! the full range QV(0:Nt) (in contrast to XV) + tf2 = fvec(2) + tf3 = fvec(3) + + g1 = ( tf2*t13 - tf3*t12) / t23 + g4 = (-tf2*t34 + tf3*t24) / t23 + + h00 = ((t34*ty2-tmp2*ty3)*(fvec(1)-g1)/t12 & + & + (tmp1*ty2-t12*ty3)*(fvec(4)-g4)/t34) + + ff = (h00*ty2*ty3/tdet + tf2*ty3 - tf3*ty2) / t23 + EndIf + + CtLhPartonX6 = ff + + Return +! ******************** + END +!======================================================================= + Function CtLhCtq6Pdf (imem,Iparton, X, Q) + Implicit Double Precision (A-H,O-Z) + include 'parmsetup.inc' + Logical Warn + Common & + & / CtqPar2 / Nx(nmxset), Nt(nmxset), NfMx(nmxset) & + & / QCDtable / Alambda(nmxset), Nfl(nmxset), Iorder(nmxset) + + Data Warn /.true./ + save Warn + + call getnset(iset) + + If (X .lt. 0D0 .or. X .gt. 1D0) Then + Print *, 'X out of range in CtLhCtq6Pdf: ', X + Stop + Endif + If (Q .lt. Alambda(iset)) Then + Print *, 'Q out of range in CtLhCtq6Pdf: ', Q + Stop + Endif + +! added to force pdf = 0.0 at x=1.0 exactly - mrw + if(x .eq. 1.0d0) then + CtLhCtq6Pdf = 0.0d0 + return + endif +! + If ((Iparton .lt. -NfMx(iset) .or. Iparton .gt. NfMx(iset))) Then + If (Warn) Then +! put a warning for calling extra flavor. + Warn = .false. + Print *, 'Warning: Iparton out of range in CtLhCtq6Pdf: ' & + & , Iparton + Endif + CtLhCtq6Pdf = 0D0 + Return + Endif + + CtLhCtq6Pdf = CtLhPartonX6 (imem,Iparton, X, Q) + if(CtLhCtq6Pdf.lt.0.D0) CtLhCtq6Pdf = 0.D0 + + Return + +! ******************** + END diff --git a/LHAPDF/lhapdf-5.9.1/src/wrapcteq65-lite.f b/LHAPDF/lhapdf-5.9.1/src/wrapcteq65-lite.f new file mode 100644 index 00000000000..95ed3b1a28c --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/wrapcteq65-lite.f @@ -0,0 +1,685 @@ +! -*- F90 -*- + + + subroutine CTEQ65evolve(x,Q,pdf) + implicit real*8(a-h,o-z) + include 'parmsetup.inc' + character*16 name(nmxset) + character*512 setpath + integer nmem(nmxset),ndef(nmxset),mmem + common/NAME/name,nmem,ndef,mmem + double precision gridx(nmxgridx),gridq(nmxgridq) + integer ngridx,ngridq,jx,jq + real*8 pdf(-6:6) + integer nset + Character Line*80 + PARAMETER (MXX = 204, MXQ = 25, MXF = 6, MaxVal=3, nhess = 0) + PARAMETER (MXPQX = (MXF+1+MaxVal) * MXQ * MXX) + Common & + & / CtqPar1nhess65 / & + & Al(nmxset), XV(0:MXX,nmxset), TV(0:MXQ,nmxset), & + & UPD(0:nhess,MXPQX,nmxset) & + & / CtqPar2 / Nx(nmxset), Nt(nmxset), NfMx(nmxset) & + & / XQrange / Qini(nmxset), Qmax(nmxset), Xmin(nmxset) & + & / QCDtable / Alambda(nmxset), Nfl(nmxset), Iorder(nmxset) & + & / Masstbl / Amass(6,nmxset) + + common/masses_LHA/cMass(nmxset),bMass(nmxset),tMass(nmxset) + + data pi / 3.141592653589793d0 / + save +! + call getnset(iset) + call getnmem(iset,imem) + + U = X * CtLhCtq65Pdf(0,1,X,Q) + D = X * CtLhCtq65Pdf(0,2,X,Q) + USEA = X * CtLhCtq65Pdf(0,-1,X,Q) + DSEA = X * CtLhCtq65Pdf(0,-2,X,Q) + STR = X * CtLhCtq65Pdf(0,-3,X,Q) + CHM = X * CtLhCtq65Pdf(0,-4,X,Q) + BOT = X * CtLhCtq65Pdf(0,-5,X,Q) + GLU = X * CtLhCtq65Pdf(0,0,X,Q) +! + pdf(0) = glu + pdf(1) = d + pdf(-1) = dsea + pdf(2) = u + pdf(-2) = usea + pdf(3) = str + pdf(-3) = str + pdf(4) = chm + pdf(-4) = chm + pdf(5) = bot + pdf(-5) = bot + pdf(6) = 0.0d0 + pdf(-6) = 0.0d0 + return +! + !like cteq65evolve, but allows + entry CTEQ65cevolve(x,Q,pdf) +! + call getnset(iset) + call getnmem(iset,imem) + + U = X * CtLhCtq65Pdf(0,1,X,Q) + D = X * CtLhCtq65Pdf(0,2,X,Q) + USEA = X * CtLhCtq65Pdf(0,-1,X,Q) + DSEA = X * CtLhCtq65Pdf(0,-2,X,Q) + STR = X * CtLhCtq65Pdf(0,3,X,Q) + SBAR = X * CtLhCtq65Pdf(0,-3,X,Q) + CHM = X * CtLhCtq65Pdf(0,4,X,Q) + CBAR = X * CtLhCtq65Pdf(0,-4,X,Q) + BOT = X * CtLhCtq65Pdf(0,5,X,Q) + GLU = X * CtLhCtq65Pdf(0,0,X,Q) +! + pdf(0) = glu + pdf(1) = d + pdf(-1) = dsea + pdf(2) = u + pdf(-2) = usea + pdf(3) = str + pdf(-3) = sbar + pdf(4) = chm + pdf(-4) = cbar + pdf(5) = bot + pdf(-5) = bot + pdf(6) = 0.0d0 + pdf(-6) = 0.0d0 + + return +! + !like cteq65evolve, but allows + entry CTEQ65sevolve(x,Q,pdf) +! + call getnset(iset) + call getnmem(iset,imem) + + U = X * CtLhCtq65Pdf(0,1,X,Q) + D = X * CtLhCtq65Pdf(0,2,X,Q) + USEA = X * CtLhCtq65Pdf(0,-1,X,Q) + DSEA = X * CtLhCtq65Pdf(0,-2,X,Q) + STR = X * CtLhCtq65Pdf(0,3,X,Q) + SBAR = X * CtLhCtq65Pdf(0,-3,X,Q) + CHM = X * CtLhCtq65Pdf(0,-4,X,Q) + BOT = X * CtLhCtq65Pdf(0,5,X,Q) + GLU = X * CtLhCtq65Pdf(0,0,X,Q) +! + pdf(0) = glu + pdf(1) = d + pdf(-1) = dsea + pdf(2) = u + pdf(-2) = usea + pdf(3) = str + pdf(-3) = sbar + pdf(4) = chm + pdf(-4) = chm + pdf(5) = bot + pdf(-5) = bot + pdf(6) = 0.0d0 + pdf(-6) = 0.0d0 + + return +! + entry CTEQ65getgrid(nset,ngridx,ngridq,gridx,gridq) + do jx=0,nx(nset) + gridx(jx+1)=xv(jx,nset) + enddo + do jq=0,nt(nset) + qtemp = alambda(nset)*dexp(dexp(tv(jq,nset))) + gridq(jq+1)=qtemp*qtemp + enddo + ngridx=nx(nset) + ngridq=nt(nset) + return + + entry CTEQ65read(nset) + call CtLhbldat1 + call CtLhbldat2 + + call LHct65set + + !*** nmem+1=number of member + read(1,*)nmem(nset),ndef(nset) +! if(nmem(nset) .gt. nhess) then +! print *,'fatal error: nmem=',nmem(nset),' > nhess=',nhess +! stop +! endif + + MxVal = 3 + Read (1, '(A)') Line + Read (1, '(A)') Line + Read (1, *) Dr, Fl, Al(nset), (Amass(I,nset),I=1,6) + Iorder(nset) = Nint(Dr) + Nfl(nset) = Nint(Fl) + Alambda(nset) = Al(nset) + + cMass(nset) = Amass(4,nset) + bMass(nset) = Amass(5,nset) + tMass(nset) = Amass(6,nset) + + Read (1, '(A)') Line +! This is the .pds (WKT) f + Read (1, *) N0, N0, N0, NfMx(nset), N0, N0 + Read (1, '(A)') Line + Read (1, *) NX(nset), NT(nset), N0, N0, N0 + Read (1, '(A)') (Line,I=1,4) + Read (1, *) & + & QINI(nset), QMAX(nset), (aa,TV(I,nset), I =0, NT(nset)) + + Read (1, '(A)') Line + Read (1, *) XMIN(nset), aa, (XV(I,nset), I =1, NX(nset)) + XV(0,nset)=0D0 +! +! Since quark = anti-quark for nfl>2 at this stage, +! we Read out only the non-redundent data points +! No of flavors = NfMx (sea) + 1 (gluon) + 2 (valence) + + + Nblk = (NX(nset)+1) * (NT(nset)+1) + Npts = Nblk * (NfMx(nset)+1+MxVal) + + !*** new version: allows nm + do ihess = 0,nmem(nset) + + Read (1, '(A)') Line + Read (1, '(A)') Line + Read (1, *, IOSTAT=IRET) (UPD(0,I,nset), I=1,Npts) + + enddo + return +! + entry CTEQ66read(nset) + call CtLhbldat1 + call CtLhbldat2 + + call LHct65set + + !*** nmem+1=number of member + read(1,*)nmem(nset),ndef(nset) +! if(nmem(nset) .gt. nhess) then +! print *,'fatal error: nmem=',nmem(nset),' > nhess=',nhess +! stop +! endif + + MxVal = 2 + Read (1, '(A)') Line + Read (1, '(A)') Line + Read (1, *) Dr, Fl, Al(nset), (Amass(I,nset),I=1,6) + Iorder(nset) = Nint(Dr) + Nfl(nset) = Nint(Fl) + Alambda(nset) = Al(nset) + + cMass(nset) = Amass(4,nset) + bMass(nset) = Amass(5,nset) + tMass(nset) = Amass(6,nset) + + Read (1, '(A)') Line +! This is the .pds (WKT) f + Read (1, *) N0, N0, N0, NfMx(nset), N0, N0 + Read (1, '(A)') Line + Read (1, *) NX(nset), NT(nset), N0, N0, N0 + Read (1, '(A)') (Line,I=1,4) + Read (1, *) & + & QINI(nset), QMAX(nset), (aa,TV(I,nset), I =0, NT(nset)) + + Read (1, '(A)') Line + Read (1, *) XMIN(nset), aa, (XV(I,nset), I =1, NX(nset)) + XV(0,nset)=0D0 +! +! Since quark = anti-quark for nfl>2 at this stage, +! we Read out only the non-redundent data points +! No of flavors = NfMx (sea) + 1 (gluon) + 2 (valence) + + + Nblk = (NX(nset)+1) * (NT(nset)+1) + Npts = Nblk * (NfMx(nset)+1+MxVal) + + !*** new version: allows nm + do ihess = 0,nmem(nset) + + Read (1, '(A)') Line + Read (1, '(A)') Line + Read (1, *, IOSTAT=IRET) (UPD(0,I,nset), I=1,Npts) + + enddo + return +! + !like CTEQ65read, but c.ne. + entry CTEQ65cread(nset) + call CtLhbldat1 + call CtLhbldat2 + call LHct65set + + !*** nmem+1=number of member + read(1,*)nmem(nset),ndef(nset) +! if(nmem(nset) .gt. nhess) then +! print *,'fatal error: nmem=',nmem(nset),' > nhess=',nhess +! stop +! endif + + !one more species free + MxVal = 4 + Read (1, '(A)') Line + Read (1, '(A)') Line + Read (1, *) Dr, Fl, Al(nset), (Amass(I,nset),I=1,6) + Iorder(nset) = Nint(Dr) + Nfl(nset) = Nint(Fl) + Alambda(nset) = Al(nset) + + cMass(nset) = Amass(4,nset) + bMass(nset) = Amass(5,nset) + tMass(nset) = Amass(6,nset) + + Read (1, '(A)') Line +! This is the .pds (WKT) f + Read (1, *) N0, N0, N0, NfMx(nset), N0, N0 + Read (1, '(A)') Line + Read (1, *) NX(nset), NT(nset), N0, N0, N0 + Read (1, '(A)') (Line,I=1,4) + Read (1, *) & + & QINI(nset), QMAX(nset), (aa,TV(I,nset), I =0, NT(nset)) + + Read (1, '(A)') Line + Read (1, *) XMIN(nset), aa, (XV(I,nset), I =1, NX(nset)) + XV(0,nset)=0D0 +! +! we Read only the non-redundent data points + + Nblk = (NX(nset)+1) * (NT(nset)+1) + Npts = Nblk * (NfMx(nset)+1+MxVal) + + !*** new version: allows nm + do ihess = 0,nmem(nset) + + Read (1, '(A)') Line + Read (1, '(A)') Line + Read (1, *, IOSTAT=IRET) (UPD(0,I,nset), I=1,Npts) + + enddo + return +! + entry CTEQ65alfa(alfas,Qalfa) + alfas = pi*CtLhALPI(Qalfa) + return +! + entry CTEQ65init(Eorder,Q2fit) + return +! + entry CTEQ65pdf(mem) +! imem = mem + call getnset(iset) + call setnmem(iset,mem) + +! have to reopen stream 1 + call getsetpath(setpath) + open(1,file=setpath(1:len_trim(setpath)),action='READ') + + line = '' + do while (line(1:3).ne.'==>') + read(1,'(a)'),line + enddo +! - backspace by one record + backspace(1) +! - dummy read up to the member requested + do n=0,mem-1 + read(1,'(a)'),line + read(1,'(a)'),line + Read (1, *, IOSTAT=IRET) (UPD(0,I,iset), I=1,Npts) + enddo +!- read in the data of the requested member + Read (1, '(A)') Line + Read (1, '(A)') Line + Read (1, *, IOSTAT=IRET) (UPD(0,I,iset), I=1,Npts) + close(1) + return +! + END + + subroutine LHct65set + Implicit Double Precision (A-H,O-Z) + common /ctq65co/ xlast, qlast, nxsave + nxsave = -1000 + xlast = -2. + qlast = -2. + return + END + +!======================================================================= + Function CtLhPartonX65 (imem,IPRTN, XX, QQ) +! Given the parton distribution function in the array U in +! COMMON / PEVLDT / , this routine interpolates to find +! the parton distribution at an arbitray point in x and q. +! + Implicit Double Precision (A-H,O-Z) + + include 'parmsetup.inc' + PARAMETER (MXX = 204, MXQ = 25, MXF = 6, MaxVal=3, nhess = 0) + PARAMETER (MXPQX = (MXF+1+MaxVal) * MXQ * MXX) + + Common & + & / CtqPar1nhess65 / & + & Al(nmxset), XV(0:MXX,nmxset), TV(0:MXQ,nmxset), & + & UPD(0:nhess,MXPQX,nmxset) & + & / CtqPar2 / Nx(nmxset), Nt(nmxset), NfMx(nmxset) & + & / XQrange / Qini(nmxset), Qmax(nmxset), Xmin(nmxset) + common /ctq65co/ xlast,qlast, nxsave + + parameter(nqvec = 4) + + Dimension fvec(4), fij(4) + Dimension xvpow(0:mxx) + Data OneP / 1.00001 / + !**** choice of interpolation variable + Data xpow / 0.3d0 / + Save xvpow + Data ixprint,iqprint/0,0/ + save ixprint,iqprint + + save jq, jx, JLx, JLq, ss, sy2, sy3, s23, ty2, ty3 + save const1 , const2, const3, const4, const5, const6 + save tt, t13, t12, t23, t34 , t24, tmp1, tmp2, tdet + + + call getnset(iset) +! call getnmem(iset,imem) + +! store the powers used for interpolation on first call... + if(nx(iset) .ne. nxsave) then + nxsave = nx(iset) + xvpow(0) = 0.D0 + do i = 1, nx(iset) + xvpow(i) = xv(i,iset)**xpow + enddo + endif + + X = XX + Q = QQ + + if((x.lt.xmin(iset)).or.(x.gt.1.d0)) then + ixprint=ixprint+1 + if(ixprint.lt.11) print 98,x + if(ixprint.eq.10) print *, & + & 'more warning messages like the last suppressed.' + endif + 98 format(' WARNING: X=',e12.5,' OUT OF RANGE') + if((q.lt.qini(iset)).or.(q.gt.qmax(iset))) then + iqprint=iqprint+1 + if(iqprint.lt.11) print 99,q + if(iqprint.eq.10) print *, & + & 'more warning messages like the last suppressed.' + endif + 99 format(' WARNING: Q=',e12.5,' OUT OF RANGE') + +! skip the initialization in x if same as in the previous call. + if(x .eq. xlast) goto 100 + xlast = x + +! ------------- find lower end of interval containing x, i.e., +! get jx such that xv(jx) .le. x .le. xv(jx+1)... + JLx = -1 + JU = Nx(iset)+1 + 11 If (JU-JLx .GT. 1) Then + JM = (JU+JLx) / 2 + If (X .Ge. XV(JM,iset)) Then + JLx = JM + Else + JU = JM + Endif + Goto 11 + Endif +! Ix 0 1 2 Jx JLx Nx-2 Nx +! |---|---|---|...|---|-x-|---|...|---|---| +! x 0 Xmin x 1 +! + If (JLx .LE. -1) Then + Print '(A,1pE12.4)','Severe error: x <= 0 in CtLhPartonX65 x=',x + Stop + ElseIf (JLx .Eq. 0) Then + Jx = 0 + Elseif (JLx .LE. Nx(iset)-2) Then + +! For interior points, keep x in the middle, as shown abo + Jx = JLx - 1 + Elseif (JLx.Eq.Nx(iset)-1 .or. x.LT.OneP) Then + +! We tolerate a slight over-shoot of one (OneP=1.00001) +! perhaps due to roundoff or whatever, but not more than th +! Keep at least 4 points >= Jx + Jx = JLx - 2 + Else + Print '(A,1pE12.4)','Severe error: x > 1 in CtLhPartonX65 x=',x + Stop + Endif +! ---------- Note: JLx uniquely identifies the x-bin; Jx does n + +! This is the variable to be interpolated in + ss = x**xpow + + If (JLx.Ge.2 .and. JLx.Le.Nx(iset)-2) Then + +! initiation work for "interior bins": store the lattice points in s + svec1 = xvpow(jx) + svec2 = xvpow(jx+1) + svec3 = xvpow(jx+2) + svec4 = xvpow(jx+3) + + s12 = svec1 - svec2 + s13 = svec1 - svec3 + s23 = svec2 - svec3 + s24 = svec2 - svec4 + s34 = svec3 - svec4 + + sy2 = ss - svec2 + sy3 = ss - svec3 + +! constants needed for interpolating in s at fixed t lattice points... + const1 = s13/s23 + const2 = s12/s23 + const3 = s34/s23 + const4 = s24/s23 + s1213 = s12 + s13 + s2434 = s24 + s34 + sdet = s12*s34 - s1213*s2434 + tmp = sy2*sy3/sdet + const5 = (s34*sy2-s2434*sy3)*tmp/s12 + const6 = (s1213*sy2-s12*sy3)*tmp/s34 + + EndIf + + 100 continue + +! skip the initialization in q if same as in the previous call. + if(q .eq. qlast) goto 110 + qlast = q + + tt = log(log(Q/Al(iset))) + +! --------------Now find lower end of interval containing Q, i.e +! get jq such that qv(jq) .le. q .le. qv(jq+1). + JLq = -1 + JU = NT(iset)+1 + 12 If (JU-JLq .GT. 1) Then + JM = (JU+JLq) / 2 + If (tt .GE. TV(JM,iset)) Then + JLq = JM + Else + JU = JM + Endif + Goto 12 + Endif + + If (JLq .LE. 0) Then + Jq = 0 + Elseif (JLq .LE. Nt(iset)-2) Then +! keep q in the middle, as shown above + Jq = JLq - 1 + Else +! JLq .GE. Nt-1 case: Keep at least 4 points >= + Jq = Nt(iset) - 3 + + Endif +! This is the interpolation variable i + + If (JLq.GE.1 .and. JLq.LE.Nt(iset)-2) Then +! store the lattice points in t.. + tvec1 = Tv(jq,iset) + tvec2 = Tv(jq+1,iset) + tvec3 = Tv(jq+2,iset) + tvec4 = Tv(jq+3,iset) + + t12 = tvec1 - tvec2 + t13 = tvec1 - tvec3 + t23 = tvec2 - tvec3 + t24 = tvec2 - tvec4 + t34 = tvec3 - tvec4 + + ty2 = tt - tvec2 + ty3 = tt - tvec3 + + tmp1 = t12 + t13 + tmp2 = t24 + t34 + + tdet = t12*t34 - tmp1*tmp2 + + EndIf + + 110 continue + +! get the pdf function values at the lattice points... +! In this code, we store 10 flavors: u,ubar,d,dbar,s,sbar,c,cbar,b=bbar, +! hence Iprtn=5 (b) is obtained from -5 (bbar) + + If (Iprtn .GE. 5) Then + Ip = - Iprtn + Else + Ip = Iprtn + EndIf + jtmp = ((Ip + NfMx(iset))*(NT(iset)+1)+(jq-1))*(NX(iset)+1)+jx+1 + + Do it = 1, nqvec + + J1 = jtmp + it*(NX(iset)+1) + + If (Jx .Eq. 0) Then +! For the first 4 x points, interpolate x^2*f(x +! This applies to the two lowest bins JLx = 0, +! We cannot put the JLx.eq.1 bin into the "interior" section +! (as we do for q), since Upd(J1) is undefined + fij(1) = 0 + fij(2) = Upd(imem,J1+1,iset) * XV(1,iset)**2 + fij(3) = Upd(imem,J1+2,iset) * XV(2,iset)**2 + fij(4) = Upd(imem,J1+3,iset) * XV(3,iset)**2 +! +! Use CtLhPolint which allows x to be anywhere w.r.t. th + + Call CtLhPolint4(XVpow(0), Fij(1), 4, ss, Fx, Dfx) + + If (x .GT. 0D0) fvec(it) = Fx / x**2 +! Pdf is undefined for x.eq + ElseIf (JLx .Eq. Nx(iset)-1) Then +! This is the highest x b + +!** fix allow 4 consecutive elements with iset... mrw 19.9.2005 + fij(1) = Upd(imem,j1,iset) + fij(2) = Upd(imem,j1+1,iset) + fij(3) = Upd(imem,j1+2,iset) + fij(4) = Upd(imem,j1+3,iset) + Call CtLhPolint4 (XVpow(Nx(iset)-3), Fij(1), 4, ss, Fx, Dfx) + + fvec(it) = Fx + + Else + +! for all interior points, use Jon's in-line function +! This applied to (JLx.Ge.2 .and. JLx.Le.Nx-2) +! (This is cubic spline interpolation, as used by cteq; it was +! changed to polint in previous Durham releases (jcp).) + sf2 = Upd(imem,J1+1,iset) + sf3 = Upd(imem,J1+2,iset) + + Fvec(it) = (const5*(Upd(imem,J1,iset) & + & - sf2*const1 + sf3*const2) & + & + const6*(Upd(imem,J1+3,iset) & + & + sf2*const3 - sf3*const4) & + & + sf2*sy3 - sf3*sy2) / s23 + + Endif + + enddo +! We now have the four values Fvec(1:4 +! interpolate in t... + + If (JLq .LE. 0) Then +! 1st Q-bin, as well as extrapolation to lower Q + Call CtLhPolint4(TV(0,iset), Fvec(1), 4, tt, ff, Dfq) + + ElseIf (JLq .GE. Nt(iset)-1) Then +! Last Q-bin, as well as extrapolation to higher + Call CtLhPolint4(TV(Nt(iset)-3,iset), Fvec(1), 4, tt, ff, Dfq) + Else +! Interrior bins : (JLq.GE.1 .and. JLq.LE.Nt-2) +! which include JLq.Eq.1 and JLq.Eq.Nt-2, since Upd is defined for +! the full range QV(0:Nt) (in contrast to XV) + tf2 = fvec(2) + tf3 = fvec(3) + + g1 = ( tf2*t13 - tf3*t12) / t23 + g4 = (-tf2*t34 + tf3*t24) / t23 + + h00 = ((t34*ty2-tmp2*ty3)*(fvec(1)-g1)/t12 & + & + (tmp1*ty2-t12*ty3)*(fvec(4)-g4)/t34) + + ff = (h00*ty2*ty3/tdet + tf2*ty3 - tf3*ty2) / t23 + EndIf + + CtLhPartonX65 = ff + + Return + END +!======================================================================= + Function CtLhCtq65Pdf (imem,Iparton, X, Q) + Implicit Double Precision (A-H,O-Z) + include 'parmsetup.inc' + Logical Warn + Common & + & / CtqPar2 / Nx(nmxset), Nt(nmxset), NfMx(nmxset) & + & / QCDtable / Alambda(nmxset), Nfl(nmxset), Iorder(nmxset) + + Data Warn /.true./ + save Warn + call getnset(iset) + + If (X .lt. 0D0 .or. X .gt. 1D0) Then + Print *, 'X out of range in CtLhCtq65Pdf: ', X + Stop + Endif + If (Q .lt. Alambda(iset)) Then + Print *, 'Q out of range in CtLhCtq65Pdf: ', Q + Stop + Endif + +! added to force pdf = 0.0 at x=1.0 exactly - mrw + if(x .eq. 1.0d0) then + CtLhCtq65Pdf = 0.0d0 + return + endif +! + If ((Iparton .lt. -NfMx(iset) .or. Iparton .gt. NfMx(iset))) Then + If (Warn) Then +! put a warning for calling extra flavor. + Warn = .false. + Print *, 'Warning: Iparton out of range in CtLhCtq65Pdf: ' & + & , Iparton + Endif + CtLhCtq65Pdf = 0D0 + Return + Endif + + CtLhCtq65Pdf = CtLhPartonX65 (imem,Iparton, X, Q) + if(CtLhCtq65Pdf.lt.0.D0) CtLhCtq65Pdf = 0.D0 + + Return + +! ******************** + END diff --git a/LHAPDF/lhapdf-5.9.1/src/wrapcteq65.f b/LHAPDF/lhapdf-5.9.1/src/wrapcteq65.f new file mode 100644 index 00000000000..bdfcb4c8f76 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/wrapcteq65.f @@ -0,0 +1,662 @@ +! -*- F90 -*- + + + subroutine CTEQ65evolve(x,Q,pdf) + implicit real*8(a-h,o-z) + include 'parmsetup.inc' + character*16 name(nmxset) + integer nmem(nmxset),ndef(nmxset),mmem + common/NAME/name,nmem,ndef,mmem + double precision gridx(nmxgridx),gridq(nmxgridq) + integer ngridx,ngridq,jx,jq + real*8 pdf(-6:6) + integer nset + Character Line*80 + PARAMETER (MXX = 204, MXQ = 25, MXF = 6, MaxVal=3, nhess = 52) + PARAMETER (MXPQX = (MXF+1+MaxVal) * MXQ * MXX) + Common & + & / CtqPar1nhess65 / & + & Al(nmxset), XV(0:MXX,nmxset), TV(0:MXQ,nmxset), & + & UPD(0:nhess,MXPQX,nmxset) & + & / CtqPar2 / Nx(nmxset), Nt(nmxset), NfMx(nmxset) & + & / XQrange / Qini(nmxset), Qmax(nmxset), Xmin(nmxset) & + & / QCDtable / Alambda(nmxset), Nfl(nmxset), Iorder(nmxset) & + & / Masstbl / Amass(6,nmxset) + + common/masses_LHA/cMass(nmxset),bMass(nmxset),tMass(nmxset) + + data pi / 3.141592653589793d0 / + save +! + call getnset(iset) + call getnmem(iset,imem) + + U = X * CtLhCtq65Pdf(imem,1,X,Q) + D = X * CtLhCtq65Pdf(imem,2,X,Q) + USEA = X * CtLhCtq65Pdf(imem,-1,X,Q) + DSEA = X * CtLhCtq65Pdf(imem,-2,X,Q) + STR = X * CtLhCtq65Pdf(imem,-3,X,Q) + CHM = X * CtLhCtq65Pdf(imem,-4,X,Q) + BOT = X * CtLhCtq65Pdf(imem,-5,X,Q) + GLU = X * CtLhCtq65Pdf(imem,0,X,Q) +! + pdf(0) = glu + pdf(1) = d + pdf(-1) = dsea + pdf(2) = u + pdf(-2) = usea + pdf(3) = str + pdf(-3) = str + pdf(4) = chm + pdf(-4) = chm + pdf(5) = bot + pdf(-5) = bot + pdf(6) = 0.0d0 + pdf(-6) = 0.0d0 + return +! + !like cteq65evolve, but allows + entry CTEQ65cevolve(x,Q,pdf) +! + call getnset(iset) + call getnmem(iset,imem) + + U = X * CtLhCtq65Pdf(imem,1,X,Q) + D = X * CtLhCtq65Pdf(imem,2,X,Q) + USEA = X * CtLhCtq65Pdf(imem,-1,X,Q) + DSEA = X * CtLhCtq65Pdf(imem,-2,X,Q) + STR = X * CtLhCtq65Pdf(imem,3,X,Q) + SBAR = X * CtLhCtq65Pdf(imem,-3,X,Q) + CHM = X * CtLhCtq65Pdf(imem,4,X,Q) + CBAR = X * CtLhCtq65Pdf(imem,-4,X,Q) + BOT = X * CtLhCtq65Pdf(imem,5,X,Q) + GLU = X * CtLhCtq65Pdf(imem,0,X,Q) +! + pdf(0) = glu + pdf(1) = d + pdf(-1) = dsea + pdf(2) = u + pdf(-2) = usea + pdf(3) = str + pdf(-3) = sbar + pdf(4) = chm + pdf(-4) = cbar + pdf(5) = bot + pdf(-5) = bot + pdf(6) = 0.0d0 + pdf(-6) = 0.0d0 + + return +! + !like cteq65evolve, but allows + entry CTEQ65sevolve(x,Q,pdf) +! + call getnset(iset) + call getnmem(iset,imem) + + U = X * CtLhCtq65Pdf(imem,1,X,Q) + D = X * CtLhCtq65Pdf(imem,2,X,Q) + USEA = X * CtLhCtq65Pdf(imem,-1,X,Q) + DSEA = X * CtLhCtq65Pdf(imem,-2,X,Q) + STR = X * CtLhCtq65Pdf(imem,3,X,Q) + SBAR = X * CtLhCtq65Pdf(imem,-3,X,Q) + CHM = X * CtLhCtq65Pdf(imem,-4,X,Q) + BOT = X * CtLhCtq65Pdf(imem,5,X,Q) + GLU = X * CtLhCtq65Pdf(imem,0,X,Q) +! + pdf(0) = glu + pdf(1) = d + pdf(-1) = dsea + pdf(2) = u + pdf(-2) = usea + pdf(3) = str + pdf(-3) = sbar + pdf(4) = chm + pdf(-4) = chm + pdf(5) = bot + pdf(-5) = bot + pdf(6) = 0.0d0 + pdf(-6) = 0.0d0 + + return + + entry CTEQ65getgrid(nset,ngridx,ngridq,gridx,gridq) + do jx=0,nx(nset) + gridx(jx+1)=xv(jx,nset) + enddo + do jq=0,nt(nset) + qtemp = alambda(nset)*dexp(dexp(tv(jq,nset))) + gridq(jq+1)=qtemp*qtemp + enddo + ngridx=nx(nset) + ngridq=nt(nset) + return +! + entry CTEQ65read(nset) + call CtLhbldat1 + call CtLhbldat2 + + call LHct65set + + !*** nmem+1=number of member + read(1,*)nmem(nset),ndef(nset) + if(nmem(nset) .gt. nhess) then + print *,'fatal error: nmem=',nmem(nset),' > nhess=',nhess + stop + endif + + MxVal = 3 + Read (1, '(A)') Line + Read (1, '(A)') Line + Read (1, *) Dr, Fl, Al(nset), (Amass(I,nset),I=1,6) + Iorder(nset) = Nint(Dr) + Nfl(nset) = Nint(Fl) + Alambda(nset) = Al(nset) + + cMass(nset) = Amass(4,nset) + bMass(nset) = Amass(5,nset) + tMass(nset) = Amass(6,nset) + + Read (1, '(A)') Line +! This is the .pds (WKT) f + Read (1, *) N0, N0, N0, NfMx(nset), N0, N0 + Read (1, '(A)') Line + Read (1, *) NX(nset), NT(nset), N0, N0, N0 + Read (1, '(A)') (Line,I=1,4) + Read (1, *) & + & QINI(nset), QMAX(nset), (aa,TV(I,nset), I =0, NT(nset)) + + Read (1, '(A)') Line + Read (1, *) XMIN(nset), aa, (XV(I,nset), I =1, NX(nset)) + XV(0,nset)=0D0 +! +! Since quark = anti-quark for nfl>2 at this stage, +! we Read out only the non-redundent data points +! No of flavors = NfMx (sea) + 1 (gluon) + 2 (valence) + + + Nblk = (NX(nset)+1) * (NT(nset)+1) + Npts = Nblk * (NfMx(nset)+1+MxVal) + + !*** new version: allows nm + do ihess = 0,nmem(nset) + + Read (1, '(A)') Line + Read (1, '(A)') Line + Read (1, *, IOSTAT=IRET) (UPD(ihess,I,nset), I=1,Npts) + + enddo + return +! + entry CTEQ66read(nset) + call CtLhbldat1 + call CtLhbldat2 + + call LHct65set + + !*** nmem+1=number of member + read(1,*)nmem(nset),ndef(nset) + if(nmem(nset) .gt. nhess) then + print *,'fatal error: nmem=',nmem(nset),' > nhess=',nhess + stop + endif + + MxVal = 2 + Read (1, '(A)') Line + Read (1, '(A)') Line + Read (1, *) Dr, Fl, Al(nset), (Amass(I,nset),I=1,6) + Iorder(nset) = Nint(Dr) + Nfl(nset) = Nint(Fl) + Alambda(nset) = Al(nset) + + cMass(nset) = Amass(4,nset) + bMass(nset) = Amass(5,nset) + tMass(nset) = Amass(6,nset) + + Read (1, '(A)') Line +! This is the .pds (WKT) f + Read (1, *) N0, N0, N0, NfMx(nset), N0, N0 + Read (1, '(A)') Line + Read (1, *) NX(nset), NT(nset), N0, N0, N0 + Read (1, '(A)') (Line,I=1,4) + Read (1, *) & + & QINI(nset), QMAX(nset), (aa,TV(I,nset), I =0, NT(nset)) + + Read (1, '(A)') Line + Read (1, *) XMIN(nset), aa, (XV(I,nset), I =1, NX(nset)) + XV(0,nset)=0D0 +! +! Since quark = anti-quark for nfl>2 at this stage, +! we Read out only the non-redundent data points +! No of flavors = NfMx (sea) + 1 (gluon) + 2 (valence) + + + Nblk = (NX(nset)+1) * (NT(nset)+1) + Npts = Nblk * (NfMx(nset)+1+MxVal) + + !*** new version: allows nm + do ihess = 0,nmem(nset) + + Read (1, '(A)') Line + Read (1, '(A)') Line + Read (1, *, IOSTAT=IRET) (UPD(ihess,I,nset), I=1,Npts) + + enddo + return +! + !like CTEQ65read, but c.ne. + entry CTEQ65cread(nset) + call CtLhbldat1 + call CtLhbldat2 + call LHct65set + + !*** nmem+1=number of member + read(1,*)nmem(nset),ndef(nset) + if(nmem(nset) .gt. nhess) then + print *,'fatal error: nmem=',nmem(nset),' > nhess=',nhess + stop + endif + + !one more species free + MxVal = 4 + Read (1, '(A)') Line + Read (1, '(A)') Line + Read (1, *) Dr, Fl, Al(nset), (Amass(I,nset),I=1,6) + Iorder(nset) = Nint(Dr) + Nfl(nset) = Nint(Fl) + Alambda(nset) = Al(nset) + + cMass(nset) = Amass(4,nset) + bMass(nset) = Amass(5,nset) + tMass(nset) = Amass(6,nset) + + Read (1, '(A)') Line +! This is the .pds (WKT) f + Read (1, *) N0, N0, N0, NfMx(nset), N0, N0 + Read (1, '(A)') Line + Read (1, *) NX(nset), NT(nset), N0, N0, N0 + Read (1, '(A)') (Line,I=1,4) + Read (1, *) & + & QINI(nset), QMAX(nset), (aa,TV(I,nset), I =0, NT(nset)) + + Read (1, '(A)') Line + Read (1, *) XMIN(nset), aa, (XV(I,nset), I =1, NX(nset)) + XV(0,nset)=0D0 +! +! we Read only the non-redundent data points + + Nblk = (NX(nset)+1) * (NT(nset)+1) + Npts = Nblk * (NfMx(nset)+1+MxVal) + + !*** new version: allows nm + do ihess = 0,nmem(nset) + + Read (1, '(A)') Line + Read (1, '(A)') Line + Read (1, *, IOSTAT=IRET) (UPD(ihess,I,nset), I=1,Npts) + + enddo + return +! + entry CTEQ65alfa(alfas,Qalfa) + alfas = pi*CtLhALPI(Qalfa) + return +! + entry CTEQ65init(Eorder,Q2fit) + return +! + entry CTEQ65pdf(mem) +! imem = mem + call getnset(iset) + call setnmem(iset,mem) + return +! + END + + subroutine LHct65set + Implicit Double Precision (A-H,O-Z) + common /ctq65co/ xlast, qlast, nxsave + nxsave = -1000 + xlast = -2. + qlast = -2. + return + END + +!======================================================================= + Function CtLhPartonX65 (imem,IPRTN, XX, QQ) +! Given the parton distribution function in the array U in +! COMMON / PEVLDT / , this routine interpolates to find +! the parton distribution at an arbitray point in x and q. +! + Implicit Double Precision (A-H,O-Z) + + include 'parmsetup.inc' + PARAMETER (MXX = 204, MXQ = 25, MXF = 6, MaxVal=3, nhess = 52) + PARAMETER (MXPQX = (MXF+1+MaxVal) * MXQ * MXX) + + Common & + & / CtqPar1nhess65 / & + & Al(nmxset), XV(0:MXX,nmxset), TV(0:MXQ,nmxset), & + & UPD(0:nhess,MXPQX,nmxset) & + & / CtqPar2 / Nx(nmxset), Nt(nmxset), NfMx(nmxset) & + & / XQrange / Qini(nmxset), Qmax(nmxset), Xmin(nmxset) + common /ctq65co/ xlast,qlast, nxsave + + parameter(nqvec = 4) + + Dimension fvec(4), fij(4) + Dimension xvpow(0:mxx) + Data OneP / 1.00001 / + !**** choice of interpolation variable + Data xpow / 0.3d0 / + Save xvpow + Data ixprint,iqprint/0,0/ + save ixprint,iqprint + + save jq, jx, JLx, JLq, ss, sy2, sy3, s23, ty2, ty3 + save const1 , const2, const3, const4, const5, const6 + save tt, t13, t12, t23, t34 , t24, tmp1, tmp2, tdet + + call getnset(iset) + call getnmem(iset,imem) + +! store the powers used for interpolation on first call... + if(nx(iset) .ne. nxsave) then + nxsave = nx(iset) + xvpow(0) = 0.D0 + do i = 1, nx(iset) + xvpow(i) = xv(i,iset)**xpow + enddo + endif + + X = XX + Q = QQ + + if((x.lt.xmin(iset)).or.(x.gt.1.d0)) then + ixprint=ixprint+1 + if(ixprint.lt.11) print 98,x + if(ixprint.eq.10) print *, & + & 'more warning messages like the last suppressed.' + endif + 98 format(' WARNING: X=',e12.5,' OUT OF RANGE') + if((q.lt.qini(iset)).or.(q.gt.qmax(iset))) then + iqprint=iqprint+1 + if(iqprint.lt.11) print 99,q + if(iqprint.eq.10) print *, & + & 'more warning messages like the last suppressed.' + endif + 99 format(' WARNING: Q=',e12.5,' OUT OF RANGE') + +! skip the initialization in x if same as in the previous call. + if(x .eq. xlast) goto 100 + xlast = x + +! ------------- find lower end of interval containing x, i.e., +! get jx such that xv(jx) .le. x .le. xv(jx+1)... + JLx = -1 + JU = Nx(iset)+1 + 11 If (JU-JLx .GT. 1) Then + JM = (JU+JLx) / 2 + If (X .Ge. XV(JM,iset)) Then + JLx = JM + Else + JU = JM + Endif + Goto 11 + Endif +! Ix 0 1 2 Jx JLx Nx-2 Nx +! |---|---|---|...|---|-x-|---|...|---|---| +! x 0 Xmin x 1 +! + If (JLx .LE. -1) Then + Print '(A,1pE12.4)','Severe error: x <= 0 in CtLhPartonX65 x=',x + Stop + ElseIf (JLx .Eq. 0) Then + Jx = 0 + Elseif (JLx .LE. Nx(iset)-2) Then + +! For interior points, keep x in the middle, as shown abo + Jx = JLx - 1 + Elseif (JLx.Eq.Nx(iset)-1 .or. x.LT.OneP) Then + +! We tolerate a slight over-shoot of one (OneP=1.00001) +! perhaps due to roundoff or whatever, but not more than th +! Keep at least 4 points >= Jx + Jx = JLx - 2 + Else + Print '(A,1pE12.4)','Severe error: x > 1 in CtLhPartonX65 x=',x + Stop + Endif +! ---------- Note: JLx uniquely identifies the x-bin; Jx does n + +! This is the variable to be interpolated in + ss = x**xpow + + If (JLx.Ge.2 .and. JLx.Le.Nx(iset)-2) Then + +! initiation work for "interior bins": store the lattice points in s + svec1 = xvpow(jx) + svec2 = xvpow(jx+1) + svec3 = xvpow(jx+2) + svec4 = xvpow(jx+3) + + s12 = svec1 - svec2 + s13 = svec1 - svec3 + s23 = svec2 - svec3 + s24 = svec2 - svec4 + s34 = svec3 - svec4 + + sy2 = ss - svec2 + sy3 = ss - svec3 + +! constants needed for interpolating in s at fixed t lattice points... + const1 = s13/s23 + const2 = s12/s23 + const3 = s34/s23 + const4 = s24/s23 + s1213 = s12 + s13 + s2434 = s24 + s34 + sdet = s12*s34 - s1213*s2434 + tmp = sy2*sy3/sdet + const5 = (s34*sy2-s2434*sy3)*tmp/s12 + const6 = (s1213*sy2-s12*sy3)*tmp/s34 + + EndIf + + 100 continue + +! skip the initialization in q if same as in the previous call. + if(q .eq. qlast) goto 110 + qlast = q + + tt = log(log(Q/Al(iset))) + +! --------------Now find lower end of interval containing Q, i.e +! get jq such that qv(jq) .le. q .le. qv(jq+1). + JLq = -1 + JU = NT(iset)+1 + 12 If (JU-JLq .GT. 1) Then + JM = (JU+JLq) / 2 + If (tt .GE. TV(JM,iset)) Then + JLq = JM + Else + JU = JM + Endif + Goto 12 + Endif + + If (JLq .LE. 0) Then + Jq = 0 + Elseif (JLq .LE. Nt(iset)-2) Then +! keep q in the middle, as shown above + Jq = JLq - 1 + Else +! JLq .GE. Nt-1 case: Keep at least 4 points >= + Jq = Nt(iset) - 3 + + Endif +! This is the interpolation variable i + + If (JLq.GE.1 .and. JLq.LE.Nt(iset)-2) Then +! store the lattice points in t.. + tvec1 = Tv(jq,iset) + tvec2 = Tv(jq+1,iset) + tvec3 = Tv(jq+2,iset) + tvec4 = Tv(jq+3,iset) + + t12 = tvec1 - tvec2 + t13 = tvec1 - tvec3 + t23 = tvec2 - tvec3 + t24 = tvec2 - tvec4 + t34 = tvec3 - tvec4 + + ty2 = tt - tvec2 + ty3 = tt - tvec3 + + tmp1 = t12 + t13 + tmp2 = t24 + t34 + + tdet = t12*t34 - tmp1*tmp2 + + EndIf + + 110 continue + +! get the pdf function values at the lattice points... +! In this code, we store 10 flavors: u,ubar,d,dbar,s,sbar,c,cbar,b=bbar, +! hence Iprtn=5 (b) is obtained from -5 (bbar) + + If (Iprtn .GE. 5) Then + Ip = - Iprtn + Else + Ip = Iprtn + EndIf + jtmp = ((Ip + NfMx(iset))*(NT(iset)+1)+(jq-1))*(NX(iset)+1)+jx+1 + + Do it = 1, nqvec + + J1 = jtmp + it*(NX(iset)+1) + + If (Jx .Eq. 0) Then +! For the first 4 x points, interpolate x^2*f(x +! This applies to the two lowest bins JLx = 0, +! We cannot put the JLx.eq.1 bin into the "interior" section +! (as we do for q), since Upd(J1) is undefined + fij(1) = 0 + fij(2) = Upd(imem,J1+1,iset) * XV(1,iset)**2 + fij(3) = Upd(imem,J1+2,iset) * XV(2,iset)**2 + fij(4) = Upd(imem,J1+3,iset) * XV(3,iset)**2 +! +! Use CtLhPolint which allows x to be anywhere w.r.t. th + + Call CtLhPolint4(XVpow(0), Fij(1), 4, ss, Fx, Dfx) + + If (x .GT. 0D0) fvec(it) = Fx / x**2 +! Pdf is undefined for x.eq + ElseIf (JLx .Eq. Nx(iset)-1) Then +! This is the highest x b + +!** fix allow 4 consecutive elements with iset... mrw 19.9.2005 + fij(1) = Upd(imem,j1,iset) + fij(2) = Upd(imem,j1+1,iset) + fij(3) = Upd(imem,j1+2,iset) + fij(4) = Upd(imem,j1+3,iset) + Call CtLhPolint4 (XVpow(Nx(iset)-3), Fij(1), 4, ss, Fx, Dfx) + + fvec(it) = Fx + + Else + +! for all interior points, use Jon's in-line function +! This applied to (JLx.Ge.2 .and. JLx.Le.Nx-2) +! (This is cubic spline interpolation, as used by cteq; it was +! changed to polint in previous Durham releases (jcp).) + sf2 = Upd(imem,J1+1,iset) + sf3 = Upd(imem,J1+2,iset) + + Fvec(it) = (const5*(Upd(imem,J1,iset) & + & - sf2*const1 + sf3*const2) & + & + const6*(Upd(imem,J1+3,iset) & + & + sf2*const3 - sf3*const4) & + & + sf2*sy3 - sf3*sy2) / s23 + + Endif + + enddo +! We now have the four values Fvec(1:4 +! interpolate in t... + + If (JLq .LE. 0) Then +! 1st Q-bin, as well as extrapolation to lower Q + Call CtLhPolint4(TV(0,iset), Fvec(1), 4, tt, ff, Dfq) + + ElseIf (JLq .GE. Nt(iset)-1) Then +! Last Q-bin, as well as extrapolation to higher + Call CtLhPolint4(TV(Nt(iset)-3,iset), Fvec(1), 4, tt, ff, Dfq) + Else +! Interrior bins : (JLq.GE.1 .and. JLq.LE.Nt-2) +! which include JLq.Eq.1 and JLq.Eq.Nt-2, since Upd is defined for +! the full range QV(0:Nt) (in contrast to XV) + tf2 = fvec(2) + tf3 = fvec(3) + + g1 = ( tf2*t13 - tf3*t12) / t23 + g4 = (-tf2*t34 + tf3*t24) / t23 + + h00 = ((t34*ty2-tmp2*ty3)*(fvec(1)-g1)/t12 & + & + (tmp1*ty2-t12*ty3)*(fvec(4)-g4)/t34) + + ff = (h00*ty2*ty3/tdet + tf2*ty3 - tf3*ty2) / t23 + EndIf + + CtLhPartonX65 = ff + + Return + END +!======================================================================= + Function CtLhCtq65Pdf (imem,Iparton, X, Q) + Implicit Double Precision (A-H,O-Z) + include 'parmsetup.inc' + Logical Warn + Common & + & / CtqPar2 / Nx(nmxset), Nt(nmxset), NfMx(nmxset) & + & / QCDtable / Alambda(nmxset), Nfl(nmxset), Iorder(nmxset) + + Data Warn /.true./ + save Warn + + call getnset(iset) + + If (X .lt. 0D0 .or. X .gt. 1D0) Then + Print *, 'X out of range in CtLhCtq65Pdf: ', X + Stop + Endif + If (Q .lt. Alambda(iset)) Then + Print *, 'Q out of range in CtLhCtq65Pdf: ', Q + Stop + Endif + +! added to force pdf = 0.0 at x=1.0 exactly - mrw + if(x .eq. 1.0d0) then + CtLhCtq65Pdf = 0.0d0 + return + endif +! + If ((Iparton .lt. -NfMx(iset) .or. Iparton .gt. NfMx(iset))) Then + If (Warn) Then +! put a warning for calling extra flavor. + Warn = .false. + Print *, 'Warning: Iparton out of range in CtLhCtq65Pdf: ' & + & , Iparton + Endif + CtLhCtq65Pdf = 0D0 + Return + Endif + + CtLhCtq65Pdf = CtLhPartonX65 (imem,Iparton, X, Q) + if(CtLhCtq65Pdf.lt.0.D0) CtLhCtq65Pdf = 0.D0 + + Return + +! ******************** + END diff --git a/LHAPDF/lhapdf-5.9.1/src/wrapcteq6lg.f b/LHAPDF/lhapdf-5.9.1/src/wrapcteq6lg.f new file mode 100644 index 00000000000..cd9123e0436 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/wrapcteq6lg.f @@ -0,0 +1,544 @@ +! -*- F90 -*- + + + subroutine CTEQ6lgevolve(x,Q,pdf,gluino) + implicit real*8(a-h,o-z) + include 'parmsetup.inc' + character*16 name(nmxset) + integer nmem(nmxset),ndef(nmxset),mmem + common/NAME/name,nmem,ndef,mmem + real*8 pdf(-6:6) + integer nset + Character Line*80 + PARAMETER (MXX = 105, MXQ = 51, MXF = 6, nhess = 8) +!gino No of flavors = 2*NfMx + 1 gluon + 1 gluino + PARAMETER (MXPQX = (2*MXF + 2) * MXQ * MXX) + Common & + & / CtqPar1nhesslg / & + & Al(0:nhess,nmxset), & + & XV(0:nhess,0:MXX,nmxset), & + & TV(0:nhess,0:MXQ,nmxset), & + & UPD(0:nhess,MXPQX,nmxset) & + & / CtqPar2lg / Nx(0:nhess,nmxset), & + & Nt(0:nhess,nmxset), & + & NfMx(0:nhess,nmxset) & + & / XQrange / Qini(nmxset), Qmax(nmxset), Xmin(nmxset) & + & / QCDtablelg / & + & Alambda(0:nhess,nmxset), Nfl(nmxset), Iorder(nmxset) & + & / Masstbllg / Amass(6,nmxset),Alg(0:nhess) + common/masses_LHA/cMass(nmxset),bMass(nmxset),tMass(nmxset) + data pi / 3.141592653589793d0 / + save +! + call getnset(iset) + call getnmem(iset,imem) +! + U = X * CtLhCtq6lgPdf(imem,1,X,Q) + D = X * CtLhCtq6lgPdf(imem,2,X,Q) + USEA = X * CtLhCtq6lgPdf(imem,-1,X,Q) + DSEA = X * CtLhCtq6lgPdf(imem,-2,X,Q) + STR = X * CtLhCtq6lgPdf(imem,3,X,Q) + CHM = X * CtLhCtq6lgPdf(imem,4,X,Q) + BOT = X * CtLhCtq6lgPdf(imem,5,X,Q) + GLU = X * CtLhCtq6lgPdf(imem,0,X,Q) + GLUINO = X * CtLhCtq6lgPdf(imem,-6,X,Q) +! + pdf(0) = glu + pdf(1) = d + pdf(-1) = dsea + pdf(2) = u + pdf(-2) = usea + pdf(3) = str + pdf(-3) = str + pdf(4) = chm + pdf(-4) = chm + pdf(5) = bot + pdf(-5) = bot + pdf(6) = 0.0d0 + pdf(-6) = 0.0d0 + + return +! + entry CTEQ6lgread(nset) + + call CtLhbldat1 + call CtLhbldat2 + + call LHct6set + !*** nmem+1=number of member + read(1,*)nmem(nset),ndef(nset) + if(nmem(nset) .gt. nhess) then + print *,'fatal error: nmem=',nmem(nset),' > nhess=',nhess + stop + endif + !*** new version: allows nm + do ihess = 0,nmem(nset) + Read (1, '(A)') Line + Read (1, '(A)') Line + Read (1, '(A)') Line + Read(1, *)Dr,Fl,Al(ihess,nset),(Amass(I,nset),I=1,6),Alg(ihess) + Iorder(nset) = Nint(Dr) + Nfl(nset) = Nint(Fl) + Alambda(ihess,nset) = Al(ihess,nset) + + cMass(nset) = Amass(4,nset) + bMass(nset) = Amass(5,nset) + tMass(nset) = Amass(6,nset) + + Read (1, '(A)') Line + Read (1, *) NX(ihess,nset), NT(ihess,nset), NfMx(ihess,nset) + + Read (1, '(A)') Line + Read (1, *) & + & QINI(nset), QMAX(nset), (TV(ihess,I,nset), I =0, NT(ihess,nset)) + + Read (1, '(A)') Line + Read (1, *) XMIN(nset), (XV(ihess,I,nset), I =0,NX(ihess,nset)) + Do 11 Iq = 0, NT(ihess,nset) + TV(ihess,Iq,nset) =Log(Log(TV(ihess,Iq,nset)/Al(ihess,nset))) + 11 Continue +! +! Since quark = anti-quark for nfl>2 at this stage, +! we Read out only the non-redundent data points +! No of flavors = NfMx (sea) + 1 (gluon) + 2 (valence) + + Nblk = (NX(ihess,nset)+1) * (NT(ihess,nset)+1) + Npts = Nblk * (2*NfMx(ihess,nset)+2) + + +! Read (1, '(A)') Line + Read (1, '(A)') Line + Read (1, *, IOSTAT=IRET) (UPD(ihess,I,nset), I=1,Npts) + + enddo + return +! + entry CTEQ6lgalfa(alfas,Qalfa) + alfas = CtLhalgluino(Qalfa) + return +! + entry CTEQ6lginit(Eorder,Q2fit) + + return +! + entry CTEQ6lgpdf(mem) +! imem = mem + call getnset(iset) + call setnmem(iset,mem) + return +! + END + +! subroutine LHct6set +! Implicit Double Precision (A-H,O-Z) +! common /ctq6co/ xlast, qlast, nxsave +! nxsave = -1000 +! xlast = -2. +! qlast = -2. +! return +! end + +!======================================================================= + Function CtLhPartonX6lg (imem,IPRTN, XX, QQ) +! Given the parton distribution function in the array U in +! COMMON / PEVLDT / , this routine interpolates to find +! the parton distribution at an arbitray point in x and q. +! + Implicit Double Precision (A-H,O-Z) + + include 'parmsetup.inc' + PARAMETER (MXX = 105, MXQ = 51, MXF = 6, nhess = 8) +!gino No of flavors = 2*NfMx + 1 gluon + 1 gluino + PARAMETER (MXPQX = (2*MXF + 2) * MXQ * MXX) + + Common & + & / CtqPar1nhesslg / & + & Al(0:nhess,nmxset), & + & XV(0:nhess,0:MXX,nmxset), & + & TV(0:nhess,0:MXQ,nmxset), & + & UPD(0:nhess,MXPQX,nmxset) & + & / CtqPar2lg / Nx(0:nhess,nmxset), & + & Nt(0:nhess,nmxset), & + & NfMx(0:nhess,nmxset) & + & / XQrange / Qini(nmxset), Qmax(nmxset), Xmin(nmxset) + + common /ctq6co/ xlast, qlast, nxsave + parameter(nqvec = 4) + + Dimension fvec(4), fij(4) + Dimension xvpow(0:mxx) + Data OneP / 1.00001 / + !**** choice of interpolation variable + Data xpow / 0.3d0 / + Save xvpow + Data ixprint,iqprint/0,0/ + save ixprint,iqprint + + save jq, jx, JLx, JLq, ss, sy2, sy3, s23, ty2, ty3 + save const1 , const2, const3, const4, const5, const6 + save tt, t13, t12, t23, t34 , t24, tmp1, tmp2, tdet + + call getnset(iset) + call getnmem(iset,imem) + + +! store the powers used for interpolation on first call... + if(nx(imem,iset).ne. nxsave) then + nxsave = nx(imem,iset) + xvpow(0) = 0.D0 + do i = 1, nx(imem,iset) + xvpow(i) = xv(imem,i,iset)**xpow + enddo + endif + + X = XX + Q = QQ + + if((x.lt.xmin(iset)).or.(x.gt.1.d0)) then + ixprint=ixprint+1 + if(ixprint.lt.11) print 98,x + if(ixprint.eq.10) print *, & + & 'more warning messages like the last suppressed.' + endif + 98 format(' WARNING: X=',e12.5,' OUT OF RANGE') + if((q.lt.qini(iset)).or.(q.gt.qmax(iset))) then + iqprint=iqprint+1 + if(iqprint.lt.11) print 99,q + if(iqprint.eq.10) print *, & + & 'more warning messages like the last suppressed.' + endif + 99 format(' WARNING: Q=',e12.5,' OUT OF RANGE') + +! skip the initialization in x if same as in the previous call. + if(x .eq. xlast) goto 100 + xlast = x + + + +!...new version + +! ------------- find lower end of interval containing x, i.e., +! get jx such that xv(jx) .le. x .le. xv(jx+1)... + JLx = -1 + JU = Nx(imem,iset)+1 + 11 If (JU-JLx .GT. 1) Then + JM = (JU+JLx) / 2 + If (X .Ge. XV(imem,JM,iset)) Then + JLx = JM + Else + JU = JM + Endif + Goto 11 + Endif +! Ix 0 1 2 Jx JLx Nx-2 Nx +! |---|---|---|...|---|-x-|---|...|---|---| +! x 0 Xmin x 1 +! + If (JLx .LE. -1) Then + Print & + & '(A,1pE12.4)', 'Severe error: x <= 0 in PartonX6LG! x = ', x + Stop + ElseIf (JLx .Eq. 0) Then + Jx = 0 + Elseif (JLx .LE. Nx(imem,iset)-2) Then + +! For interrior points, keep x in the middle, as shown ab + Jx = JLx - 1 + Elseif (JLx.Eq.Nx(imem,iset)-1 .or. x.LT.OneP) Then + +! We tolerate a slight over-shoot of one (OneP=1.00001) +! perhaps due to roundoff or whatever, but not more than th +! Keep at least 4 points >= Jx + Jx = JLx - 2 + Else + Print & + & '(A,1pE12.4)', 'Severe error: x > 1 in PartonX6LG! x = ', x + Stop + Endif +! ---------- Note: JLx uniquely identifies the x-bin; Jx does n + +! This is the variable to be interpolated in + ss = x**xpow + + If (JLx.Ge.2 .and. JLx.Le.Nx(imem,iset)-2) Then + +! initiation work for "interior bins": store the lattice points in s + svec1 = xvpow(jx) + svec2 = xvpow(jx+1) + svec3 = xvpow(jx+2) + svec4 = xvpow(jx+3) + + s12 = svec1 - svec2 + s13 = svec1 - svec3 + s23 = svec2 - svec3 + s24 = svec2 - svec4 + s34 = svec3 - svec4 + + sy2 = ss - svec2 + sy3 = ss - svec3 + +! constants needed for interpolating in s at fixed t lattice points... + const1 = s13/s23 + const2 = s12/s23 + const3 = s34/s23 + const4 = s24/s23 + s1213 = s12 + s13 + s2434 = s24 + s34 + sdet = s12*s34 - s1213*s2434 + tmp = sy2*sy3/sdet + const5 = (s34*sy2-s2434*sy3)*tmp/s12 + const6 = (s1213*sy2-s12*sy3)*tmp/s34 + + EndIf + + 100 continue + + if(q.eq.qlast) goto 110 + qlast = q + + + tt = log(log(Q/Al(imem,iset))) + +! --------------Now find lower end of interval containing Q, i.e +! get jq such that qv(jq) .le. q .le. qv(jq+1). + JLq = -1 + JU = NT(imem,iset)+1 + 12 If (JU-JLq .GT. 1) Then + JM = (JU+JLq) / 2 + If (tt .GE. TV(imem,JM,iset)) Then + JLq = JM + Else + JU = JM + Endif + Goto 12 + Endif + + If (JLq .LE. 0) Then + Jq = 0 + Elseif (JLq .LE. Nt(imem,iset)-2) Then +! keep q in the middle, as shown above + Jq = JLq - 1 + Else +! JLq .GE. Nt-1 case: Keep at least 4 points >= + Jq = Nt(imem,iset) - 3 + Endif + + If (JLq.GE.1 .and. JLq.LE.Nt(imem,iset)-2) Then +! store the lattice points in t.. + tvec1 = Tv(imem,jq,iset) + tvec2 = Tv(imem,jq+1,iset) + tvec3 = Tv(imem,jq+2,iset) + tvec4 = Tv(imem,jq+3,iset) + + t12 = tvec1 - tvec2 + t13 = tvec1 - tvec3 + t23 = tvec2 - tvec3 + t24 = tvec2 - tvec4 + t34 = tvec3 - tvec4 + + ty2 = tt - tvec2 + ty3 = tt - tvec3 + + tmp1 = t12 + t13 + tmp2 = t24 + t34 + + tdet = t12*t34 - tmp1*tmp2 + + EndIf + + + 110 continue + +! get the pdf function values at the lattice points... + + jtmp = ((IPRTN + NfMx(imem,iset) + 1)*(NT(imem,iset)+1)+(jq-1)) & + & *(NX(imem,iset)+1)+jx+1 + + + Do it = 1, nqvec + + J1 = jtmp + it*(NX(imem,iset)+1) + + If (Jx .Eq. 0) Then +! For the first 4 x points, interpolate x^2*f(x +! This applies to the two lowest bins JLx = 0, +! We can not put the JLx.eq.1 bin into the "interrior" sectio +! (as we do for q), since Upd(J1) is undefined + fij(1) = 0 + fij(2) = Upd(imem,J1+1,iset) * XV(imem,1,iset)**2 + fij(3) = Upd(imem,J1+2,iset) * XV(imem,2,iset)**2 + fij(4) = Upd(imem,J1+3,iset) * XV(imem,3,iset)**2 +! +! Use Polint which allows x to be anywhere w.r.t. the gr + + Call CtLhPolint4lg (XVpow(0), Fij(1), ss, Fx) + + If (x .GT. 0D0) Fvec(it) = Fx / x**2 +! Pdf is undefined for x.eq + ElseIf (JLx .Eq. Nx(imem,iset)-1) Then +! This is the highest x b + + Call CtLhPolint4lg (XVpow(Nx(imem,iset)-3), Upd(imem,J1,iset), & + & ss, Fx) + + Fvec(it) = Fx + + Else +! for all interior points, use Jon's in-line funct +! This applied to (JLx.Ge.2 .and. JLx.Le.Nx + sf2 = Upd(imem,J1+1,iset) + sf3 = Upd(imem,J1+2,iset) + + g1 = sf2*const1 - sf3*const2 + g4 = -sf2*const3 + sf3*const4 + + Fvec(it) = (const5*(Upd(imem,J1,iset)-g1) & + & + const6*(Upd(imem,J1+3,iset)-g4) & + & + sf2*sy3 - sf3*sy2) / s23 + + Endif + + enddo +! We now have the four values Fvec(1:4 +! interpolate in t... + + + If (JLq .LE. 0) Then +! 1st Q-bin, as well as extrapolation to lower Q + Call CtLhPolint4lg (TV(imem,0,iset), Fvec(1), tt, ff) + + ElseIf (JLq .GE. Nt(imem,iset)-1) Then +! Last Q-bin, as well as extrapolation to higher + Call CtLhPolint4lg (TV(imem,Nt(imem,iset)-3,iset), & + & Fvec(1), tt, ff) + Else +! Interrior bins : (JLq.GE.1 .and. JLq.LE.Nt-2) +! which include JLq.Eq.1 and JLq.Eq.Nt-2, since Upd is defined for +! the full range QV(0:Nt) (in contrast to XV) + tf2 = fvec(2) + tf3 = fvec(3) + + g1 = ( tf2*t13 - tf3*t12) / t23 + g4 = (-tf2*t34 + tf3*t24) / t23 + + h00 = ((t34*ty2-tmp2*ty3)*(fvec(1)-g1)/t12 & + & + (tmp1*ty2-t12*ty3)*(fvec(4)-g4)/t34) + + + ff = (h00*ty2*ty3/tdet + tf2*ty3 - tf3*ty2) / t23 + EndIf + + CtLhPartonX6lg = ff + + Return +! ******************** + END +!======================================================================= + + Function CtLhCtq6lgPdf (imem,Iparton, X, Q) + Implicit Double Precision (A-H,O-Z) + include 'parmsetup.inc' + PARAMETER (nhess = 8) + Logical Warn + Common & + & / CtqPar2lg / Nx(0:nhess,nmxset), Nt(0:nhess,nmxset), & + & NfMx(0:nhess,nmxset) & + & / QCDtablelg / Alambda(0:nhess,nmxset), Nfl(nmxset), & + & Iorder(nmxset) + + Data Warn /.true./ + save Warn + + call getnset(iset) + + If (X .lt. 0D0 .or. X .gt. 1D0) Then + Print *, 'X out of range in CtLhCtq6Pdf: ', X + Stop + Endif + If (Q .lt. Alambda(imem,iset)) Then + Print *, 'Q out of range in CtLhCtq6Pdf: ', Q + Stop + Endif + +! added to force pdf = 0.0 at x=1.0 exactly - mrw + if(x .eq. 1.0d0) then + CtLhCtq6lgPdf = 0.0d0 + return + endif +! + If ((Iparton .lt. -NfMx(imem,iset)-1 .or. Iparton .gt. & + & NfMx(imem,iset))) Then + If (Warn) Then +! put a warning for calling extra flavor. + Warn = .false. + Print *,'Warning: Iparton out of range in CtLhCtq6lgPdf: ' & + & , Iparton + Endif + CtLhCtq6lgPdf = 0D0 + print *,' returning CtLhCtq6lgPdf = ', CtLhCtq6lgPdf + Return + Endif + + CtLhCtq6lgPdf = CtLhPartonX6lg (imem,Iparton, X, Q) + if(CtLhCtq6lgPdf.lt.0.D0) CtLhCtq6lgPdf = 0.D0 + Return + +! ******************** + END +!======================================================================= + + SUBROUTINE CtLhPOLINT4lg (XA,YA,X,Y) + + IMPLICIT DOUBLE PRECISION (A-H, O-Z) +! The POLINT4 routine is based on the POLINT routine from "Numerical Re +! but assuming N=4, and ignoring the error estimation. +! suggested by Z. Sullivan. + DIMENSION XA(*),YA(*) + + H1=XA(1)-X + H2=XA(2)-X + H3=XA(3)-X + H4=XA(4)-X + + W=YA(2)-YA(1) + DEN=W/(H1-H2) + D1=H2*DEN + C1=H1*DEN + + W=YA(3)-YA(2) + DEN=W/(H2-H3) + D2=H3*DEN + C2=H2*DEN + + W=YA(4)-YA(3) + DEN=W/(H3-H4) + D3=H4*DEN + C3=H3*DEN + + W=C2-D1 + DEN=W/(H1-H3) + CD1=H3*DEN + CC1=H1*DEN + + W=C3-D2 + DEN=W/(H2-H4) + CD2=H4*DEN + CC2=H2*DEN + + W=CC2-CD1 + DEN=W/(H1-H4) + DD1=H4*DEN + DC1=H1*DEN + + If((H3+H4).lt.0D0) Then + Y=YA(4)+D3+CD2+DD1 + Elseif((H2+H3).lt.0D0) Then + Y=YA(3)+D2+CD1+DC1 + Elseif((H1+H2).lt.0D0) Then + Y=YA(2)+C2+CD1+DC1 + ELSE + Y=YA(1)+C1+CC1+DC1 + ENDIF + + RETURN + END diff --git a/LHAPDF/lhapdf-5.9.1/src/wrapdgg.f b/LHAPDF/lhapdf-5.9.1/src/wrapdgg.f new file mode 100644 index 00000000000..4eb74bf4e87 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/wrapdgg.f @@ -0,0 +1,580 @@ +! -*- F90 -*- + + + subroutine DGGevolvep(xin,qin,p2in,ip2in,pdf) + include 'parmsetup.inc' + real*8 xin,qin,q2in,p2in,pdf(-6:6),xval(45),qcdl4,qcdl5 + real*8 upv,dnv,usea,dsea,str,chm,bot,top,glu + character*16 name(nmxset) + integer nmem(nmxset),ndef(nmxset),mmem + common/NAME/name,nmem,ndef,mmem + integer nset,iset + + save + call getnset(iset) + call getnmem(iset,imem) + + if(imem.eq.1.or.imem.eq.0) then + call DGPHO1(xin,qin,upv,dnv,usea,dsea,str,chm,bot,glu) + + elseif(imem.eq.2) then + call DGPHO2(xin,qin,upv,dnv,usea,dsea,str,chm,bot,glu) + + elseif(imem.eq.3) then + call DGPHO3(xin,qin,upv,dnv,usea,dsea,str,chm,bot,glu) + + elseif(imem.eq.4) then + call DGPHO4(xin,qin,upv,dnv,usea,dsea,str,chm,bot,glu) + + else + CONTINUE + endif + + pdf(-6)= 0.0d0 + pdf(6)= 0.0d0 + pdf(-5)= bot + pdf(5 )= bot + pdf(-4)= chm + pdf(4 )= chm + pdf(-3)= str + pdf(3 )= str + pdf(-2)= usea + pdf(2 )= upv + pdf(-1)= dsea + pdf(1 )= dnv + pdf(0 )= glu + + return +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + entry DGGread(nset) + read(1,*)nmem(nset),ndef(nset) + return +! +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + entry DGGalfa(alfas,qalfa) + call getnset(iset) + call getnmem(iset,imem) + call GetOrderAsM(iset,iord) + call Getlam4M(iset,imem,qcdl4) + call Getlam5M(iset,imem,qcdl5) + call aspdflib(alfas,Qalfa,iord,qcdl5) + return +! +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + entry DGGinit(Eorder,Q2fit) + return +! +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + entry DGGpdf(mem) + call getnset(iset) + call setnmem(iset,mem) +! imem = mem + return +! + 1000 format(5e13.5) + END +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + SUBROUTINE DGPHO1(DX,DQ,DUV,DDV,DUB,DDB,DSB,DCB,DBB,DGL) +!******************************************************************** +!* * +!* Parametrization of parton distribution functions * +!* in the photon (LO analysis) - full solution of AP eq.! * +!* * +!* authors: M.Drees and K.Grassie (DG) * +!* /Z. Phys. C28 (1985) 451/ * +!* * +!* Prepared by: * +!* Krzysztof Charchula, DESY * +!* bitnet: F1PCHA@DHHDESY3 * +!* decnet: 13313::CHARCHULA * +!* * +!* Modified by: * +!* H. Plothow-Besch/CERN-PPE * +!* * +!******************************************************************** +! + implicit real*8 (a-h,o-z) + double precision & + & A(3,4,3),AT(3), & + & B(5,4,2,3),BT(5,2),XQPOM(2),E(2), & + & DX,DQ,DUV,DDV,DUB,DDB,DSB,DCB,DBB,DGL + PARAMETER (ALPEM=7.29927D-3, PI=3.141592D0) + PARAMETER (ALAM=0.4D0) +!...comments +!...-------------------------------------------------- +!... nf=3 for 1< Q2 <32 GeV2 +!... nf=4 for 32< Q2 <200 GeV2 +!... nf=5 for 200< Q2 <1D4 GeV2 +!...-------------------------------------------------- +! +!...initialization of gluon parameters array for DG + DATA (((A(I,J,K),I=1,3),J=1,4),K=1,3)/ & + & -0.20700, -0.19870, 5.1190, & + & 0.61580, 0.62570, -0.2752, & + & 1.07400, 8.35200, -6.9930, & + & 0.00000, 5.02400, 2.2980, & + & 0.8926D-2,0.0509, -0.2313, & + & 0.65940, 0.27740, 0.1382, & + & 0.47660, -0.39060, 6.5420, & + & 0.01975, -0.32120, 0.5162, & + & 0.03197, -0.618D-2,-0.1216, & + & 1.01800, 0.94760, 0.9047, & + & 0.24610, -0.60940, 2.6530, & + & 0.02707, -0.01067, 0.2003D-2/ +! +!...initialization of quark parameters array for DG + DATA (((B(I,J,K,1),I=1,5),J=1,4),K=1,2)/ & + & 2.2850, 6.0730, -0.4202, -0.0808, 0.0553, & + & -0.0153, -0.8132, 0.0178, 0.6346, 1.1360, & + & 1.33D3, -41.310, 0.9216, 1.2080, 0.9512, & + & 4.2190, 3.1650, 0.1800, 0.2030, 0.0116, & + & 16.690, 0.1760, -0.0208, -0.0168, -0.1986, & + & -0.7916, 0.0479, 0.3386D-2, 1.3530, 1.1000, & + & 1.0990D3, 1.0470, 4.8530, 1.4260, 1.1360, & + & 4.4280, 0.0250, 0.8404, 1.2390, -0.2779/ + DATA (((B(I,J,K,2),I=1,5),J=1,4),K=1,2)/ & + & -0.3711, -0.1717, 0.08766, -0.8915, -0.1816, & + & 1.0610, 0.7815, 0.02197, 0.2857, 0.5866, & + & 4.7580, 1.5350, 0.10960, 2.9730, 2.4210, & + & -0.0150, 0.7067D-2,0.20400, 0.1185, 0.4059, & + & -0.1207, 25.000, -0.01230, -0.0919, 0.02015, & + & 1.0710, -1.6480, 1.16200, 0.7912, 0.9869, & + & 1.9770, -0.01563, 0.48240, 0.6397, -0.07036, & + & -0.8625D-2,6.4380, -0.01100, 2.3270, 0.01694/ + DATA (((B(I,J,K,3),I=1,5),J=1,4),K=1,2)/ & + & 15.8, 2.742, 0.02917, -0.0342, -0.02302, & + & -0.9464, -0.7332, 0.04657, 0.7196, 0.9229, & + & -0.5, 0.7148, 0.1785, 0.7338, 0.5873, & + & -0.2118, 3.287, 0.04811, 0.08139,-0.79D-4, & + & 6.734, 59.88, -0.3226D-2,-0.03321, 0.1059, & + & -1.008, -2.983, 0.8432, 0.9475, 0.6954, & + & -0.08594, 4.48, 0.3616, -0.3198, -0.6663, & + & 0.07625, 0.9686, 0.1383D-2, 0.02132, 0.3683/ +! +!...specification of sets + Q2 = DQ*DQ + IF (Q2.LT.32.0D0) NFL=3 + IF((Q2.GE.32.0D0).AND.(Q2.LT.200.0D0)) NFL=4 + IF (Q2.GE.200.0D0) NFL=5 +! +!...calculations + ALAM2=ALAM**2 + T=LOG(Q2/ALAM2) + LF=NFL-2 +! +!...gluons + DO 11 I=1,3 + AT(I)=A(I,1,LF)*T**A(I,2,LF)+A(I,3,LF)*T**(-A(I,4,LF)) + 11 CONTINUE + POMG=AT(1)*DX**AT(2)*(1.D0-DX)**AT(3) + DGL=POMG*ALPEM +! +!...quarks + E(1)=1.0D0 + IF(NFL.EQ.3) THEN + E(2)=9.0D0 + ELSEIF(NFL.EQ.4) THEN + E(2)=10.0D0 + ELSEIF(NFL.EQ.5) THEN + E(2)=55.0D0/6.0D0 + ENDIF + DO 13 J=1,2 + DO 15 I=1,5 + BTP=B(I,1,J,LF)*T**B(I,2,J,LF) + BT(I,J)=BTP+B(I,3,J,LF)*T**(-B(I,4,J,LF)) + 15 CONTINUE + 13 CONTINUE +! +!...singlet & non-singlet combinations + DO 17 J=1,2 + POM1=DX*(DX*DX+(1.D0-DX)**2)/(BT(1,J)-BT(2,J)*LOG(1.D0-DX)) + POM2=BT(3,J)*DX**BT(4,J)*(1.D0-DX)**BT(5,J) + XQPOM(J)=E(J)*POM1+POM2 + 17 CONTINUE +! +!...quarks flavours + IF (NFL.EQ.3) THEN + DUB=ALPEM*1.D0/6.D0*(XQPOM(2)+9.D0*XQPOM(1)) + DDB=ALPEM*1.D0/6.D0*(XQPOM(2)-9.D0/2.D0*XQPOM(1)) + DSB=DDB + DCB=0.D0 + DBB=0.D0 + ELSEIF (NFL.EQ.4) THEN + DUB=ALPEM*1.D0/8.D0*(XQPOM(2)+6.D0*XQPOM(1)) + DCB=DUB + DDB=ALPEM*1.D0/8.D0*(XQPOM(2)-6.D0*XQPOM(1)) + DSB=DDB + DBB=0.D0 + ELSEIF (NFL.EQ.5) THEN + DUB=ALPEM*1.D0/10.D0*(XQPOM(2)+15.D0/2.D0*XQPOM(1)) + DCB=DUB + DDB=ALPEM*1.D0/10.D0*(XQPOM(2)-5.D0*XQPOM(1)) + DSB=DDB + DBB=DDB + ENDIF + DUV=DUB + DDV=DDB +! + RETURN + END +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + SUBROUTINE DGPHO2(DX,DQ,DUV,DDV,DUB,DDB,DSB,DCB,DBB,DGL) +!******************************************************************** +!* * +!* Parametrization of parton distribution functions * +!* in the photon (LO analysis) - full solution of AP eq.! * +!* * +!* authors: M.Drees and K.Grassie (DG) * +!* /Z. Phys. C28 (1985) 451/ * +!* * +!* Prepared by: * +!* Krzysztof Charchula, DESY * +!* bitnet: F1PCHA@DHHDESY3 * +!* decnet: 13313::CHARCHULA * +!* * +!* Modified by: * +!* H. Plothow-Besch/CERN-PPE * +!* * +!******************************************************************** +! + implicit real*8 (a-h,o-z) + double precision & + & A(3,4,3),AT(3), & + & B(5,4,2,3),BT(5,2),XQPOM(2),E(2), & + & DX,DQ,DUV,DDV,DUB,DDB,DSB,DCB,DBB,DGL + PARAMETER (ALPEM=7.29927D-3, PI=3.141592D0) + PARAMETER (ALAM=0.4D0) +!...comments +!...-------------------------------------------------- +!... with nf=3 (valid for 1< Q2 <50 GeV2) +!...-------------------------------------------------- +! +!...initialization of gluon parameters array for DG + DATA (((A(I,J,K),I=1,3),J=1,4),K=1,3)/ & + & -0.20700, -0.19870, 5.1190, & + & 0.61580, 0.62570, -0.2752, & + & 1.07400, 8.35200, -6.9930, & + & 0.00000, 5.02400, 2.2980, & + & 0.8926D-2,0.0509, -0.2313, & + & 0.65940, 0.27740, 0.1382, & + & 0.47660, -0.39060, 6.5420, & + & 0.01975, -0.32120, 0.5162, & + & 0.03197, -0.618D-2,-0.1216, & + & 1.01800, 0.94760, 0.9047, & + & 0.24610, -0.60940, 2.6530, & + & 0.02707, -0.01067, 0.2003D-2/ +! +!...initialization of quark parameters array for DG + DATA (((B(I,J,K,1),I=1,5),J=1,4),K=1,2)/ & + & 2.2850, 6.0730, -0.4202, -0.0808, 0.0553, & + & -0.0153, -0.8132, 0.0178, 0.6346, 1.1360, & + & 1.33D3, -41.310, 0.9216, 1.2080, 0.9512, & + & 4.2190, 3.1650, 0.1800, 0.2030, 0.0116, & + & 16.690, 0.1760, -0.0208, -0.0168, -0.1986, & + & -0.7916, 0.0479, 0.3386D-2, 1.3530, 1.1000, & + & 1.0990D3, 1.0470, 4.8530, 1.4260, 1.1360, & + & 4.4280, 0.0250, 0.8404, 1.2390, -0.2779/ + DATA (((B(I,J,K,2),I=1,5),J=1,4),K=1,2)/ & + & -0.3711, -0.1717, 0.08766, -0.8915, -0.1816, & + & 1.0610, 0.7815, 0.02197, 0.2857, 0.5866, & + & 4.7580, 1.5350, 0.10960, 2.9730, 2.4210, & + & -0.0150, 0.7067D-2,0.20400, 0.1185, 0.4059, & + & -0.1207, 25.000, -0.01230, -0.0919, 0.02015, & + & 1.0710, -1.6480, 1.16200, 0.7912, 0.9869, & + & 1.9770, -0.01563, 0.48240, 0.6397, -0.07036, & + & -0.8625D-2,6.4380, -0.01100, 2.3270, 0.01694/ + DATA (((B(I,J,K,3),I=1,5),J=1,4),K=1,2)/ & + & 15.8, 2.742, 0.02917, -0.0342, -0.02302, & + & -0.9464, -0.7332, 0.04657, 0.7196, 0.9229, & + & -0.5, 0.7148, 0.1785, 0.7338, 0.5873, & + & -0.2118, 3.287, 0.04811, 0.08139,-0.79D-4, & + & 6.734, 59.88, -0.3226D-2,-0.03321, 0.1059, & + & -1.008, -2.983, 0.8432, 0.9475, 0.6954, & + & -0.08594, 4.48, 0.3616, -0.3198, -0.6663, & + & 0.07625, 0.9686, 0.1383D-2, 0.02132, 0.3683/ +! +!...specification of sets + NFL=3 +! +!...calculations + Q2 = DQ*DQ + ALAM2=ALAM**2 + T=LOG(Q2/ALAM2) + LF=NFL-2 +! +!...gluons + DO 11 I=1,3 + AT(I)=A(I,1,LF)*T**A(I,2,LF)+A(I,3,LF)*T**(-A(I,4,LF)) + 11 CONTINUE + POMG=AT(1)*DX**AT(2)*(1.D0-DX)**AT(3) + DGL=POMG*ALPEM +! +!...quarks + E(1)=1.D0 + E(2)=9.D0 + DO 13 J=1,2 + DO 15 I=1,5 + BTP=B(I,1,J,LF)*T**B(I,2,J,LF) + BT(I,J)=BTP+B(I,3,J,LF)*T**(-B(I,4,J,LF)) + 15 CONTINUE + 13 CONTINUE +! +!...singlet & non-singlet combinations + DO 17 J=1,2 + POM1=DX*(DX*DX+(1.D0-DX)**2)/(BT(1,J)-BT(2,J)*LOG(1.D0-DX)) + POM2=BT(3,J)*DX**BT(4,J)*(1.D0-DX)**BT(5,J) + XQPOM(J)=E(J)*POM1+POM2 + 17 CONTINUE +! +!...quarks flavours + DUB=ALPEM*1.D0/6.D0*(XQPOM(2)+9.D0*XQPOM(1)) + DUV=DUB + DDB=ALPEM*1.D0/6.D0*(XQPOM(2)-9.D0/2.D0*XQPOM(1)) + DDV=DDB + DSB=DDB + DCB=0.D0 + DBB=0.D0 +! + RETURN + END +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + SUBROUTINE DGPHO3(DX,DQ,DUV,DDV,DUB,DDB,DSB,DCB,DBB,DGL) +!******************************************************************** +!* * +!* Parametrization of parton distribution functions * +!* in the photon (LO analysis) - full solution of AP eq.! * +!* * +!* authors: M.Drees and K.Grassie (DG) * +!* /Z. Phys. C28 (1985) 451/ * +!* * +!* Prepared by: * +!* Krzysztof Charchula, DESY * +!* bitnet: F1PCHA@DHHDESY3 * +!* decnet: 13313::CHARCHULA * +!* * +!* Modified by: * +!* H. Plothow-Besch/CERN-PPE * +!* * +!******************************************************************** +! + implicit real*8 (a-h,o-z) + double precision & + & A(3,4,3),AT(3), & + & B(5,4,2,3),BT(5,2),XQPOM(2),E(2), & + & DX,DQ,DUV,DDV,DUB,DDB,DSB,DCB,DBB,DGL + PARAMETER (ALPEM=7.29927D-3, PI=3.141592D0) + PARAMETER (ALAM=0.4D0) +!...comments +!...-------------------------------------------------- +!... with nf=4 (valid for 20< Q2 <500 GeV2) +!...-------------------------------------------------- +! +!...initialization of gluon parameters array for DG + DATA (((A(I,J,K),I=1,3),J=1,4),K=1,3)/ & + & -0.20700, -0.19870, 5.1190, & + & 0.61580, 0.62570, -0.2752, & + & 1.07400, 8.35200, -6.9930, & + & 0.00000, 5.02400, 2.2980, & + & 0.8926D-2,0.0509, -0.2313, & + & 0.65940, 0.27740, 0.1382, & + & 0.47660, -0.39060, 6.5420, & + & 0.01975, -0.32120, 0.5162, & + & 0.03197, -0.618D-2,-0.1216, & + & 1.01800, 0.94760, 0.9047, & + & 0.24610, -0.60940, 2.6530, & + & 0.02707, -0.01067, 0.2003D-2/ +! +!...initialization of quark parameters array for DG + DATA (((B(I,J,K,1),I=1,5),J=1,4),K=1,2)/ & + & 2.2850, 6.0730, -0.4202, -0.0808, 0.0553, & + & -0.0153, -0.8132, 0.0178, 0.6346, 1.1360, & + & 1.33D3, -41.310, 0.9216, 1.2080, 0.9512, & + & 4.2190, 3.1650, 0.1800, 0.2030, 0.0116, & + & 16.690, 0.1760, -0.0208, -0.0168, -0.1986, & + & -0.7916, 0.0479, 0.3386D-2, 1.3530, 1.1000, & + & 1.0990D3, 1.0470, 4.8530, 1.4260, 1.1360, & + & 4.4280, 0.0250, 0.8404, 1.2390, -0.2779/ + DATA (((B(I,J,K,2),I=1,5),J=1,4),K=1,2)/ & + & -0.3711, -0.1717, 0.08766, -0.8915, -0.1816, & + & 1.0610, 0.7815, 0.02197, 0.2857, 0.5866, & + & 4.7580, 1.5350, 0.10960, 2.9730, 2.4210, & + & -0.0150, 0.7067D-2,0.20400, 0.1185, 0.4059, & + & -0.1207, 25.000, -0.01230, -0.0919, 0.02015, & + & 1.0710, -1.6480, 1.16200, 0.7912, 0.9869, & + & 1.9770, -0.01563, 0.48240, 0.6397, -0.07036, & + & -0.8625D-2,6.4380, -0.01100, 2.3270, 0.01694/ + DATA (((B(I,J,K,3),I=1,5),J=1,4),K=1,2)/ & + & 15.8, 2.742, 0.02917, -0.0342, -0.02302, & + & -0.9464, -0.7332, 0.04657, 0.7196, 0.9229, & + & -0.5, 0.7148, 0.1785, 0.7338, 0.5873, & + & -0.2118, 3.287, 0.04811, 0.08139,-0.79D-4, & + & 6.734, 59.88, -0.3226D-2,-0.03321, 0.1059, & + & -1.008, -2.983, 0.8432, 0.9475, 0.6954, & + & -0.08594, 4.48, 0.3616, -0.3198, -0.6663, & + & 0.07625, 0.9686, 0.1383D-2, 0.02132, 0.3683/ +! +!...specification of sets + NFL=4 +! +!...calculations + Q2 = DQ*DQ + ALAM2=ALAM**2 + T=LOG(Q2/ALAM2) + LF=NFL-2 +! +!...gluons + DO 11 I=1,3 + AT(I)=A(I,1,LF)*T**A(I,2,LF)+A(I,3,LF)*T**(-A(I,4,LF)) + 11 CONTINUE + POMG=AT(1)*DX**AT(2)*(1.D0-DX)**AT(3) + DGL=POMG*ALPEM +! +!...quarks + E(1)=1.D0 + E(2)=10.D0 + DO 13 J=1,2 + DO 15 I=1,5 + BTP=B(I,1,J,LF)*T**B(I,2,J,LF) + BT(I,J)=BTP+B(I,3,J,LF)*T**(-B(I,4,J,LF)) + 15 CONTINUE + 13 CONTINUE +! +!...singlet & non-singlet combinations + DO 17 J=1,2 + POM1=DX*(DX*DX+(1.D0-DX)**2)/(BT(1,J)-BT(2,J)*LOG(1.D0-DX)) + POM2=BT(3,J)*DX**BT(4,J)*(1.D0-DX)**BT(5,J) + XQPOM(J)=E(J)*POM1+POM2 + 17 CONTINUE +! +!...quarks flavours + DUB=ALPEM*1.D0/8.D0*(XQPOM(2)+6.D0*XQPOM(1)) + DUV=DUB + DDB=ALPEM*1.D0/8.D0*(XQPOM(2)-6.D0*XQPOM(1)) + DDV=DDB + DSB=DDB + DCB=DUB + DBB=0.D0 +! + RETURN + END +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + SUBROUTINE DGPHO4(DX,DQ,DUV,DDV,DUB,DDB,DSB,DCB,DBB,DGL) +!******************************************************************** +!* * +!* Parametrization of parton distribution functions * +!* in the photon (LO analysis) - full solution of AP eq.! * +!* * +!* authors: M.Drees and K.Grassie (DG) * +!* /Z. Phys. C28 (1985) 451/ * +!* * +!* Prepared by: * +!* Krzysztof Charchula, DESY * +!* bitnet: F1PCHA@DHHDESY3 * +!* decnet: 13313::CHARCHULA * +!* * +!* Modified by: * +!* H. Plothow-Besch/CERN-PPE * +!* * +!******************************************************************** +! + implicit real*8 (a-h,o-z) + double precision & + & A(3,4,3),AT(3), & + & B(5,4,2,3),BT(5,2),XQPOM(2),E(2), & + & DX,DQ,DUV,DDV,DUB,DDB,DSB,DCB,DBB,DGL + PARAMETER (ALPEM=7.29927D-3, PI=3.141592D0) + PARAMETER (ALAM=0.4D0) +!...comments +!...-------------------------------------------------- +!... with nf=5 (valid for 200< Q2 <1D4 GeV2) +!...-------------------------------------------------- +! +!...initialization of gluon parameters array for DG + DATA (((A(I,J,K),I=1,3),J=1,4),K=1,3)/ & + & -0.20700, -0.19870, 5.1190, & + & 0.61580, 0.62570, -0.2752, & + & 1.07400, 8.35200, -6.9930, & + & 0.00000, 5.02400, 2.2980, & + & 0.8926D-2,0.0509, -0.2313, & + & 0.65940, 0.27740, 0.1382, & + & 0.47660, -0.39060, 6.5420, & + & 0.01975, -0.32120, 0.5162, & + & 0.03197, -0.618D-2,-0.1216, & + & 1.01800, 0.94760, 0.9047, & + & 0.24610, -0.60940, 2.6530, & + & 0.02707, -0.01067, 0.2003D-2/ +! +!...initialization of quark parameters array for DG + DATA (((B(I,J,K,1),I=1,5),J=1,4),K=1,2)/ & + & 2.2850, 6.0730, -0.4202, -0.0808, 0.0553, & + & -0.0153, -0.8132, 0.0178, 0.6346, 1.1360, & + & 1.33D3, -41.310, 0.9216, 1.2080, 0.9512, & + & 4.2190, 3.1650, 0.1800, 0.2030, 0.0116, & + & 16.690, 0.1760, -0.0208, -0.0168, -0.1986, & + & -0.7916, 0.0479, 0.3386D-2, 1.3530, 1.1000, & + & 1.0990D3, 1.0470, 4.8530, 1.4260, 1.1360, & + & 4.4280, 0.0250, 0.8404, 1.2390, -0.2779/ + DATA (((B(I,J,K,2),I=1,5),J=1,4),K=1,2)/ & + & -0.3711, -0.1717, 0.08766, -0.8915, -0.1816, & + & 1.0610, 0.7815, 0.02197, 0.2857, 0.5866, & + & 4.7580, 1.5350, 0.10960, 2.9730, 2.4210, & + & -0.0150, 0.7067D-2,0.20400, 0.1185, 0.4059, & + & -0.1207, 25.000, -0.01230, -0.0919, 0.02015, & + & 1.0710, -1.6480, 1.16200, 0.7912, 0.9869, & + & 1.9770, -0.01563, 0.48240, 0.6397, -0.07036, & + & -0.8625D-2,6.4380, -0.01100, 2.3270, 0.01694/ + DATA (((B(I,J,K,3),I=1,5),J=1,4),K=1,2)/ & + & 15.8, 2.742, 0.02917, -0.0342, -0.02302, & + & -0.9464, -0.7332, 0.04657, 0.7196, 0.9229, & + & -0.5, 0.7148, 0.1785, 0.7338, 0.5873, & + & -0.2118, 3.287, 0.04811, 0.08139,-0.79D-4, & + & 6.734, 59.88, -0.3226D-2,-0.03321, 0.1059, & + & -1.008, -2.983, 0.8432, 0.9475, 0.6954, & + & -0.08594, 4.48, 0.3616, -0.3198, -0.6663, & + & 0.07625, 0.9686, 0.1383D-2, 0.02132, 0.3683/ +! +!...specification of sets + NFL=5 +! +!...calculations + Q2 = DQ*DQ + ALAM2=ALAM**2 + T=LOG(Q2/ALAM2) + LF=NFL-2 +! +!...gluons + DO 11 I=1,3 + AT(I)=A(I,1,LF)*T**A(I,2,LF)+A(I,3,LF)*T**(-A(I,4,LF)) + 11 CONTINUE + POMG=AT(1)*DX**AT(2)*(1.D0-DX)**AT(3) + DGL=POMG*ALPEM +! +!...quarks + E(1)=1.D0 + E(2)=55.D0/6.D0 + DO 13 J=1,2 + DO 15 I=1,5 + BTP=B(I,1,J,LF)*T**B(I,2,J,LF) + BT(I,J)=BTP+B(I,3,J,LF)*T**(-B(I,4,J,LF)) + 15 CONTINUE + 13 CONTINUE +! +!...singlet & non-singlet combinations + DO 17 J=1,2 + POM1=DX*(DX*DX+(1.D0-DX)**2)/(BT(1,J)-BT(2,J)*LOG(1.D0-DX)) + POM2=BT(3,J)*DX**BT(4,J)*(1.D0-DX)**BT(5,J) + XQPOM(J)=E(J)*POM1+POM2 + 17 CONTINUE +! +!...quarks flavours + DUB=ALPEM*1.D0/10.D0*(XQPOM(2)+15.D0/2.D0*XQPOM(1)) + DUV=DUB + DCB=DUB + DDB=ALPEM*1.D0/10.D0*(XQPOM(2)-5.D0*XQPOM(1)) + DDV=DDB + DSB=DDB + DCB=DUB + DBB=DDB +! + RETURN + END diff --git a/LHAPDF/lhapdf-5.9.1/src/wrapdog.f b/LHAPDF/lhapdf-5.9.1/src/wrapdog.f new file mode 100644 index 00000000000..005c243cf76 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/wrapdog.f @@ -0,0 +1,174 @@ +! -*- F90 -*- + + + subroutine DOGevolvep0(xin,qin,p2in,ip2in,pdf) + include 'parmsetup.inc' + real*8 xin,qin,q2in,p2in,pdf(-6:6),xval(45),qcdl4,qcdl5 + real*8 upv,dnv,usea,dsea,str,chm,bot,top,glu + character*16 name(nmxset) + integer nmem(nmxset),ndef(nmxset),mmem + common/NAME/name,nmem,ndef,mmem + integer ns + + save + + call DOPHO1(xin,qin,upv,dnv,usea,dsea,str,chm,bot,glu) + + pdf(-6)= 0.0d0 + pdf(6)= 0.0d0 + pdf(-5)= bot + pdf(5 )= bot + pdf(-4)= chm + pdf(4 )= chm + pdf(-3)= str + pdf(3 )= str + pdf(-2)= usea + pdf(2 )= upv + pdf(-1)= dsea + pdf(1 )= dnv + pdf(0 )= glu + + return +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + entry DOGevolvep1(xin,qin,p2in,ip2in,pdf) + + call DOPHO2(xin,qin,upv,dnv,usea,dsea,str,chm,bot,glu) + + pdf(-6)= 0.0d0 + pdf(6)= 0.0d0 + pdf(-5)= bot + pdf(5 )= bot + pdf(-4)= chm + pdf(4 )= chm + pdf(-3)= str + pdf(3 )= str + pdf(-2)= usea + pdf(2 )= upv + pdf(-1)= dsea + pdf(1 )= dnv + pdf(0 )= glu + + return +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + entry DOGread(nset) + read(1,*)nmem(nset),ndef(nset) + return +! +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + entry DOGalfa(alfas,qalfa) + call getnset(iset) + call GetOrderAsM(iset,iord) + call Getlam4M(iset,imem,qcdl4) + call Getlam5M(iset,imem,qcdl5) + call aspdflib(alfas,Qalfa,iord,qcdl5) + return +! +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + entry DOGinit(Eorder,Q2fit) + return +! +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + entry DOGpdf(mem) + imem = mem + return +! + 1000 format(5e13.5) + END +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + SUBROUTINE DOPHO1(DX,DQ,DUV,DDV,DUB,DDB,DSB,DCB,DBB,DGL) +!******************************************************************** +!* * +!* Parametrization of parton distribution functions * +!* in the photon (LO analysis) - asymptotic solution of AP eq.! * +!* * +!* authors: D.Duke and H.Owens (DO) * +!* /Phys.Rev. D26 (1982) 1600/ * +!* * +!* Prepared by: * +!* Krzysztof Charchula, DESY * +!* bitnet: F1PCHA@DHHDESY3 * +!* decnet: 13313::CHARCHULA * +!* * +!* Modified by: * +!* H. Plothow-Besch/CERN-PPE * +!* * +!******************************************************************** +! + implicit real*8 (a-h,o-z) + double precision & + & CQ(5), & + & DX,DQ,DUV,DDV,DUB,DDB,DSB,DCB,DBB,DGL + PARAMETER (ALPEM=7.29927D-3, PI=3.141592D0) + PARAMETER (ALAM=0.2D0) + DATA CQ/0.33333D0,0.66666D0,0.33333D0,0.66666D0,0.33333D0/ +! + Q2 = DQ*DQ + ALAM2=ALAM**2 + FQ=ALPEM/(2.*PI)*LOG(Q2/ALAM2) +! +!...gluons + POMG=0.194*(1.-DX)**1.03/(DX**0.97) + DGL=POMG*FQ +! +!...quarks + POM1=(1.81-1.67*DX+2.16*DX**2) + POM2=DX**0.7/(1.-0.4*LOG(1.-DX)) + POM3=38.D-4*(1.-DX)**1.82/(DX**1.18) + DDB=(CQ(1)**2*POM1*POM2+POM3)*FQ + DDV=DDB + DUB=(CQ(2)**2*POM1*POM2+POM3)*FQ + DUV=DUB + DSB=(CQ(3)**2*POM1*POM2+POM3)*FQ + DCB=(CQ(4)**2*POM1*POM2+POM3)*FQ + DBB=(CQ(5)**2*POM1*POM2+POM3)*FQ + RETURN + END +!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + SUBROUTINE DOPHO2(DX,DQ,DUV,DDV,DUB,DDB,DSB,DCB,DBB,DGL) +!******************************************************************** +!* * +!* Parametrization of parton distribution functions * +!* in the photon (LO analysis) - asymptotic solution of AP eq.! * +!* * +!* authors: D.Duke and H.Owens (DO) * +!* /Phys.Rev. D26 (1982) 1600/ * +!* * +!* Prepared by: * +!* Krzysztof Charchula, DESY * +!* bitnet: F1PCHA@DHHDESY3 * +!* decnet: 13313::CHARCHULA * +!* * +!* Modified by: * +!* H. Plothow-Besch/CERN-PPE * +!* * +!******************************************************************** +! + implicit real*8 (a-h,o-z) + double precision & + & CQ(5), & + & DX,DQ,DUV,DDV,DUB,DDB,DSB,DCB,DBB,DGL + PARAMETER (ALPEM=7.29927D-3,PI=3.141592D0) + PARAMETER (ALAM=0.4D0) + DATA CQ/0.33333D0,0.66666D0,0.33333D0,0.66666D0,0.33333D0/ +! + Q2 = DQ*DQ + ALAM2=ALAM**2 + FQ=ALPEM/(2.*PI)*LOG(Q2/ALAM2) +! +!...gluons + POMG=0.194*(1.-DX)**1.03/(DX**0.97) + DGL=POMG*FQ +! +!...quarks + POM1=(1.81-1.67*DX+2.16*DX**2) + POM2=DX**0.7/(1.-0.4*LOG(1.-DX)) + POM3=38.D-4*(1.-DX)**1.82/(DX**1.18) + DDB=(CQ(1)**2*POM1*POM2+POM3)*FQ + DDV=DDB + DUB=(CQ(2)**2*POM1*POM2+POM3)*FQ + DUV=DUB + DSB=(CQ(3)**2*POM1*POM2+POM3)*FQ + DCB=(CQ(4)**2*POM1*POM2+POM3)*FQ + DBB=(CQ(5)**2*POM1*POM2+POM3)*FQ + RETURN + END diff --git a/LHAPDF/lhapdf-5.9.1/src/wrapevolve.F b/LHAPDF/lhapdf-5.9.1/src/wrapevolve.F new file mode 100644 index 00000000000..98bac22a949 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/wrapevolve.F @@ -0,0 +1,884 @@ +! -*- F90 -*- + + + subroutine evolvePDF(x,Q,f) + implicit none + include 'parmsetup.inc' + real*8 gridx(nmxgridx),gridq(nmxgridq) + integer nxgrid,nqgrid + integer nset,imem,Eorder,IP2 + real*8 x,Q,P2,Q2fit,f(-6:6),alfas,a,photon,gluino + nset = 1 + call evolvePDFM(nset,x,Q,f) + return +! + entry evolvePDFp(x,Q,P2,IP2,f) + nset = 1 + call evolvePDFpM(nset,x,Q,P2,IP2,f) + return +! + entry evolvePDFa(x,Q,a,f) + nset = 1 + call evolvePDFaM(nset,x,Q,a,f) + return +! + entry evolvePDFphoton(x,Q,f,photon) + nset = 1 + call evolvePDFphotonM(nset,x,Q,f,photon) + return +! + entry evolvePDFgluino(x,Q,f,gluino) + nset = 1 + call evolvePDFgluinoM(nset,x,Q,f,gluino) + return +! + entry initPDF(imem) + nset = 1 + call initPDFM(nset,imem) + return + + entry getgrid(nxgrid,nqgrid,gridx,gridq) + nset = 1 + call getgridM(nset,nxgrid,nqgrid,gridx,gridq) + + return + END +! + subroutine evolvePDFaM(nset,xin,Qin,a,f) + implicit none + real*8 x,Q,a,f(-6:6) + real*8 ruv,rdv,ru,rd,rs,rc,rb,rt,rg + integer nset,iimem,j + real*8 xin,qin,q2in + character*20 lparm + real*8 xmin,xmax,q2min,q2max + integer iorder,ipset,ia + + + call getlhaparm(18,lparm) + if(lparm.ne.'EXTRAPOLATE') then + call getnmem(nset,iimem) + call getminmaxm(nset,iimem,xmin,xmax,q2min,q2max) + x = max(xmin,min(xmax,xin)) + q2in = qin**2 + q = sqrt(max(0d0,q2min,min(q2max,q2in))) + else + x = xin + q = qin + endif + + call getlhaparm(15,lparm) + if(lparm.eq.'EPS08') then + call eps08(x,q,a,ruv,rdv,ru,rd,rs,rc,rb,rt,rg) + else if(lparm(1:5).eq.'EPS09') then + if(lparm.eq.'EPS09LO') then + iorder=1 + ipset=1 + else if(lparm.eq.'EPS09NLO') then + iorder=2 + ipset=1 + else if(lparm(1:8).eq.'EPS09LO,') then + iorder=1 + read(lparm(9:),*)ipset + else if(lparm(1:9).eq.'EPS09NLO,') then + iorder=2 + read(lparm(10:),*)ipset + else + iorder=2 + ipset=1 + endif + ia = a + call eps09(iorder,ipset,ia,x,q,ruv,rdv,ru,rd,rs,rc,rb,rg) + rt = 1.0d0 + else + call eks98(x,q,a,ruv,rdv,ru,rd,rs,rc,rb,rt,rg) + endif + + call evolvePDFM(nset,x,Q,f) + f(0) = f(0)*rg + f(1) = f(1)*rdv-f(-1)*(rdv-rd) + f(2) = f(2)*ruv-f(-2)*(ruv-ru) + f(3) = f(3)*rs + f(4) = f(4)*rc + f(5) = f(5)*rb + f(6) = f(6)*rt + f(-6) = f(-6)*rt + f(-5) = f(-5)*rb + f(-4) = f(-4)*rc + f(-3) = f(-3)*rs + f(-2) = f(-2)*ru + f(-1) = f(-1)*rd + + return + end +! + subroutine evolvePDFM(nset,xin,Qin,f) + implicit none + include 'parmsetup.inc' + integer Eorder,index,imem + character*16 name(nmxset) + integer nmem(nmxset),ndef(nmxset),mem,ip2 + common/NAME/name,nmem,ndef,mem + integer iset,iimem + common/SET/iset,iimem + integer nset,j + real*8 x,xin,Q,Qin,Q2fit,alfas,p2,q2in + real*8 f(-6:6),photon,gluino,xphoton + character*20 lparm + real*8 xmin,xmax,q2min,q2max + real*8 gridx(nmxgridx),gridq(nmxgridq) + integer nxgrid,nqgrid + character*512 setpath + integer nnpdf,nnpdf100,nnpdf1000 + data nnpdf,nnpdf100,nnpdf1000/0,0,0/ + save +! + call setnset(nset) +! +! print *,'this is evolvePDFM, name=',nset,name(nset) +! set all f's to 0.0d0 at start +! do j = -6,6 +! f(j) = 0.0d0 +! enddo + + call getlhaparm(18,lparm) + if(lparm.ne.'EXTRAPOLATE') then + call getnmem(nset,iimem) + call getminmaxm(nset,iimem,xmin,xmax,q2min,q2max) + x = max(xmin,min(xmax,xin)) + q2in = qin**2 + q = sqrt(max(0d0,q2min,min(q2max,q2in))) + else + x = xin + q = qin + endif + +#ifdef QCDNUM + if (name(nset).eq.'QCDNUM') call QCDNUMevolve(x,Q,f) + if (name(nset).eq.'QCDNUM_MRST') call QCDNUMevolve(x,Q,f) + if (name(nset).eq.'QCDNUM_MRST3') call QCDNUM3evolve(x,Q,f) + if (name(nset).eq.'QCDNUM_MRST4') call QCDNUM4evolve(x,Q,f) +#endif +#ifdef GRV + if (name(nset).eq.'GRV') call GRVevolve(x,Q,f) +#endif +#ifdef ZEUS + if (name(nset)(1:12).eq.'QCDNUM_ZEUS_') call ZEUSevolve(x,Q,f) +#endif +#ifdef HERA + if (name(nset)(1:12).eq.'QCDNUM_HERA_') call HERAevolve(x,Q,f) + if (name(nset)(1:8).eq.'HERAGRID') call HERAGRIDevolve(x,Q,f) +#endif +#ifdef CTEQ + if (name(nset).eq.'EVLCTEQ') call EVLCTEQevolve(x,Q,f) + if (name(nset).eq.'CTEQ5grid') call CTEQ5evolve(x,Q,f) + if (name(nset).eq.'CTEQ6grid') call CTEQ6evolve(x,Q,f) + if (name(nset).eq.'CTEQ65grid') call CTEQ65evolve(x,Q,f) + if (name(nset).eq.'CTEQ65cgrid') call CTEQ65cevolve(x,Q,f) + if (name(nset).eq.'CTEQ65sgrid') call CTEQ65sevolve(x,Q,f) + if (name(nset).eq.'CTEQ6ABgrid') call CTEQ6evolve(x,Q,f) + if (name(nset).eq.'CTEQ66grid') call CTEQ65evolve(x,Q,f) + if (name(nset).eq.'CT10grid') call CT12evolve(x,Q,f) + if (name(nset).eq.'CT12grid') call CT12evolve(x,Q,f) +#endif +#ifdef MRST + if (name(nset).eq.'MRST') call QCDNUMevolve(x,Q,f) + if (name(nset).eq.'MRSTpdf') call QCDNUMevolve(x,Q,f) + if (name(nset).eq.'MRSTgrid') call MRSTevolve(x,Q,f) + if (name(nset).eq.'MRST3grid') call MRSTevolve(x,Q,f) + if (name(nset).eq.'MRST4grid') call MRSTevolve(x,Q,f) +#endif +#ifdef MRSTQED + if (name(nset).eq.'MRST4qed') call MRSTqedevolve(x,Q,f,xphoton) +#endif +#ifdef MRST98 + if (name(nset).eq.'MRST98grid') call MRST98evolve(x,Q,f) +#endif +#ifdef MRST06 + if (name(nset).eq.'MRST2006grid') call MRST2006evolve(x,Q,f) +#endif +#ifdef MSTW + if (name(nset).eq.'MSTWgrid') call MSTWevolve(x,Q,f,xphoton) +#endif +#ifdef ALEKHIN + if (name(nset).eq.'A02M') call A02Mevolve(x,Q,f) + if (name(nset).eq.'ABKM09') call ABKM09evolve(x,Q,f) + if (name(nset).eq.'ABM11') call ABM11evolve(x,Q,f) +#endif +#ifdef H1 + if (name(nset).eq.'H12000') call H1evolve(x,Q,f) +#endif +#ifdef GJR + if (name(nset)(1:5).eq.'GJR08') call GJRevolve(x,Q,f) +#endif +#ifdef NNPDF + if (name(nset).eq.'NNPDF') call NNPDFevolve(x,Q,f) + if (name(nset).eq.'NNPDFint') call NNPDFINTevolve(x,Q,f) + if (name(nset).eq.'NNPDF20int') call NNPDFINT20evolve(x,Q,f) + if (name(nset).eq.'NNPDF20intqed') call NNPDFINT20qedevolve(x,Q,f,xphoton) +#endif +#ifdef HKN + if (name(nset).eq.'HKNgrid') call hknevolve(x,Q,f) +#endif +#ifdef PIONS + if (name(nset).eq.'OWP') call OWPevolve(x,Q,f) + if (name(nset).eq.'SMRSP') call SMRSPevolve(x,Q,f) + if (name(nset).eq.'GRVP0') call GRVP0evolve(x,Q,f) + if (name(nset).eq.'GRVP1') call GRVP1evolve(x,Q,f) + if (name(nset).eq.'ABFKWP') call ABFKWPevolve(x,Q,f) +#endif +#ifdef USER + if (name(nset).eq.'USER') call USERevolve(x,Q,f) + if (name(nset)(1:8).eq.'USERGRID') call USERGRIDevolve(x,Q,f) +#endif + return +! + entry evolvePDFpM(nset,xin,Qin,P2,IP2,f) +! + call setnset(nset) +! + call getlhaparm(18,lparm) + if(lparm.ne.'EXTRAPOLATE') then + call getnmem(nset,iimem) + call getminmaxm(nset,iimem,xmin,xmax,q2min,q2max) + x = max(xmin,min(xmax,xin)) + q2in = qin**2 + q = sqrt(max(0d0,q2min,min(q2max,q2in))) + else + x = xin + q = qin + endif +! +#ifdef PHOTONS + if(name(nset).eq.'SASG') call SASGevolvep(x,Q,P2,IP2,f) + if(name(nset).eq.'GRVG0') call GRVGevolvep0(x,Q,P2,IP2,f) + if(name(nset).eq.'GRVG1') call GRVGevolvep1(x,Q,P2,IP2,f) + if (name(nset).eq.'DOG0') call DOGevolvep0(x,Q,P2,IP2,f) + if (name(nset).eq.'DOG1') call DOGevolvep1(x,Q,P2,IP2,f) + if (name(nset).eq.'DGG') call DGGevolvep(x,Q,P2,IP2,f) + if (name(nset).eq.'LACG') call LACGevolvep(x,Q,P2,IP2,f) + if (name(nset).eq.'GSG0') call GSGevolvep0(x,Q,P2,IP2,f) + if (name(nset).eq.'GSG1') call GSGevolvep1(x,Q,P2,IP2,f) + if (name(nset).eq.'GSG960') call GSG96evolvep0(x,Q,P2,IP2,f) + if (name(nset).eq.'GSG961') call GSG96evolvep1(x,Q,P2,IP2,f) + if (name(nset).eq.'ACFGP') call ACFGPevolvep(x,Q,P2,IP2,f) + if (name(nset).eq.'WHITG') call WHITGevolvep(x,Q,P2,IP2,f) +#endif + return +! + entry evolvePDFphotonM(nset,xin,qin,f,photon) + +! + call setnset(nset) +! + call getlhaparm(18,lparm) + if(lparm.ne.'EXTRAPOLATE') then + call getnmem(nset,iimem) + call getminmaxm(nset,iimem,xmin,xmax,q2min,q2max) + x = max(xmin,min(xmax,xin)) + q2in = qin**2 + q = sqrt(max(0d0,q2min,min(q2max,q2in))) + else + x = xin + q = qin + endif +! +#ifdef MRSTQED + if(name(nset).eq.'MRST4qed') then + call MRSTqedevolve(x,Q,f,photon) + else if (name(nset).ne.'NNPDF20intqed') then + photon = 0.0d0 + endif +#endif +! +#ifdef NNPDF + if(name(nset).eq.'NNPDF20intqed') then + call NNPDFINT20qedevolve(x,Q,f,photon) + else if (name(nset).ne.'MRST4qed') then + photon = 0.0d0 + endif +#endif +! + return + + entry evolvePDFgluinoM(nset,xin,qin,f,gluino) + +! + call setnset(nset) +! + call getlhaparm(18,lparm) + if(lparm.ne.'EXTRAPOLATE') then + call getnmem(nset,iimem) + call getminmaxm(nset,iimem,xmin,xmax,q2min,q2max) + x = max(xmin,min(xmax,xin)) + q2in = qin**2 + q = sqrt(max(0d0,q2min,min(q2max,q2in))) + else + x = xin + q = qin + endif +! +#ifdef CTEQ + if(name(nset).eq.'CTEQ6LGgrid') then + call CTEQ6LGevolve(x,Q,f,gluino) + else + gluino = 0.0d0 + endif +#endif + return + + + entry readevolve(nset) +! + call getsetpath(setpath) +! + if(index(setpath,'NNPDF').gt.0) then + if(nset.gt.1) then + if((index(setpath,'1000.').gt.0.and.nnpdf.gt.0).or.(index(setpath,'100.').gt.0.and.nnpdf1000.gt.0)) then + print *,'LHAPDF ERROR: MULTISET-INITIALIZATION with NNPDF 1000 sets IS NOT AVAIABLE (AT THE MOMENT)!' + STOP + endif + endif + nnpdf=nnpdf+1 + if(index(setpath,'1000').gt.0) then + nnpdf1000=nnpdf1000+1 + else + nnpdf100=nnpdf100+1 + endif + endif + +! + read(1,*) name(nset) +! print *, 'this is readevolve', name(nset) +! + call setnset(nset) +! +#ifdef QCDNUM + if (name(nset).eq.'QCDNUM') call QCDNUMread(nset) + if (name(nset).eq.'QCDNUM_MRST') call QCDNUMread(nset) + if (name(nset).eq.'QCDNUM_MRST3') call QCDNUM3read(nset) + if (name(nset).eq.'QCDNUM_MRST4') call QCDNUM4read(nset) +#endif +#ifdef GRV + if (name(nset).eq.'GRV') call GRVread(nset) +#endif +#ifdef ZEUS + if (name(nset)(1:12).eq.'QCDNUM_ZEUS_') call ZEUSread(nset) +#endif +#ifdef HERA + if (name(nset)(1:12).eq.'QCDNUM_HERA_') call HERAread(nset) + if (name(nset)(1:8).eq.'HERAGRID') call HERAGRIDread(nset) +#endif +#ifdef CTEQ + if (name(nset).eq.'EVLCTEQ') call EVLCTEQread(nset) + if (name(nset).eq.'CTEQ5grid') call CTEQ5read(nset) + if (name(nset).eq.'CTEQ6grid') call CTEQ6read(nset) + if (name(nset).eq.'CTEQ65grid') call CTEQ65read(nset) + if (name(nset).eq.'CTEQ65cgrid') call CTEQ65cread(nset) + if (name(nset).eq.'CTEQ65sgrid') call CTEQ65read(nset) + if (name(nset).eq.'CTEQ6ABgrid') call CTEQ6read(nset) + if (name(nset).eq.'CTEQ66grid') call CTEQ66read(nset) + if (name(nset).eq.'CTEQ6LGgrid') call CTEQ6LGread(nset) + if (name(nset).eq.'CT10grid') call CT12read(nset) + if (name(nset).eq.'CT12grid') call CT12read(nset) +#endif +#ifdef MRST + if (name(nset).eq.'MRST') call QCDNUMread(nset) + if (name(nset).eq.'MRSTpdf') call QCDNUMread(nset) + if (name(nset).eq.'MRSTgrid') call MRSTread(nset) + if (name(nset).eq.'MRST3grid') call MRSTread(nset) + if (name(nset).eq.'MRST4grid') call MRSTread(nset) +#endif +#ifdef MRSTQED + if (name(nset).eq.'MRST4qed') call MRSTqedread(nset) +#endif +#ifdef MRST98 + if (name(nset).eq.'MRST98grid') call MRST98read(nset) +#endif +#ifdef MRST06 + if (name(nset).eq.'MRST2006grid') call MRST2006read(nset) +#endif +#ifdef MSTW + if (name(nset).eq.'MSTWgrid') call MSTWread(nset) +#endif +#ifdef ALEKHIN + if (name(nset).eq.'A02M') call A02Mread(nset) + if (name(nset).eq.'ABKM09') call ABKM09read(nset) + if (name(nset).eq.'ABM11') call ABM11read(nset) +#endif +#ifdef H1 + if (name(nset).eq.'H12000') call H1read(nset) +#endif +#ifdef GJR + if (name(nset)(1:5).eq.'GJR08') call GJRread(nset) +#endif +#ifdef NNPDF + if (name(nset).eq.'NNPDF') call NNPDFread(nset) + if (name(nset).eq.'NNPDFint') call NNPDFINTread(nset) + if (name(nset).eq.'NNPDF20int') call NNPDFINT20read(nset) + if (name(nset).eq.'NNPDF20intqed') call NNPDFINT20qedread(nset) +#endif +#ifdef HKN + if (name(nset).eq.'HKNgrid') call hknread(nset) +#endif +#ifdef PHOTONS + if (name(nset).eq.'SASG') call SASGread(nset) + if (name(nset).eq.'GRVG0' .OR. & + & name(nset).eq.'GRVG1') call GRVGread(nset) + if (name(nset).eq.'DOG0' .OR. & + & name(nset).eq.'DOG1') call DOGread(nset) + if (name(nset).eq.'DGG') call DGGread(nset) + if (name(nset).eq.'LACG') call LACGread(nset) + if (name(nset).eq.'GSG0' .OR. & + & name(nset).eq.'GSG1') call GSGread(nset) + if (name(nset).eq.'GSG960' .OR. & + & name(nset).eq.'GSG961') call GSG96read(nset) + if (name(nset).eq.'ACFGP') call ACFGPread(nset) + if (name(nset).eq.'WHITG') call WHITGread(nset) +#endif +#ifdef PIONS + if (name(nset).eq.'OWP') call OWPread(nset) + if (name(nset).eq.'SMRSP') call SMRSPread(nset) + if (name(nset).eq.'GRVP0' .OR. & + & name(nset).eq.'GRVP1') call GRVPread(nset) + if (name(nset).eq.'ABFKWP') call ABFKWPread(nset) +#endif +#ifdef USER + if (name(nset).eq.'USER') call USERread(nset) + if (name(nset)(1:8).eq.'USERGRID') call USERGRIDread(nset) +#endif + return +! + entry alfasevolve(nset,alfas,Qin) +! + call setnset(nset) + q = qin +#ifdef QCDNUM + if (name(nset).eq.'QCDNUM') call QCDNUMalfa(alfas,Q) + if (name(nset).eq.'QCDNUM_MRST') call QCDNUMalfa(alfas,Q) + if (name(nset).eq.'QCDNUM_MRST3') call QCDNUM3alfa(alfas,Q) + if (name(nset).eq.'QCDNUM_MRST4') call QCDNUM4alfa(alfas,Q) +#endif +#ifdef GRV + if (name(nset).eq.'GRV') call GRValfa(alfas,Q) +#endif +#ifdef ZEUS + if (name(nset)(1:12).eq.'QCDNUM_ZEUS_') call ZEUSalfa(alfas,Q) +#endif +#ifdef HERA + if (name(nset)(1:12).eq.'QCDNUM_HERA_') call HERAalfa(alfas,Q) + if (name(nset)(1:8).eq.'HERAGRID') call HERAGRIDalfa(alfas,Q) +#endif +#ifdef CTEQ + if (name(nset).eq.'EVLCTEQ') call EVLCTEQalfa(alfas,Q) + if (name(nset).eq.'CTEQ5grid') call CTEQ5alfa(alfas,Q) + if (name(nset).eq.'CTEQ6grid') call CTEQ6alfa(alfas,Q) + if (name(nset).eq.'CTEQ65grid') call CTEQ65alfa(alfas,Q) + if (name(nset).eq.'CTEQ65cgrid') call CTEQ65alfa(alfas,Q) + if (name(nset).eq.'CTEQ65sgrid') call CTEQ65alfa(alfas,Q) + if (name(nset).eq.'CTEQ66grid') call CTEQ65alfa(alfas,Q) + if (name(nset).eq.'CTEQ6LGgrid') call CTEQ6LGalfa(alfas,Q) + if (name(nset).eq.'CT10grid') call CT12alfa(alfas,Q) + if (name(nset).eq.'CT12grid') call CT12alfa(alfas,Q) +#endif +#ifdef MRST + if (name(nset).eq.'MRST') call QCDNUMalfa(alfas,Q) + if (name(nset).eq.'MRSTpdf') call QCDNUMalfa(alfas,Q) + if (name(nset).eq.'MRSTgrid') call MRSTalfa(5,alfas,Q) + if (name(nset).eq.'MRST3grid') call MRSTalfa(3,alfas,Q) + if (name(nset).eq.'MRST4grid') call MRSTalfa(4,alfas,Q) +#endif +#ifdef MRSTQED + if (name(nset).eq.'MRST4qed') call MRSTqedalfa(4,alfas,Q) +#endif +#ifdef MRST98 + if (name(nset).eq.'MRST98grid') call MRST98alfa(alfas,Q) +#endif +#ifdef MRST06 + if (name(nset).eq.'MRST2006grid') call MRST2006alfa(5,alfas,Q) +#endif +#ifdef MSTW + if (name(nset).eq.'MSTWgrid') call MSTWalfa(alfas,Q) +#endif +#ifdef ALEKHIN + if (name(nset).eq.'A02M') call A02Malfa(alfas,Q) + if (name(nset).eq.'ABKM09') call ABKM09alfa(alfas,Q) + if (name(nset).eq.'ABM11') call ABM11alfa(alfas,Q) +#endif +#ifdef H1 + if (name(nset).eq.'H12000') call H1alfa(alfas,Q) +#endif +#ifdef GJR + if (name(nset)(1:5).eq.'GJR08') call GJRalfa(alfas,Q) +#endif +#ifdef NNPDF + if (name(nset).eq.'NNPDF') call NNPDFalfa(alfas,Q) + if (name(nset).eq.'NNPDFint') call NNPDFINTalfa(alfas,Q) + if (name(nset).eq.'NNPDF20int') call NNPDFINT20alfa(alfas,Q) + if (name(nset).eq.'NNPDF20intqed') call NNPDFINT20qedalfa(alfas,Q) +#endif +#ifdef HKN + if (name(nset).eq.'HKNgrid') call hknalfa(alfas,Q) +#endif +#ifdef PHOTONS + if (name(nset).eq.'SASG') call SASGalfa(alfas,Q) + if (name(nset).eq.'GRVG0' .OR. & + & name(nset).eq.'GRVG1') call GRVGalfa(alfas,Q) + if (name(nset).eq.'DOG0' .OR. & + & name(nset).eq.'DOG1') call DOGalfa(alfas,Q) + if (name(nset).eq.'DGG') call DGGalfa(alfas,Q) + if (name(nset).eq.'LACG') call LACGalfa(alfas,Q) + if (name(nset).eq.'GSG0' .OR. & + & name(nset).eq.'GSG1') call GSGalfa(alfas,Q) + if (name(nset).eq.'GSG960' .OR. & + & name(nset).eq.'GSG961') call GSG96alfa(alfas,Q) + if (name(nset).eq.'ACFGP') call ACFGPalfa(alfas,Q) + if (name(nset).eq.'WHITG') call WHITGalfa(alfas,Q) +#endif +#ifdef PIONS + if (name(nset).eq.'OWP') call OWPalfa(alfas,Q) + if (name(nset).eq.'SMRSP') call SMRSPalfa(alfas,Q) + if (name(nset).eq.'GRVP0' .OR. & + & name(nset).eq.'GRVP1') call GRVPalfa(alfas,Q) + if (name(nset).eq.'ABFKWP') call ABFKWPalfa(alfas,Q) +#endif +#ifdef USER + if (name(nset).eq.'USER') call USERalfa(alfas,Q) + if (name(nset)(1:8).eq.'USERGRID') call USERGRIDalfa(alfas,Q) +#endif + return +! + entry initevolution(nset,Eorder,Q2fit) +! + call setnset(nset) +! +#ifdef QCDNUM + if (name(nset).eq.'QCDNUM') call QCDNUMinit(nset,Eorder,Q2fit) + if (name(nset).eq.'QCDNUM_MRST') then + call QCDNUMinit(nset,Eorder,Q2fit) + call QNLSET('BMARK',.TRUE.) + endif + if (name(nset).eq.'QCDNUM_MRST3') then + call QCDNUM3init(nset,Eorder,Q2fit) + call QNLSET('BMARK',.TRUE.) + endif + if (name(nset).eq.'QCDNUM_MRST4') then + call QCDNUM4init(nset,Eorder,Q2fit) + call QNLSET('BMARK',.TRUE.) + endif +#endif +#ifdef GRV + if (name(nset).eq.'GRV') call GRVinit(Eorder,Q2fit) +#endif +#ifdef ZEUS + if (name(nset)(1:12).eq.'QCDNUM_ZEUS_') & + & call ZEUSinit(nset,Eorder,Q2fit) +#endif +#ifdef HERA + if (name(nset)(1:12).eq.'QCDNUM_HERA_') & + & call HERAinit(nset,Eorder,Q2fit) + if (name(nset)(1:8).eq.'HERAGRID')call HERAGRIDinit(nset,Eorder,Q2fit) +#endif +#ifdef CTEQ + if (name(nset).eq.'EVLCTEQ') call EVLCTEQinit(nset,Eorder,Q2fit) + if (name(nset).eq.'CTEQ5grid') call CTEQ5init(Eorder,Q2fit) + if (name(nset).eq.'CTEQ6grid') call CTEQ6init(Eorder,Q2fit) + if (name(nset).eq.'CTEQ65grid') call CTEQ65init(Eorder,Q2fit) + if (name(nset).eq.'CTEQ65cgrid') call CTEQ65init(Eorder,Q2fit) + if (name(nset).eq.'CTEQ65sgrid') call CTEQ65init(Eorder,Q2fit) + if (name(nset).eq.'CTEQ66grid') call CTEQ65init(Eorder,Q2fit) + if (name(nset).eq.'CTEQ6LGgrid') call CTEQ6LGinit(Eorder,Q2fit) + if (name(nset).eq.'CT10grid') call CT12init(Eorder,Q2fit) + if (name(nset).eq.'CT12grid') call CT12init(Eorder,Q2fit) +#endif +#ifdef MRST + if (name(nset).eq.'MRSTgrid') call MRSTinit(Eorder,Q2fit) + if (name(nset).eq.'MRST3grid') call MRSTinit(Eorder,Q2fit) + if (name(nset).eq.'MRST4grid') call MRSTinit(Eorder,Q2fit) +#endif +#ifdef MRSTQED + if (name(nset).eq.'MRST4qed') call MRSTqedinit(Eorder,Q2fit) +#endif +#ifdef MRST98 + if (name(nset).eq.'MRST98grid') call MRST98init(Eorder,Q2fit) +#endif +#ifdef MRST06 + if (name(nset).eq.'MRST2006grid') call MRST2006init(Eorder,Q2fit) +#endif +#ifdef MSTW + if (name(nset).eq.'MSTWgrid') call MSTWinit(Eorder,Q2fit) +#endif +#ifdef ALEKHIN + if (name(nset).eq.'A02M') call A02Minit + if (name(nset).eq.'ABKM09') call ABKM09init + if (name(nset).eq.'ABM11') call ABM11init +#endif +#ifdef H1 + if (name(nset).eq.'H12000') call H1init(Eorder,Q2fit) +#endif +#ifdef GJR + if (name(nset)(1:5).eq.'GJR08') call GJRinit(Eorder,Q2fit) +#endif +#ifdef NNPDF + if (name(nset).eq.'NNPDF') call NNPDFinit(nset,Eorder,Q2fit) + if (name(nset).eq.'NNPDFint') call NNPDFINTinit(nset,Eorder,Q2fit) + if (name(nset).eq.'NNPDF20int') call NNPDFINT20init(nset,Eorder,Q2fit) + if (name(nset).eq.'NNPDF20intqed') call NNPDFINT20qedinit(nset,Eorder,Q2fit) +#endif +#ifdef PHOTONS + if (name(nset).eq.'SASG') call SASGinit(Eorder,Q2fit) + if (name(nset).eq.'GRVG0' .OR. & + & name(nset).eq.'GRVG1') call GRVGinit(Eorder,Q2fit) + if (name(nset).eq.'DOG0' .OR. & + & name(nset).eq.'DOG1') call DOGinit(Eorder,Q2fit) + if (name(nset).eq.'DGG') call DGGinit(Eorder,Q2fit) + if (name(nset).eq.'LACG') call LACGinit(Eorder,Q2fit) + if (name(nset).eq.'GSG0' .OR. & + & name(nset).eq.'GSG1') call GSGinit(Eorder,Q2fit) + if (name(nset).eq.'GSG960' .OR. & + & name(nset).eq.'GSG961') call GSG96init(Eorder,Q2fit) + if (name(nset).eq.'ACFGP') call ACFGPinit(Eorder,Q2fit) + if (name(nset).eq.'WHITG') call WHITGinit(Eorder,Q2fit) +#endif +#ifdef PIONS + if (name(nset).eq.'OWP') call OWPinit(Eorder,Q2fit) + if (name(nset).eq.'SMRSP') call SMRSPinit(Eorder,Q2fit) + if (name(nset).eq.'GRVP0' .OR. & + & name(nset).eq.'GRVP1') call GRVPinit(Eorder,Q2fit) + if (name(nset).eq.'ABFKWP') call ABFKWPinit(Eorder,Q2fit) +#endif +#ifdef HKN + if (name(nset).eq.'HKNgrid') call hkninit(nset,Eorder,Q2fit) +#endif +#ifdef USER + if (name(nset).eq.'USER') call USERinit(nset,Eorder,Q2fit) + if (name(nset)(1:8).eq.'USERGRID') call USERGRIDinit(nset,Eorder,Q2fit) +#endif + return +! + entry initPDFM(nset,imem) +! + call setnset(nset) + call setnmem(nset,imem) +! + iimem = imem +#ifdef QCDNUM + if (name(nset).eq.'QCDNUM') then + call InitEvolvePDF(nset,imem) + call QCDNUMpdf(nset) + endif + if (name(nset).eq.'QCDNUM_MRST') then + call InitEvolvePDF(nset,imem) + call QCDNUMpdf(nset) + endif + if (name(nset).eq.'QCDNUM_MRST3') then + call InitEvolvePDF(nset,imem) + call QCDNUM3pdf(nset) + endif + if (name(nset).eq.'QCDNUM_MRST4') then + call InitEvolvePDF(nset,imem) + call QCDNUM4pdf(nset) + endif +#endif +#ifdef ZEUS + if (name(nset)(1:12).eq.'QCDNUM_ZEUS_') then + call InitEvolvePDF(nset,imem) + call ZEUSpdf(nset) + endif +#endif +#ifdef HERA + if (name(nset)(1:12).eq.'QCDNUM_HERA_') then + call InitEvolvePDF(nset,imem) + call HERApdf(nset) + endif + if (name(nset)(1:8).eq.'HERAGRID') call HERAGRIDpdf(imem) +#endif +#ifdef MRST + if (name(nset).eq.'MRST') then + call InitEvolvePDF(nset,imem) + call QCDNUMpdf(nset) + endif + if (name(nset).eq.'MRSTpdf') then + call InitEvolvePDF(nset,imem) + call QCDNUMpdf(nset) + endif + if (name(nset).eq.'MRSTgrid') call MRSTpdf(imem) + if (name(nset).eq.'MRST3grid') call MRSTpdf(imem) + if (name(nset).eq.'MRST4grid') call MRSTpdf(imem) +#endif +#ifdef MRSTQED + if (name(nset).eq.'MRST4qed') call MRSTqedpdf(imem) +#endif +#ifdef MRST98 + if (name(nset).eq.'MRST98grid') call MRST98pdf(imem) +#endif +#ifdef MRST06 + if (name(nset).eq.'MRST2006grid') call MRST2006pdf(imem) +#endif +#ifdef CTEQ + if (name(nset).eq.'EVLCTEQ') then + call InitEvolvePDF(nset,imem) + call EVLCTEQpdf(nset) +! call EVLCTEQpdf(nset,imem) + endif + if (name(nset).eq.'CTEQ65grid') then + call CTEQ6NewAlpha(nset,imem) + endif + if (name(nset).eq.'CTEQ65cgrid') then + call CTEQ6NewAlpha(nset,imem) + endif + if (name(nset).eq.'CTEQ65sgrid') then + call CTEQ6NewAlpha(nset,imem) + endif + if (name(nset).eq.'CTEQ6ABgrid') then + call CTEQ6NewAlpha(nset,imem) +! call CTEQ6pdf(nset) + endif + if (name(nset).eq.'CTEQ66grid') then + call CTEQ6NewAlpha(nset,imem) + endif + if (name(nset).eq.'CT10grid') then + call CTEQ6NewAlpha(nset,imem) + endif + if (name(nset).eq.'CT12grid') then + call CTEQ6NewAlpha(nset,imem) + endif + if (name(nset).eq.'CTEQ5grid') call CTEQ5pdf(imem) + if (name(nset).eq.'CTEQ6grid') call CTEQ6pdf(imem) + if (name(nset).eq.'CTEQ65grid') call CTEQ65pdf(imem) + if (name(nset).eq.'CTEQ66grid') call CTEQ65pdf(imem) + if (name(nset).eq.'CTEQ65cgrid') call CTEQ65pdf(imem) + if (name(nset).eq.'CTEQ65sgrid') call CTEQ65pdf(imem) + if (name(nset).eq.'CTEQ6ABgrid') call CTEQ6pdf(imem) + if (name(nset).eq.'CTEQ66grid') call CTEQ65pdf(imem) + if (name(nset).eq.'CTEQ6LGgrid') call CTEQ6LGpdf(imem) + if (name(nset).eq.'CT10grid') call CT12pdf(imem) + if (name(nset).eq.'CT12grid') call CT12pdf(imem) +#endif +#ifdef H1 + if (name(nset).eq.'H12000') then + call InitEvolvePDF(nset,imem) + call H1pdf(imem) + endif +#endif +#ifdef NNPDF + if (name(nset).eq.'NNPDF') then + call InitEvolvePDF(nset,imem) + call NNPDFpdf(nset) + endif + if (name(nset).eq.'NNPDFint') then + call InitEvolvePDF(nset,imem) + call NNPDFINTpdf(imem) + endif + if (name(nset).eq.'NNPDF20int') then + call InitEvolvePDF(nset,imem) + call NNPDFINT20pdf(imem) + endif + if (name(nset).eq.'NNPDF20intqed') then + call InitEvolvePDF(nset,imem) + call NNPDFINT20qedpdf(imem) + endif +#endif +#ifdef MSTW + if (name(nset).eq.'MSTWgrid') call MSTWpdf(imem) +#endif +#ifdef GJR + if (name(nset)(1:5).eq.'GJR08') call GJRpdf(imem) +#endif +#ifdef ALEKHIN + if (name(nset).eq.'A02M') call A02Mpdf(imem) + if (name(nset).eq.'ABKM09') call ABKM09pdf(imem) + if (name(nset).eq.'ABM11') call ABM11pdf(imem) +#endif +#ifdef HKN + if (name(nset).eq.'HKNgrid') call hknpdf(imem) +#endif +#ifdef PHOTONS +! if (name(nset).eq.'GRV0' .OR. & +! & name(nset).eq.'GRV1') call GRVpdf(imem) + if (name(nset).eq.'SASG') call SASGpdf(imem) + if (name(nset).eq.'GRVG') call GRVGpdf(imem) + if (name(nset).eq.'DOG0' .OR. & + & name(nset).eq.'DOG1') call DOGpdf(imem) + if (name(nset).eq.'DGG') call DGGpdf(imem) + if (name(nset).eq.'LACG') call LACGpdf(imem) + if (name(nset).eq.'GSG0' .OR. & + & name(nset).eq.'GSG1') call GSGpdf(imem) + if (name(nset).eq.'GSG960' .OR. & + & name(nset).eq.'GSG961') call GSG96pdf(imem) + if (name(nset).eq.'ACFGP') call ACFGPpdf(imem) + if (name(nset).eq.'WHITG') call WHITGpdf(imem) +#endif +#ifdef PIONS + if (name(nset).eq.'OWP') call OWPpdf(imem) + if (name(nset).eq.'SMRSP') call SMRSPpdf(imem) + if (name(nset).eq.'GRVP0' .OR. & + & name(nset).eq.'GRVP1') call GRVPpdf(imem) + if (name(nset).eq.'ABFKWP') call ABFKWPpdf(imem) +#endif +#ifdef USER + if (name(nset).eq.'USER') then + call InitEvolvePDF(nset,imem) + call USERpdf(imem) + endif + if (name(nset)(1:8).eq.'USERGRID') then + call InitEvolvePDF(nset,imem) + call USERGRIDpdf(imem) + endif +#endif + return +! + entry getGridM(nset,nxgrid,nqgrid,gridx,gridq) +#ifdef MRST + if(name(nset).eq.'MRSTgrid') call MRSTgetgrid(nset,nxgrid,nqgrid,gridx,gridq) + if(name(nset).eq.'MRST3grid') call MRSTgetgrid(nset,nxgrid,nqgrid,gridx,gridq) + if(name(nset).eq.'MRST4grid') call MRSTgetgrid(nset,nxgrid,nqgrid,gridx,gridq) +#endif +#ifdef MRSTQED + if(name(nset).eq.'MRST4qed') call MRSTqedgetgrid(nset,nxgrid,nqgrid,gridx,gridq) +#endif +#ifdef MRST98 + if(name(nset).eq.'MRST98grid') call MRST98getgrid(nset,nxgrid,nqgrid,gridx,gridq) +#endif +#ifdef MRST06 + if(name(nset).eq.'MRST2006grid') call MRST2006getgrid(nset,nxgrid,nqgrid,gridx,gridq) +#endif +#ifdef MSTW + if(name(nset).eq.'MSTWgrid') call MSTWgetgrid(nset,nxgrid,nqgrid,gridx,gridq) +#endif +#ifdef CTEQ + if (name(nset).eq.'CTEQ6grid') call CTEQ6getgrid(nset,nxgrid,nqgrid,gridx,gridq) + if (name(nset).eq.'CTEQ6ABgrid') call CTEQ6getgrid(nset,nxgrid,nqgrid,gridx,gridq) + if (name(nset).eq.'CTEQ5grid') call CTEQ5getgrid(nset,nxgrid,nqgrid,gridx,gridq) + if (name(nset).eq.'CTEQ65grid') call CTEQ65getgrid(nset,nxgrid,nqgrid,gridx,gridq) + if (name(nset).eq.'CTEQ65cgrid') call CTEQ65getgrid(nset,nxgrid,nqgrid,gridx,gridq) + if (name(nset).eq.'CTEQ65sgrid') call CTEQ65getgrid(nset,nxgrid,nqgrid,gridx,gridq) + if (name(nset).eq.'CTEQ66grid') call CTEQ65getgrid(nset,nxgrid,nqgrid,gridx,gridq) + if (name(nset).eq.'CT10grid') call CT12getgrid(nset,nxgrid,nqgrid,gridx,gridq) + if (name(nset).eq.'CT12grid') call CT12getgrid(nset,nxgrid,nqgrid,gridx,gridq) +#endif +#ifdef NNPDF +! if (name(nset).eq.'NNPDFint') call NNPDFINTgetgrid(nset,nxgrid,nqgrid,gridx,gridq) + if (name(nset).eq.'NNPDF20int') call NNPDFINT20getgrid(nset,nxgrid,nqgrid,gridx,gridq) + if (name(nset).eq.'NNPDF20qedint') call NNPDFINT20qedgetgrid(nset,nxgrid,nqgrid,gridx,gridq) +#endif +#ifdef HERA + if (name(nset)(1:8).eq.'HERAGRID') call HERAGRIDgetgrid(nset,nxgrid,nqgrid,gridx,gridq) +#endif +#ifdef ALEKHIN + if (name(nset).eq.'A02M') call A02Mgetgrid(nset,nxgrid,nqgrid,gridx,gridq) + if (name(nset).eq.'ABKM09') call ABKM09getgrid(nset,nxgrid,nqgrid,gridx,gridq) + if (name(nset).eq.'ABM11') call ABM11getgrid(nset,nxgrid,nqgrid,gridx,gridq) +#endif +#ifdef GJR + if (name(nset)(1:5).eq.'GJR08') call GJRgetgrid(nset,nxgrid,nqgrid,gridx,gridq) +#endif +#ifdef H1 + if (name(nset).eq.'H12000') call H1getgrid(nset,nxgrid,nqgrid,gridx,gridq) +#endif +#ifdef HKN + if (name(nset).eq.'HKNgrid') call hkngetgrid(nset,nxgrid,nqgrid,gridx,gridq) +#endif + return + + end diff --git a/LHAPDF/lhapdf-5.9.1/src/wrapevolve.f b/LHAPDF/lhapdf-5.9.1/src/wrapevolve.f new file mode 100644 index 00000000000..98bac22a949 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/wrapevolve.f @@ -0,0 +1,884 @@ +! -*- F90 -*- + + + subroutine evolvePDF(x,Q,f) + implicit none + include 'parmsetup.inc' + real*8 gridx(nmxgridx),gridq(nmxgridq) + integer nxgrid,nqgrid + integer nset,imem,Eorder,IP2 + real*8 x,Q,P2,Q2fit,f(-6:6),alfas,a,photon,gluino + nset = 1 + call evolvePDFM(nset,x,Q,f) + return +! + entry evolvePDFp(x,Q,P2,IP2,f) + nset = 1 + call evolvePDFpM(nset,x,Q,P2,IP2,f) + return +! + entry evolvePDFa(x,Q,a,f) + nset = 1 + call evolvePDFaM(nset,x,Q,a,f) + return +! + entry evolvePDFphoton(x,Q,f,photon) + nset = 1 + call evolvePDFphotonM(nset,x,Q,f,photon) + return +! + entry evolvePDFgluino(x,Q,f,gluino) + nset = 1 + call evolvePDFgluinoM(nset,x,Q,f,gluino) + return +! + entry initPDF(imem) + nset = 1 + call initPDFM(nset,imem) + return + + entry getgrid(nxgrid,nqgrid,gridx,gridq) + nset = 1 + call getgridM(nset,nxgrid,nqgrid,gridx,gridq) + + return + END +! + subroutine evolvePDFaM(nset,xin,Qin,a,f) + implicit none + real*8 x,Q,a,f(-6:6) + real*8 ruv,rdv,ru,rd,rs,rc,rb,rt,rg + integer nset,iimem,j + real*8 xin,qin,q2in + character*20 lparm + real*8 xmin,xmax,q2min,q2max + integer iorder,ipset,ia + + + call getlhaparm(18,lparm) + if(lparm.ne.'EXTRAPOLATE') then + call getnmem(nset,iimem) + call getminmaxm(nset,iimem,xmin,xmax,q2min,q2max) + x = max(xmin,min(xmax,xin)) + q2in = qin**2 + q = sqrt(max(0d0,q2min,min(q2max,q2in))) + else + x = xin + q = qin + endif + + call getlhaparm(15,lparm) + if(lparm.eq.'EPS08') then + call eps08(x,q,a,ruv,rdv,ru,rd,rs,rc,rb,rt,rg) + else if(lparm(1:5).eq.'EPS09') then + if(lparm.eq.'EPS09LO') then + iorder=1 + ipset=1 + else if(lparm.eq.'EPS09NLO') then + iorder=2 + ipset=1 + else if(lparm(1:8).eq.'EPS09LO,') then + iorder=1 + read(lparm(9:),*)ipset + else if(lparm(1:9).eq.'EPS09NLO,') then + iorder=2 + read(lparm(10:),*)ipset + else + iorder=2 + ipset=1 + endif + ia = a + call eps09(iorder,ipset,ia,x,q,ruv,rdv,ru,rd,rs,rc,rb,rg) + rt = 1.0d0 + else + call eks98(x,q,a,ruv,rdv,ru,rd,rs,rc,rb,rt,rg) + endif + + call evolvePDFM(nset,x,Q,f) + f(0) = f(0)*rg + f(1) = f(1)*rdv-f(-1)*(rdv-rd) + f(2) = f(2)*ruv-f(-2)*(ruv-ru) + f(3) = f(3)*rs + f(4) = f(4)*rc + f(5) = f(5)*rb + f(6) = f(6)*rt + f(-6) = f(-6)*rt + f(-5) = f(-5)*rb + f(-4) = f(-4)*rc + f(-3) = f(-3)*rs + f(-2) = f(-2)*ru + f(-1) = f(-1)*rd + + return + end +! + subroutine evolvePDFM(nset,xin,Qin,f) + implicit none + include 'parmsetup.inc' + integer Eorder,index,imem + character*16 name(nmxset) + integer nmem(nmxset),ndef(nmxset),mem,ip2 + common/NAME/name,nmem,ndef,mem + integer iset,iimem + common/SET/iset,iimem + integer nset,j + real*8 x,xin,Q,Qin,Q2fit,alfas,p2,q2in + real*8 f(-6:6),photon,gluino,xphoton + character*20 lparm + real*8 xmin,xmax,q2min,q2max + real*8 gridx(nmxgridx),gridq(nmxgridq) + integer nxgrid,nqgrid + character*512 setpath + integer nnpdf,nnpdf100,nnpdf1000 + data nnpdf,nnpdf100,nnpdf1000/0,0,0/ + save +! + call setnset(nset) +! +! print *,'this is evolvePDFM, name=',nset,name(nset) +! set all f's to 0.0d0 at start +! do j = -6,6 +! f(j) = 0.0d0 +! enddo + + call getlhaparm(18,lparm) + if(lparm.ne.'EXTRAPOLATE') then + call getnmem(nset,iimem) + call getminmaxm(nset,iimem,xmin,xmax,q2min,q2max) + x = max(xmin,min(xmax,xin)) + q2in = qin**2 + q = sqrt(max(0d0,q2min,min(q2max,q2in))) + else + x = xin + q = qin + endif + +#ifdef QCDNUM + if (name(nset).eq.'QCDNUM') call QCDNUMevolve(x,Q,f) + if (name(nset).eq.'QCDNUM_MRST') call QCDNUMevolve(x,Q,f) + if (name(nset).eq.'QCDNUM_MRST3') call QCDNUM3evolve(x,Q,f) + if (name(nset).eq.'QCDNUM_MRST4') call QCDNUM4evolve(x,Q,f) +#endif +#ifdef GRV + if (name(nset).eq.'GRV') call GRVevolve(x,Q,f) +#endif +#ifdef ZEUS + if (name(nset)(1:12).eq.'QCDNUM_ZEUS_') call ZEUSevolve(x,Q,f) +#endif +#ifdef HERA + if (name(nset)(1:12).eq.'QCDNUM_HERA_') call HERAevolve(x,Q,f) + if (name(nset)(1:8).eq.'HERAGRID') call HERAGRIDevolve(x,Q,f) +#endif +#ifdef CTEQ + if (name(nset).eq.'EVLCTEQ') call EVLCTEQevolve(x,Q,f) + if (name(nset).eq.'CTEQ5grid') call CTEQ5evolve(x,Q,f) + if (name(nset).eq.'CTEQ6grid') call CTEQ6evolve(x,Q,f) + if (name(nset).eq.'CTEQ65grid') call CTEQ65evolve(x,Q,f) + if (name(nset).eq.'CTEQ65cgrid') call CTEQ65cevolve(x,Q,f) + if (name(nset).eq.'CTEQ65sgrid') call CTEQ65sevolve(x,Q,f) + if (name(nset).eq.'CTEQ6ABgrid') call CTEQ6evolve(x,Q,f) + if (name(nset).eq.'CTEQ66grid') call CTEQ65evolve(x,Q,f) + if (name(nset).eq.'CT10grid') call CT12evolve(x,Q,f) + if (name(nset).eq.'CT12grid') call CT12evolve(x,Q,f) +#endif +#ifdef MRST + if (name(nset).eq.'MRST') call QCDNUMevolve(x,Q,f) + if (name(nset).eq.'MRSTpdf') call QCDNUMevolve(x,Q,f) + if (name(nset).eq.'MRSTgrid') call MRSTevolve(x,Q,f) + if (name(nset).eq.'MRST3grid') call MRSTevolve(x,Q,f) + if (name(nset).eq.'MRST4grid') call MRSTevolve(x,Q,f) +#endif +#ifdef MRSTQED + if (name(nset).eq.'MRST4qed') call MRSTqedevolve(x,Q,f,xphoton) +#endif +#ifdef MRST98 + if (name(nset).eq.'MRST98grid') call MRST98evolve(x,Q,f) +#endif +#ifdef MRST06 + if (name(nset).eq.'MRST2006grid') call MRST2006evolve(x,Q,f) +#endif +#ifdef MSTW + if (name(nset).eq.'MSTWgrid') call MSTWevolve(x,Q,f,xphoton) +#endif +#ifdef ALEKHIN + if (name(nset).eq.'A02M') call A02Mevolve(x,Q,f) + if (name(nset).eq.'ABKM09') call ABKM09evolve(x,Q,f) + if (name(nset).eq.'ABM11') call ABM11evolve(x,Q,f) +#endif +#ifdef H1 + if (name(nset).eq.'H12000') call H1evolve(x,Q,f) +#endif +#ifdef GJR + if (name(nset)(1:5).eq.'GJR08') call GJRevolve(x,Q,f) +#endif +#ifdef NNPDF + if (name(nset).eq.'NNPDF') call NNPDFevolve(x,Q,f) + if (name(nset).eq.'NNPDFint') call NNPDFINTevolve(x,Q,f) + if (name(nset).eq.'NNPDF20int') call NNPDFINT20evolve(x,Q,f) + if (name(nset).eq.'NNPDF20intqed') call NNPDFINT20qedevolve(x,Q,f,xphoton) +#endif +#ifdef HKN + if (name(nset).eq.'HKNgrid') call hknevolve(x,Q,f) +#endif +#ifdef PIONS + if (name(nset).eq.'OWP') call OWPevolve(x,Q,f) + if (name(nset).eq.'SMRSP') call SMRSPevolve(x,Q,f) + if (name(nset).eq.'GRVP0') call GRVP0evolve(x,Q,f) + if (name(nset).eq.'GRVP1') call GRVP1evolve(x,Q,f) + if (name(nset).eq.'ABFKWP') call ABFKWPevolve(x,Q,f) +#endif +#ifdef USER + if (name(nset).eq.'USER') call USERevolve(x,Q,f) + if (name(nset)(1:8).eq.'USERGRID') call USERGRIDevolve(x,Q,f) +#endif + return +! + entry evolvePDFpM(nset,xin,Qin,P2,IP2,f) +! + call setnset(nset) +! + call getlhaparm(18,lparm) + if(lparm.ne.'EXTRAPOLATE') then + call getnmem(nset,iimem) + call getminmaxm(nset,iimem,xmin,xmax,q2min,q2max) + x = max(xmin,min(xmax,xin)) + q2in = qin**2 + q = sqrt(max(0d0,q2min,min(q2max,q2in))) + else + x = xin + q = qin + endif +! +#ifdef PHOTONS + if(name(nset).eq.'SASG') call SASGevolvep(x,Q,P2,IP2,f) + if(name(nset).eq.'GRVG0') call GRVGevolvep0(x,Q,P2,IP2,f) + if(name(nset).eq.'GRVG1') call GRVGevolvep1(x,Q,P2,IP2,f) + if (name(nset).eq.'DOG0') call DOGevolvep0(x,Q,P2,IP2,f) + if (name(nset).eq.'DOG1') call DOGevolvep1(x,Q,P2,IP2,f) + if (name(nset).eq.'DGG') call DGGevolvep(x,Q,P2,IP2,f) + if (name(nset).eq.'LACG') call LACGevolvep(x,Q,P2,IP2,f) + if (name(nset).eq.'GSG0') call GSGevolvep0(x,Q,P2,IP2,f) + if (name(nset).eq.'GSG1') call GSGevolvep1(x,Q,P2,IP2,f) + if (name(nset).eq.'GSG960') call GSG96evolvep0(x,Q,P2,IP2,f) + if (name(nset).eq.'GSG961') call GSG96evolvep1(x,Q,P2,IP2,f) + if (name(nset).eq.'ACFGP') call ACFGPevolvep(x,Q,P2,IP2,f) + if (name(nset).eq.'WHITG') call WHITGevolvep(x,Q,P2,IP2,f) +#endif + return +! + entry evolvePDFphotonM(nset,xin,qin,f,photon) + +! + call setnset(nset) +! + call getlhaparm(18,lparm) + if(lparm.ne.'EXTRAPOLATE') then + call getnmem(nset,iimem) + call getminmaxm(nset,iimem,xmin,xmax,q2min,q2max) + x = max(xmin,min(xmax,xin)) + q2in = qin**2 + q = sqrt(max(0d0,q2min,min(q2max,q2in))) + else + x = xin + q = qin + endif +! +#ifdef MRSTQED + if(name(nset).eq.'MRST4qed') then + call MRSTqedevolve(x,Q,f,photon) + else if (name(nset).ne.'NNPDF20intqed') then + photon = 0.0d0 + endif +#endif +! +#ifdef NNPDF + if(name(nset).eq.'NNPDF20intqed') then + call NNPDFINT20qedevolve(x,Q,f,photon) + else if (name(nset).ne.'MRST4qed') then + photon = 0.0d0 + endif +#endif +! + return + + entry evolvePDFgluinoM(nset,xin,qin,f,gluino) + +! + call setnset(nset) +! + call getlhaparm(18,lparm) + if(lparm.ne.'EXTRAPOLATE') then + call getnmem(nset,iimem) + call getminmaxm(nset,iimem,xmin,xmax,q2min,q2max) + x = max(xmin,min(xmax,xin)) + q2in = qin**2 + q = sqrt(max(0d0,q2min,min(q2max,q2in))) + else + x = xin + q = qin + endif +! +#ifdef CTEQ + if(name(nset).eq.'CTEQ6LGgrid') then + call CTEQ6LGevolve(x,Q,f,gluino) + else + gluino = 0.0d0 + endif +#endif + return + + + entry readevolve(nset) +! + call getsetpath(setpath) +! + if(index(setpath,'NNPDF').gt.0) then + if(nset.gt.1) then + if((index(setpath,'1000.').gt.0.and.nnpdf.gt.0).or.(index(setpath,'100.').gt.0.and.nnpdf1000.gt.0)) then + print *,'LHAPDF ERROR: MULTISET-INITIALIZATION with NNPDF 1000 sets IS NOT AVAIABLE (AT THE MOMENT)!' + STOP + endif + endif + nnpdf=nnpdf+1 + if(index(setpath,'1000').gt.0) then + nnpdf1000=nnpdf1000+1 + else + nnpdf100=nnpdf100+1 + endif + endif + +! + read(1,*) name(nset) +! print *, 'this is readevolve', name(nset) +! + call setnset(nset) +! +#ifdef QCDNUM + if (name(nset).eq.'QCDNUM') call QCDNUMread(nset) + if (name(nset).eq.'QCDNUM_MRST') call QCDNUMread(nset) + if (name(nset).eq.'QCDNUM_MRST3') call QCDNUM3read(nset) + if (name(nset).eq.'QCDNUM_MRST4') call QCDNUM4read(nset) +#endif +#ifdef GRV + if (name(nset).eq.'GRV') call GRVread(nset) +#endif +#ifdef ZEUS + if (name(nset)(1:12).eq.'QCDNUM_ZEUS_') call ZEUSread(nset) +#endif +#ifdef HERA + if (name(nset)(1:12).eq.'QCDNUM_HERA_') call HERAread(nset) + if (name(nset)(1:8).eq.'HERAGRID') call HERAGRIDread(nset) +#endif +#ifdef CTEQ + if (name(nset).eq.'EVLCTEQ') call EVLCTEQread(nset) + if (name(nset).eq.'CTEQ5grid') call CTEQ5read(nset) + if (name(nset).eq.'CTEQ6grid') call CTEQ6read(nset) + if (name(nset).eq.'CTEQ65grid') call CTEQ65read(nset) + if (name(nset).eq.'CTEQ65cgrid') call CTEQ65cread(nset) + if (name(nset).eq.'CTEQ65sgrid') call CTEQ65read(nset) + if (name(nset).eq.'CTEQ6ABgrid') call CTEQ6read(nset) + if (name(nset).eq.'CTEQ66grid') call CTEQ66read(nset) + if (name(nset).eq.'CTEQ6LGgrid') call CTEQ6LGread(nset) + if (name(nset).eq.'CT10grid') call CT12read(nset) + if (name(nset).eq.'CT12grid') call CT12read(nset) +#endif +#ifdef MRST + if (name(nset).eq.'MRST') call QCDNUMread(nset) + if (name(nset).eq.'MRSTpdf') call QCDNUMread(nset) + if (name(nset).eq.'MRSTgrid') call MRSTread(nset) + if (name(nset).eq.'MRST3grid') call MRSTread(nset) + if (name(nset).eq.'MRST4grid') call MRSTread(nset) +#endif +#ifdef MRSTQED + if (name(nset).eq.'MRST4qed') call MRSTqedread(nset) +#endif +#ifdef MRST98 + if (name(nset).eq.'MRST98grid') call MRST98read(nset) +#endif +#ifdef MRST06 + if (name(nset).eq.'MRST2006grid') call MRST2006read(nset) +#endif +#ifdef MSTW + if (name(nset).eq.'MSTWgrid') call MSTWread(nset) +#endif +#ifdef ALEKHIN + if (name(nset).eq.'A02M') call A02Mread(nset) + if (name(nset).eq.'ABKM09') call ABKM09read(nset) + if (name(nset).eq.'ABM11') call ABM11read(nset) +#endif +#ifdef H1 + if (name(nset).eq.'H12000') call H1read(nset) +#endif +#ifdef GJR + if (name(nset)(1:5).eq.'GJR08') call GJRread(nset) +#endif +#ifdef NNPDF + if (name(nset).eq.'NNPDF') call NNPDFread(nset) + if (name(nset).eq.'NNPDFint') call NNPDFINTread(nset) + if (name(nset).eq.'NNPDF20int') call NNPDFINT20read(nset) + if (name(nset).eq.'NNPDF20intqed') call NNPDFINT20qedread(nset) +#endif +#ifdef HKN + if (name(nset).eq.'HKNgrid') call hknread(nset) +#endif +#ifdef PHOTONS + if (name(nset).eq.'SASG') call SASGread(nset) + if (name(nset).eq.'GRVG0' .OR. & + & name(nset).eq.'GRVG1') call GRVGread(nset) + if (name(nset).eq.'DOG0' .OR. & + & name(nset).eq.'DOG1') call DOGread(nset) + if (name(nset).eq.'DGG') call DGGread(nset) + if (name(nset).eq.'LACG') call LACGread(nset) + if (name(nset).eq.'GSG0' .OR. & + & name(nset).eq.'GSG1') call GSGread(nset) + if (name(nset).eq.'GSG960' .OR. & + & name(nset).eq.'GSG961') call GSG96read(nset) + if (name(nset).eq.'ACFGP') call ACFGPread(nset) + if (name(nset).eq.'WHITG') call WHITGread(nset) +#endif +#ifdef PIONS + if (name(nset).eq.'OWP') call OWPread(nset) + if (name(nset).eq.'SMRSP') call SMRSPread(nset) + if (name(nset).eq.'GRVP0' .OR. & + & name(nset).eq.'GRVP1') call GRVPread(nset) + if (name(nset).eq.'ABFKWP') call ABFKWPread(nset) +#endif +#ifdef USER + if (name(nset).eq.'USER') call USERread(nset) + if (name(nset)(1:8).eq.'USERGRID') call USERGRIDread(nset) +#endif + return +! + entry alfasevolve(nset,alfas,Qin) +! + call setnset(nset) + q = qin +#ifdef QCDNUM + if (name(nset).eq.'QCDNUM') call QCDNUMalfa(alfas,Q) + if (name(nset).eq.'QCDNUM_MRST') call QCDNUMalfa(alfas,Q) + if (name(nset).eq.'QCDNUM_MRST3') call QCDNUM3alfa(alfas,Q) + if (name(nset).eq.'QCDNUM_MRST4') call QCDNUM4alfa(alfas,Q) +#endif +#ifdef GRV + if (name(nset).eq.'GRV') call GRValfa(alfas,Q) +#endif +#ifdef ZEUS + if (name(nset)(1:12).eq.'QCDNUM_ZEUS_') call ZEUSalfa(alfas,Q) +#endif +#ifdef HERA + if (name(nset)(1:12).eq.'QCDNUM_HERA_') call HERAalfa(alfas,Q) + if (name(nset)(1:8).eq.'HERAGRID') call HERAGRIDalfa(alfas,Q) +#endif +#ifdef CTEQ + if (name(nset).eq.'EVLCTEQ') call EVLCTEQalfa(alfas,Q) + if (name(nset).eq.'CTEQ5grid') call CTEQ5alfa(alfas,Q) + if (name(nset).eq.'CTEQ6grid') call CTEQ6alfa(alfas,Q) + if (name(nset).eq.'CTEQ65grid') call CTEQ65alfa(alfas,Q) + if (name(nset).eq.'CTEQ65cgrid') call CTEQ65alfa(alfas,Q) + if (name(nset).eq.'CTEQ65sgrid') call CTEQ65alfa(alfas,Q) + if (name(nset).eq.'CTEQ66grid') call CTEQ65alfa(alfas,Q) + if (name(nset).eq.'CTEQ6LGgrid') call CTEQ6LGalfa(alfas,Q) + if (name(nset).eq.'CT10grid') call CT12alfa(alfas,Q) + if (name(nset).eq.'CT12grid') call CT12alfa(alfas,Q) +#endif +#ifdef MRST + if (name(nset).eq.'MRST') call QCDNUMalfa(alfas,Q) + if (name(nset).eq.'MRSTpdf') call QCDNUMalfa(alfas,Q) + if (name(nset).eq.'MRSTgrid') call MRSTalfa(5,alfas,Q) + if (name(nset).eq.'MRST3grid') call MRSTalfa(3,alfas,Q) + if (name(nset).eq.'MRST4grid') call MRSTalfa(4,alfas,Q) +#endif +#ifdef MRSTQED + if (name(nset).eq.'MRST4qed') call MRSTqedalfa(4,alfas,Q) +#endif +#ifdef MRST98 + if (name(nset).eq.'MRST98grid') call MRST98alfa(alfas,Q) +#endif +#ifdef MRST06 + if (name(nset).eq.'MRST2006grid') call MRST2006alfa(5,alfas,Q) +#endif +#ifdef MSTW + if (name(nset).eq.'MSTWgrid') call MSTWalfa(alfas,Q) +#endif +#ifdef ALEKHIN + if (name(nset).eq.'A02M') call A02Malfa(alfas,Q) + if (name(nset).eq.'ABKM09') call ABKM09alfa(alfas,Q) + if (name(nset).eq.'ABM11') call ABM11alfa(alfas,Q) +#endif +#ifdef H1 + if (name(nset).eq.'H12000') call H1alfa(alfas,Q) +#endif +#ifdef GJR + if (name(nset)(1:5).eq.'GJR08') call GJRalfa(alfas,Q) +#endif +#ifdef NNPDF + if (name(nset).eq.'NNPDF') call NNPDFalfa(alfas,Q) + if (name(nset).eq.'NNPDFint') call NNPDFINTalfa(alfas,Q) + if (name(nset).eq.'NNPDF20int') call NNPDFINT20alfa(alfas,Q) + if (name(nset).eq.'NNPDF20intqed') call NNPDFINT20qedalfa(alfas,Q) +#endif +#ifdef HKN + if (name(nset).eq.'HKNgrid') call hknalfa(alfas,Q) +#endif +#ifdef PHOTONS + if (name(nset).eq.'SASG') call SASGalfa(alfas,Q) + if (name(nset).eq.'GRVG0' .OR. & + & name(nset).eq.'GRVG1') call GRVGalfa(alfas,Q) + if (name(nset).eq.'DOG0' .OR. & + & name(nset).eq.'DOG1') call DOGalfa(alfas,Q) + if (name(nset).eq.'DGG') call DGGalfa(alfas,Q) + if (name(nset).eq.'LACG') call LACGalfa(alfas,Q) + if (name(nset).eq.'GSG0' .OR. & + & name(nset).eq.'GSG1') call GSGalfa(alfas,Q) + if (name(nset).eq.'GSG960' .OR. & + & name(nset).eq.'GSG961') call GSG96alfa(alfas,Q) + if (name(nset).eq.'ACFGP') call ACFGPalfa(alfas,Q) + if (name(nset).eq.'WHITG') call WHITGalfa(alfas,Q) +#endif +#ifdef PIONS + if (name(nset).eq.'OWP') call OWPalfa(alfas,Q) + if (name(nset).eq.'SMRSP') call SMRSPalfa(alfas,Q) + if (name(nset).eq.'GRVP0' .OR. & + & name(nset).eq.'GRVP1') call GRVPalfa(alfas,Q) + if (name(nset).eq.'ABFKWP') call ABFKWPalfa(alfas,Q) +#endif +#ifdef USER + if (name(nset).eq.'USER') call USERalfa(alfas,Q) + if (name(nset)(1:8).eq.'USERGRID') call USERGRIDalfa(alfas,Q) +#endif + return +! + entry initevolution(nset,Eorder,Q2fit) +! + call setnset(nset) +! +#ifdef QCDNUM + if (name(nset).eq.'QCDNUM') call QCDNUMinit(nset,Eorder,Q2fit) + if (name(nset).eq.'QCDNUM_MRST') then + call QCDNUMinit(nset,Eorder,Q2fit) + call QNLSET('BMARK',.TRUE.) + endif + if (name(nset).eq.'QCDNUM_MRST3') then + call QCDNUM3init(nset,Eorder,Q2fit) + call QNLSET('BMARK',.TRUE.) + endif + if (name(nset).eq.'QCDNUM_MRST4') then + call QCDNUM4init(nset,Eorder,Q2fit) + call QNLSET('BMARK',.TRUE.) + endif +#endif +#ifdef GRV + if (name(nset).eq.'GRV') call GRVinit(Eorder,Q2fit) +#endif +#ifdef ZEUS + if (name(nset)(1:12).eq.'QCDNUM_ZEUS_') & + & call ZEUSinit(nset,Eorder,Q2fit) +#endif +#ifdef HERA + if (name(nset)(1:12).eq.'QCDNUM_HERA_') & + & call HERAinit(nset,Eorder,Q2fit) + if (name(nset)(1:8).eq.'HERAGRID')call HERAGRIDinit(nset,Eorder,Q2fit) +#endif +#ifdef CTEQ + if (name(nset).eq.'EVLCTEQ') call EVLCTEQinit(nset,Eorder,Q2fit) + if (name(nset).eq.'CTEQ5grid') call CTEQ5init(Eorder,Q2fit) + if (name(nset).eq.'CTEQ6grid') call CTEQ6init(Eorder,Q2fit) + if (name(nset).eq.'CTEQ65grid') call CTEQ65init(Eorder,Q2fit) + if (name(nset).eq.'CTEQ65cgrid') call CTEQ65init(Eorder,Q2fit) + if (name(nset).eq.'CTEQ65sgrid') call CTEQ65init(Eorder,Q2fit) + if (name(nset).eq.'CTEQ66grid') call CTEQ65init(Eorder,Q2fit) + if (name(nset).eq.'CTEQ6LGgrid') call CTEQ6LGinit(Eorder,Q2fit) + if (name(nset).eq.'CT10grid') call CT12init(Eorder,Q2fit) + if (name(nset).eq.'CT12grid') call CT12init(Eorder,Q2fit) +#endif +#ifdef MRST + if (name(nset).eq.'MRSTgrid') call MRSTinit(Eorder,Q2fit) + if (name(nset).eq.'MRST3grid') call MRSTinit(Eorder,Q2fit) + if (name(nset).eq.'MRST4grid') call MRSTinit(Eorder,Q2fit) +#endif +#ifdef MRSTQED + if (name(nset).eq.'MRST4qed') call MRSTqedinit(Eorder,Q2fit) +#endif +#ifdef MRST98 + if (name(nset).eq.'MRST98grid') call MRST98init(Eorder,Q2fit) +#endif +#ifdef MRST06 + if (name(nset).eq.'MRST2006grid') call MRST2006init(Eorder,Q2fit) +#endif +#ifdef MSTW + if (name(nset).eq.'MSTWgrid') call MSTWinit(Eorder,Q2fit) +#endif +#ifdef ALEKHIN + if (name(nset).eq.'A02M') call A02Minit + if (name(nset).eq.'ABKM09') call ABKM09init + if (name(nset).eq.'ABM11') call ABM11init +#endif +#ifdef H1 + if (name(nset).eq.'H12000') call H1init(Eorder,Q2fit) +#endif +#ifdef GJR + if (name(nset)(1:5).eq.'GJR08') call GJRinit(Eorder,Q2fit) +#endif +#ifdef NNPDF + if (name(nset).eq.'NNPDF') call NNPDFinit(nset,Eorder,Q2fit) + if (name(nset).eq.'NNPDFint') call NNPDFINTinit(nset,Eorder,Q2fit) + if (name(nset).eq.'NNPDF20int') call NNPDFINT20init(nset,Eorder,Q2fit) + if (name(nset).eq.'NNPDF20intqed') call NNPDFINT20qedinit(nset,Eorder,Q2fit) +#endif +#ifdef PHOTONS + if (name(nset).eq.'SASG') call SASGinit(Eorder,Q2fit) + if (name(nset).eq.'GRVG0' .OR. & + & name(nset).eq.'GRVG1') call GRVGinit(Eorder,Q2fit) + if (name(nset).eq.'DOG0' .OR. & + & name(nset).eq.'DOG1') call DOGinit(Eorder,Q2fit) + if (name(nset).eq.'DGG') call DGGinit(Eorder,Q2fit) + if (name(nset).eq.'LACG') call LACGinit(Eorder,Q2fit) + if (name(nset).eq.'GSG0' .OR. & + & name(nset).eq.'GSG1') call GSGinit(Eorder,Q2fit) + if (name(nset).eq.'GSG960' .OR. & + & name(nset).eq.'GSG961') call GSG96init(Eorder,Q2fit) + if (name(nset).eq.'ACFGP') call ACFGPinit(Eorder,Q2fit) + if (name(nset).eq.'WHITG') call WHITGinit(Eorder,Q2fit) +#endif +#ifdef PIONS + if (name(nset).eq.'OWP') call OWPinit(Eorder,Q2fit) + if (name(nset).eq.'SMRSP') call SMRSPinit(Eorder,Q2fit) + if (name(nset).eq.'GRVP0' .OR. & + & name(nset).eq.'GRVP1') call GRVPinit(Eorder,Q2fit) + if (name(nset).eq.'ABFKWP') call ABFKWPinit(Eorder,Q2fit) +#endif +#ifdef HKN + if (name(nset).eq.'HKNgrid') call hkninit(nset,Eorder,Q2fit) +#endif +#ifdef USER + if (name(nset).eq.'USER') call USERinit(nset,Eorder,Q2fit) + if (name(nset)(1:8).eq.'USERGRID') call USERGRIDinit(nset,Eorder,Q2fit) +#endif + return +! + entry initPDFM(nset,imem) +! + call setnset(nset) + call setnmem(nset,imem) +! + iimem = imem +#ifdef QCDNUM + if (name(nset).eq.'QCDNUM') then + call InitEvolvePDF(nset,imem) + call QCDNUMpdf(nset) + endif + if (name(nset).eq.'QCDNUM_MRST') then + call InitEvolvePDF(nset,imem) + call QCDNUMpdf(nset) + endif + if (name(nset).eq.'QCDNUM_MRST3') then + call InitEvolvePDF(nset,imem) + call QCDNUM3pdf(nset) + endif + if (name(nset).eq.'QCDNUM_MRST4') then + call InitEvolvePDF(nset,imem) + call QCDNUM4pdf(nset) + endif +#endif +#ifdef ZEUS + if (name(nset)(1:12).eq.'QCDNUM_ZEUS_') then + call InitEvolvePDF(nset,imem) + call ZEUSpdf(nset) + endif +#endif +#ifdef HERA + if (name(nset)(1:12).eq.'QCDNUM_HERA_') then + call InitEvolvePDF(nset,imem) + call HERApdf(nset) + endif + if (name(nset)(1:8).eq.'HERAGRID') call HERAGRIDpdf(imem) +#endif +#ifdef MRST + if (name(nset).eq.'MRST') then + call InitEvolvePDF(nset,imem) + call QCDNUMpdf(nset) + endif + if (name(nset).eq.'MRSTpdf') then + call InitEvolvePDF(nset,imem) + call QCDNUMpdf(nset) + endif + if (name(nset).eq.'MRSTgrid') call MRSTpdf(imem) + if (name(nset).eq.'MRST3grid') call MRSTpdf(imem) + if (name(nset).eq.'MRST4grid') call MRSTpdf(imem) +#endif +#ifdef MRSTQED + if (name(nset).eq.'MRST4qed') call MRSTqedpdf(imem) +#endif +#ifdef MRST98 + if (name(nset).eq.'MRST98grid') call MRST98pdf(imem) +#endif +#ifdef MRST06 + if (name(nset).eq.'MRST2006grid') call MRST2006pdf(imem) +#endif +#ifdef CTEQ + if (name(nset).eq.'EVLCTEQ') then + call InitEvolvePDF(nset,imem) + call EVLCTEQpdf(nset) +! call EVLCTEQpdf(nset,imem) + endif + if (name(nset).eq.'CTEQ65grid') then + call CTEQ6NewAlpha(nset,imem) + endif + if (name(nset).eq.'CTEQ65cgrid') then + call CTEQ6NewAlpha(nset,imem) + endif + if (name(nset).eq.'CTEQ65sgrid') then + call CTEQ6NewAlpha(nset,imem) + endif + if (name(nset).eq.'CTEQ6ABgrid') then + call CTEQ6NewAlpha(nset,imem) +! call CTEQ6pdf(nset) + endif + if (name(nset).eq.'CTEQ66grid') then + call CTEQ6NewAlpha(nset,imem) + endif + if (name(nset).eq.'CT10grid') then + call CTEQ6NewAlpha(nset,imem) + endif + if (name(nset).eq.'CT12grid') then + call CTEQ6NewAlpha(nset,imem) + endif + if (name(nset).eq.'CTEQ5grid') call CTEQ5pdf(imem) + if (name(nset).eq.'CTEQ6grid') call CTEQ6pdf(imem) + if (name(nset).eq.'CTEQ65grid') call CTEQ65pdf(imem) + if (name(nset).eq.'CTEQ66grid') call CTEQ65pdf(imem) + if (name(nset).eq.'CTEQ65cgrid') call CTEQ65pdf(imem) + if (name(nset).eq.'CTEQ65sgrid') call CTEQ65pdf(imem) + if (name(nset).eq.'CTEQ6ABgrid') call CTEQ6pdf(imem) + if (name(nset).eq.'CTEQ66grid') call CTEQ65pdf(imem) + if (name(nset).eq.'CTEQ6LGgrid') call CTEQ6LGpdf(imem) + if (name(nset).eq.'CT10grid') call CT12pdf(imem) + if (name(nset).eq.'CT12grid') call CT12pdf(imem) +#endif +#ifdef H1 + if (name(nset).eq.'H12000') then + call InitEvolvePDF(nset,imem) + call H1pdf(imem) + endif +#endif +#ifdef NNPDF + if (name(nset).eq.'NNPDF') then + call InitEvolvePDF(nset,imem) + call NNPDFpdf(nset) + endif + if (name(nset).eq.'NNPDFint') then + call InitEvolvePDF(nset,imem) + call NNPDFINTpdf(imem) + endif + if (name(nset).eq.'NNPDF20int') then + call InitEvolvePDF(nset,imem) + call NNPDFINT20pdf(imem) + endif + if (name(nset).eq.'NNPDF20intqed') then + call InitEvolvePDF(nset,imem) + call NNPDFINT20qedpdf(imem) + endif +#endif +#ifdef MSTW + if (name(nset).eq.'MSTWgrid') call MSTWpdf(imem) +#endif +#ifdef GJR + if (name(nset)(1:5).eq.'GJR08') call GJRpdf(imem) +#endif +#ifdef ALEKHIN + if (name(nset).eq.'A02M') call A02Mpdf(imem) + if (name(nset).eq.'ABKM09') call ABKM09pdf(imem) + if (name(nset).eq.'ABM11') call ABM11pdf(imem) +#endif +#ifdef HKN + if (name(nset).eq.'HKNgrid') call hknpdf(imem) +#endif +#ifdef PHOTONS +! if (name(nset).eq.'GRV0' .OR. & +! & name(nset).eq.'GRV1') call GRVpdf(imem) + if (name(nset).eq.'SASG') call SASGpdf(imem) + if (name(nset).eq.'GRVG') call GRVGpdf(imem) + if (name(nset).eq.'DOG0' .OR. & + & name(nset).eq.'DOG1') call DOGpdf(imem) + if (name(nset).eq.'DGG') call DGGpdf(imem) + if (name(nset).eq.'LACG') call LACGpdf(imem) + if (name(nset).eq.'GSG0' .OR. & + & name(nset).eq.'GSG1') call GSGpdf(imem) + if (name(nset).eq.'GSG960' .OR. & + & name(nset).eq.'GSG961') call GSG96pdf(imem) + if (name(nset).eq.'ACFGP') call ACFGPpdf(imem) + if (name(nset).eq.'WHITG') call WHITGpdf(imem) +#endif +#ifdef PIONS + if (name(nset).eq.'OWP') call OWPpdf(imem) + if (name(nset).eq.'SMRSP') call SMRSPpdf(imem) + if (name(nset).eq.'GRVP0' .OR. & + & name(nset).eq.'GRVP1') call GRVPpdf(imem) + if (name(nset).eq.'ABFKWP') call ABFKWPpdf(imem) +#endif +#ifdef USER + if (name(nset).eq.'USER') then + call InitEvolvePDF(nset,imem) + call USERpdf(imem) + endif + if (name(nset)(1:8).eq.'USERGRID') then + call InitEvolvePDF(nset,imem) + call USERGRIDpdf(imem) + endif +#endif + return +! + entry getGridM(nset,nxgrid,nqgrid,gridx,gridq) +#ifdef MRST + if(name(nset).eq.'MRSTgrid') call MRSTgetgrid(nset,nxgrid,nqgrid,gridx,gridq) + if(name(nset).eq.'MRST3grid') call MRSTgetgrid(nset,nxgrid,nqgrid,gridx,gridq) + if(name(nset).eq.'MRST4grid') call MRSTgetgrid(nset,nxgrid,nqgrid,gridx,gridq) +#endif +#ifdef MRSTQED + if(name(nset).eq.'MRST4qed') call MRSTqedgetgrid(nset,nxgrid,nqgrid,gridx,gridq) +#endif +#ifdef MRST98 + if(name(nset).eq.'MRST98grid') call MRST98getgrid(nset,nxgrid,nqgrid,gridx,gridq) +#endif +#ifdef MRST06 + if(name(nset).eq.'MRST2006grid') call MRST2006getgrid(nset,nxgrid,nqgrid,gridx,gridq) +#endif +#ifdef MSTW + if(name(nset).eq.'MSTWgrid') call MSTWgetgrid(nset,nxgrid,nqgrid,gridx,gridq) +#endif +#ifdef CTEQ + if (name(nset).eq.'CTEQ6grid') call CTEQ6getgrid(nset,nxgrid,nqgrid,gridx,gridq) + if (name(nset).eq.'CTEQ6ABgrid') call CTEQ6getgrid(nset,nxgrid,nqgrid,gridx,gridq) + if (name(nset).eq.'CTEQ5grid') call CTEQ5getgrid(nset,nxgrid,nqgrid,gridx,gridq) + if (name(nset).eq.'CTEQ65grid') call CTEQ65getgrid(nset,nxgrid,nqgrid,gridx,gridq) + if (name(nset).eq.'CTEQ65cgrid') call CTEQ65getgrid(nset,nxgrid,nqgrid,gridx,gridq) + if (name(nset).eq.'CTEQ65sgrid') call CTEQ65getgrid(nset,nxgrid,nqgrid,gridx,gridq) + if (name(nset).eq.'CTEQ66grid') call CTEQ65getgrid(nset,nxgrid,nqgrid,gridx,gridq) + if (name(nset).eq.'CT10grid') call CT12getgrid(nset,nxgrid,nqgrid,gridx,gridq) + if (name(nset).eq.'CT12grid') call CT12getgrid(nset,nxgrid,nqgrid,gridx,gridq) +#endif +#ifdef NNPDF +! if (name(nset).eq.'NNPDFint') call NNPDFINTgetgrid(nset,nxgrid,nqgrid,gridx,gridq) + if (name(nset).eq.'NNPDF20int') call NNPDFINT20getgrid(nset,nxgrid,nqgrid,gridx,gridq) + if (name(nset).eq.'NNPDF20qedint') call NNPDFINT20qedgetgrid(nset,nxgrid,nqgrid,gridx,gridq) +#endif +#ifdef HERA + if (name(nset)(1:8).eq.'HERAGRID') call HERAGRIDgetgrid(nset,nxgrid,nqgrid,gridx,gridq) +#endif +#ifdef ALEKHIN + if (name(nset).eq.'A02M') call A02Mgetgrid(nset,nxgrid,nqgrid,gridx,gridq) + if (name(nset).eq.'ABKM09') call ABKM09getgrid(nset,nxgrid,nqgrid,gridx,gridq) + if (name(nset).eq.'ABM11') call ABM11getgrid(nset,nxgrid,nqgrid,gridx,gridq) +#endif +#ifdef GJR + if (name(nset)(1:5).eq.'GJR08') call GJRgetgrid(nset,nxgrid,nqgrid,gridx,gridq) +#endif +#ifdef H1 + if (name(nset).eq.'H12000') call H1getgrid(nset,nxgrid,nqgrid,gridx,gridq) +#endif +#ifdef HKN + if (name(nset).eq.'HKNgrid') call hkngetgrid(nset,nxgrid,nqgrid,gridx,gridq) +#endif + return + + end diff --git a/LHAPDF/lhapdf-5.9.1/src/wrapgjr-lite.f b/LHAPDF/lhapdf-5.9.1/src/wrapgjr-lite.f new file mode 100644 index 00000000000..5651828c253 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/wrapgjr-lite.f @@ -0,0 +1,276 @@ + subroutine GJRevolve(xin,qin,pdf) + implicit real*8 (a-h,o-z) + include 'parmsetup.inc' + character*16 name(nmxset) + integer nmem(nmxset),ndef(nmxset),mmem + common/NAME/name,nmem,ndef,mmem + double precision gridx(nmxgridx),gridq(nmxgridq) + integer ngridx,ngridq,jx,jq + CHARACTER*80 LINE + character*512 setpath + dimension pdf(-6:6) + integer ng(2),init,set,i,j,k,l,nset,iset + parameter(nhess=0) + double precision fgrid(118,99,-5:3,0:nhess),grid(217) +! common/fgridc/fgrid + double precision upv,dnv,usea,dsea,str,chm,bot,glu + double precision arg(2) + double precision lha_dfint + double precision lha_gjr08 + data ng /118,99/ + + data grid & + & /1d-9,1.25d-9,1.6d-9,2d-9,2.5d-9,3.16d-9,4d-9,5d-9,6.3d-9,8d-9, & + & 1d-8,1.25d-8,1.6d-8,2d-8,2.5d-8,3.16d-8,4d-8,5d-8,6.3d-8,8d-8, & + & 1d-7,1.25d-7,1.6d-7,2d-7,2.5d-7,3.16d-7,4d-7,5d-7,6.3d-7,8d-7, & + & 1d-6,1.25d-6,1.6d-6,2d-6,2.5d-6,3.16d-6,4d-6,5d-6,6.3d-6,8d-6, & + & 1d-5,1.25d-5,1.6d-5,2d-5,2.5d-5,3.16d-5,4d-5,5d-5,6.3d-5,8d-5, & + & 1d-4,1.25d-4,1.6d-4,2d-4,2.5d-4,3.16d-4,4d-4,5d-4,6.3d-4,8d-4, & + & 1d-3,1.25d-3,1.6d-3,2d-3,2.5d-3,3.16d-3,4d-3,5d-3,6.3d-3,8d-3, & + & 1d-2,1.25d-2,1.6d-2,2d-2,2.5d-2,3.16d-2,4d-2,5d-2,6.3d-2,8d-2, & + & 0.10d0,0.125d0,0.15d0,0.175d0,0.20d0,0.225d0,0.25d0,0.275d0, & + & 0.30d0,0.325d0,0.35d0,0.375d0,0.40d0,0.425d0,0.45d0,0.475d0, & + & 0.50d0,0.525d0,0.55d0,0.575d0,0.60d0,0.625d0,0.65d0,0.675d0, & + & 0.70d0,0.725d0,0.75d0,0.775d0,0.80d0,0.825d0,0.85d0,0.875d0, & + & 0.9d0,0.920d0,0.94d0,0.960d0,0.98d0,1d0, & + & 0.3d0,0.31d0,0.35d0,0.375d0,0.4d0,0.45d0,0.5d0,0.51d0,0.525d0, & + & 0.55d0,0.575d0,0.6d0,0.65d0,0.7d0,0.75d0,0.8d0,0.85d0,0.9d0, & + & 1d0,1.25d0,1.6d0,2d0,2.5d0,3.16d0,4d0,5d0,6.3d0,8d0, & + & 1d1,1.25d1,1.6d1,2d1,2.5d1,3.16d1,4d1,5d1,6.3d1,8d1, & + & 1d2,1.25d2,1.6d2,2d2,2.5d2,3.16d2,4d2,5d2,6.3d2,8d2, & + & 1d3,1.25d3,1.6d3,2d3,2.5d3,3.16d3,4d3,5d3,6.3d3,8d3, & + & 1d4,1.25d4,1.6d4,2d4,2.5d4,3.16d4,4d4,5d4,6.3d4,8d4, & + & 1d5,1.25d5,1.6d5,2d5,2.5d5,3.16d5,4d5,5d5,6.3d5,8d5, & + & 1d6,1.25d6,1.6d6,2d6,2.5d6,3.16d6,4d6,5d6,6.3d6,8d6, & + & 1d7,1.25d7,1.6d7,2d7,2.5d7,3.16d7,4d7,5d7,6.3d7,8d7,1d8/ + + save + x=xin + q2=qin*qin + call getnset(iset) + call getnmem(iset,imem) + upv = LHA_GJR08(x,Q2,grid,fgrid,ng,1,imem) + dnv = LHA_GJR08(x,Q2,grid,fgrid,ng,2,imem) + usea = LHA_GJR08(x,Q2,grid,fgrid,ng,-1,imem) + dsea = LHA_GJR08(x,Q2,grid,fgrid,ng,-2,imem) + str = LHA_GJR08(x,Q2,grid,fgrid,ng,-3,imem) + glu = LHA_GJR08(x,Q2,grid,fgrid,ng,0,imem) + pdf(-6) = 0.0d0 + pdf(6) = 0.0d0 + pdf(-5) = 0.0d0 + pdf(5) = 0.0d0 + pdf(-4) = 0.0d0 + pdf(4) = 0.0d0 + pdf(-3) = str + pdf(3) = str + pdf(-2) = usea + pdf(2) = upv+usea + pdf(-1) = dsea + pdf(1) = dnv+dsea + pdf(0) = glu + if(name(iset)(1:7).eq.'GJR08VF'.or. & + & name(iset)(1:7).eq.'GJR08LO') then + chm = LHA_GJR08(x,Q2,grid,fgrid,ng,-4,imem) + bot = LHA_GJR08(x,Q2,grid,fgrid,ng,-5,imem) + pdf(-5) = bot + pdf(5) = bot + pdf(-4) = chm + pdf(4) = chm + endif + return +! +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +! + entry GJRgetgrid(nset,ngridx,ngridq,gridx,gridq) + + ngridx=118 + do jx=1,118 + gridx(jx)=grid(jx) + enddo + + ngridq=99 + do jq=1,99 + gridq(jq)=grid(118+jq) + enddo + + return + +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + entry GJRread(nset) +! + call getnmem(nset,imem) + read(1,*)nmem(nset),ndef(nset) +! - dummy read in to get to End: (stream 1 is still open) + do i = 0,nmem(nset) + do j=1,118 + do k=1,99 + read(1,'(a)') line + enddo + enddo + enddo + + return +! + +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + entry GJRalfa(alfas,qalfa) + call getnset(iset) + call getnmem(iset,imem) + arg(1) = 1d-9 + arg(2) = qalfa*qalfa +! imem = 0 + alfas = lha_dfint(2,arg,ng,grid,fgrid(1,1,3,0)) + return +! +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + entry GJRinit(Eorder,Q2fit) + return +! +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + entry GJRpdf(mem) + imem = mem + call getnset(iset) + call setnmem(iset,imem) +! have to reopen stream 1 + call getsetpath(setpath) + open(1,file=setpath(1:len_trim(setpath)),action='READ') + line = '' + do while (line(2:11).ne.'Evolution:') + read(1,'(a)'),line + enddo + read(1,'(a)'),line + read(1,'(a)'),line + + read(1,*)nmem(iset),ndef(iset) + + do i = 0,mem-1 + do j=1,118 + do k=1,99 + read(1,'(a)') line + enddo + enddo + enddo + + lstart = -3 + if(name(iset)(1:7).eq.'GJR08VF') lstart=-5 + i=0 + do j=1,118 + do k=1,99 + if(name(iset)(1:7).eq.'GJR08VF'.or. & + & name(iset)(1:7).eq.'GJR08LO') then + read(1,*) fgrid(j,k,-5,i),fgrid(j,k,-4,i), & + & fgrid(j,k,-3,i),fgrid(j,k,-2,i),fgrid(j,k,-1,i), & + & fgrid(j,k,0,i),fgrid(j,k,1,i),fgrid(j,k,2,i), & + & fgrid(j,k,3,i) + else + read(1,*) fgrid(j,k,-3,i),fgrid(j,k,-2,i),fgrid(j,k,-1,i), & + & fgrid(j,k,0,i),fgrid(j,k,1,i),fgrid(j,k,2,i), & + & fgrid(j,k,3,i) + endif + if(name(iset)(1:7).ne.'GJR08LO') then + do l=-lstart,3 + if (grid(118+k) < 0.5d0) then + fgrid(j,k,l,i)=0d0 + fgrid(j,k,l,i)=0d0/fgrid(j,k,l,i) + endif + enddo + endif + enddo + enddo + + close(1) + + return +! + 1000 format(5e13.5) + end +! +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + + double precision function LHA_GJR08(x,Q2,grid,fgrid,ng,n,set) + implicit none + integer ng(2),n,set + double precision grid(217),arg(2),x,Q2 + double precision lha_dfint + integer nhess + parameter(nhess=0) + double precision fgrid(118,99,-5:3,0:nhess) +! common/fgridc/fgrid + arg(1) = x + arg(2) = Q2 + LHA_GJR08 = lha_dfint(2,arg,ng,grid,fgrid(1,1,n,0)) + end + +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + + + +!! CERNLIB E104 modified to be used with GJR08 GRIDS: +!! Name changed from fint to dfint. +!! Name changed from dfint to lha_dfint. +!! Real variables changed to double precision. +!! External references to CERNLIB (error handling) routines removed. + DOUBLE PRECISION FUNCTION LHA_DFINT(NARG,ARG,NENT,ENT,TABLE) + INTEGER NENT(9), INDEX(32) + DOUBLE PRECISION ARG(9), ENT(9), TABLE(9), WEIGHT(32) + LHA_DFINT = 0d0 + IF(NARG .LT. 1 .OR. NARG .GT. 5) GOTO 300 + LMAX = 0 + ISTEP = 1 + KNOTS = 1 + INDEX(1) = 1 + WEIGHT(1) = 1d0 + DO 100 N = 1, NARG + X = ARG(N) + NDIM = NENT(N) + LOCA = LMAX + LMIN = LMAX + 1 + LMAX = LMAX + NDIM + IF(NDIM .GT. 2) GOTO 10 + IF(NDIM .EQ. 1) GOTO 100 + H = X - ENT(LMIN) + IF(H .EQ. 0.) GOTO 90 + ISHIFT = ISTEP + IF(X-ENT(LMIN+1) .EQ. 0d0) GOTO 21 + ISHIFT = 0 + ETA = H / (ENT(LMIN+1) - ENT(LMIN)) + GOTO 30 + 10 LOCB = LMAX + 1 + 11 LOCC = (LOCA+LOCB) / 2 +! IF(X-ENT(LOCC)) 12, 20, 13 + IF(X-ENT(LOCC).lt.0) goto 12 + IF(X-ENT(LOCC).eq.0) goto 20 + IF(X-ENT(LOCC).gt.0) goto 13 + 12 LOCB = LOCC + GOTO 14 + 13 LOCA = LOCC + 14 IF(LOCB-LOCA .GT. 1) GOTO 11 + LOCA = MIN0( MAX0(LOCA,LMIN), LMAX-1 ) + ISHIFT = (LOCA - LMIN) * ISTEP + ETA = (X - ENT(LOCA)) / (ENT(LOCA+1) - ENT(LOCA)) + GOTO 30 + 20 ISHIFT = (LOCC - LMIN) * ISTEP + 21 DO 22 K = 1, KNOTS + INDEX(K) = INDEX(K) + ISHIFT + 22 CONTINUE + GOTO 90 + 30 DO 31 K = 1, KNOTS + INDEX(K) = INDEX(K) + ISHIFT + INDEX(K+KNOTS) = INDEX(K) + ISTEP + WEIGHT(K+KNOTS) = WEIGHT(K) * ETA + WEIGHT(K) = WEIGHT(K) - WEIGHT(K+KNOTS) + 31 CONTINUE + KNOTS = 2*KNOTS + 90 ISTEP = ISTEP * NDIM + 100 CONTINUE + DO 200 K = 1, KNOTS + I = INDEX(K) + LHA_DFINT = LHA_DFINT + WEIGHT(K) * TABLE(I) + 200 CONTINUE + RETURN + 300 WRITE(*,1000) NARG + STOP +1000 FORMAT( 7X, 24HFUNCTION DFINT... NARG =,I6, & + & 17H NOT WITHIN RANGE) + END + diff --git a/LHAPDF/lhapdf-5.9.1/src/wrapgjr.f b/LHAPDF/lhapdf-5.9.1/src/wrapgjr.f new file mode 100644 index 00000000000..593d94ea3e5 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/wrapgjr.f @@ -0,0 +1,244 @@ + subroutine GJRevolve(xin,qin,pdf) + implicit real*8 (a-h,o-z) + include 'parmsetup.inc' + character*16 name(nmxset) + integer nmem(nmxset),ndef(nmxset),mmem + common/NAME/name,nmem,ndef,mmem + double precision gridx(nmxgridx),gridq(nmxgridq) + integer ngridx,ngridq,jx,jq + CHARACTER*80 LINE + dimension pdf(-6:6) + integer ng(2),init,set,i,j,k,l,nset,iset + double precision fgrid(118,99,-5:3,0:26),grid(217) + !double precision fgrid(118,99,-5:3,0:0),grid(217) +! common/fgridc/fgrid + double precision upv,dnv,usea,dsea,str,chm,bot,glu + double precision arg(2) + double precision lha_dfint + double precision lha_gjr08 + data ng /118,99/ + + data grid & + & /1d-9,1.25d-9,1.6d-9,2d-9,2.5d-9,3.16d-9,4d-9,5d-9,6.3d-9,8d-9, & + & 1d-8,1.25d-8,1.6d-8,2d-8,2.5d-8,3.16d-8,4d-8,5d-8,6.3d-8,8d-8, & + & 1d-7,1.25d-7,1.6d-7,2d-7,2.5d-7,3.16d-7,4d-7,5d-7,6.3d-7,8d-7, & + & 1d-6,1.25d-6,1.6d-6,2d-6,2.5d-6,3.16d-6,4d-6,5d-6,6.3d-6,8d-6, & + & 1d-5,1.25d-5,1.6d-5,2d-5,2.5d-5,3.16d-5,4d-5,5d-5,6.3d-5,8d-5, & + & 1d-4,1.25d-4,1.6d-4,2d-4,2.5d-4,3.16d-4,4d-4,5d-4,6.3d-4,8d-4, & + & 1d-3,1.25d-3,1.6d-3,2d-3,2.5d-3,3.16d-3,4d-3,5d-3,6.3d-3,8d-3, & + & 1d-2,1.25d-2,1.6d-2,2d-2,2.5d-2,3.16d-2,4d-2,5d-2,6.3d-2,8d-2, & + & 0.10d0,0.125d0,0.15d0,0.175d0,0.20d0,0.225d0,0.25d0,0.275d0, & + & 0.30d0,0.325d0,0.35d0,0.375d0,0.40d0,0.425d0,0.45d0,0.475d0, & + & 0.50d0,0.525d0,0.55d0,0.575d0,0.60d0,0.625d0,0.65d0,0.675d0, & + & 0.70d0,0.725d0,0.75d0,0.775d0,0.80d0,0.825d0,0.85d0,0.875d0, & + & 0.9d0,0.920d0,0.94d0,0.960d0,0.98d0,1d0, & + & 0.3d0,0.31d0,0.35d0,0.375d0,0.4d0,0.45d0,0.5d0,0.51d0,0.525d0, & + & 0.55d0,0.575d0,0.6d0,0.65d0,0.7d0,0.75d0,0.8d0,0.85d0,0.9d0, & + & 1d0,1.25d0,1.6d0,2d0,2.5d0,3.16d0,4d0,5d0,6.3d0,8d0, & + & 1d1,1.25d1,1.6d1,2d1,2.5d1,3.16d1,4d1,5d1,6.3d1,8d1, & + & 1d2,1.25d2,1.6d2,2d2,2.5d2,3.16d2,4d2,5d2,6.3d2,8d2, & + & 1d3,1.25d3,1.6d3,2d3,2.5d3,3.16d3,4d3,5d3,6.3d3,8d3, & + & 1d4,1.25d4,1.6d4,2d4,2.5d4,3.16d4,4d4,5d4,6.3d4,8d4, & + & 1d5,1.25d5,1.6d5,2d5,2.5d5,3.16d5,4d5,5d5,6.3d5,8d5, & + & 1d6,1.25d6,1.6d6,2d6,2.5d6,3.16d6,4d6,5d6,6.3d6,8d6, & + & 1d7,1.25d7,1.6d7,2d7,2.5d7,3.16d7,4d7,5d7,6.3d7,8d7,1d8/ + + save + x=xin + q2=qin*qin + call getnset(iset) + call getnmem(iset,imem) + upv = LHA_GJR08(x,Q2,grid,fgrid,ng,1,imem) + dnv = LHA_GJR08(x,Q2,grid,fgrid,ng,2,imem) + usea = LHA_GJR08(x,Q2,grid,fgrid,ng,-1,imem) + dsea = LHA_GJR08(x,Q2,grid,fgrid,ng,-2,imem) + str = LHA_GJR08(x,Q2,grid,fgrid,ng,-3,imem) + glu = LHA_GJR08(x,Q2,grid,fgrid,ng,0,imem) + pdf(-6) = 0.0d0 + pdf(6) = 0.0d0 + pdf(-5) = 0.0d0 + pdf(5) = 0.0d0 + pdf(-4) = 0.0d0 + pdf(4) = 0.0d0 + pdf(-3) = str + pdf(3) = str + pdf(-2) = usea + pdf(2) = upv+usea + pdf(-1) = dsea + pdf(1) = dnv+dsea + pdf(0) = glu + if(name(iset)(1:7).eq.'GJR08VF'.or. & + & name(iset)(1:7).eq.'GJR08LO') then + chm = LHA_GJR08(x,Q2,grid,fgrid,ng,-4,imem) + bot = LHA_GJR08(x,Q2,grid,fgrid,ng,-5,imem) + pdf(-5) = bot + pdf(5) = bot + pdf(-4) = chm + pdf(4) = chm + endif + return +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +! + entry GJRgetgrid(nset,ngridx,ngridq,gridx,gridq) + + ngridx=118 + do jx=1,118 + gridx(jx)=grid(jx) + enddo + + ngridq=99 + do jq=1,99 + gridq(jq)=grid(118+jq) + enddo + + return + +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + entry GJRread(nset) +! + call getnmem(nset,imem) + read(1,*)nmem(nset),ndef(nset) + lstart = -3 + if(name(nset)(1:7).eq.'GJR08VF') lstart=-5 + do i=0,nmem(nset) + !do ii=0,nmem(nset) +! i = 0 + do j=1,118 + do k=1,99 + if(name(nset)(1:7).eq.'GJR08VF'.or. & + & name(nset)(1:7).eq.'GJR08LO') then + read(1,*) fgrid(j,k,-5,i),fgrid(j,k,-4,i), & + & fgrid(j,k,-3,i),fgrid(j,k,-2,i),fgrid(j,k,-1,i), & + & fgrid(j,k,0,i),fgrid(j,k,1,i),fgrid(j,k,2,i), & + & fgrid(j,k,3,i) + else + read(1,*) fgrid(j,k,-3,i),fgrid(j,k,-2,i),fgrid(j,k,-1,i), & + & fgrid(j,k,0,i),fgrid(j,k,1,i),fgrid(j,k,2,i), & + & fgrid(j,k,3,i) + endif + if(name(nset)(1:7).ne.'GJR08LO') then + do l=-lstart,3 + if (grid(118+k) < 0.5d0) then + fgrid(j,k,l,i)=0d0 + fgrid(j,k,l,i)=0d0/fgrid(j,k,l,i) + endif + enddo + endif + enddo + enddo + enddo + + return +! + +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + entry GJRalfa(alfas,qalfa) + call getnset(iset) + call getnmem(iset,imem) + arg(1) = 1d-9 + arg(2) = qalfa*qalfa +! imem = 0 + alfas = lha_dfint(2,arg,ng,grid,fgrid(1,1,3,imem)) + return +! +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + entry GJRinit(Eorder,Q2fit) + return +! +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + entry GJRpdf(mem) + imem = mem + call getnset(iset) + call setnmem(iset,imem) + return +! + 1000 format(5e13.5) + end +! +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + + double precision function LHA_GJR08(x,Q2,grid,fgrid,ng,n,set) + implicit none + integer ng(2),n,set + double precision grid(217),arg(2),x,Q2 + double precision lha_dfint + double precision fgrid(118,99,-5:3,0:26) +! common/fgridc/fgrid + arg(1) = x + arg(2) = Q2 + LHA_GJR08 = lha_dfint(2,arg,ng,grid,fgrid(1,1,n,set)) + end + +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + + + +!! CERNLIB E104 modified to be used with GJR08 GRIDS: +!! Name changed from fint to dfint. +!! Name changed from dfint to lha_dfint. +!! Real variables changed to double precision. +!! External references to CERNLIB (error handling) routines removed. + DOUBLE PRECISION FUNCTION LHA_DFINT(NARG,ARG,NENT,ENT,TABLE) + INTEGER NENT(9), INDEX(32) + DOUBLE PRECISION ARG(9), ENT(9), TABLE(9), WEIGHT(32) + LHA_DFINT = 0d0 + IF(NARG .LT. 1 .OR. NARG .GT. 5) GOTO 300 + LMAX = 0 + ISTEP = 1 + KNOTS = 1 + INDEX(1) = 1 + WEIGHT(1) = 1d0 + DO 100 N = 1, NARG + X = ARG(N) + NDIM = NENT(N) + LOCA = LMAX + LMIN = LMAX + 1 + LMAX = LMAX + NDIM + IF(NDIM .GT. 2) GOTO 10 + IF(NDIM .EQ. 1) GOTO 100 + H = X - ENT(LMIN) + IF(H .EQ. 0.) GOTO 90 + ISHIFT = ISTEP + IF(X-ENT(LMIN+1) .EQ. 0d0) GOTO 21 + ISHIFT = 0 + ETA = H / (ENT(LMIN+1) - ENT(LMIN)) + GOTO 30 + 10 LOCB = LMAX + 1 + 11 LOCC = (LOCA+LOCB) / 2 +! IF(X-ENT(LOCC)) 12, 20, 13 + IF(X-ENT(LOCC).lt.0) goto 12 + IF(X-ENT(LOCC).eq.0) goto 20 + IF(X-ENT(LOCC).gt.0) goto 13 + 12 LOCB = LOCC + GOTO 14 + 13 LOCA = LOCC + 14 IF(LOCB-LOCA .GT. 1) GOTO 11 + LOCA = MIN0( MAX0(LOCA,LMIN), LMAX-1 ) + ISHIFT = (LOCA - LMIN) * ISTEP + ETA = (X - ENT(LOCA)) / (ENT(LOCA+1) - ENT(LOCA)) + GOTO 30 + 20 ISHIFT = (LOCC - LMIN) * ISTEP + 21 DO 22 K = 1, KNOTS + INDEX(K) = INDEX(K) + ISHIFT + 22 CONTINUE + GOTO 90 + 30 DO 31 K = 1, KNOTS + INDEX(K) = INDEX(K) + ISHIFT + INDEX(K+KNOTS) = INDEX(K) + ISTEP + WEIGHT(K+KNOTS) = WEIGHT(K) * ETA + WEIGHT(K) = WEIGHT(K) - WEIGHT(K+KNOTS) + 31 CONTINUE + KNOTS = 2*KNOTS + 90 ISTEP = ISTEP * NDIM + 100 CONTINUE + DO 200 K = 1, KNOTS + I = INDEX(K) + LHA_DFINT = LHA_DFINT + WEIGHT(K) * TABLE(I) + 200 CONTINUE + RETURN + 300 WRITE(*,1000) NARG + STOP +1000 FORMAT( 7X, 24HFUNCTION DFINT... NARG =,I6, & + & 17H NOT WITHIN RANGE) + END + diff --git a/LHAPDF/lhapdf-5.9.1/src/wrapgrv.f b/LHAPDF/lhapdf-5.9.1/src/wrapgrv.f new file mode 100644 index 00000000000..d33eedc2c22 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/wrapgrv.f @@ -0,0 +1,277 @@ +! -*- F90 -*- + + + subroutine GRVevolve(xin,qin,pdf) + implicit real*8 (a-h,o-z) + include 'parmsetup.inc' + PARAMETER(ngrid=2) + PARAMETER (NPART=6, NX=68, NQ=27, NARG=2) + character*16 name(nmxset) + integer nmem(nmxset),ndef(nmxset),mmem + common/NAME/name,nmem,ndef,mmem + DIMENSION XXUVF(0:ngrid,NX,NQ), XXDVF(0:ngrid,NX,NQ), & + & XXDEF(0:ngrid,NX,NQ), XXUDF(0:ngrid,NX,NQ), & + & XXSF(0:ngrid,NX,NQ), XXGF(0:ngrid,NX,NQ), & + & XUVF(NX,NQ), XDVF(NX,NQ), & + & XDEF(NX,NQ), XUDF(NX,NQ), & + & XSF(NX,NQ), XGF(NX,NQ), & + & PARTON (NPART,NQ,NX-1), & + & QS(NQ), XB(NX), XT(NARG), NA(NARG), ARRF(NX+NQ) + CHARACTER*80 LINE + dimension pdf(-6:6) + save + x=xin + q2=qin*qin +!...CHECK OF X AND Q2 VALUES : + IF ( (X.LT.0.99D-9) .OR. (X.GT.1.D0) ) THEN + WRITE(6,91) + 91 FORMAT (2X,'PARTON INTERPOLATION: X OUT OF RANGE') + STOP + ENDIF + IF ( (Q2.LT.0.799) .OR. (Q2.GT.1.01E6) ) THEN + WRITE(6,92) + 92 FORMAT (2X,'PARTON INTERPOLATION: Q2 OUT OF RANGE') + STOP + ENDIF +!...INTERPOLATION : + DO IQ=1,NQ + DO IX=1,NX + xuvf(ix,iq)=xxuvf(imem,ix,iq) + xdvf(ix,iq)=xxdvf(imem,ix,iq) + xdef(ix,iq)=xxdef(imem,ix,iq) + xudf(ix,iq)=xxudf(imem,ix,iq) + xsf(ix,iq)=xxsf(imem,ix,iq) + xgf(ix,iq)=xxgf(imem,ix,iq) + enddo + enddo + XT(1) = DLOG(X) + XT(2) = DLOG(Q2) + X1 = 1.- X + XV = X**0.5 + XS = X**(-0.2) + UV = FINT_LHA(NARG,XT,NA,ARRF,XUVF) * X1**3 * XV + DV = FINT_LHA(NARG,XT,NA,ARRF,XDVF) * X1**4 * XV + DE = FINT_LHA(NARG,XT,NA,ARRF,XDEF) * X1**7 * XV + UD = FINT_LHA(NARG,XT,NA,ARRF,XUDF) * X1**7 * XS + US = 0.5 * (UD - DE) + DS = 0.5 * (UD + DE) + SS = FINT_LHA(NARG,XT,NA,ARRF,XSF) * X1**7 * XS + GL = FINT_LHA(NARG,XT,NA,ARRF,XGF) * X1**5 * XS +! + + pdf(-6) = 0.0d0 + pdf(6) = 0.0d0 + pdf(-5) = 0.0d0 + pdf(5) = 0.0d0 + pdf(-4) = 0.0d0 + pdf(4) = 0.0d0 + pdf(-3) = ss + pdf(3) = ss + pdf(-2) = us + pdf(2) = uv+us + pdf(-1) = ds + pdf(1) = dv+ds + pdf(0) = gl + return +! +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + entry GRVread(nset) +! +! print *,'calling grvread' + read(1,*)nmem(nset),ndef(nset) + + read(1,93)xb +! print *,xb + read(1,93)qs +! print *,qs + 93 format(8e8.2) +! + do ng=0,nmem(nset) +! + READ(1,89) LINE + 89 FORMAT(A80) +! print *,line + DO 15 M = 1, NX-1 + DO 15 N = 1, NQ + READ(1,90) PARTON(1,N,M), PARTON(2,N,M), PARTON(3,N,M), & + & PARTON(4,N,M), PARTON(5,N,M), PARTON(6,N,M) + 90 FORMAT (6(1PE10.3)) + 15 CONTINUE +! +!....ARRAYS FOR THE INTERPOLATION SUBROUTINE : + DO 10 IQ = 1, NQ + DO 20 IX = 1, NX-1 + XB0V = XB(IX)**0.5 + XB0S = XB(IX)**(-0.2) + XB1 = 1.-XB(IX) + xXUVF(ng,IX,IQ) = PARTON(1,IQ,IX) / (XB1**3 * XB0V) + xXDVF(ng,IX,IQ) = PARTON(2,IQ,IX) / (XB1**4 * XB0V) + xXDEF(ng,IX,IQ) = PARTON(3,IQ,IX) / (XB1**7 * XB0V) + xXUDF(ng,IX,IQ) = PARTON(4,IQ,IX) / (XB1**7 * XB0S) + xXSF(ng,IX,IQ) = PARTON(5,IQ,IX) / (XB1**7 * XB0S) + xXGF(ng,IX,IQ) = PARTON(6,IQ,IX) / (XB1**5 * XB0S) + 20 END DO + xXUVF(ng,NX,IQ) = 0.E0 + xXDVF(ng,NX,IQ) = 0.E0 + xXDEF(ng,NX,IQ) = 0.E0 + xXUDF(ng,NX,IQ) = 0.E0 + xXSF(ng,NX,IQ) = 0.E0 + xXGF(ng,NX,IQ) = 0.E0 + 10 END DO + NA(1) = NX + NA(2) = NQ + DO 30 IX = 1, NX + ARRF(IX) = DLOG(XB(IX)) + 30 END DO + DO 40 IQ = 1, NQ + ARRF(NX+IQ) = DLOG(QS(IQ)) + 40 END DO + + enddo + + return +! +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + entry GRValfa(alfas,qalfa) + call getnset(iset) + q2alfa = qalfa*qalfa + call GetOrderAsM(iset,iord) + nord=iord+1 + alfas=grvals(q2alfa,nord) + alfas = 4.0d0*3.14159d0*alfas + return +! +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + entry GRVinit(Eorder,Q2fit) + return +! +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + entry GRVpdf(mem) + imem = mem + return +! + 1000 format(5e13.5) + END +! + FUNCTION FINT_LHA(NARG,ARG,NENT,ENT,TABLE) +!******************************************************************** +! * +! THE INTERPOLATION ROUTINE (CERN LIBRARY ROUTINE E104) * +! * +!******************************************************************** + IMPLICIT DOUBLE PRECISION (A-H, O-Z) + DIMENSION ARG(5),NENT(5),ENT(10),TABLE(10) + DIMENSION D(5),NCOMB(5),IENT(5) + KD=1 + M=1 + JA=1 + DO 5 I=1,NARG + NCOMB(I)=1 + JB=JA-1+NENT(I) + DO 2 J=JA,JB + IF (ARG(I).LE.ENT(J)) GOTO 3 + 2 END DO + J=JB + 3 IF (J.NE.JA) GOTO 4 + J=J+1 + 4 JR=J-1 + D(I)=(ENT(J)-ARG(I))/(ENT(J)-ENT(JR)) + IENT(I)=J-JA + KD=KD+IENT(I)*M + M=M*NENT(I) + 5 JA=JB+1 + FINT_LHA=0. + 10 FAC=1. + IADR=KD + IFADR=1 + DO 15 I=1,NARG + IF (NCOMB(I).EQ.0) GOTO 12 + FAC=FAC*(1.-D(I)) + GOTO 15 + 12 FAC=FAC*D(I) + IADR=IADR-IFADR + 15 IFADR=IFADR*NENT(I) + FINT_LHA=FINT_LHA+FAC*TABLE(IADR) + IL=NARG + 40 IF (NCOMB(IL).EQ.0) GOTO 80 + NCOMB(IL)=0 + IF (IL.EQ.NARG) GOTO 10 + IL=IL+1 + DO 50 K=IL,NARG + 50 NCOMB(K)=1 + GOTO 10 + 80 IL=IL-1 + IF(IL.NE.0) GOTO 40 + RETURN + END + +! FUNCTION ALPHAS (Q2, NAORD) + FUNCTION grvals (Q2, NAORD) +!******************************************************************** +! * +! THE ALPHA_S ROUTINE. * +! * +! INPUT : Q2 = scale in GeV**2 (not too low, of course); * +! NAORD = 1 (LO), 2 (NLO). * +! * +! OUTPUT: alphas_s/(4 pi) for use with the GRV(98) partons. * +! * +!******************************************************i************* +! + IMPLICIT DOUBLE PRECISION (A - Z) + INTEGER NF, K, I, NAORD + DIMENSION LAMBDAL (3:6), LAMBDAN (3:6), Q2THR (3) +! +!...HEAVY QUARK THRESHOLDS AND LAMBDA VALUES : + DATA Q2THR / 1.960, 20.25, 30625. / + DATA LAMBDAL / 0.2041, 0.1750, 0.1320, 0.0665 / + DATA LAMBDAN / 0.2994, 0.2460, 0.1677, 0.0678 / +! +!...DETERMINATION OF THE APPROPRIATE NUMBER OF FLAVOURS : + NF = 3 + DO 10 K = 1, 3 + IF (Q2 .GT. Q2THR (K)) THEN + NF = NF + 1 + ELSE + GOTO 20 + END IF + 10 CONTINUE +! +!...LO ALPHA_S AND BETA FUNCTION FOR NLO CALCULATION : + 20 B0 = 11.- 2./3.* NF + B1 = 102.- 38./3.* NF + B10 = B1 / (B0*B0) + IF (NAORD .EQ. 1) THEN + LAM2 = LAMBDAL (NF) * LAMBDAL (NF) + ALP = 1./(B0 * DLOG (Q2/LAM2)) + GOTO 1 + ELSE IF (NAORD .EQ. 2) then + LAM2 = LAMBDAN (NF) * LAMBDAN (NF) + B1 = 102.- 38./3.* NF + B10 = B1 / (B0*B0) + ELSE + WRITE (6,91) + 91 FORMAT ('INVALID CHOICE FOR ORDER IN ALPHA_S') + STOP + END IF +! +!...START VALUE FOR NLO ITERATION : + LQ2 = DLOG (Q2 / LAM2) + ALP = 1./(B0*LQ2) * (1.- B10*DLOG(LQ2)/LQ2) +! +!...EXACT NLO VALUE, FOUND VIA NEWTON PROCEDURE : + DO 2 I = 1, 6 + XL = DLOG (1./(B0*ALP) + B10) + XLP = DLOG (1./(B0*ALP*1.01) + B10) + XLM = DLOG (1./(B0*ALP*0.99) + B10) + Y = LQ2 - 1./ (B0*ALP) + B10 * XL + Y1 = (- 1./ (B0*ALP*1.01) + B10 * XLP & + & + 1./ (B0*ALP*0.99) - B10 * XLP) / (0.02D0*ALP) + ALP = ALP - Y/Y1 + 2 CONTINUE +! +!...OUTPUT : +! 1 ALPHAS = ALP + 1 grvals = ALP + RETURN + END diff --git a/LHAPDF/lhapdf-5.9.1/src/wrapgrvg.f b/LHAPDF/lhapdf-5.9.1/src/wrapgrvg.f new file mode 100644 index 00000000000..7d3ccb9d090 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/wrapgrvg.f @@ -0,0 +1,773 @@ +! -*- F90 -*- + + + subroutine GRVGevolvep0(xin,qin,p2in,ip2in,pdf) + include 'parmsetup.inc' + real*8 xin,qin,q2in,p2in,pdf(-6:6),xval(45),qcdl4,qcdl5 + real*8 upv,dnv,usea,dsea,str,chm,bot,top,glu,zbot,zchm + character*16 name(nmxset) + integer nmem(nmxset),ndef(nmxset),mmem + common/NAME/name,nmem,ndef,mmem + integer nset + + save + + call getnset(iset) + call getnmem(iset,imem) + if(imem.eq.1) then + call GRVGALO (xin,qin,upv,dnv,usea,dsea,str,chm,bot,glu) + elseif(imem.eq.2.or.imem.eq.0) then + q2in = qin*qin +! calls GRVGALO for charm and bottom, rest from GRSGALO + call GRVGALO(xin,qin,upv,dnv,usea,dsea,str,chm,bot,glu) + call GRSGALO(xin,q2in,p2in, & + & upv,dnv,usea,dsea,str,zchm,zbot,glu) + else + CONTINUE + endif + pdf(-6)= 0.0d0 + pdf(6)= 0.0d0 + pdf(-5)= bot + pdf(5 )= bot + pdf(-4)= chm + pdf(4 )= chm + pdf(-3)= str + pdf(3 )= str + pdf(-2)= usea + pdf(2 )= upv + pdf(-1)= dsea + pdf(1 )= dnv + pdf(0 )= glu + + return +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + entry GRVGevolvep1(xin,qin,p2in,ip2in,pdf) + + if(imem.eq.1) then + call GRVGAH0 (xin,qin,upv,dnv,usea,dsea,str,chm,bot,glu) + elseif(imem.eq.2 .or. imem.eq.0) then + call GRVGAHO (xin,qin,upv,dnv,usea,dsea,str,chm,bot,glu) + else + CONTINUE + endif + + pdf(-6)= 0.0d0 + pdf(6)= 0.0d0 + pdf(-5)= bot + pdf(5 )= bot + pdf(-4)= chm + pdf(4 )= chm + pdf(-3)= str + pdf(3 )= str + pdf(-2)= usea + pdf(2 )= upv + pdf(-1)= dsea + pdf(1 )= dnv + pdf(0 )= glu + + return +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + entry GRVGread(nset) + read(1,*)nmem(nset),ndef(nset) + return +! +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + entry GRVGalfa(alfas,qalfa) + call getnset(iset) + call GetOrderAsM(iset,iord) + call Getlam4M(iset,imem,qcdl4) + call Getlam5M(iset,imem,qcdl5) + call aspdflib(alfas,Qalfa,iord,qcdl5) + return +! +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + entry GRVGinit(Eorder,Q2fit) + return +! +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + entry GRVGpdf(mem) + call getnset(iset) + call setnmem(iset,mem) + +! imem = mem + return +! + 1000 format(5e13.5) + END +! + SUBROUTINE GRVGAH0 (ZX,ZQ,ZUV,ZDV,ZUB,ZDB,ZSB,ZCB,ZBB,ZGL) +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! * +! G R V - P H O T O N - P A R A M E T R I Z A T I O N S * +! * +! FOR A DETAILED EXPLANATION SEE : * +! M. GLUECK, E.REYA, A.VOGT: DO-TH 91/31 * +! * +! THE OUTPUT IS ALWAYS 1./ ALPHA(EM) * X * PARTON DENSITY * +! output modified by HPB to be always X * PARTON DENSITY * +! * +! THE PARAMETRIZATIONS ARE FITTED TO THE PARTON DISTRIBUTIONS * +! FOR Q ** 2 BETWEEN MU ** 2 (= 0.25 / 0.30 GEV ** 2 IN LO * +! / HO) AND 1.E6 GEV ** 2 AND FOR X BETWEEN 1.E-5 AND 1. * +! * +! HEAVY QUARK THRESHOLDS Q(H) = M(H) : * +! M(C) = 1.5, M(B) = 4.5, M(T) = 100 GEV * +! * +! CORRESPONDING LAMBDA(F) VALUES FOR F ACTIVE FLAVOURS : * +! LO : LAMBDA(3) = 0.232, LAMBDA(4) = 0.200, * +! LAMBDA(5) = 0.153, LAMBDA(6) = 0.082 GEV * +! HO : LAMBDA(3) = 0.248, LAMBDA(4) = 0.200, * +! LAMBDA(5) = 0.131, LAMBDA(6) = 0.053 GEV * +! * +! HO DISTRIBUTIONS REFER TO THE DIS(GAMMA) SCHEME, SEE : * +! M. GLUECK, E.REYA, A.VOGT: DO-TH 91/26 * +! * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! + IMPLICIT REAL (A - Y) + double precision & + & ZX,ZQ,ZUV,ZDV,ZUB,ZDB,ZSB,ZCB,ZBB,ZGL + REAL X, Q + DATA ALPHEM/7.29927D-3/ + X = ZX + Q = ZQ + MU2 = 0.3 + LAM2 = 0.248 * 0.248 + Q2 = Q*Q + S = ALOG (ALOG(Q2/LAM2) / ALOG(MU2/LAM2)) + SS = SQRT (S) + S2 = S * S +!...X * U = X * UBAR : + AL = 1.447 + BE = 0.848 + AK = 0.527 + 0.200 * S - 0.107 * S2 + BK = 7.106 - 0.310 * SS - 0.786 * S2 + AG = 0.197 + 0.533 * S + BG = 0.062 - 0.398 * S + 0.109 * S2 + C = 0.755 * S - 0.112 * S2 + D = 0.318 - 0.059 * S + E = 4.225 + 1.708 * S + ES = 1.752 + 0.866 * S + U0 = GRVGF (X, S, AL, BE, AK, BK, AG, BG, C, D, E, ES) + ZUV = U0 * ALPHEM + ZUB = ZUV +!...X * D = X * DBAR : + AL = 1.424 + BE = 0.770 + AK = 0.500 + 0.067 * SS - 0.055 * S2 + BK = 0.376 - 0.453 * SS + 0.405 * S2 + AG = 0.156 + 0.184 * S + BG = 0.0 - 0.528 * S + 0.146 * S2 + C = 0.121 + 0.092 * S + D = 0.379 - 0.301 * S + 0.081 * S2 + E = 4.346 + 1.638 * S + ES = 1.645 + 1.016 * S + D0 = GRVGF (X, S, AL, BE, AK, BK, AG, BG, C, D, E, ES) + ZDV = D0 * ALPHEM + ZDB = ZDV +!...X * G : + AL = 0.661 + BE = 0.793 + AK = 0.537 - 0.600 * SS + BK = 6.389 - 0.953 * S2 + AG = 0.558 - 0.383 * SS + 0.261 * S2 + BG = 0.0 - 0.305 * S + C = -0.222 + 0.078 * S2 + D = 0.153 + 0.978 * S - 0.209 * S2 + E = 1.429 + 1.772 * S + ES = 3.331 + 0.806 * S + G0 = GRVGF (X, S, AL, BE, AK, BK, AG, BG, C, D, E, ES) + ZGL = G0 * ALPHEM +!...X * S = X * SBAR : + SF = 0.0 + AL = 1.578 + BE = 0.863 + AK = 0.622 + 0.332 * S - 0.300 * S2 + BK = 2.469 + AG = 0.211 - 0.064 * SS - 0.018 * S2 + BG = -0.215 + 0.122 * S + C = 0.153 + D = 0.0 + 0.253 * S - 0.081 * S2 + E = 3.990 + 2.014 * S + ES = 1.720 + 0.986 * S + S0 = GRVGFS (X, S, SF, AL, BE, AK, BK, AG, BG, C, D, E, ES) + ZSB = S0 * ALPHEM +!...X * C = X * CBAR : + SF = 0.820 + AL = 0.929 + BE = 0.381 + AK = 1.228 - 0.231 * S + BK = 3.806 - 0.337 * S2 + AG = 0.932 + 0.150 * S + BG = -0.906 + C = 1.133 + D = 0.0 + 0.138 * S - 0.028 * S2 + E = 5.588 + 0.628 * S + ES = 2.665 + 1.054 * S + C0 = GRVGFS (X, S, SF, AL, BE, AK, BK, AG, BG, C, D, E, ES) + ZCB = C0 * ALPHEM +!...X * B = X * BBAR : + SF = 1.297 + AL = 0.970 + BE = 0.207 + AK = 1.719 - 0.292 * S + BK = 0.928 + 0.096 * S + AG = 0.845 + 0.178 * S + BG = -2.310 + C = 1.558 + D = -0.191 + 0.151 * S + E = 6.089 + 0.282 * S + ES = 3.379 + 1.062 * S + B0 = GRVGFS (X, S, SF, AL, BE, AK, BK, AG, BG, C, D, E, ES) + ZBB = B0 * ALPHEM +! + RETURN + END +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + SUBROUTINE GRVGAHO (ZX,ZQ,ZUV,ZDV,ZUB,ZDB,ZSB,ZCB,ZBB,ZGL) +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! * +! G R V - P H O T O N - P A R A M E T R I Z A T I O N S * +! * +! FOR A DETAILED EXPLANATION SEE : * +! M. GLUECK, E.REYA, A.VOGT: DO-TH 91/31 * +! * +! THE OUTPUT IS ALWAYS 1./ ALPHA(EM) * X * PARTON DENSITY * +! output modified by HPB to be always X * PARTON DENSITY * +! * +! THE PARAMETRIZATIONS ARE FITTED TO THE PARTON DISTRIBUTIONS * +! FOR Q ** 2 BETWEEN MU ** 2 (= 0.25 / 0.30 GEV ** 2 IN LO * +! / HO) AND 1.E6 GEV ** 2 AND FOR X BETWEEN 1.E-5 AND 1. * +! * +! HEAVY QUARK THRESHOLDS Q(H) = M(H) : * +! M(C) = 1.5, M(B) = 4.5, M(T) = 100 GEV * +! * +! CORRESPONDING LAMBDA(F) VALUES FOR F ACTIVE FLAVOURS : * +! LO : LAMBDA(3) = 0.232, LAMBDA(4) = 0.200, * +! LAMBDA(5) = 0.153, LAMBDA(6) = 0.082 GEV * +! HO : LAMBDA(3) = 0.248, LAMBDA(4) = 0.200, * +! LAMBDA(5) = 0.131, LAMBDA(6) = 0.053 GEV * +! * +! HO DISTRIBUTIONS REFER TO THE DIS(GAMMA) SCHEME, SEE : * +! M. GLUECK, E.REYA, A.VOGT: DO-TH 91/26 * +! * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! + IMPLICIT REAL (A - Y) + double precision & + & ZX,ZQ,ZUV,ZDV,ZUB,ZDB,ZSB,ZCB,ZBB,ZGL + DATA ALPHEM/7.29927D-3/ + REAL X, Q + X = ZX + Q = ZQ + MU2 = 0.3 + LAM2 = 0.248 * 0.248 + Q2 = Q*Q + S = ALOG (ALOG(Q2/LAM2) / ALOG(MU2/LAM2)) + SS = SQRT (S) + S2 = S * S +!...X * U = X * UBAR : + AL = 0.583 + BE = 0.688 + AK = 0.449 - 0.025 * S - 0.071 * S2 + BK = 5.060 - 1.116 * SS + AG = 0.103 + BG = 0.319 + 0.422 * S + C = 1.508 + 4.792 * S - 1.963 * S2 + D = 1.075 + 0.222 * SS - 0.193 * S2 + E = 4.147 + 1.131 * S + ES = 1.661 + 0.874 * S + UH = GRVGF (X, S, AL, BE, AK, BK, AG, BG, C, D, E, ES) + ZUV = UH * ALPHEM + ZUB = ZUV +!...X * D = X * DBAR : + AL = 0.591 + BE = 0.698 + AK = 0.442 - 0.132 * S - 0.058 * S2 + BK = 5.437 - 1.916 * SS + AG = 0.099 + BG = 0.311 - 0.059 * S + C = 0.800 + 0.078 * S - 0.100 * S2 + D = 0.862 + 0.294 * SS - 0.184 * S2 + E = 4.202 + 1.352 * S + ES = 1.841 + 0.990 * S + DH = GRVGF (X, S, AL, BE, AK, BK, AG, BG, C, D, E, ES) + ZDV = DH * ALPHEM + ZDB = ZDV +!...X * G : + AL = 1.161 + BE = 1.591 + AK = 0.530 - 0.742 * SS + 0.025 * S2 + BK = 5.662 + AG = 0.533 - 0.281 * SS + 0.218 * S2 + BG = 0.025 - 0.518 * S + 0.156 * S2 + C = -0.282 + 0.209 * S2 + D = 0.107 + 1.058 * S - 0.218 * S2 + E = 0.0 + 2.704 * S + ES = 3.071 - 0.378 * S + GH = GRVGF (X, S, AL, BE, AK, BK, AG, BG, C, D, E, ES) + ZGL = GH * ALPHEM +!...X * S = X * SBAR : + SF = 0.0 + AL = 0.635 + BE = 0.456 + AK = 1.770 - 0.735 * SS - 0.079 * S2 + BK = 3.832 + AG = 0.084 - 0.023 * S + BG = 0.136 + C = 2.119 - 0.942 * S + 0.063 * S2 + D = 1.271 + 0.076 * S - 0.190 * S2 + E = 4.604 + 0.737 * S + ES = 1.641 + 0.976 * S + SH = GRVGFS (X, S, SF, AL, BE, AK, BK, AG, BG, C, D, E, ES) + ZSB = SH * ALPHEM +!...X * C = X * CBAR : + SF = 0.820 + AL = 0.926 + BE = 0.152 + AK = 1.142 - 0.175 * S + BK = 3.276 + AG = 0.504 + 0.317 * S + BG = -0.433 + C = 3.334 + D = 0.398 + 0.326 * S - 0.107 * S2 + E = 5.493 + 0.408 * S + ES = 2.426 + 1.277 * S + CH = GRVGFS (X, S, SF, AL, BE, AK, BK, AG, BG, C, D, E, ES) + ZCB = CH * ALPHEM +!...X * B = X * BBAR : + SF = 1.297 + AL = 0.969 + BE = 0.266 + AK = 1.953 - 0.391 * S + BK = 1.657 - 0.161 * S + AG = 1.076 + 0.034 * S + BG = -2.015 + C = 1.662 + D = 0.353 + 0.016 * S + E = 5.713 + 0.249 * S + ES = 3.456 + 0.673 * S + BH = GRVGFS (X, S, SF, AL, BE, AK, BK, AG, BG, C, D, E, ES) + ZBB = BH * ALPHEM +! + RETURN + END +!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + SUBROUTINE GRVGALO (ZX,ZQ,ZUV,ZDV,ZUB,ZDB,ZSB,ZCB,ZBB,ZGL) +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! * +! G R V - P H O T O N - P A R A M E T R I Z A T I O N S * +! * +! FOR A DETAILED EXPLANATION SEE : * +! M. GLUECK, E.REYA, A.VOGT: DO-TH 91/31 * +! * +! THE OUTPUT IS ALWAYS 1./ ALPHA(EM) * X * PARTON DENSITY * +! output modified by HPB to be always X * PARTON DENSITY * +! * +! THE PARAMETRIZATIONS ARE FITTED TO THE PARTON DISTRIBUTIONS * +! FOR Q ** 2 BETWEEN MU ** 2 (= 0.25 / 0.30 GEV ** 2 IN LO * +! / HO) AND 1.E6 GEV ** 2 AND FOR X BETWEEN 1.E-5 AND 1. * +! * +! HEAVY QUARK THRESHOLDS Q(H) = M(H) : * +! M(C) = 1.5, M(B) = 4.5, M(T) = 100 GEV * +! * +! CORRESPONDING LAMBDA(F) VALUES FOR F ACTIVE FLAVOURS : * +! LO : LAMBDA(3) = 0.232, LAMBDA(4) = 0.200, * +! LAMBDA(5) = 0.153, LAMBDA(6) = 0.082 GEV * +! HO : LAMBDA(3) = 0.248, LAMBDA(4) = 0.200, * +! LAMBDA(5) = 0.131, LAMBDA(6) = 0.053 GEV * +! * +! HO DISTRIBUTIONS REFER TO THE DIS(GAMMA) SCHEME, SEE : * +! M. GLUECK, E.REYA, A.VOGT: DO-TH 91/26 * +! * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! + IMPLICIT REAL (A - Y) + double precision & + & ZX,ZQ,ZUV,ZDV,ZUB,ZDB,ZSB,ZCB,ZBB,ZGL + REAL X, Q + DATA ALPHEM/7.29927D-3/ + X = ZX + Q = ZQ + MU2 = 0.25 + LAM2 = 0.232 * 0.232 + Q2 = Q*Q + S = ALOG (ALOG(Q2/LAM2) / ALOG(MU2/LAM2)) + SS = SQRT (S) + S2 = S * S +!...X * U = X * UBAR : + AL = 1.717 + BE = 0.641 + AK = 0.500 - 0.176 * S + BK = 15.00 - 5.687 * SS - 0.552 * S2 + AG = 0.235 + 0.046 * SS + BG = 0.082 - 0.051 * S + 0.168 * S2 + C = 0.0 + 0.459 * S + D = 0.354 - 0.061 * S + E = 4.899 + 1.678 * S + ES = 2.046 + 1.389 * S + UL = GRVGF (X, S, AL, BE, AK, BK, AG, BG, C, D, E, ES) + ZUV = UL * ALPHEM + ZUB = ZUV +!...X * D = X * DBAR : + AL = 1.549 + BE = 0.782 + AK = 0.496 + 0.026 * S + BK = 0.685 - 0.580 * SS + 0.608 * S2 + AG = 0.233 + 0.302 * S + BG = 0.0 - 0.818 * S + 0.198 * S2 + C = 0.114 + 0.154 * S + D = 0.405 - 0.195 * S + 0.046 * S2 + E = 4.807 + 1.226 * S + ES = 2.166 + 0.664 * S + DL = GRVGF (X, S, AL, BE, AK, BK, AG, BG, C, D, E, ES) + ZDV = DL * ALPHEM + ZDB = ZDV +!...X * G : + AL = 0.676 + BE = 1.089 + AK = 0.462 - 0.524 * SS + BK = 5.451 - 0.804 * S2 + AG = 0.535 - 0.504 * SS + 0.288 * S2 + BG = 0.364 - 0.520 * S + C = -0.323 + 0.115 * S2 + D = 0.233 + 0.790 * S - 0.139 * S2 + E = 0.893 + 1.968 * S + ES = 3.432 + 0.392 * S + GL = GRVGF (X, S, AL, BE, AK, BK, AG, BG, C, D, E, ES) + ZGL = GL * ALPHEM +!...X * S = X * SBAR : + SF = 0.0 + AL = 1.609 + BE = 0.962 + AK = 0.470 - 0.099 * S2 + BK = 3.246 + AG = 0.121 - 0.068 * SS + BG = -0.090 + 0.074 * S + C = 0.062 + 0.034 * S + D = 0.0 + 0.226 * S - 0.060 * S2 + E = 4.288 + 1.707 * S + ES = 2.122 + 0.656 * S + SL = GRVGFS (X, S, SF, AL, BE, AK, BK, AG, BG, C, D, E, ES) + ZSB = SL * ALPHEM +!...X * C = X * CBAR : + SF = 0.888 + AL = 0.970 + BE = 0.545 + AK = 1.254 - 0.251 * S + BK = 3.932 - 0.327 * S2 + AG = 0.658 + 0.202 * S + BG = -0.699 + C = 0.965 + D = 0.0 + 0.141 * S - 0.027 * S2 + E = 4.911 + 0.969 * S + ES = 2.796 + 0.952 * S + CL = GRVGFS (X, S, SF, AL, BE, AK, BK, AG, BG, C, D, E, ES) + ZCB = CL * ALPHEM +!...X * B = X * BBAR : + SF = 1.351 + AL = 1.016 + BE = 0.338 + AK = 1.961 - 0.370 * S + BK = 0.923 + 0.119 * S + AG = 0.815 + 0.207 * S + BG = -2.275 + C = 1.480 + D = -0.223 + 0.173 * S + E = 5.426 + 0.623 * S + ES = 3.819 + 0.901 * S + BL = GRVGFS (X, S, SF, AL, BE, AK, BK, AG, BG, C, D, E, ES) + ZBB = BL * ALPHEM +! + RETURN + END +!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +!----------------------------------------------------------------------- +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! * +! G R S - LO - VIRTUAL PHOTON PARAMETRIZATIONS * +! * +! FOR A DETAILED EXPLANATION SEE * +! M. GLUECK, E.REYA, M. STRATMANN : * +! PHYS. REV. D51 (1995) 3220 * +! * +! THE PARAMETRIZATIONS ARE FITTED TO THE EVOLVED PARTONS FOR * +! Q**2 / GEV**2 BETWEEN 0.6 AND 5.E4 * +! AND (!) Q**2 > 5 P**2 * +! P**2 / GEV**2 BETWEEN 0.0 AND 10. * +! P**2 = 0 <=> REAL PHOTON * +! X BETWEEN 1.E-4 AND 1. * +! * +! HEAVY QUARK THRESHOLDS Q(H) = M(H) IN THE BETA FUNCTION : * +! M(C) = 1.5, M(B) = 4.5 * +! CORRESPONDING LAMBDA(F) VALUES IN GEV FOR Q**2 > M(H)**2 : * +! LO : LAMBDA(3) = 0.232, LAMBDA(4) = 0.200, * +! LAMBDA(5) = 0.153, * +! THE NUMBER OF ACTIVE QUARK FLAVOURS IS NF = 3 EVERYWHERE * +! EXCEPT IN THE BETA FUNCTION, I.E. THE HEAVY QUARKS C,B,... * +! ARE NOT PRESENT AS PARTONS IN THE Q2-EVOLUTION. * +! * +! PLEASE REPORT ANY STRANGE BEHAVIOUR TO : * +! STRAT@HAL1.PHYSIK.UNI-DORTMUND.DE * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! +!...INPUT PARAMETERS : +! +! X = MOMENTUM FRACTION +! Q2 = SCALE Q**2 IN GEV**2 +! P2 = VIRTUALITY OF THE PHOTON IN GEV**2 +! +!...OUTPUT (ALWAYS X TIMES THE DISTRIBUTION DIVIDED BY ALPHA_EM) : +!...OUTPUT (ALWAYS X TIMES THE DISTRIBUTION) : modified H.P.-B. 10.9.19 +! +!******************************************************* + SUBROUTINE GRSGALO(DX,DQ2,DP2, & + & DUPV,DDNV,DUSEA,DDSEA,DSTR,DCHM,DBOT,DGL) +! subroutine grsgalo(x,q2,p2,ugam,dgam,sgam,ggam) + implicit real*8 (a-h,o-z) + double precision & + & x, q2, p2, mu2, lam2, & + & ugam, dgam, sgam, ggam, & + & DUPV,DDNV,DUSEA,DDSEA,DSTR,DCHM,DBOT,DGL +! + dimension u1(40),ds1(40),g1(40) + dimension ud2(20),s2(20),g2(20) + dimension up0(20),dsp0(20),gp0(20) + DATA ALPHEM/7.29927D-3/ +! + data u1/-0.139d0,0.783d0,0.132d0,0.087d0,0.003d0,-0.0134d0, & + & 0.009d0,-0.017d0,0.092d0,-0.516d0,-0.085d0,0.439d0, & + & 0.013d0,0.108d0,-0.019d0,-0.272d0,-0.167d0,0.138d0, & + & 0.076d0,0.026d0,-0.013d0,0.27d0,0.107d0,-0.097d0,0.04d0, & + & 0.064d0,0.011d0,0.002d0,0.057d0,-0.057d0,0.162d0, & + & -0.172d0,0.124d0,-0.016d0,-0.065d0,0.044d0,-1.009d0, & + & 0.622d0,0.227d0,-0.184d0/ + data ds1/0.033d0,0.007d0,-0.0516d0,0.12d0,0.001d0,-0.013d0, & + & 0.018d0,-0.028d0,0.102d0,-0.595d0,-0.114d0,0.669d0, & + & 0.022d0,0.001d0,-0.003d0,-0.0583d0,-0.041d0,0.035d0, & + & 0.009d0,0.009d0,0.004d0,0.054d0,0.025d0,-0.02d0, & + & 0.007d0,0.021d0,0.01d0,0.004d0,-0.067d0,0.06d0,-0.148d0, & + & 0.13d0,0.032d0,-0.009d0,-0.06d0,0.036d0,-0.39d0,0.033d0, & + & 0.245d0,-0.171d0/ + data g1/0.025d0,0.d0,-0.018d0,0.112d0,-0.025d0,0.177d0, & + & -0.022d0,0.024d0,0.001d0,-0.0104d0,0.d0,0.d0,-1.082d0, & + & -1.666d0,0.d0,0.086d0,0.d0,0.053d0,0.005d0,-0.058d0, & + & 0.034d0,0.073d0,1.08d0,1.63d0,-0.0256d0,-0.088d0,0.d0, & + & 0.d0,-0.004d0,0.016d0,0.007d0,-0.012d0,0.01d0,-0.673d0, & + & 0.126d0,-0.167d0,0.032d0,-0.227d0,0.086d0,-0.159d0/ + data ud2/0.756d0,0.187d0,0.109d0,-0.163d0,0.002d0,0.004d0, & + & 0.054d0,-0.039d0,22.53d0,-21.02d0,5.608d0,0.332d0, & + & -0.008d0,-0.021d0,0.381d0,0.572d0,4.774d0,1.436d0, & + & -0.614d0,3.548d0/ + data s2/0.902d0,0.182d0,0.271d0,-0.346d0,0.017d0,-0.01d0, & + & -0.011d0,0.0065d0,17.1d0,-13.29d0,6.519d0,0.031d0, & + & -0.0176d0,0.003d0,1.243d0,0.804d0,4.709d0,1.499d0, & + & -0.48d0,3.401d0/ + data g2/0.364d0,1.31d0,0.86d0,-0.254d0,0.611d0,0.008d0, & + & -0.097d0,-2.412d0,-0.843d0,2.248d0,-0.201d0,1.33d0, & + & 0.572d0,0.44d0,1.233d0,0.009d0,0.954d0,1.862d0,3.791d0, & + & -0.079d0/ + data up0/1.551d0,0.105d0,1.089d0,-0.172d0,3.822d0,-2.162d0, & + & 0.533d0,-0.467d0,-0.412d0,0.2d0,0.377d0,0.299d0,0.487d0, & + & 0.0766d0,0.119d0,0.063d0,7.605d0,0.234d0,-0.567d0, & + & 2.294d0/ + data dsp0/2.484d0,1.214d0,1.088d0,-0.1735d0,4.293d0, & + & -2.802d0,0.5975d0,-0.1193d0,-0.0872d0,0.0418d0,0.128d0, & + & 0.0337d0,0.127d0,0.0135d0,0.14d0,0.0423d0,6.946d0, & + & 0.814d0,1.531d0,0.124d0/ + data gp0/1.682d0,1.1d0,0.5888d0,-0.4714d0,0.5362d0,0.0127d0, & + & -2.438d0,0.03399d0,0.07825d0,0.05842d0,0.08393d0,2.348d0, & + & -0.07182d0,1.084d0,0.3098d0,-0.07514d0,3.327d0,1.1d0, & + & 2.264d0,0.2675d0/ +! + save u1,ds1,g1,ud2,s2,g2,up0,dsp0,gp0 +! + x = DX + q = SQRT(DQ2) + q2 = DQ2 + p2 = DP2 + mu2=0.25d0 + lam2=0.232d0*0.232d0 +! + if(p2.le.0.25d0) then + s=log(log(q2/lam2)/log(mu2/lam2)) + lp1=0.d0 + lp2=0.d0 + else + if(q2.lt.p2) then + write(*,1000) + 1000 format & + & (' WARNING: GRSGALO has been called with Q2 < P2 !',/, & + & ' GRSGALO is about to blow up, therefore',/, & + & ' Q2 is set equal to P2') + q2=p2 + endif + s=log(log(q2/lam2)/log(p2/lam2)) + lp1=log(p2/mu2)*log(p2/mu2) + lp2=log(p2/mu2+log(p2/mu2)) + endif +! + alp=up0(1)+lp1*u1(1)+lp2*u1(2) + bet=up0(2)+lp1*u1(3)+lp2*u1(4) + a=up0(3)+lp1*u1(5)+lp2*u1(6)+ & + & (up0(4)+lp1*u1(7)+lp2*u1(8))*s + b=up0(5)+lp1*u1(9)+lp2*u1(10)+ & + & (up0(6)+lp1*u1(11)+lp2*u1(12))*s**0.5+ & + & (up0(7)+lp1*u1(13)+lp2*u1(14))*s**2 + gb=up0(8)+lp1*u1(15)+lp2*u1(16)+ & + & (up0(9)+lp1*u1(17)+lp2*u1(18))*s+ & + & (up0(10)+lp1*u1(19)+lp2*u1(20))*s**2 + ga=up0(11)+lp1*u1(21)+lp2*u1(22)+ & + & (up0(12)+lp1*u1(23)+lp2*u1(24))*s**0.5 + gc=up0(13)+lp1*u1(25)+lp2*u1(33)+ & + & (up0(14)+lp1*u1(26)+lp2*u1(34))*s + gd=up0(15)+lp1*u1(27)+lp2*u1(35)+ & + & (up0(16)+lp1*u1(28)+lp2*u1(36))*s + ge=up0(17)+lp1*u1(29)+lp2*u1(37)+ & + & (up0(18)+lp1*u1(30)+lp2*u1(38))*s + gep=up0(19)+lp1*u1(31)+lp2*u1(39)+ & + & (up0(20)+lp1*u1(32)+lp2*u1(40))*s + upart1=grsf2(x,s,alp,bet,a,b,ga,gb,gc,gd,ge,gep) +! + alp=dsp0(1)+lp1*ds1(1)+lp2*ds1(2) + bet=dsp0(2)+lp1*ds1(3)+lp2*ds1(4) + a=dsp0(3)+lp1*ds1(5)+lp2*ds1(6)+ & + & (dsp0(4)+lp1*ds1(7)+lp2*ds1(8))*s + b=dsp0(5)+lp1*ds1(9)+lp2*ds1(10)+ & + & (dsp0(6)+lp1*ds1(11)+lp2*ds1(12))*s**0.5+ & + & (dsp0(7)+lp1*ds1(13)+lp2*ds1(14))*s**2 + gb=dsp0(8)+lp1*ds1(15)+lp2*ds1(16)+ & + & (dsp0(9)+lp1*ds1(17)+lp2*ds1(18))*s+ & + & (dsp0(10)+lp1*ds1(19)+lp2*ds1(20))*s**2 + ga=dsp0(11)+lp1*ds1(21)+lp2*ds1(22)+ & + & (dsp0(12)+lp1*ds1(23)+lp2*ds1(24))*s + gc=dsp0(13)+lp1*ds1(25)+lp2*ds1(33)+ & + & (dsp0(14)+lp1*ds1(26)+lp2*ds1(34))*s + gd=dsp0(15)+lp1*ds1(27)+lp2*ds1(35)+ & + & (dsp0(16)+lp1*ds1(28)+lp2*ds1(36))*s + ge=dsp0(17)+lp1*ds1(29)+lp2*ds1(37)+ & + & (dsp0(18)+lp1*ds1(30)+lp2*ds1(38))*s + gep=dsp0(19)+lp1*ds1(31)+lp2*ds1(39)+ & + & (dsp0(20)+lp1*ds1(32)+lp2*ds1(40))*s + dspart1=grsf2(x,s,alp,bet,a,b,ga,gb,gc,gd,ge,gep) +! + alp=gp0(1)+lp1*g1(1)+lp2*g1(2) + bet=gp0(2)+lp1*g1(3)+lp2*g1(4) + a=gp0(3)+lp1*g1(5)+lp2*g1(6)+ & + & (gp0(4)+lp1*g1(7)+lp2*g1(8))*s**0.5 + b=gp0(5)+lp1*g1(9)+lp2*g1(10)+ & + & (gp0(6)+lp1*g1(11)+lp2*g1(12))*s**2 + gb=gp0(7)+lp1*g1(13)+lp2*g1(14)+ & + & (gp0(8)+lp1*g1(15)+lp2*g1(16))*s + ga=gp0(9)+lp1*g1(17)+lp2*g1(18)+ & + & (gp0(10)+lp1*g1(19)+lp2*g1(20))*s**0.5+ & + & (gp0(11)+lp1*g1(21)+lp2*g1(22))*s**2 + gc=gp0(12)+lp1*g1(23)+lp2*g1(24)+ & + & (gp0(13)+lp1*g1(25)+lp2*g1(26))*s**2 + gd=gp0(14)+lp1*g1(27)+lp2*g1(28)+ & + & (gp0(15)+lp1*g1(29)+lp2*g1(30))*s+ & + & (gp0(16)+lp1*g1(31)+lp2*g1(32))*s**2 + ge=gp0(17)+lp1*g1(33)+lp2*g1(34)+ & + & (gp0(18)+lp1*g1(35)+lp2*g1(36))*s + gep=gp0(19)+lp1*g1(37)+lp2*g1(38)+ & + & (gp0(20)+lp1*g1(39)+lp2*g1(40))*s + gpart1=grsf2(x,s,alp,bet,a,b,ga,gb,gc,gd,ge,gep) +! + s=log(log(q2/lam2)/log(mu2/lam2)) + suppr=1.d0/(1.d0+p2/0.59d0)**2 +! + alp=ud2(1) + bet=ud2(2) + a=ud2(3)+ud2(4)*s + ga=ud2(5)+ud2(6)*s**0.5 + gc=ud2(7)+ud2(8)*s + b=ud2(9)+ud2(10)*s+ud2(11)*s**2 + gb=ud2(12)+ud2(13)*s+ud2(14)*s**2 + gd=ud2(15)+ud2(16)*s + ge=ud2(17)+ud2(18)*s + gep=ud2(19)+ud2(20)*s + udpart2=suppr*grsf1(x,s,alp,bet,a,b,ga,gb,gc,gd,ge,gep) +! + alp=s2(1) + bet=s2(2) + a=s2(3)+s2(4)*s + ga=s2(5)+s2(6)*s**0.5 + gc=s2(7)+s2(8)*s + b=s2(9)+s2(10)*s+s2(11)*s**2 + gb=s2(12)+s2(13)*s+s2(14)*s**2 + gd=s2(15)+s2(16)*s + ge=s2(17)+s2(18)*s + gep=s2(19)+s2(20)*s + spart2=suppr*grsf2(x,s,alp,bet,a,b,ga,gb,gc,gd,ge,gep) +! + alp=g2(1) + bet=g2(2) + a=g2(3)+g2(4)*s**0.5 + b=g2(5)+g2(6)*s**2 + gb=g2(7)+g2(8)*s + ga=g2(9)+g2(10)*s**0.5+g2(11)*s**2 + gc=g2(12)+g2(13)*s**2 + gd=g2(14)+g2(15)*s+g2(16)*s**2 + ge=g2(17)+g2(18)*s + gep=g2(19)+g2(20)*s + gpart2=suppr*grsf1(x,s,alp,bet,a,b,ga,gb,gc,gd,ge,gep) +! + ugam=upart1+udpart2 + DUPV = UGAM * ALPHEM + DUSEA = DUPV + dgam=dspart1+udpart2 + DDNV = DGAM * ALPHEM + DDSEA = DDNV + sgam=dspart1+spart2 + DSTR = SGAM * ALPHEM + ggam=gpart1+gpart2 + DGL = GGAM * ALPHEM +! + DCHM = 0.D0 + DBOT = 0.D0 +! + return + END +!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + FUNCTION GRVGF (X, S, AL, BE, AK, BK, AG, BG, C, D, E, ES) + IMPLICIT REAL (A - Z) + SX = SQRT (X) + LX = ALOG (1./X) + GRVGF = (X**AK * (AG + BG * SX + C * X**BK) + S**AL & + & * EXP (-E + SQRT (ES * S**BE * LX))) * (1.- X)**D + RETURN + END +!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + FUNCTION GRVGFS (X, S, SF, AL, BE, AK, BK, AG, BG, C, D, E, ES) + IMPLICIT REAL (A - Z) + IF (S .LE. SF) THEN + GRVGFS = 0.0 + ELSE + SX = SQRT (X) + LX = ALOG (1./X) + DS = S - SF + GRVGFS = (DS * X**AK * (AG + BG * SX + C * X**BK) + DS**AL & + & * EXP (-E + SQRT (ES * S**BE * LX))) * (1.- X)**D + END IF + RETURN + END +!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + double precision function grsf1(x,s,alp,bet,a,b,ga,gb,gc,gd, & + & ge,gep) + implicit real*8 (a-h,o-z) +! + grsf1=(x**a*(ga+gb*sqrt(x)+gc*x**b)+ & + & s**alp*exp(-ge+sqrt(gep*s**bet*log(1.d0/x))))* & + & (1.d0-x)**gd + return + END +!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + double precision function grsf2(x,s,alp,bet,a,b,ga,gb,gc,gd, & + & ge,gep) + implicit real*8 (a-h,o-z) +! + grsf2=(s*x**a*(ga+gb*sqrt(x)+gc*x**b)+ & + & s**alp*exp(-ge+sqrt(gep*s**bet*log(1.d0/x))))* & + & (1.d0-x)**gd + return + END diff --git a/LHAPDF/lhapdf-5.9.1/src/wrapgrvpi.f b/LHAPDF/lhapdf-5.9.1/src/wrapgrvpi.f new file mode 100644 index 00000000000..8df3b3e55b3 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/wrapgrvpi.f @@ -0,0 +1,401 @@ +! -*- F90 -*- + + + subroutine GRVP1evolve(xin,qin,pdf) + include 'parmsetup.inc' + real*8 xin,qin,pdf(-6:6),xval(45),qcdl4,qcdl5 + real*8 upv,dnv,usea,dsea,str,chm,bot,top,glu + character*16 name(nmxset) + integer nmem(nmxset),ndef(nmxset),mmem + common/NAME/name,nmem,ndef,mmem + integer nset + + save + + call grvpiho(xin,Qin,upv,dnv,usea,str,chm,bot,top,glu) + + pdf(-6)= top + pdf(6)= top + pdf(-5)= bot + pdf(5 )= bot + pdf(-4)= chm + pdf(4 )= chm + pdf(-3)= str + pdf(3 )= str + pdf(-2)= usea + pdf(2 )= upv+usea + pdf(-1)= usea + pdf(1 )= dnv+usea + pdf(0 )= glu + + return +! + entry GRVP0evolve(xin,qin,pdf) + + call grvpilo(xin,Qin,upv,dnv,usea,str,chm,bot,top,glu) + + pdf(-6)= top + pdf(6)= top + pdf(-5)= bot + pdf(5 )= bot + pdf(-4)= chm + pdf(4 )= chm + pdf(-3)= str + pdf(3 )= str + pdf(-2)= usea + pdf(2 )= upv+usea + pdf(-1)= usea + pdf(1 )= dnv+usea + pdf(0 )= glu + + return +! +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + entry GRVPread(nset) + read(1,*)nmem(nset),ndef(nset) + return +! +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + entry GRVPalfa(alfas,qalfa) + call getnset(iset) + call getnmem(iset,imem) + call GetOrderAsM(iset,iord) + call Getlam4M(iset,imem,qcdl4) + call Getlam5M(iset,imem,qcdl5) + call aspdflib(alfas,Qalfa,iord,qcdl5) + return +! +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + entry GRVPinit(Eorder,Q2fit) + return +! +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + entry GRVPpdf(mem) +! imem = mem + call getnset(iset) + call setnmem(iset,mem) + return +! + 1000 format(5e13.5) + END +! +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +! +! $Id: wrapgrvpi.f 356 2008-08-28 15:58:02Z buckley $ +! +! $Log$ +! Revision 1.2 2005/10/07 15:15:05 whalley +! Changes to most files for V5 - multiset initializations +! +! Revision 1.1.1.1 2005/05/06 14:54:43 whalley +! Initial CVS import of the LHAPDF code and data sets +! +! Revision 1.1.1.2 1996/10/30 08:28:44 cernlib +! Version 7.04 +! +! Revision 1.1.1.1 1996/04/12 15:29:24 plothow +! Version 7.01 +! +! + SUBROUTINE GRVPIHO (ZX,ZQ,ZUV,ZDV,ZUDB,ZSB,ZCB,ZBB,ZTB,ZGL) +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! * +! G R V - P I O N - P A R A M E T R I Z A T I O N S * +! * +! FOR A DETAILED EXPLANATION SEE : * +! M. GLUECK, E.REYA, A.VOGT: DO-TH 91/16 * +! * +! THE PARAMETRIZATIONS ARE FITTED TO THE PARTON DISTRIBUTIONS * +! FOR Q ** 2 BETWEEN MU ** 2 (= 0.25 / 0.30 GEV ** 2 IN LO * +! / HO) AND 1.E8 GEV ** 2 AND FOR X BETWEEN 1.E-5 AND 1. * +! REGIONS, WHERE THE DISTRIBUTION UNDER CONSIDERATION IS NEG- * +! LIGIBLE, I.E. BELOW ABOUT 1.E-4, WERE EXCLUDED FROM THE FIT. * +! * +! HEAVY QUARK THRESHOLDS Q(H) = M(H) : * +! M(C) = 1.5, M(B) = 4.5, M(T) = 100 GEV * +! * +! CORRESPONDING LAMBDA(F) VALUES FOR F ACTIVE FLAVOURS : * +! LO : LAMBDA(3) = 0.232, LAMBDA(4) = 0.200, * +! LAMBDA(5) = 0.153, LAMBDA(6) = 0.082 GEV * +! HO : LAMBDA(3) = 0.248, LAMBDA(4) = 0.200, * +! LAMBDA(5) = 0.131, LAMBDA(6) = 0.053 GEV * +! * +! HO DISTRIBUTION REFER TO THE MS-BAR SCHEME OF BARDEEN ET AL. * +! * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! + IMPLICIT REAL (A - Y) + double precision & + & ZX,ZQ,ZUV,ZDV,ZUDB,ZSB,ZCB,ZBB,ZTB,ZGL + REAL X, Q + X = ZX + Q = ZQ + MU2 = 0.3 + LAM2 = 0.248 * 0.248 + Q2 = Q*Q + S = ALOG (ALOG(Q2/LAM2) / ALOG(MU2/LAM2)) + DS = SQRT (S) + S2 = S * S +!...X * VALENCE : + NV = 0.456 + 0.150 * DS + 0.112 * S - 0.019 * S2 + AKV = 0.505 - 0.033 * S + AGV = 0.748 - 0.669 * DS - 0.133 * S + DV = 0.365 + 0.197 * DS + 0.394 * S + VAP = GRVFVP (X, NV, AKV, AGV, DV) + ZUV = VAP + ZDV = ZUV +!...X * GLUON : + ALG = 1.096 + BEG = 1.371 + AKG = 0.437 - 0.689 * DS + BKG = -0.631 + AGG = 1.324 - 0.441 * DS - 0.130 * S + BGG = -0.955 + 0.259 * S + CG = 1.075 - 0.302 * S + DG = 1.158 + 1.229 * S + EG = 0.0 + 2.510 * S + ESG = 2.604 + 0.165 * S + GLP = GRVFGP(X,S, ALG, BEG, AKG, BKG, AGG, BGG, CG, DG, EG, ESG) + ZGL = GLP +!...X * QBAR (SU(3)-SYMMETRIC SEA) : + SL = 0.0 + ALS = 0.85 + BES = 0.96 + AKS = -0.350 + 0.806 * S + AGS = -1.663 + BS = 3.148 + DS = 2.273 + 1.438 * S + EST = 3.214 + 1.545 * S + ESS = 1.341 + 1.938 * S + QBP = GRVFQBP (X, S, SL, ALS, BES, AKS, AGS, BS, DS, EST, ESS) + ZUDB = QBP + ZSB = ZUDB +!...X * CBAR = X * C : + SC = 0.820 + ALC = 0.98 + BEC = 0.0 + AKC = 0.0 - 0.457 * S + AGC = 0.0 + BC = -1.00 + 1.40 * S + DC = 1.318 + 0.584 * S + EC = 4.45 + 1.235 * S + ESC = 1.496 + 1.010 * S + CBP = GRVFQBP (X, S, SC, ALC, BEC, AKC, AGC, BC, DC, EC, ESC) + ZCB = CBP +!...X * BBAR = X * B : + SBO = 1.297 + ALB = 0.99 + BEB = 0.0 + AKB = 0.0 - 0.172 * S + AGB = 0.0 + BBO = 0.0 + DB = 1.447 + 0.485 * S + EB = 4.79 + 1.164 * S + ESB = 1.724 + 2.121 * S + BBP = GRVFQBP (X, S, SBO, ALB, BEB, AKB, AGB, BBO, DB, EB, ESB) + ZBB = BBP +!...X * TBAR = X * T : + TBP = 0. + ZTB = TBP + RETURN + END +!================================================================= +! +! $Id: wrapgrvpi.f 356 2008-08-28 15:58:02Z buckley $ +! +! $Log$ +! Revision 1.2 2005/10/07 15:15:05 whalley +! Changes to most files for V5 - multiset initializations +! +! Revision 1.1.1.1 2005/05/06 14:54:43 whalley +! Initial CVS import of the LHAPDF code and data sets +! +! Revision 1.1.1.2 1996/10/30 08:28:44 cernlib +! Version 7.04 +! +! Revision 1.1.1.1 1996/04/12 15:29:24 plothow +! Version 7.01 +! +! + SUBROUTINE GRVPILO (ZX,ZQ,ZUV,ZDV,ZUDB,ZSB,ZCB,ZBB,ZTB,ZGL) +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! * +! G R V - P I O N - P A R A M E T R I Z A T I O N S * +! * +! FOR A DETAILED EXPLANATION SEE : * +! M. GLUECK, E.REYA, A.VOGT: DO-TH 91/16 * +! * +! THE PARAMETRIZATIONS ARE FITTED TO THE PARTON DISTRIBUTIONS * +! FOR Q ** 2 BETWEEN MU ** 2 (= 0.25 / 0.30 GEV ** 2 IN LO * +! / HO) AND 1.E8 GEV ** 2 AND FOR X BETWEEN 1.E-5 AND 1. * +! REGIONS, WHERE THE DISTRIBUTION UNDER CONSIDERATION IS NEG- * +! LIGIBLE, I.E. BELOW ABOUT 1.E-4, WERE EXCLUDED FROM THE FIT. * +! * +! HEAVY QUARK THRESHOLDS Q(H) = M(H) : * +! M(C) = 1.5, M(B) = 4.5, M(T) = 100 GEV * +! * +! CORRESPONDING LAMBDA(F) VALUES FOR F ACTIVE FLAVOURS : * +! LO : LAMBDA(3) = 0.232, LAMBDA(4) = 0.200, * +! LAMBDA(5) = 0.153, LAMBDA(6) = 0.082 GEV * +! HO : LAMBDA(3) = 0.248, LAMBDA(4) = 0.200, * +! LAMBDA(5) = 0.131, LAMBDA(6) = 0.053 GEV * +! * +! HO DISTRIBUTION REFER TO THE MS-BAR SCHEME OF BARDEEN ET AL. * +! * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! + IMPLICIT REAL (A - Y) + double precision & + & ZX,ZQ,ZUV,ZDV,ZUDB,ZSB,ZCB,ZBB,ZTB,ZGL + REAL X, Q + X = ZX + Q = ZQ + MU2 = 0.25 + LAM2 = 0.232 * 0.232 + Q2 = Q*Q + S = ALOG (ALOG(Q2/LAM2) / ALOG(MU2/LAM2)) + DS = SQRT (S) + S2 = S * S +!...X * VALENCE : + NV = 0.519 + 0.180 * S - 0.011 * S2 + AKV = 0.499 - 0.027 * S + AGV = 0.381 - 0.419 * S + DV = 0.367 + 0.563 * S + VAP = GRVFVP (X, NV, AKV, AGV, DV) + ZUV = VAP + ZDV = ZUV +!...X * GLUON : + ALG = 0.599 + BEG = 1.263 + AKG = 0.482 + 0.341 * DS + BKG = 0.0 + AGG = 0.678 + 0.877 * S - 0.175 * S2 + BGG = 0.338 - 1.597 * S + CG = 0.0 - 0.233 * S + 0.406 * S2 + DG = 0.390 + 1.053 * S + EG = 0.618 + 2.070 * S + ESG = 3.676 + GLP = GRVFGP(X,S, ALG, BEG, AKG, BKG, AGG, BGG, CG, DG, EG, ESG) + ZGL = GLP +!...X * QBAR (SU(3)-SYMMETRIC SEA) : + SL = 0.0 + ALS = 0.55 + BES = 0.56 + AKS = 2.538 - 0.763 * S + AGS = -0.748 + BS = 0.313 + 0.935 * S + DS = 3.359 + EST = 4.433 + 1.301 * S + ESS = 9.30 - 0.887 * S + QBP = GRVFQBP (X, S, SL, ALS, BES, AKS, AGS, BS, DS, EST, ESS) + ZUDB = QBP + ZSB = ZUDB +!...X * CBAR = X * C : + SC = 0.888 + ALC = 1.02 + BEC = 0.39 + AKC = 0.0 + AGC = 0.0 + BC = 1.008 + DC = 1.208 + 0.771 * S + EC = 4.40 + 1.493 * S + ESC = 2.032 + 1.901 * S + CBP = GRVFQBP (X, S, SC, ALC, BEC, AKC, AGC, BC, DC, EC, ESC) + ZCB = CBP +!...X * BBAR = X * B : + SBO = 1.351 + ALB = 1.03 + BEB = 0.39 + AKB = 0.0 + AGB = 0.0 + BBO = 0.0 + DB = 0.697 + 0.855 * S + EB = 4.51 + 1.490 * S + ESB = 3.056 + 1.694 * S + BBP = GRVFQBP (X, S, SBO, ALB, BEB, AKB, AGB, BBO, DB, EB, ESB) + ZBB = BBP +!...X * TBAR = X * T : + TBP = 0. + ZTB = TBP + RETURN + END +!==================================================================== +! +! $Id: wrapgrvpi.f 356 2008-08-28 15:58:02Z buckley $ +! +! $Log$ +! Revision 1.2 2005/10/07 15:15:05 whalley +! Changes to most files for V5 - multiset initializations +! +! Revision 1.1.1.1 2005/05/06 14:54:43 whalley +! Initial CVS import of the LHAPDF code and data sets +! +! Revision 1.1.1.2 1996/10/30 08:28:38 cernlib +! Version 7.04 +! +! Revision 1.1.1.1 1996/04/12 15:29:23 plothow +! Version 7.01 +! +! + FUNCTION GRVFVP (X, N, AK, AG, D) + IMPLICIT REAL (A - Z) + DX = SQRT (X) + GRVFVP = N * X**AK * (1.+ AG*DX) * (1.- X)**D + RETURN + END +!==================================================================== +! +! $Id: wrapgrvpi.f 356 2008-08-28 15:58:02Z buckley $ +! +! $Log$ +! Revision 1.2 2005/10/07 15:15:05 whalley +! Changes to most files for V5 - multiset initializations +! +! Revision 1.1.1.1 2005/05/06 14:54:43 whalley +! Initial CVS import of the LHAPDF code and data sets +! +! Revision 1.1.1.2 1996/10/30 08:28:37 cernlib +! Version 7.04 +! +! Revision 1.1.1.1 1996/04/12 15:29:23 plothow +! Version 7.01 +! +! + FUNCTION GRVFQBP (X, S, ST, AL, BE, AK, AG, B, D, E, ES) + IMPLICIT REAL (A - Z) + DX = SQRT (X) + LX = ALOG (1./X) + IF (S .LE. ST) THEN + GRVFQBP = 0.0 + ELSE + GRVFQBP = (S-ST)**AL / LX**AK * (1.+ AG*DX + B*X) * (1.- X)**D& + & * EXP (-E + SQRT (ES * S**BE * LX)) + END IF + RETURN + END +!==================================================================== +! +! $Id: wrapgrvpi.f 356 2008-08-28 15:58:02Z buckley $ +! +! $Log$ +! Revision 1.2 2005/10/07 15:15:05 whalley +! Changes to most files for V5 - multiset initializations +! +! Revision 1.1.1.1 2005/05/06 14:54:43 whalley +! Initial CVS import of the LHAPDF code and data sets +! +! Revision 1.1.1.2 1996/10/30 08:28:36 cernlib +! Version 7.04 +! +! Revision 1.1.1.1 1996/04/12 15:29:23 plothow +! Version 7.01 +! +! + FUNCTION GRVFGP (X, S, AL, BE, AK, BK, AG, BG, C, D, E, ES) + IMPLICIT REAL (A - Z) + DX = SQRT (X) + LX = ALOG (1./X) + GRVFGP = (X**AK * (AG + BG*DX + C*X) * LX**BK + S**AL & + & * EXP (-E + SQRT (ES * S**BE * LX))) * (1.- X)**D + RETURN + END diff --git a/LHAPDF/lhapdf-5.9.1/src/wrapgsg.f b/LHAPDF/lhapdf-5.9.1/src/wrapgsg.f new file mode 100644 index 00000000000..0c1b768654c --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/wrapgsg.f @@ -0,0 +1,225 @@ +! -*- F90 -*- + + + subroutine GSGevolvep0(xin,qin,p2in,ip2in,pdf) + include 'parmsetup.inc' + real*8 xin,qin,q2in,p2in,pdf(-6:6),xval(45),qcdl4,qcdl5 + real*8 upv,dnv,usea,dsea,str,chm,bot,top,glu + real*8 SIG,QNS,GL + real*8 holdit + common/gsgdat/SIG(78,11,3),QNS(78,11,3),GL(78,11,3) + character*16 name(nmxset) + integer nmem(nmxset),ndef(nmxset),mmem + common/NAME/name,nmem,ndef,mmem + integer nset + save + + call getnset(iset) + call getnmem(iset,iimem) +! -- this is LO 2 --> 3 0/1 --> 2 + if(iimem.eq.2) iimem = 3 + if(iimem.eq.0) iimem = 2 + if(iimem.eq.1) iimem = 2 + + call SFGSHL(iimem,xin,qin,upv,dnv,usea,dsea,str,chm,bot,glu) + + pdf(-6)= 0.0d0 + pdf(6)= 0.0d0 + pdf(-5)= bot + pdf(5 )= bot + pdf(-4)= chm + pdf(4 )= chm + pdf(-3)= str + pdf(3 )= str + pdf(-2)= usea + pdf(2 )= upv + pdf(-1)= dsea + pdf(1 )= dnv + pdf(0 )= glu + + return +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + entry GSGevolvep1(xin,qin,p2in,ip2in,pdf) + +!--- this is HO --- iimem=1 + iimem = 1 + call SFGSHL(iimem,xin,qin,upv,dnv,usea,dsea,str,chm,bot,glu) + + + pdf(-6)= 0.0d0 + pdf(6)= 0.0d0 + pdf(-5)= bot + pdf(5 )= bot + pdf(-4)= chm + pdf(4 )= chm + pdf(-3)= str + pdf(3 )= str + pdf(-2)= usea + pdf(2 )= upv + pdf(-1)= dsea + pdf(1 )= dnv + pdf(0 )= glu + + return +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + entry GSGread(nset) + read(1,*)nmem(nset),ndef(nset) + do j=1,3 + do k=1,78 + do m=1,11 + read(1,*)SIG(k,m,j),QNS(k,m,j),GL(k,m,j) + enddo + enddo + enddo + return +! +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + entry GSGalfa(alfas,qalfa) + call getnset(iset) + call getnmem(iset,imem) + call GetOrderAsM(iset,iord) + call Getlam4M(iset,imem,qcdl4) + call Getlam5M(iset,imem,qcdl5) + call aspdflib(alfas,Qalfa,iord,qcdl5) +! call aspdflib(alfas,Qalfa,iord,qcdl5) + + return +! +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + entry GSGinit(Eorder,Q2fit) + return +! +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + entry GSGpdf(mem) + call getnset(iset) + call setnmem(iset,mem) +! imem = mem + return +! + 1000 format(5e13.5) + END +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +! SUBROUTINE SFGSHO(X,Q,U,D,US,DS,S,C,B,G) + SUBROUTINE SFGSHL(iset,X,Q,U,D,US,DS,S,C,B,G) +! +!**************************************************************** +! Subroutine returns the parton distributions in the photon in * +! higher order. u,d etc. gives the actual distributions and * +! not x times the distributions; Q2 means Q 2. The distributions* +! are valid for 5.0e -4< x < 1.0 and 5.3 GeV 2 < Q 2 < 1.0e 8. * +! if higher Q 2 or lower x is required, these may be obtained * +! from the authors on request. * +! Lionel Gordon July 1991 : Gordon@uk.ac.man.ph.v2 * +!**************************************************************** +! + implicit real*8 (a-h,o-z) + PARAMETER(NP=78,NQ=11,NARG=2) + double precision & + & DBFINT, & + & Y(NP), & + & XT(NARG),A(NP+NQ),QT(NQ) +! + SIG(NP,NQ),QNS(NP,NQ),GL(NP,NQ),Y(NP), + common/gsgdat/SIG(78,11,3),QNS(78,11,3),GL(78,11,3) + DIMENSION NA(NARG) + EXTERNAL GSXCOR +! SAVE SIG,QNS,GL,Y,ICALL + SAVE Y,ICALL + DATA QT /5.3D0,20.0D0,50.0D0,1.0D2,5.0D2,1.0D3,1.0D4,1.0D5, & + & 1.0D6,1.0D7,1.0D8/ + DATA ZEROD/0.D0/ + DATA ICALL/0/ +!***************************************************************** + U = ZEROD + D = ZEROD + S = ZEROD + C = ZEROD + B = ZEROD + G = ZEROD +!if x is out of range + if(iset.eq.1) then + IF((X.LT.5.0D-4).OR.(X.GT.0.95D0)) GOTO 90 + else + IF((X.LT.5.0D-4).OR.(X.GT.0.99D0)) GOTO 90 + endif + +!****************************************************************** + IF (ICALL.NE.1) THEN +! get the x coordinates + CALL GSXCOR(Y,NP) + ICALL=1 + END IF +! + DO 30 IX=1,NP + A(IX)=Y(IX) + 30 END DO + DO 40 IQ=1,NQ + A(NP+IQ)=QT(IQ) + 40 END DO +! + Q2 = Q*Q + NA(1)=NP + NA(2)=NQ + XT(1)=X + XT(2)=Q2 + XSIG=DBFINT(2,XT,NA,A,SIG(1,1,iset)) + XQNS=DBFINT(2,XT,NA,A,QNS(1,1,iset)) + G =DBFINT(2,XT,NA,A,GL(1,1,iset)) +! + IF (Q2.LT.50.0D0) THEN +! Use three flavour evolution. + U=(XSIG+9.0D0*XQNS)/6.0D0 + D=(XSIG-4.5D0*XQNS)/6.0D0 + S=D + C=ZEROD + B=ZEROD +! + ELSE IF((Q2.GT.50.0D0).AND.(Q2.LT.250.0D0)) THEN +! Use four flavour evolution + U=(XSIG+6.0D0*XQNS)/8.0D0 + D=(XSIG-6.0D0*XQNS)/8.0D0 + S=D + C=U + B=ZEROD + ELSE +! Use five flavour evolution + U=(XSIG+7.5D0*XQNS)/10.0D0 + D=(XSIG-5.0D0*XQNS)/10.0D0 + S=D + C=U + B=D + ENDIF + U=X*U + US=U + D=X*D + DS=D + S=X*S + C=X*C + B=X*B + G=X*G + 90 RETURN + END +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + SUBROUTINE GSXCOR(Y,NP) +! + implicit real*8 (a-h,o-z) + double precision & + & Y(NP) + N=1 + DO 10 IX=1,20,2 + Y(N)= (IX)/2000.0D0 + N=N+1 + 10 END DO + DO 20 IX=30,200,10 + Y(N)= (IX)/2000.0D0 + N=N+1 + 20 END DO + DO 30 IX=240,1600,40 + Y(N)= (IX)/2000.0D0 + N=N+1 + 30 END DO + DO 40 IX=1625,1980,25 + Y(N)= (IX)/2000.0D0 + N=N+1 + 40 END DO + RETURN + END diff --git a/LHAPDF/lhapdf-5.9.1/src/wrapgsg96.f b/LHAPDF/lhapdf-5.9.1/src/wrapgsg96.f new file mode 100644 index 00000000000..8ce26812121 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/wrapgsg96.f @@ -0,0 +1,211 @@ +! -*- F90 -*- + + + subroutine GSG96evolvep0(xin,qin,p2in,ip2in,pdf) + include 'parmsetup.inc' + real*8 xin,qin,q2in,p2in,pdf(-6:6),xval(45),qcdl4,qcdl5 + real*8 upv,dnv,usea,dsea,str,chm,bot,top,glu + real*8 SIG,QNS,GL + common/gsgdat/SIG(78,11,3),QNS(78,11,3),GL(78,11,3) + character*16 name(nmxset) + integer nmem(nmxset),ndef(nmxset),mmem + common/NAME/name,nmem,ndef,mmem + integer nset + + save + + iimem = 2 + call GS96HL(iimem,xin,qin,upv,dnv,str,chm,bot,glu) + usea = upv + dsea = dnv + + pdf(-6)= 0.0d0 + pdf(6)= 0.0d0 + pdf(-5)= bot + pdf(5 )= bot + pdf(-4)= chm + pdf(4 )= chm + pdf(-3)= str + pdf(3 )= str + pdf(-2)= usea + pdf(2 )= upv + pdf(-1)= dsea + pdf(1 )= dnv + pdf(0 )= glu + + return +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + entry GSG96evolvep1(xin,qin,p2in,ip2in,pdf) + + iimem = 1 + call GS96HL(iimem,xin,qin,upv,dnv,str,chm,bot,glu) + usea = upv + dsea = dnv + + pdf(-6)= 0.0d0 + pdf(6)= 0.0d0 + pdf(-5)= bot + pdf(5 )= bot + pdf(-4)= chm + pdf(4 )= chm + pdf(-3)= str + pdf(3 )= str + pdf(-2)= usea + pdf(2 )= upv + pdf(-1)= dsea + pdf(1 )= dnv + pdf(0 )= glu + + return +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + entry GSG96read(nset) + read(1,*)nmem(nset),ndef(nset) + + do m = 1,2 + do k = 1,78 + read(1,*)(sig(k,j,m),j=1,4) + read(1,*)(sig(k,j,m),j=5,8) + read(1,*)(sig(k,j,m),j=9,11) + enddo + do k = 1,78 + read(1,*)(qns(k,j,m),j=1,4) + read(1,*)(qns(k,j,m),j=5,8) + read(1,*)(qns(k,j,m),j=9,11) + enddo + do k = 1,78 + read(1,*)(gl(k,j,m),j=1,4) + read(1,*)(gl(k,j,m),j=5,8) + read(1,*)(gl(k,j,m),j=9,11) + enddo + enddo + return +! +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + entry GSG96alfa(alfas,qalfa) + call getnset(iset) + call getnmem(iset,imem) + call GetOrderAsM(iset,iord) + call Getlam4M(iset,imem,qcdl4) + call Getlam5M(iset,imem,qcdl5) + call aspdflib(alfas,Qalfa,iord,qcdl5) + return +! +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + entry GSG96init(Eorder,Q2fit) + return +! +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + entry GSG96pdf(mem) + call getnset(iset) + call setnmem(iset,mem) +! imem = mem + return +! + 1000 format(5e13.5) + END +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +! SUBROUTINE GS96HO(X,Q,U,D,S,C,B,G) + SUBROUTINE GS96HL(iset,X,Q,U,D,S,C,B,G) + implicit real*8 (a-h,o-z) + PARAMETER(NP=78,NQ=11,NARG=2) +!**************************************************************** +! Subroutine returns the parton distributions in the photon in * +! next-to-leading order. u,d etc. gives the actual distributions* +! not x times the distributions; Q2 means Q^2. The distributions* +! are valid for 5.0e^-4< x < 1.0 and 5.3 GeV^2 < Q^2 < 1.0e^8. * +! if higher Q^2 or lower x is required, these may be obtained * +! from the authors on request. * +! Lionel Gordon April 1996 : Gordon@hep.anl.gov * +! John Storrow :johns@a3.ph.man.ac.uk * +!**************************************************************** +! DIMENSION SIG(NP,NQ),QNS(NP,NQ),GL(NP,NQ),Y(NP) + DIMENSION Y(NP) + DIMENSION XT(NARG),NA(NARG),A(NP+NQ),QT(NQ) + common/gsgdat/SIG(78,11,3),QNS(78,11,3),GL(78,11,3) + EXTERNAL GS2XCOR +! SAVE SIG,QNS,GL,Y,ICALL + SAVE Y,ICALL + DATA QT /3.0D0,20.0D0,50.0D0,100.0D0,500.0D0,1.0D3,1.0D4,1.0D5, & + & 1.0D6,1.0D7,1.0D8/ +!***************************************************************** + q2=q*q +!if x is out of range + IF((X.LT.5.0D-4).OR.(X.GT.1.0D0)) GOTO 90 +!****************************************************************** + IF (ICALL.NE.1) THEN +! get the x coordinates + CALL GS2XCOR(Y,NP) + ICALL=1 + END IF +! + DO 30 IX=1,NP + A(IX)=Y(IX) + 30 END DO + DO 40 IQ=1,NQ + A(NP+IQ)=QT(IQ) + 40 END DO +! + NA(1)=NP + NA(2)=NQ + XT(1)=X + XT(2)=Q2 + XSIG=DBFINT(2,XT,NA,A,SIG(1,1,iset)) + XQNS=DBFINT(2,XT,NA,A,QNS(1,1,iset)) + G =DBFINT(2,XT,NA,A,GL(1,1,iset)) +! + IF (Q2.LT.50.0D0) THEN +! Use three flavour evolution. + U=(XSIG+9.0D0*XQNS)/6.0D0 + D=(XSIG-4.5D0*XQNS)/6.0D0 + S=D + C=0.0D0 + B=0.0D0 +! + ELSE IF((Q2.GT.50.0).AND.(Q2.LT.250.0)) THEN +! Use four flavour evolution + U=(XSIG+6.0D0*XQNS)/8.0D0 + D=(XSIG-6.0D0*XQNS)/8.0D0 + S=D + C=U + B=0.0D0 + ELSE +! Use five flavour evolution + U=(XSIG+7.5D0*XQNS)/10.0D0 + D=(XSIG-5.0D0*XQNS)/10.0D0 + S=D + C=U + B=D + ENDIF + U=X*U + US=U + D=X*D + DS=D + S=X*S + C=X*C + B=X*B + G=X*G + 90 RETURN + END +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + SUBROUTINE GS2XCOR(Y,NP) + IMPLICIT REAL*8(A-H,O-Z) + DIMENSION Y(NP) + N=1 + DO 10 IX=1,20,2 + Y(N)=DBLE(IX)/2000.0D0 + N=N+1 + 10 END DO + DO 20 IX=30,200,10 + Y(N)=DBLE(IX)/2000.0D0 + N=N+1 + 20 END DO + DO 30 IX=240,1600,40 + Y(N)=REAL(IX)/2000.0D0 + N=N+1 + 30 END DO + DO 40 IX=1625,1980,25 + Y(N)=REAL(IX)/2000.0D0 + N=N+1 + 40 END DO + RETURN + END diff --git a/LHAPDF/lhapdf-5.9.1/src/wraph1-lite.f b/LHAPDF/lhapdf-5.9.1/src/wraph1-lite.f new file mode 100644 index 00000000000..0c831fbab31 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/wraph1-lite.f @@ -0,0 +1,341 @@ +! -*- F90 -*- + + + subroutine H1evolve(xin,qin,pdf) + implicit real*8 (a-h,o-z) +!****************************************************** +! lite version !!! +! done on 13/07/04 at 10.04.39 +! evolution has been made starting at q2_input = 4.000 +! available for : 1.500 <= q2 <= 1000000.000 +! and : 0.000057 <= x <= 0.906052 +!* +! for x outside limits, the closest limit +! is assumed : f2(x>xmax,q2)=f2(xmax,q2) +! f2(xq2max)=f2(x,q2max) +! f2(x,q2 X =', 1PE12.3) + STOP + ENDIF + IF((Q2.LT.1.D0).OR.(Q2.GT.1.D8)) THEN + WRITE(*,1040) Q2 + 1040 FORMAT (' ','FF WARNING: OUT OF RANGE --> Q2 =', 1PE12.3) + STOP + ENDIF + +! INTERPOLATION. +! X: CUBIC SPLINE INTERPOLATION, LOG(Q2): LINEAR INTERPOLATION. + J=ISERCH(NQ,QG,Q2) + IF(J.EQ.NQ) J=NQ-1 + K=ISERCH(NX,XG,X) + DO I=1,ND + DX=X-XG(K) + PDFJ1(I)=PDFG(K,J,I,0) & + & +DX*(BXG(K,J,I,0)+DX*(CXG(K,J,I,0)+DX*DXG(K,J,I,0))) + PDFJ2(I)=PDFG(K,J+1,I,0) & + & +DX*(BXG(K,J+1,I,0)+DX*(CXG(K,J+1,I,0)+DX*DXG(K,J+1,I,0))) + + ENDDO + +! -- Nuclear PDF functions -- + T=(DLOG(Q2)-DLOG(QG(J)))/(DLOG(QG(J+1))-DLOG(QG(J))) + f(0)=(1.D0-T)*PDFJ1(1)+T*PDFJ2(1) ! g + f(1)=(1.D0-T)*PDFJ1(3)+T*PDFJ2(3) ! d + f(2)=(1.D0-T)*PDFJ1(2)+T*PDFJ2(2) ! u + f(-1)=(1.D0-T)*PDFJ1(5)+T*PDFJ2(5) ! db + f(-2)=(1.D0-T)*PDFJ1(4)+T*PDFJ2(4) ! ub + f(-3)=(1.D0-T)*PDFJ1(6)+T*PDFJ2(6) ! sb + f(4)=(1.D0-T)*PDFJ1(7)+T*PDFJ2(7) ! c + f(3)=f(-3) ! s=sb + f(-4)=f(4) ! cb=c + return + +! +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +! + entry hkngetgrid(nset,ngridx,ngridq,gridx,gridq) + + ngridx=NX + do jx=1,ngridx + gridx(jx)=XG(jx) + enddo + ngridq=NQ + do jq=1,ngridq + gridq(jq)=QG(jq) + enddo + + return + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + entry hknread(nset) + !dummy read to get to the End: (stream 1 is still open) + + read(1,*)nmem(nset),ndef(nset) + + do n=0,nmem(nset) + DO J=1,NQ + DO K=1,NX-1 + READ(1,'(a)') line + ENDDO + ENDDO + enddo + + return +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + entry hknalfa(alfas,Q) +! call alphamrs(4,alfas,q) + call alphahkn(q,alfas) + return +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + entry hkninit(nset,Eorder,Q2fit) + return +! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + entry hknpdf(mem) + + call getnset(iset) + call setnmem(iset,mem) + + ! here is the real read!! + + ! have to reopen stream 1 + call getsetpath(setpath) + open(1,file=setpath(1:len_trim(setpath)),action='READ') + + line = '' + do while (line(2:11).ne.'Evolution:') + read(1,'(a)'),line + enddo + read(1,'(a)'),line + read(1,'(a)'),line + + read(1,*)nmem(iset),ndef(iset) + ! - dummy read up to the member requested + do i=0,mem-1 + do j=1,nq + do k=1,nx-1 + read(1,'(a)')line + enddo + enddo + enddo + ! Now read in the grids from the grid file. + DO J=1,NQ + DO K=1,NX-1 + READ(1,1025) (PDFG(K,J,I,0), I=1,NFF) +! print *, + ENDDO + ENDDO + DO I=1,ND + DO J=1,NQ + PDFG(NX,J,I,0)=0.D0 ! x=1 NPDF=0.D0 + CALL LSPLINE(NX,XG,PDFG,BXG,CXG,DXG,ISET,I,J,0) + ENDDO + ENDDO + + close(1) + + 1025 FORMAT(1X,7(1PE14.6)) + + return +! + END +! --------------------------------------------------------------------- + SUBROUTINE LSPLINE(N,X,Y,B,C,D,ISET,I,J,nmem) +! --------------------------------------------------------------------- +! CALCULATE THE COEFFICIENTS B,C,D IN A CUBIC SPLINE INTERPOLATION. +! INTERPOLATION SUBROUTINES ARE TAKEN FROM +! G.E. FORSYTHE, M.A. MALCOLM AND C.B. MOLER, +! COMPUTER METHODS FOR MATHEMATICAL COMPUTATIONS (PRENTICE-HALL, 1977). + IMPLICIT REAL*8(A-H,O-Z) + PARAMETER (NQ=33, NX=117, ND=7, nhess=12) + DIMENSION Y(NX,NQ,ND,0:nhess),B(NX,NQ,ND,0:nhess),C(NX,NQ,ND,0:nhess),D(NX,NQ,ND,0:nhess) & + & ,X(NX) + NM1=N-1 + IF(N.LT.2) RETURN + IF(N.LT.3) GO TO 250 + D(1,J,I,nmem)=X(2)-X(1) + C(2,J,I,nmem)=(Y(2,J,I,nmem)-Y(1,J,I,nmem))/D(1,J,I,nmem) + DO 210 K=2,NM1 + D(K,J,I,nmem)=X(K+1)-X(K) + B(K,J,I,nmem)=2.0D0*(D(K-1,J,I,nmem)+D(K,J,I,nmem)) + C(K+1,J,I,nmem)=(Y(K+1,J,I,nmem)-Y(K,J,I,nmem))/D(K,J,I,nmem) + C(K,J,I,nmem)=C(K+1,J,I,nmem)-C(K,J,I,nmem) + 210 CONTINUE + B(1,J,I,nmem)=-D(1,J,I,nmem) + B(N,J,I,nmem)=-D(N-1,J,I,nmem) + C(1,J,I,nmem)=0.0D0 + C(N,J,I,nmem)=0.0D0 + IF(N.EQ.3) GO TO 215 + C(1,J,I,nmem)=C(3,J,I,nmem)/(X(4)-X(2))-C(2,J,I,nmem)/(X(3)-X(1)) + C(N,J,I,nmem)=C(N-1,J,I,nmem)/(X(N)-X(N-2))-C(N-2,J,I,nmem)/(X(N-1)-X(N-3)) + C(1,J,I,nmem)=C(1,J,I,nmem)*D(1,J,I,nmem)**2.0D0/(X(4)-X(1)) + C(N,J,I,nmem)=-C(N,J,I,nmem)*D(N-1,J,I,nmem)**2.0D0/(X(N)-X(N-3)) + 215 CONTINUE + DO 220 K=2,N + T=D(K-1,J,I,nmem)/B(K-1,J,I,nmem) + B(K,J,I,nmem)=B(K,J,I,nmem)-T*D(K-1,J,I,nmem) + C(K,J,I,nmem)=C(K,J,I,nmem)-T*C(K-1,J,I,nmem) + 220 CONTINUE + C(N,J,I,nmem)=C(N,J,I,nmem)/B(N,J,I,nmem) + DO 230 IB=1,NM1 + K=N-IB + C(K,J,I,nmem)=(C(K,J,I,nmem)-D(K,J,I,nmem)*C(K+1,J,I,nmem))/B(K,J,I,nmem) + 230 CONTINUE + B(N,J,I,nmem)=(Y(N,J,I,nmem)-Y(NM1,J,I,nmem))/D(NM1,J,I,nmem) & + & +D(NM1,J,I,nmem)*(C(NM1,J,I,nmem)+2.0D0*C(N,J,I,nmem)) + DO 240 K=1,NM1 + B(K,J,I,nmem)=(Y(K+1,J,I,nmem)-Y(K,J,I,nmem))/D(K,J,I,nmem) & + & -D(K,J,I,nmem)*(C(K+1,J,I,nmem)+2.0D0*C(K,J,I,nmem)) + D(K,J,I,nmem)=(C(K+1,J,I,nmem)-C(K,J,I,nmem))/D(K,J,I,nmem) + C(K,J,I,nmem)=3.0D0*C(K,J,I,nmem) + 240 CONTINUE + C(N,J,I,nmem)=3.0D0*C(N,J,I,nmem) + D(N,J,I,nmem)=D(N-1,J,I,nmem) + RETURN + 250 CONTINUE + B(1,J,I,nmem)=(Y(2,J,I,nmem)-Y(1,J,I,nmem))/(X(2)-X(1)) + C(1,J,I,nmem)=0.0D0 + D(1,J,I,nmem)=0.0D0 + B(2,J,I,nmem)=B(1,J,I,nmem) + C(2,J,I,nmem)=0.0D0 + D(2,J,I,nmem)=0.0D0 + RETURN + END +! --------------------------------------------------------------------- + INTEGER FUNCTION ISERCH(N,X,Y) +! --------------------------------------------------------------------- +! THIS FUNCTION SEARCHES "I" WHICH SATISFIES THE RELATION +! X(I) <= Y < X(I+1) BY USING A BINARY SEARCH. + IMPLICIT REAL*8(A-H,O-Z) + DIMENSION X(117) + + MIN=1 + MAX=N+1 + + 10 CONTINUE + MID=(MIN+MAX)/2 + IF(Y.LT.X(MID)) THEN + MAX=MID + ELSE + MIN=MID + END IF + IF((MAX-MIN).GT.1) GO TO 10 + + ISERCH=MIN + + RETURN + END +! ********************************************************************* +! THE END OF THE PROGRAM. +! ********************************************************************* +! --------------------------------------------------------------------- +! IN: Q2=Q^2 [GeV^2], IORDER=1:LO, 2:NLO +! OUT: Alpha_s +! + SUBROUTINE alphahkn(Q,ALPHA_S) +! --------------------------------------------------------------------- +! RUNNING COUPLING CONSTANTS. + IMPLICIT REAL*8(A-H,O-Z) + DATA DLAML,DLAMN/0.174D0, 0.3D0/ +! DATA THRE4,THRE5/1.35D0, 4.3D0/ + DATA THRE4,THRE5/1.35D0, 1.D+6/ + + call getnset(nset) + call GetOrderAsM(nset,iord) + q2 = q*q + iorder = iord + 1 + + PI=4.D0*DATAN(1.D0) + CTHRE=THRE4*THRE4 + BTHRE=THRE5*THRE5 + CF=4.D0/3.D0 + CG=3.D0 + TR=1.D0/2.D0 + +! Changing the number of the quark flavor at heavy quark mass threshold + Q2thr=Q2 + IF(Q2thr.LT.CTHRE) F=3.D0 + IF((Q2thr.GE.CTHRE).AND.(Q2thr.LT.BTHRE)) F=4.D0 + IF(Q2thr.GE.BTHRE) F=5.D0 + + B0=11.D0/3.D0*CG-4.D0/3.D0*TR*F + B1=34.D0/3.D0*CG*CG-10.D0/3.D0*CG*F-2.D0*CF*F + +! Changing Lambda_QCD for connecting alpah_s at the threshold + IF(Q2thr.LT.CTHRE) then ! Lambda_QCD (4to3) + DLAMF=DLAML*(DSQRT(CTHRE)/DLAML)**(2.D0/3.D0/B0) + DLAMFN=DLAMN*(DSQRT(CTHRE)/DLAMN)**(2.D0/27.D0) & + & *DLOG(CTHRE/(DLAMN*DLAMN))**(107.D0/2025.D0) + + ELSE IF((Q2thr.GE.CTHRE).AND.(Q2thr.LT.BTHRE)) then + DLAMF=DLAML + DLAMFN=DLAMN + + ELSE IF(Q2thr.GE.BTHRE) Then ! Lambda_QCD (4to5) + DLAMF=DLAML*(DSQRT(BTHRE)/DLAML)**(-2.D0/3.D0/B0) + DLAMFN=DLAMN*(DLAMN/DSQRT(BTHRE))**(2.D0/23.D0) & + & *DLOG(BTHRE/(DLAMN*DLAMN))**(-963.D0/13225.D0) + END IF + +! Calculating alpha_s(Q^2) + IF(IORDER.EQ.2) DLAMF=DLAMFN + DLNLAM=DLOG(DLAMF*DLAMF) + DLNQ2=DLOG(Q2)-DLNLAM + + ALPHA=4.D0*PI/B0/DLNQ2 ! LO + IF(IORDER.EQ.2) THEN ! NLO + ALPHA=ALPHA*(1.D0-B1*DLOG(DLNQ2)/(B0*B0*DLNQ2)) + END IF + + ALPHA_S=ALPHA + + RETURN + END +! --------------------------------------------------------------------- diff --git a/LHAPDF/lhapdf-5.9.1/src/wraphkn.f b/LHAPDF/lhapdf-5.9.1/src/wraphkn.f new file mode 100644 index 00000000000..eac1fd9ee9c --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/wraphkn.f @@ -0,0 +1,330 @@ +! -*- F90 -*- + subroutine hknevolve(x,Q,f) + implicit none + integer nq,nx,nd,nff,nset,nhess +! PARAMETER (NQ=33, NX=117, ND=94, NFF=7,sets=19) + PARAMETER (NQ=33, NX=117, ND=7, NFF=7, nhess=19) + include 'parmsetup.inc' + character*16 name(nmxset) + integer nmem(nmxset),ndef(nmxset),mmem + common/NAME/name,nmem,ndef,mmem + double precision gridx(nmxgridx),gridq(nmxgridq) + integer ngridx,ngridq,jx,jq + CHARACTER*80 LINE + double precision pdf(-6:6),x,q,q2 + double precision QG(NQ),XG(NX),PDFG(NX,NQ,ND,0:nhess),DNPDF(-4:4) & + & ,BXG(NX,NQ,ND,0:nhess), CXG(NX,NQ,ND,0:nhess), DXG(NX,NQ,ND,0:nhess) + double precision PDFJ1(ND), PDFJ2(ND) + double precision T,DX + integer iset,imem + integer i,j,k,n + integer iserch + real*8 f(-6:6) + real*8 alfas + real*8 Eorder,Q2fit + DATA QG / & + & 1.000000D+00, 1.467799D+00, 2.154435D+00, & + & 3.162278D+00, 4.641589D+00, 6.812921D+00, & + & 1.000000D+01, 1.467799D+01, 2.154435D+01, & + & 3.162278D+01, 4.641589D+01, 6.812921D+01, & + & 1.000000D+02, 1.778279D+02, 3.162278D+02, 5.623413D+02, & + & 1.000000D+03, 1.778279D+03, 3.162278D+03, 5.623413D+03, & + & 1.000000D+04, 1.778279D+04, 3.162278D+04, 5.623413D+04, & + & 1.000000D+05, 1.778279D+05, 3.162278D+05, 5.623413D+05, & + & 1.000000D+06, 4.641589D+06, & + & 1.000000D+07, 4.641589D+07, & + & 1.000000D+08 / + + DATA XG / & + & 1.000000D-09, 1.333521D-09, 1.778279D-09, 2.371374D-09, & + & 3.162278D-09, 4.216965D-09, 5.623413D-09, 7.498942D-09, & + & 1.000000D-08, 1.333521D-08, 1.778279D-08, 2.371374D-08, & + & 3.162278D-08, 4.216965D-08, 5.623413D-08, 7.498942D-08, & + & 1.000000D-07, 1.333521D-07, 1.778279D-07, 2.371374D-07, & + & 3.162278D-07, 4.216965D-07, 5.623413D-07, 7.498942D-07, & + & 1.000000D-06, 1.333521D-06, 1.778279D-06, 2.371374D-06, & + & 3.162278D-06, 4.216965D-06, 5.623413D-06, 7.498942D-06, & + & 1.000000D-05, 1.333521D-05, 1.778279D-05, 2.371374D-05, & + & 3.162278D-05, 4.216965D-05, 5.623413D-05, 7.498942D-05, & + & 1.000000D-04, 1.333521D-04, 1.778279D-04, 2.371374D-04, & + & 3.162278D-04, 4.216965D-04, 5.623413D-04, 7.498942D-04, & + & 1.000000D-03, 1.154782D-03, 1.333521D-03, 1.539927D-03, & + & 1.778279D-03, 2.053525D-03, 2.371374D-03, 2.738420D-03, & + & 3.162278D-03, 3.651741D-03, 4.216965D-03, 4.869675D-03, & + & 5.623413D-03, 6.493816D-03, 7.498942D-03, 8.659643D-03, & + & 1.000000D-02, 1.154782D-02, 1.333521D-02, 1.539927D-02, & + & 1.778279D-02, 2.053525D-02, 2.371374D-02, 2.738420D-02, & + & 3.162278D-02, 3.651741D-02, 4.216965D-02, 4.869675D-02, & + & 5.623413D-02, 6.493816D-02, 7.498942D-02, 8.659643D-02, & + & 1.000000D-1, 1.250000D-1, 1.500000D-1, 1.750000D-1, & + & 2.000000D-1, 2.250000D-1, 2.500000D-1, 2.750000D-1, & + & 3.000000D-1, 3.250000D-1, 3.500000D-1, 3.750000D-1, & + & 4.000000D-1, 4.250000D-1, 4.500000D-1, 4.750000D-1, & + & 5.000000D-1, 5.250000D-1, 5.500000D-1, 5.750000D-1, & + & 6.000000D-1, 6.250000D-1, 6.500000D-1, 6.750000D-1, & + & 7.000000D-1, 7.250000D-1, 7.500000D-1, 7.750000D-1, & + & 8.000000D-1, 8.250000D-1, 8.500000D-1, 8.750000D-1, & + & 9.000000D-1, 9.250000D-1, 9.500000D-1, 9.750000D-1, & + & 1.000000D+0 / + + save + + call getnset(iset) + call getnmem(iset,imem) + + DO I=-4,4 + DNPDF(I)=0.D0 + END DO + + q2 = q*q +! CHECK X AND Q2 VALUES. + IF((X.LT.1.D-9).OR.(X.GT.1.D0)) THEN + WRITE(*,1030) X + 1030 FORMAT (' ','FF WARNING: OUT OF RANGE --> X =', 1PE12.3) + STOP + ENDIF + IF((Q2.LT.1.D0).OR.(Q2.GT.1.D8)) THEN + WRITE(*,1040) Q2 + 1040 FORMAT (' ','FF WARNING: OUT OF RANGE --> Q2 =', 1PE12.3) + STOP + ENDIF + +! INTERPOLATION. +! X: CUBIC SPLINE INTERPOLATION, LOG(Q2): LINEAR INTERPOLATION. + J=ISERCH(NQ,QG,Q2) + IF(J.EQ.NQ) J=NQ-1 + K=ISERCH(NX,XG,X) + DO I=1,ND + DX=X-XG(K) + PDFJ1(I)=PDFG(K,J,I,imem) & + & +DX*(BXG(K,J,I,imem)+DX*(CXG(K,J,I,imem)+DX*DXG(K,J,I,imem))) + PDFJ2(I)=PDFG(K,J+1,I,imem) & + & +DX*(BXG(K,J+1,I,imem)+DX*(CXG(K,J+1,I,imem)+DX*DXG(K,J+1,I,imem))) + + ENDDO + +! -- Nuclear PDF functions -- + T=(DLOG(Q2)-DLOG(QG(J)))/(DLOG(QG(J+1))-DLOG(QG(J))) + f(0)=(1.D0-T)*PDFJ1(1)+T*PDFJ2(1) ! g + f(1)=(1.D0-T)*PDFJ1(3)+T*PDFJ2(3) ! d + f(2)=(1.D0-T)*PDFJ1(2)+T*PDFJ2(2) ! u + f(-1)=(1.D0-T)*PDFJ1(5)+T*PDFJ2(5) ! db + f(-2)=(1.D0-T)*PDFJ1(4)+T*PDFJ2(4) ! ub + f(-3)=(1.D0-T)*PDFJ1(6)+T*PDFJ2(6) ! sb + f(4)=(1.D0-T)*PDFJ1(7)+T*PDFJ2(7) ! c + f(3)=f(-3) ! s=sb + f(-4)=f(4) ! cb=c + f(5)= 0.0d0 !bottom=0 + f(-5) = f(5) + f(6) = 0.0d0 !top=0 + f(-6) = f(6) + return + +! +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +! + entry hkngetgrid(nset,ngridx,ngridq,gridx,gridq) + + ngridx=NX + do jx=1,ngridx + gridx(jx)=XG(jx) + enddo + ngridq=NQ + do jq=1,ngridq + gridq(jq)=QG(jq) + enddo + + return + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + entry hknread(nset) + + read(1,*)nmem(nset),ndef(nset) + ! print *,nset,nmem(nset),ndef(nset) + + do n=0,nmem(nset) + DO J=1,NQ + DO K=1,NX-1 + READ(1,1025) (PDFG(K,J,I,n), I=1,NFF) + !print *,n,j,k + ENDDO + ENDDO + DO I=1,ND + DO J=1,NQ + PDFG(NX,J,I,n)=0.D0 ! x=1 NPDF=0.D0 + CALL LSPLINE(NX,XG,PDFG,BXG,CXG,DXG,ISET,I,J,n) + ENDDO + ENDDO + enddo + + 1025 FORMAT(1X,7(1PE14.6)) + return +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + entry hknalfa(alfas,Q) +! call alphamrs(4,alfas,q) + call alphahkn(q,alfas) + return +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + entry hkninit(nset,Eorder,Q2fit) + return +! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + entry hknpdf(nset) + return +! + END +! --------------------------------------------------------------------- + SUBROUTINE LSPLINE(N,X,Y,B,C,D,ISET,I,J,nmem) +! --------------------------------------------------------------------- +! CALCULATE THE COEFFICIENTS B,C,D IN A CUBIC SPLINE INTERPOLATION. +! INTERPOLATION SUBROUTINES ARE TAKEN FROM +! G.E. FORSYTHE, M.A. MALCOLM AND C.B. MOLER, +! COMPUTER METHODS FOR MATHEMATICAL COMPUTATIONS (PRENTICE-HALL, 1977). + IMPLICIT REAL*8(A-H,O-Z) + PARAMETER (NQ=33, NX=117, ND=7, nhess=19) + DIMENSION Y(NX,NQ,ND,0:nhess),B(NX,NQ,ND,0:nhess),C(NX,NQ,ND,0:nhess),D(NX,NQ,ND,0:nhess) & + & ,X(NX) + NM1=N-1 + IF(N.LT.2) RETURN + IF(N.LT.3) GO TO 250 + D(1,J,I,nmem)=X(2)-X(1) + C(2,J,I,nmem)=(Y(2,J,I,nmem)-Y(1,J,I,nmem))/D(1,J,I,nmem) + DO 210 K=2,NM1 + D(K,J,I,nmem)=X(K+1)-X(K) + B(K,J,I,nmem)=2.0D0*(D(K-1,J,I,nmem)+D(K,J,I,nmem)) + C(K+1,J,I,nmem)=(Y(K+1,J,I,nmem)-Y(K,J,I,nmem))/D(K,J,I,nmem) + C(K,J,I,nmem)=C(K+1,J,I,nmem)-C(K,J,I,nmem) + 210 CONTINUE + B(1,J,I,nmem)=-D(1,J,I,nmem) + B(N,J,I,nmem)=-D(N-1,J,I,nmem) + C(1,J,I,nmem)=0.0D0 + C(N,J,I,nmem)=0.0D0 + IF(N.EQ.3) GO TO 215 + C(1,J,I,nmem)=C(3,J,I,nmem)/(X(4)-X(2))-C(2,J,I,nmem)/(X(3)-X(1)) + C(N,J,I,nmem)=C(N-1,J,I,nmem)/(X(N)-X(N-2))-C(N-2,J,I,nmem)/(X(N-1)-X(N-3)) + C(1,J,I,nmem)=C(1,J,I,nmem)*D(1,J,I,nmem)**2.0D0/(X(4)-X(1)) + C(N,J,I,nmem)=-C(N,J,I,nmem)*D(N-1,J,I,nmem)**2.0D0/(X(N)-X(N-3)) + 215 CONTINUE + DO 220 K=2,N + T=D(K-1,J,I,nmem)/B(K-1,J,I,nmem) + B(K,J,I,nmem)=B(K,J,I,nmem)-T*D(K-1,J,I,nmem) + C(K,J,I,nmem)=C(K,J,I,nmem)-T*C(K-1,J,I,nmem) + 220 CONTINUE + C(N,J,I,nmem)=C(N,J,I,nmem)/B(N,J,I,nmem) + DO 230 IB=1,NM1 + K=N-IB + C(K,J,I,nmem)=(C(K,J,I,nmem)-D(K,J,I,nmem)*C(K+1,J,I,nmem))/B(K,J,I,nmem) + 230 CONTINUE + B(N,J,I,nmem)=(Y(N,J,I,nmem)-Y(NM1,J,I,nmem))/D(NM1,J,I,nmem) & + & +D(NM1,J,I,nmem)*(C(NM1,J,I,nmem)+2.0D0*C(N,J,I,nmem)) + DO 240 K=1,NM1 + B(K,J,I,nmem)=(Y(K+1,J,I,nmem)-Y(K,J,I,nmem))/D(K,J,I,nmem) & + & -D(K,J,I,nmem)*(C(K+1,J,I,nmem)+2.0D0*C(K,J,I,nmem)) + D(K,J,I,nmem)=(C(K+1,J,I,nmem)-C(K,J,I,nmem))/D(K,J,I,nmem) + C(K,J,I,nmem)=3.0D0*C(K,J,I,nmem) + 240 CONTINUE + C(N,J,I,nmem)=3.0D0*C(N,J,I,nmem) + D(N,J,I,nmem)=D(N-1,J,I,nmem) + RETURN + 250 CONTINUE + B(1,J,I,nmem)=(Y(2,J,I,nmem)-Y(1,J,I,nmem))/(X(2)-X(1)) + C(1,J,I,nmem)=0.0D0 + D(1,J,I,nmem)=0.0D0 + B(2,J,I,nmem)=B(1,J,I,nmem) + C(2,J,I,nmem)=0.0D0 + D(2,J,I,nmem)=0.0D0 + RETURN + END +! --------------------------------------------------------------------- + INTEGER FUNCTION ISERCH(N,X,Y) +! --------------------------------------------------------------------- +! THIS FUNCTION SEARCHES "I" WHICH SATISFIES THE RELATION +! X(I) <= Y < X(I+1) BY USING A BINARY SEARCH. + IMPLICIT REAL*8(A-H,O-Z) + DIMENSION X(117) + + MIN=1 + MAX=N+1 + + 10 CONTINUE + MID=(MIN+MAX)/2 + IF(Y.LT.X(MID)) THEN + MAX=MID + ELSE + MIN=MID + END IF + IF((MAX-MIN).GT.1) GO TO 10 + + ISERCH=MIN + + RETURN + END +! ********************************************************************* +! THE END OF THE PROGRAM. +! ********************************************************************* +! --------------------------------------------------------------------- +! IN: Q2=Q^2 [GeV^2], IORDER=1:LO, 2:NLO +! OUT: Alpha_s +! + SUBROUTINE alphahkn(Q,ALPHA_S) +! --------------------------------------------------------------------- +! RUNNING COUPLING CONSTANTS. + IMPLICIT REAL*8(A-H,O-Z) + DATA DLAML,DLAMN/0.174D0, 0.3D0/ +! DATA THRE4,THRE5/1.35D0, 4.3D0/ + DATA THRE4,THRE5/1.35D0, 1.D+6/ + + call getnset(nset) + call GetOrderAsM(nset,iord) + q2 = q*q + iorder = iord + 1 + + PI=4.D0*DATAN(1.D0) + CTHRE=THRE4*THRE4 + BTHRE=THRE5*THRE5 + CF=4.D0/3.D0 + CG=3.D0 + TR=1.D0/2.D0 + +! Changing the number of the quark flavor at heavy quark mass threshold + Q2thr=Q2 + IF(Q2thr.LT.CTHRE) F=3.D0 + IF((Q2thr.GE.CTHRE).AND.(Q2thr.LT.BTHRE)) F=4.D0 + IF(Q2thr.GE.BTHRE) F=5.D0 + + B0=11.D0/3.D0*CG-4.D0/3.D0*TR*F + B1=34.D0/3.D0*CG*CG-10.D0/3.D0*CG*F-2.D0*CF*F + +! Changing Lambda_QCD for connecting alpah_s at the threshold + IF(Q2thr.LT.CTHRE) then ! Lambda_QCD (4to3) + DLAMF=DLAML*(DSQRT(CTHRE)/DLAML)**(2.D0/3.D0/B0) + DLAMFN=DLAMN*(DSQRT(CTHRE)/DLAMN)**(2.D0/27.D0) & + & *DLOG(CTHRE/(DLAMN*DLAMN))**(107.D0/2025.D0) + + ELSE IF((Q2thr.GE.CTHRE).AND.(Q2thr.LT.BTHRE)) then + DLAMF=DLAML + DLAMFN=DLAMN + + ELSE IF(Q2thr.GE.BTHRE) Then ! Lambda_QCD (4to5) + DLAMF=DLAML*(DSQRT(BTHRE)/DLAML)**(-2.D0/3.D0/B0) + DLAMFN=DLAMN*(DLAMN/DSQRT(BTHRE))**(2.D0/23.D0) & + & *DLOG(BTHRE/(DLAMN*DLAMN))**(-963.D0/13225.D0) + END IF + +! Calculating alpha_s(Q^2) + IF(IORDER.EQ.2) DLAMF=DLAMFN + DLNLAM=DLOG(DLAMF*DLAMF) + DLNQ2=DLOG(Q2)-DLNLAM + + ALPHA=4.D0*PI/B0/DLNQ2 ! LO + IF(IORDER.EQ.2) THEN ! NLO + ALPHA=ALPHA*(1.D0-B1*DLOG(DLNQ2)/(B0*B0*DLNQ2)) + END IF + + ALPHA_S=ALPHA + + RETURN + END +! --------------------------------------------------------------------- diff --git a/LHAPDF/lhapdf-5.9.1/src/wraplacg.f b/LHAPDF/lhapdf-5.9.1/src/wraplacg.f new file mode 100644 index 00000000000..67008feb72d --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/wraplacg.f @@ -0,0 +1,2887 @@ +! -*- F90 -*- + + + subroutine LACGevolvep(xin,qin,p2in,ip2in,pdf) + include 'parmsetup.inc' + real*8 xin,qin,q2in,p2in,pdf(-6:6),xval(45),qcdl4,qcdl5 + character*16 name(nmxset) + integer nmem(nmxset),ndef(nmxset),mmem + common/NAME/name,nmem,ndef,mmem + integer nset + save + + q2in=qin*qin + call getnset(iset) + call getnmem(iset,imem) + + if(imem.eq.1.or.imem.eq.0) then + call PHLAC1(xin,q2in,pdf) + + elseif(imem.eq.2) then + call PHLAC2(xin,q2in,pdf) + + elseif(imem.eq.3) then + call PHLAC3(xin,q2in,pdf) + + elseif(imem.eq.4) then + call PHGAL(xin,q2in,pdf) + + else + CONTINUE + endif + + return +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + entry LACGread(nset) + read(1,*)nmem(nset),ndef(nset) + return +! +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + entry LACGalfa(alfas,qalfa) + call getnset(iset) + call GetOrderAsM(iset,iord) + call Getlam4M(iset,imem,qcdl4) + call Getlam5M(iset,imem,qcdl5) + call aspdflib(alfas,Qalfa,iord,qcdl5) + return +! +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + entry LACGinit(Eorder,Q2fit) + return +! +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + entry LACGpdf(mem) + call getnset(iset) + call setnmem(iset,mem) +! imem = mem + return +! + 1000 format(5e13.5) + END +! +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + SUBROUTINE PHLAC1(X,Q2,XPDF) + implicit real*8 (a-h,o-z) + PARAMETER(IX=100,IQ=7,NARG=2,NFUN=4) + double precision & + & DBFINT, & + & XT(IX),Q2T(IQ),ARG(NARG),ENT(IX+IQ), & + & XPV(IX,IQ,0:NFUN),XPDF(-6:6) + DIMENSION NA(NARG) + DATA ZEROD/0.D0/ +!...100 x valuse; in (D-4,.77) log spaced (78 points) +!... in (.78,.995) lineary spaced (22 points) + DATA Q2T/4.D0,10.D0,50.D0,1.D2,1.D3,1.D4,1.D5/ + DATA XT/ & + &0.1000D-03,0.1123D-03,0.1262D-03,0.1417D-03,0.1592D-03,0.1789D-03,& + &0.2009D-03,0.2257D-03,0.2535D-03,0.2848D-03,0.3199D-03,0.3593D-03,& + &0.4037D-03,0.4534D-03,0.5093D-03,0.5722D-03,0.6427D-03,0.7220D-03,& + &0.8110D-03,0.9110D-03,0.1023D-02,0.1150D-02,0.1291D-02,0.1451D-02,& + &0.1629D-02,0.1830D-02,0.2056D-02,0.2310D-02,0.2594D-02,0.2914D-02,& + &0.3274D-02,0.3677D-02,0.4131D-02,0.4640D-02,0.5212D-02,0.5855D-02,& + &0.6577D-02,0.7388D-02,0.8299D-02,0.9323D-02,0.1047D-01,0.1176D-01,& + &0.1321D-01,0.1484D-01,0.1667D-01,0.1873D-01,0.2104D-01,0.2363D-01,& + &0.2655D-01,0.2982D-01,0.3350D-01,0.3763D-01,0.4227D-01,0.4748D-01,& + &0.5334D-01,0.5992D-01,0.6731D-01,0.7560D-01,0.8493D-01,0.9540D-01,& + &0.1072D+00,0.1204D+00,0.1352D+00,0.1519D+00,0.1706D+00,0.1917D+00,& + &0.2153D+00,0.2419D+00,0.2717D+00,0.3052D+00,0.3428D+00,0.3851D+00,& + &0.4326D+00,0.4859D+00,0.5458D+00,0.6131D+00,0.6887D+00,0.7737D+00,& + &0.7837D+00,0.7937D+00,0.8037D+00,0.8137D+00,0.8237D+00,0.8337D+00,& + &0.8437D+00,0.8537D+00,0.8637D+00,0.8737D+00,0.8837D+00,0.8937D+00,& + &0.9037D+00,0.9137D+00,0.9237D+00,0.9337D+00,0.9437D+00,0.9537D+00,& + &0.9637D+00,0.9737D+00,0.9837D+00,0.9937D+00/ + +!...place for DATA blocks + DATA (XPV(I,1,0),I=1,100)/ & + &0.1565D+01,0.1506D+01,0.1448D+01,0.1391D+01,0.1338D+01,0.1286D+01,& + &0.1236D+01,0.1189D+01,0.1143D+01,0.1098D+01,0.1056D+01,0.1015D+01,& + &0.9745D+00,0.9371D+00,0.9004D+00,0.8646D+00,0.8312D+00,0.7984D+00,& + &0.7665D+00,0.7365D+00,0.7073D+00,0.6785D+00,0.6518D+00,0.6254D+00,& + &0.5998D+00,0.5756D+00,0.5519D+00,0.5287D+00,0.5068D+00,0.4854D+00,& + &0.4644D+00,0.4443D+00,0.4249D+00,0.4058D+00,0.3872D+00,0.3694D+00,& + &0.3519D+00,0.3348D+00,0.3181D+00,0.3020D+00,0.2861D+00,0.2705D+00,& + &0.2553D+00,0.2413D+00,0.2263D+00,0.2118D+00,0.1980D+00,0.1843D+00,& + &0.1706D+00,0.1573D+00,0.1442D+00,0.1315D+00,0.1190D+00,0.1070D+00,& + &0.9501D-01,0.8376D-01,0.7302D-01,0.6278D-01,0.5319D-01,0.4429D-01,& + &0.3613D-01,0.2884D-01,0.2246D-01,0.1692D-01,0.1231D-01,0.8569D-02,& + &0.5692D-02,0.3556D-02,0.2071D-02,0.1106D-02,0.5306D-03,0.2221D-03,& + &0.7821D-04,0.2192D-04,0.4488D-05,0.5808D-06,0.3699D-07,0.6624D-09,& + &0.3750D-09,0.2067D-09,0.1106D-09,0.5732D-10,0.2868D-10,0.1378D-10,& + &0.6286D-11,0.2737D-11,0.1123D-11,0.4323D-12,0.1545D-12,0.5043D-13,& + &0.1478D-13,0.3800D-14,0.8317D-15,0.1485D-15,0.2036D-16,0.1950D-17,& + &0.1118D-18,0.2870D-20,0.1704D-22,0.0000D+00/ + DATA (XPV(I,1,1),I=1,100)/ & + &0.2916D-06,0.3304D-06,0.3747D-06,0.4246D-06,0.4815D-06,0.5462D-06,& + &0.6192D-06,0.7024D-06,0.7966D-06,0.9039D-06,0.1025D-05,0.1163D-05,& + &0.1321D-05,0.1499D-05,0.1701D-05,0.1932D-05,0.2193D-05,0.2490D-05,& + &0.2828D-05,0.3212D-05,0.3647D-05,0.4146D-05,0.4707D-05,0.5351D-05,& + &0.6077D-05,0.6906D-05,0.7851D-05,0.8925D-05,0.1014D-04,0.1153D-04,& + &0.1311D-04,0.1490D-04,0.1695D-04,0.1927D-04,0.2191D-04,0.2492D-04,& + &0.2834D-04,0.3223D-04,0.3666D-04,0.4169D-04,0.4740D-04,0.5389D-04,& + &0.6128D-04,0.6966D-04,0.7921D-04,0.9006D-04,0.1023D-03,0.1163D-03,& + &0.1321D-03,0.1500D-03,0.1703D-03,0.1933D-03,0.2192D-03,0.2485D-03,& + &0.2817D-03,0.3190D-03,0.3609D-03,0.4080D-03,0.4608D-03,0.5198D-03,& + &0.5859D-03,0.6591D-03,0.7400D-03,0.8298D-03,0.9282D-03,0.1036D-02,& + &0.1153D-02,0.1280D-02,0.1415D-02,0.1558D-02,0.1706D-02,0.1859D-02,& + &0.2011D-02,0.2158D-02,0.2291D-02,0.2397D-02,0.2457D-02,0.2434D-02,& + &0.2424D-02,0.2411D-02,0.2397D-02,0.2381D-02,0.2362D-02,0.2341D-02,& + &0.2317D-02,0.2291D-02,0.2262D-02,0.2230D-02,0.2194D-02,0.2154D-02,& + &0.2110D-02,0.2060D-02,0.2006D-02,0.1944D-02,0.1874D-02,0.1795D-02,& + &0.1702D-02,0.1592D-02,0.1567D-02,0.9891D-03/ + DATA (XPV(I,1,2),I=1,100)/ & + &0.1611D-06,0.1839D-06,0.2101D-06,0.2397D-06,0.2738D-06,0.3129D-06,& + &0.3572D-06,0.4081D-06,0.4661D-06,0.5325D-06,0.6084D-06,0.6950D-06,& + &0.7944D-06,0.9077D-06,0.1037D-05,0.1186D-05,0.1355D-05,0.1550D-05,& + &0.1771D-05,0.2025D-05,0.2315D-05,0.2649D-05,0.3027D-05,0.3464D-05,& + &0.3959D-05,0.4528D-05,0.5180D-05,0.5926D-05,0.6776D-05,0.7751D-05,& + &0.8869D-05,0.1014D-04,0.1161D-04,0.1328D-04,0.1519D-04,0.1738D-04,& + &0.1988D-04,0.2274D-04,0.2602D-04,0.2976D-04,0.3404D-04,0.3893D-04,& + &0.4452D-04,0.5090D-04,0.5821D-04,0.6657D-04,0.7608D-04,0.8693D-04,& + &0.9936D-04,0.1135D-03,0.1296D-03,0.1479D-03,0.1688D-03,0.1925D-03,& + &0.2195D-03,0.2501D-03,0.2847D-03,0.3239D-03,0.3682D-03,0.4180D-03,& + &0.4743D-03,0.5371D-03,0.6071D-03,0.6855D-03,0.7721D-03,0.8679D-03,& + &0.9724D-03,0.1086D-02,0.1208D-02,0.1338D-02,0.1472D-02,0.1609D-02,& + &0.1742D-02,0.1864D-02,0.1962D-02,0.2019D-02,0.2006D-02,0.1875D-02,& + &0.1850D-02,0.1823D-02,0.1794D-02,0.1762D-02,0.1728D-02,0.1691D-02,& + &0.1651D-02,0.1609D-02,0.1563D-02,0.1514D-02,0.1462D-02,0.1405D-02,& + &0.1345D-02,0.1280D-02,0.1209D-02,0.1133D-02,0.1051D-02,0.9598D-03,& + &0.8591D-03,0.7454D-03,0.6438D-03,0.3654D-03/ + DATA (XPV(I,1,3),I=1,100)/ & + &0.3274D-03,0.3407D-03,0.3547D-03,0.3691D-03,0.3843D-03,0.4000D-03,& + &0.4163D-03,0.4333D-03,0.4510D-03,0.4693D-03,0.4885D-03,0.5084D-03,& + &0.5291D-03,0.5506D-03,0.5730D-03,0.5963D-03,0.6205D-03,0.6456D-03,& + &0.6717D-03,0.6989D-03,0.7270D-03,0.7564D-03,0.7866D-03,0.8183D-03,& + &0.8507D-03,0.8847D-03,0.9198D-03,0.9561D-03,0.9936D-03,0.1032D-02,& + &0.1073D-02,0.1114D-02,0.1157D-02,0.1200D-02,0.1245D-02,0.1292D-02,& + &0.1339D-02,0.1387D-02,0.1436D-02,0.1486D-02,0.1537D-02,0.1588D-02,& + &0.1639D-02,0.1693D-02,0.1742D-02,0.1792D-02,0.1842D-02,0.1889D-02,& + &0.1933D-02,0.1974D-02,0.2011D-02,0.2043D-02,0.2070D-02,0.2090D-02,& + &0.2098D-02,0.2100D-02,0.2091D-02,0.2069D-02,0.2034D-02,0.1984D-02,& + &0.1918D-02,0.1835D-02,0.1738D-02,0.1621D-02,0.1490D-02,0.1344D-02,& + &0.1189D-02,0.1026D-02,0.8614D-03,0.7006D-03,0.5505D-03,0.4173D-03,& + &0.3076D-03,0.2258D-03,0.1743D-03,0.1526D-03,0.1584D-03,0.1876D-03,& + &0.1921D-03,0.1968D-03,0.2016D-03,0.2066D-03,0.2117D-03,0.2169D-03,& + &0.2222D-03,0.2276D-03,0.2331D-03,0.2385D-03,0.2441D-03,0.2495D-03,& + &0.2550D-03,0.2603D-03,0.2654D-03,0.2702D-03,0.2746D-03,0.2783D-03,& + &0.2811D-03,0.2822D-03,0.3078D-03,0.2079D-03/ + DATA (XPV(I,1,4),I=1,100)/ & + &0.1280D-03,0.1332D-03,0.1387D-03,0.1444D-03,0.1503D-03,0.1565D-03,& + &0.1629D-03,0.1696D-03,0.1765D-03,0.1837D-03,0.1913D-03,0.1991D-03,& + &0.2072D-03,0.2157D-03,0.2245D-03,0.2337D-03,0.2433D-03,0.2532D-03,& + &0.2636D-03,0.2743D-03,0.2855D-03,0.2971D-03,0.3092D-03,0.3218D-03,& + &0.3347D-03,0.3483D-03,0.3624D-03,0.3770D-03,0.3920D-03,0.4077D-03,& + &0.4239D-03,0.4407D-03,0.4581D-03,0.4759D-03,0.4944D-03,0.5134D-03,& + &0.5330D-03,0.5531D-03,0.5736D-03,0.5947D-03,0.6162D-03,0.6379D-03,& + &0.6601D-03,0.6836D-03,0.7055D-03,0.7279D-03,0.7508D-03,0.7728D-03,& + &0.7940D-03,0.8146D-03,0.8342D-03,0.8524D-03,0.8689D-03,0.8834D-03,& + &0.8941D-03,0.9028D-03,0.9080D-03,0.9090D-03,0.9056D-03,0.8971D-03,& + &0.8831D-03,0.8635D-03,0.8385D-03,0.8068D-03,0.7698D-03,0.7276D-03,& + &0.6819D-03,0.6336D-03,0.5849D-03,0.5382D-03,0.4968D-03,0.4641D-03,& + &0.4444D-03,0.4423D-03,0.4636D-03,0.5150D-03,0.6053D-03,0.7458D-03,& + &0.7649D-03,0.7844D-03,0.8043D-03,0.8247D-03,0.8455D-03,0.8667D-03,& + &0.8883D-03,0.9100D-03,0.9320D-03,0.9540D-03,0.9761D-03,0.9981D-03,& + &0.1020D-02,0.1041D-02,0.1062D-02,0.1081D-02,0.1098D-02,0.1113D-02,& + &0.1124D-02,0.1129D-02,0.1231D-02,0.8316D-03/ + DATA (XPV(I,2,0),I=1,100)/ & + &0.2212D+01,0.2119D+01,0.2028D+01,0.1939D+01,0.1857D+01,0.1776D+01,& + &0.1698D+01,0.1624D+01,0.1553D+01,0.1484D+01,0.1419D+01,0.1356D+01,& + &0.1294D+01,0.1237D+01,0.1181D+01,0.1127D+01,0.1076D+01,0.1027D+01,& + &0.9785D+00,0.9336D+00,0.8899D+00,0.8471D+00,0.8075D+00,0.7686D+00,& + &0.7310D+00,0.6957D+00,0.6613D+00,0.6278D+00,0.5965D+00,0.5661D+00,& + &0.5364D+00,0.5083D+00,0.4813D+00,0.4551D+00,0.4298D+00,0.4058D+00,& + &0.3825D+00,0.3599D+00,0.3382D+00,0.3174D+00,0.2974D+00,0.2780D+00,& + &0.2592D+00,0.2421D+00,0.2243D+00,0.2074D+00,0.1915D+00,0.1760D+00,& + &0.1608D+00,0.1463D+00,0.1324D+00,0.1192D+00,0.1064D+00,0.9439D-01,& + &0.8268D-01,0.7190D-01,0.6185D-01,0.5247D-01,0.4390D-01,0.3611D-01,& + &0.2914D-01,0.2306D-01,0.1786D-01,0.1344D-01,0.9848D-02,0.7000D-02,& + &0.4846D-02,0.3270D-02,0.2179D-02,0.1460D-02,0.1009D-02,0.7343D-03,& + &0.5643D-03,0.4488D-03,0.3576D-03,0.2761D-03,0.1995D-03,0.1267D-03,& + &0.1190D-03,0.1115D-03,0.1041D-03,0.9690D-04,0.8988D-04,0.8302D-04,& + &0.7627D-04,0.6975D-04,0.6340D-04,0.5723D-04,0.5123D-04,0.4542D-04,& + &0.3981D-04,0.3439D-04,0.2918D-04,0.2419D-04,0.1944D-04,0.1495D-04,& + &0.1075D-04,0.6861D-05,0.3406D-05,0.5274D-06/ + DATA (XPV(I,2,1),I=1,100)/ & + &0.1934D-01,0.1855D-01,0.1777D-01,0.1701D-01,0.1631D-01,0.1562D-01,& + &0.1494D-01,0.1432D-01,0.1370D-01,0.1310D-01,0.1254D-01,0.1200D-01,& + &0.1146D-01,0.1097D-01,0.1048D-01,0.1000D-01,0.9557D-02,0.9122D-02,& + &0.8698D-02,0.8300D-02,0.7912D-02,0.7530D-02,0.7176D-02,0.6826D-02,& + &0.6487D-02,0.6168D-02,0.5856D-02,0.5551D-02,0.5264D-02,0.4985D-02,& + &0.4712D-02,0.4451D-02,0.4202D-02,0.3959D-02,0.3723D-02,0.3500D-02,& + &0.3284D-02,0.3075D-02,0.2874D-02,0.2684D-02,0.2502D-02,0.2326D-02,& + &0.2160D-02,0.2010D-02,0.1857D-02,0.1716D-02,0.1588D-02,0.1467D-02,& + &0.1354D-02,0.1252D-02,0.1160D-02,0.1080D-02,0.1011D-02,0.9547D-03,& + &0.9083D-03,0.8767D-03,0.8586D-03,0.8538D-03,0.8634D-03,0.8871D-03,& + &0.9256D-03,0.9785D-03,0.1046D-02,0.1127D-02,0.1222D-02,0.1329D-02,& + &0.1448D-02,0.1578D-02,0.1715D-02,0.1859D-02,0.2008D-02,0.2158D-02,& + &0.2307D-02,0.2450D-02,0.2584D-02,0.2700D-02,0.2788D-02,0.2821D-02,& + &0.2820D-02,0.2817D-02,0.2812D-02,0.2806D-02,0.2798D-02,0.2788D-02,& + &0.2776D-02,0.2762D-02,0.2745D-02,0.2725D-02,0.2702D-02,0.2676D-02,& + &0.2645D-02,0.2609D-02,0.2568D-02,0.2519D-02,0.2461D-02,0.2392D-02,& + &0.2304D-02,0.2214D-02,0.2038D-02,0.1660D-02/ + DATA (XPV(I,2,2),I=1,100)/ & + &0.1934D-01,0.1855D-01,0.1777D-01,0.1701D-01,0.1631D-01,0.1562D-01,& + &0.1494D-01,0.1431D-01,0.1370D-01,0.1310D-01,0.1254D-01,0.1200D-01,& + &0.1146D-01,0.1096D-01,0.1048D-01,0.1000D-01,0.9555D-02,0.9120D-02,& + &0.8695D-02,0.8297D-02,0.7909D-02,0.7526D-02,0.7172D-02,0.6822D-02,& + &0.6483D-02,0.6162D-02,0.5850D-02,0.5544D-02,0.5256D-02,0.4976D-02,& + &0.4702D-02,0.4441D-02,0.4190D-02,0.3945D-02,0.3708D-02,0.3483D-02,& + &0.3266D-02,0.3054D-02,0.2851D-02,0.2659D-02,0.2473D-02,0.2295D-02,& + &0.2124D-02,0.1970D-02,0.1813D-02,0.1667D-02,0.1533D-02,0.1406D-02,& + &0.1286D-02,0.1177D-02,0.1077D-02,0.9879D-03,0.9093D-03,0.8417D-03,& + &0.7835D-03,0.7391D-03,0.7071D-03,0.6872D-03,0.6807D-03,0.6873D-03,& + &0.7074D-03,0.7409D-03,0.7879D-03,0.8480D-03,0.9206D-03,0.1005D-02,& + &0.1101D-02,0.1206D-02,0.1319D-02,0.1437D-02,0.1558D-02,0.1676D-02,& + &0.1786D-02,0.1880D-02,0.1947D-02,0.1969D-02,0.1924D-02,0.1773D-02,& + &0.1748D-02,0.1721D-02,0.1691D-02,0.1660D-02,0.1627D-02,0.1592D-02,& + &0.1555D-02,0.1515D-02,0.1473D-02,0.1429D-02,0.1382D-02,0.1332D-02,& + &0.1279D-02,0.1222D-02,0.1162D-02,0.1098D-02,0.1028D-02,0.9527D-03,& + &0.8688D-03,0.7804D-03,0.6649D-03,0.4897D-03/ + DATA (XPV(I,2,3),I=1,100)/ & + &0.1968D-01,0.1890D-01,0.1814D-01,0.1740D-01,0.1671D-01,0.1604D-01,& + &0.1538D-01,0.1477D-01,0.1418D-01,0.1359D-01,0.1305D-01,0.1253D-01,& + &0.1202D-01,0.1154D-01,0.1108D-01,0.1062D-01,0.1020D-01,0.9794D-02,& + &0.9396D-02,0.9025D-02,0.8666D-02,0.8313D-02,0.7989D-02,0.7671D-02,& + &0.7364D-02,0.7078D-02,0.6800D-02,0.6530D-02,0.6279D-02,0.6037D-02,& + &0.5802D-02,0.5581D-02,0.5371D-02,0.5168D-02,0.4973D-02,0.4791D-02,& + &0.4616D-02,0.4448D-02,0.4290D-02,0.4140D-02,0.3998D-02,0.3862D-02,& + &0.3733D-02,0.3622D-02,0.3502D-02,0.3391D-02,0.3291D-02,0.3192D-02,& + &0.3095D-02,0.3004D-02,0.2916D-02,0.2830D-02,0.2745D-02,0.2662D-02,& + &0.2572D-02,0.2486D-02,0.2397D-02,0.2302D-02,0.2203D-02,0.2098D-02,& + &0.1984D-02,0.1863D-02,0.1735D-02,0.1597D-02,0.1451D-02,0.1298D-02,& + &0.1142D-02,0.9853D-03,0.8318D-03,0.6865D-03,0.5549D-03,0.4424D-03,& + &0.3541D-03,0.2939D-03,0.2636D-03,0.2636D-03,0.2924D-03,0.3480D-03,& + &0.3556D-03,0.3634D-03,0.3713D-03,0.3793D-03,0.3875D-03,0.3956D-03,& + &0.4039D-03,0.4120D-03,0.4203D-03,0.4282D-03,0.4362D-03,0.4438D-03,& + &0.4511D-03,0.4579D-03,0.4641D-03,0.4694D-03,0.4735D-03,0.4760D-03,& + &0.4749D-03,0.4752D-03,0.4578D-03,0.3923D-03/ + DATA (XPV(I,2,4),I=1,100)/ & + &0.1947D-01,0.1869D-01,0.1792D-01,0.1717D-01,0.1646D-01,0.1578D-01,& + &0.1511D-01,0.1449D-01,0.1389D-01,0.1329D-01,0.1274D-01,0.1220D-01,& + &0.1168D-01,0.1119D-01,0.1071D-01,0.1024D-01,0.9809D-02,0.9384D-02,& + &0.8970D-02,0.8582D-02,0.8205D-02,0.7835D-02,0.7492D-02,0.7155D-02,& + &0.6828D-02,0.6521D-02,0.6223D-02,0.5931D-02,0.5657D-02,0.5393D-02,& + &0.5134D-02,0.4889D-02,0.4653D-02,0.4425D-02,0.4205D-02,0.3997D-02,& + &0.3796D-02,0.3602D-02,0.3416D-02,0.3241D-02,0.3072D-02,0.2910D-02,& + &0.2755D-02,0.2618D-02,0.2475D-02,0.2342D-02,0.2220D-02,0.2103D-02,& + &0.1991D-02,0.1887D-02,0.1789D-02,0.1699D-02,0.1614D-02,0.1536D-02,& + &0.1460D-02,0.1393D-02,0.1331D-02,0.1273D-02,0.1220D-02,0.1169D-02,& + &0.1122D-02,0.1077D-02,0.1035D-02,0.9924D-03,0.9517D-03,0.9118D-03,& + &0.8737D-03,0.8375D-03,0.8050D-03,0.7782D-03,0.7598D-03,0.7539D-03,& + &0.7655D-03,0.8012D-03,0.8696D-03,0.9820D-03,0.1152D-02,0.1396D-02,& + &0.1427D-02,0.1459D-02,0.1492D-02,0.1525D-02,0.1558D-02,0.1592D-02,& + &0.1625D-02,0.1659D-02,0.1692D-02,0.1724D-02,0.1757D-02,0.1787D-02,& + &0.1817D-02,0.1845D-02,0.1869D-02,0.1891D-02,0.1907D-02,0.1915D-02,& + &0.1910D-02,0.1909D-02,0.1831D-02,0.1563D-02/ + DATA (XPV(I,3,0),I=1,100)/ & + &0.3308D+01,0.3150D+01,0.2995D+01,0.2845D+01,0.2706D+01,0.2570D+01,& + &0.2439D+01,0.2318D+01,0.2200D+01,0.2086D+01,0.1980D+01,0.1877D+01,& + &0.1778D+01,0.1685D+01,0.1596D+01,0.1510D+01,0.1429D+01,0.1352D+01,& + &0.1277D+01,0.1207D+01,0.1140D+01,0.1074D+01,0.1014D+01,0.9560D+00,& + &0.8999D+00,0.8477D+00,0.7974D+00,0.7487D+00,0.7036D+00,0.6603D+00,& + &0.6186D+00,0.5793D+00,0.5421D+00,0.5064D+00,0.4722D+00,0.4403D+00,& + &0.4097D+00,0.3805D+00,0.3528D+00,0.3267D+00,0.3020D+00,0.2783D+00,& + &0.2558D+00,0.2356D+00,0.2151D+00,0.1960D+00,0.1783D+00,0.1614D+00,& + &0.1452D+00,0.1302D+00,0.1160D+00,0.1028D+00,0.9044D-01,0.7901D-01,& + &0.6820D-01,0.5850D-01,0.4968D-01,0.4167D-01,0.3454D-01,0.2823D-01,& + &0.2273D-01,0.1806D-01,0.1416D-01,0.1093D-01,0.8342D-02,0.6321D-02,& + &0.4798D-02,0.3669D-02,0.2855D-02,0.2271D-02,0.1847D-02,0.1524D-02,& + &0.1262D-02,0.1035D-02,0.8272D-03,0.6323D-03,0.4496D-03,0.2797D-03,& + &0.2619D-03,0.2446D-03,0.2277D-03,0.2113D-03,0.1953D-03,0.1798D-03,& + &0.1645D-03,0.1498D-03,0.1356D-03,0.1218D-03,0.1085D-03,0.9565D-04,& + &0.8330D-04,0.7145D-04,0.6013D-04,0.4938D-04,0.3923D-04,0.2974D-04,& + &0.2099D-04,0.1303D-04,0.6225D-05,0.9782D-06/ + DATA (XPV(I,3,1),I=1,100)/ & + &0.5631D-01,0.5377D-01,0.5129D-01,0.4888D-01,0.4664D-01,0.4445D-01,& + &0.4233D-01,0.4035D-01,0.3843D-01,0.3656D-01,0.3482D-01,0.3313D-01,& + &0.3148D-01,0.2994D-01,0.2845D-01,0.2700D-01,0.2565D-01,0.2434D-01,& + &0.2307D-01,0.2188D-01,0.2072D-01,0.1960D-01,0.1855D-01,0.1753D-01,& + &0.1655D-01,0.1563D-01,0.1474D-01,0.1387D-01,0.1306D-01,0.1227D-01,& + &0.1151D-01,0.1080D-01,0.1011D-01,0.9451D-02,0.8816D-02,0.8220D-02,& + &0.7648D-02,0.7097D-02,0.6576D-02,0.6084D-02,0.5618D-02,0.5172D-02,& + &0.4750D-02,0.4374D-02,0.3996D-02,0.3647D-02,0.3330D-02,0.3034D-02,& + &0.2756D-02,0.2506D-02,0.2281D-02,0.2081D-02,0.1906D-02,0.1756D-02,& + &0.1627D-02,0.1527D-02,0.1453D-02,0.1402D-02,0.1377D-02,0.1376D-02,& + &0.1398D-02,0.1442D-02,0.1507D-02,0.1591D-02,0.1692D-02,0.1808D-02,& + &0.1936D-02,0.2075D-02,0.2220D-02,0.2370D-02,0.2522D-02,0.2675D-02,& + &0.2827D-02,0.2977D-02,0.3127D-02,0.3276D-02,0.3425D-02,0.3559D-02,& + &0.3572D-02,0.3583D-02,0.3593D-02,0.3601D-02,0.3608D-02,0.3613D-02,& + &0.3616D-02,0.3616D-02,0.3614D-02,0.3609D-02,0.3600D-02,0.3586D-02,& + &0.3568D-02,0.3542D-02,0.3510D-02,0.3467D-02,0.3412D-02,0.3340D-02,& + &0.3240D-02,0.3140D-02,0.2881D-02,0.2260D-02/ + DATA (XPV(I,3,2),I=1,100)/ & + &0.5631D-01,0.5377D-01,0.5129D-01,0.4888D-01,0.4664D-01,0.4445D-01,& + &0.4233D-01,0.4035D-01,0.3843D-01,0.3656D-01,0.3481D-01,0.3312D-01,& + &0.3147D-01,0.2994D-01,0.2845D-01,0.2700D-01,0.2565D-01,0.2433D-01,& + &0.2306D-01,0.2187D-01,0.2072D-01,0.1959D-01,0.1855D-01,0.1752D-01,& + &0.1654D-01,0.1562D-01,0.1472D-01,0.1385D-01,0.1304D-01,0.1226D-01,& + &0.1149D-01,0.1077D-01,0.1009D-01,0.9422D-02,0.8784D-02,0.8185D-02,& + &0.7608D-02,0.7054D-02,0.6527D-02,0.6030D-02,0.5558D-02,0.5105D-02,& + &0.4676D-02,0.4292D-02,0.3905D-02,0.3547D-02,0.3219D-02,0.2910D-02,& + &0.2620D-02,0.2356D-02,0.2115D-02,0.1897D-02,0.1703D-02,0.1533D-02,& + &0.1382D-02,0.1258D-02,0.1158D-02,0.1080D-02,0.1025D-02,0.9926D-03,& + &0.9811D-03,0.9900D-03,0.1018D-02,0.1064D-02,0.1125D-02,0.1200D-02,& + &0.1286D-02,0.1381D-02,0.1481D-02,0.1583D-02,0.1683D-02,0.1776D-02,& + &0.1857D-02,0.1917D-02,0.1949D-02,0.1938D-02,0.1870D-02,0.1718D-02,& + &0.1695D-02,0.1670D-02,0.1644D-02,0.1617D-02,0.1589D-02,0.1559D-02,& + &0.1527D-02,0.1494D-02,0.1459D-02,0.1423D-02,0.1385D-02,0.1344D-02,& + &0.1302D-02,0.1256D-02,0.1208D-02,0.1157D-02,0.1101D-02,0.1040D-02,& + &0.9712D-03,0.9017D-03,0.7902D-03,0.5856D-03/ + DATA (XPV(I,3,3),I=1,100)/ & + &0.5668D-01,0.5415D-01,0.5169D-01,0.4930D-01,0.4707D-01,0.4490D-01,& + &0.4280D-01,0.4084D-01,0.3894D-01,0.3708D-01,0.3536D-01,0.3369D-01,& + &0.3207D-01,0.3056D-01,0.2909D-01,0.2766D-01,0.2634D-01,0.2505D-01,& + &0.2381D-01,0.2264D-01,0.2152D-01,0.2042D-01,0.1941D-01,0.1842D-01,& + &0.1747D-01,0.1658D-01,0.1572D-01,0.1489D-01,0.1411D-01,0.1337D-01,& + &0.1264D-01,0.1196D-01,0.1131D-01,0.1069D-01,0.1009D-01,0.9533D-02,& + &0.8998D-02,0.8483D-02,0.7997D-02,0.7540D-02,0.7105D-02,0.6689D-02,& + &0.6295D-02,0.5947D-02,0.5588D-02,0.5256D-02,0.4952D-02,0.4661D-02,& + &0.4382D-02,0.4123D-02,0.3879D-02,0.3650D-02,0.3434D-02,0.3232D-02,& + &0.3033D-02,0.2850D-02,0.2676D-02,0.2508D-02,0.2345D-02,0.2186D-02,& + &0.2029D-02,0.1875D-02,0.1723D-02,0.1569D-02,0.1416D-02,0.1264D-02,& + &0.1115D-02,0.9718D-03,0.8371D-03,0.7147D-03,0.6091D-03,0.5242D-03,& + &0.4643D-03,0.4324D-03,0.4307D-03,0.4600D-03,0.5208D-03,0.6116D-03,& + &0.6232D-03,0.6348D-03,0.6465D-03,0.6582D-03,0.6698D-03,0.6813D-03,& + &0.6927D-03,0.7037D-03,0.7145D-03,0.7247D-03,0.7344D-03,0.7433D-03,& + &0.7512D-03,0.7579D-03,0.7629D-03,0.7658D-03,0.7660D-03,0.7620D-03,& + &0.7516D-03,0.7414D-03,0.6912D-03,0.5511D-03/ + DATA (XPV(I,3,4),I=1,100)/ & + &0.5645D-01,0.5392D-01,0.5144D-01,0.4905D-01,0.4681D-01,0.4462D-01,& + &0.4251D-01,0.4054D-01,0.3863D-01,0.3676D-01,0.3503D-01,0.3335D-01,& + &0.3171D-01,0.3018D-01,0.2870D-01,0.2726D-01,0.2592D-01,0.2462D-01,& + &0.2335D-01,0.2217D-01,0.2103D-01,0.1992D-01,0.1889D-01,0.1788D-01,& + &0.1691D-01,0.1600D-01,0.1512D-01,0.1426D-01,0.1347D-01,0.1270D-01,& + &0.1195D-01,0.1125D-01,0.1058D-01,0.9929D-02,0.9308D-02,0.8726D-02,& + &0.8167D-02,0.7630D-02,0.7121D-02,0.6641D-02,0.6185D-02,0.5749D-02,& + &0.5336D-02,0.4968D-02,0.4595D-02,0.4249D-02,0.3933D-02,0.3635D-02,& + &0.3352D-02,0.3093D-02,0.2854D-02,0.2635D-02,0.2436D-02,0.2256D-02,& + &0.2089D-02,0.1945D-02,0.1818D-02,0.1706D-02,0.1610D-02,0.1528D-02,& + &0.1458D-02,0.1400D-02,0.1353D-02,0.1314D-02,0.1283D-02,0.1259D-02,& + &0.1242D-02,0.1231D-02,0.1228D-02,0.1235D-02,0.1254D-02,0.1291D-02,& + &0.1351D-02,0.1446D-02,0.1586D-02,0.1789D-02,0.2074D-02,0.2452D-02,& + &0.2500D-02,0.2547D-02,0.2594D-02,0.2642D-02,0.2689D-02,0.2735D-02,& + &0.2781D-02,0.2826D-02,0.2869D-02,0.2910D-02,0.2950D-02,0.2985D-02,& + &0.3017D-02,0.3044D-02,0.3065D-02,0.3076D-02,0.3077D-02,0.3062D-02,& + &0.3020D-02,0.2980D-02,0.2782D-02,0.2225D-02/ + DATA (XPV(I,4,0),I=1,100)/ & + &0.3752D+01,0.3563D+01,0.3380D+01,0.3204D+01,0.3040D+01,0.2881D+01,& + &0.2728D+01,0.2585D+01,0.2448D+01,0.2314D+01,0.2191D+01,0.2072D+01,& + &0.1957D+01,0.1850D+01,0.1747D+01,0.1648D+01,0.1556D+01,0.1467D+01,& + &0.1381D+01,0.1302D+01,0.1226D+01,0.1152D+01,0.1084D+01,0.1018D+01,& + &0.9554D+00,0.8969D+00,0.8408D+00,0.7867D+00,0.7367D+00,0.6889D+00,& + &0.6429D+00,0.5998D+00,0.5591D+00,0.5202D+00,0.4832D+00,0.4487D+00,& + &0.4159D+00,0.3845D+00,0.3551D+00,0.3274D+00,0.3013D+00,0.2764D+00,& + &0.2529D+00,0.2319D+00,0.2108D+00,0.1912D+00,0.1731D+00,0.1560D+00,& + &0.1397D+00,0.1246D+00,0.1106D+00,0.9755D-01,0.8546D-01,0.7436D-01,& + &0.6395D-01,0.5468D-01,0.4632D-01,0.3879D-01,0.3214D-01,0.2631D-01,& + &0.2126D-01,0.1701D-01,0.1348D-01,0.1056D-01,0.8234D-02,0.6412D-02,& + &0.5029D-02,0.3987D-02,0.3214D-02,0.2636D-02,0.2192D-02,0.1833D-02,& + &0.1527D-02,0.1252D-02,0.9989D-03,0.7610D-03,0.5388D-03,0.3334D-03,& + &0.3120D-03,0.2911D-03,0.2708D-03,0.2511D-03,0.2319D-03,0.2132D-03,& + &0.1950D-03,0.1774D-03,0.1603D-03,0.1439D-03,0.1280D-03,0.1127D-03,& + &0.9795D-04,0.8387D-04,0.7044D-04,0.5771D-04,0.4573D-04,0.3455D-04,& + &0.2427D-04,0.1497D-04,0.7094D-05,0.1118D-05/ + DATA (XPV(I,4,1),I=1,100)/ & + &0.7267D-01,0.6928D-01,0.6597D-01,0.6277D-01,0.5978D-01,0.5687D-01,& + &0.5406D-01,0.5144D-01,0.4890D-01,0.4643D-01,0.4414D-01,0.4191D-01,& + &0.3975D-01,0.3774D-01,0.3579D-01,0.3389D-01,0.3213D-01,0.3042D-01,& + &0.2877D-01,0.2723D-01,0.2574D-01,0.2428D-01,0.2294D-01,0.2163D-01,& + &0.2037D-01,0.1919D-01,0.1805D-01,0.1695D-01,0.1592D-01,0.1493D-01,& + &0.1397D-01,0.1306D-01,0.1220D-01,0.1138D-01,0.1059D-01,0.9845D-02,& + &0.9136D-02,0.8456D-02,0.7814D-02,0.7210D-02,0.6639D-02,0.6096D-02,& + &0.5583D-02,0.5128D-02,0.4672D-02,0.4253D-02,0.3873D-02,0.3519D-02,& + &0.3189D-02,0.2893D-02,0.2627D-02,0.2391D-02,0.2185D-02,0.2009D-02,& + &0.1858D-02,0.1741D-02,0.1654D-02,0.1594D-02,0.1563D-02,0.1558D-02,& + &0.1580D-02,0.1625D-02,0.1693D-02,0.1781D-02,0.1887D-02,0.2008D-02,& + &0.2141D-02,0.2284D-02,0.2434D-02,0.2587D-02,0.2742D-02,0.2898D-02,& + &0.3053D-02,0.3209D-02,0.3370D-02,0.3537D-02,0.3715D-02,0.3891D-02,& + &0.3909D-02,0.3925D-02,0.3940D-02,0.3954D-02,0.3967D-02,0.3977D-02,& + &0.3985D-02,0.3990D-02,0.3993D-02,0.3992D-02,0.3987D-02,0.3977D-02,& + &0.3961D-02,0.3938D-02,0.3907D-02,0.3863D-02,0.3806D-02,0.3729D-02,& + &0.3619D-02,0.3510D-02,0.3213D-02,0.2499D-02/ + DATA (XPV(I,4,2),I=1,100)/ & + &0.7267D-01,0.6928D-01,0.6597D-01,0.6277D-01,0.5978D-01,0.5687D-01,& + &0.5406D-01,0.5144D-01,0.4890D-01,0.4643D-01,0.4413D-01,0.4191D-01,& + &0.3974D-01,0.3773D-01,0.3578D-01,0.3389D-01,0.3213D-01,0.3042D-01,& + &0.2876D-01,0.2722D-01,0.2573D-01,0.2427D-01,0.2293D-01,0.2162D-01,& + &0.2035D-01,0.1917D-01,0.1803D-01,0.1693D-01,0.1590D-01,0.1490D-01,& + &0.1394D-01,0.1303D-01,0.1217D-01,0.1134D-01,0.1055D-01,0.9801D-02,& + &0.9086D-02,0.8401D-02,0.7753D-02,0.7143D-02,0.6564D-02,0.6013D-02,& + &0.5492D-02,0.5026D-02,0.4559D-02,0.4128D-02,0.3735D-02,0.3366D-02,& + &0.3020D-02,0.2707D-02,0.2422D-02,0.2165D-02,0.1936D-02,0.1736D-02,& + &0.1559D-02,0.1413D-02,0.1295D-02,0.1202D-02,0.1135D-02,0.1092D-02,& + &0.1073D-02,0.1077D-02,0.1101D-02,0.1143D-02,0.1201D-02,0.1274D-02,& + &0.1357D-02,0.1448D-02,0.1543D-02,0.1639D-02,0.1732D-02,0.1817D-02,& + &0.1888D-02,0.1938D-02,0.1960D-02,0.1941D-02,0.1870D-02,0.1725D-02,& + &0.1703D-02,0.1680D-02,0.1656D-02,0.1631D-02,0.1604D-02,0.1577D-02,& + &0.1548D-02,0.1517D-02,0.1485D-02,0.1452D-02,0.1417D-02,0.1380D-02,& + &0.1341D-02,0.1299D-02,0.1255D-02,0.1207D-02,0.1156D-02,0.1098D-02,& + &0.1033D-02,0.9674D-03,0.8541D-03,0.6354D-03/ + DATA (XPV(I,4,3),I=1,100)/ & + &0.7305D-01,0.6967D-01,0.6638D-01,0.6319D-01,0.6022D-01,0.5733D-01,& + &0.5454D-01,0.5194D-01,0.4942D-01,0.4697D-01,0.4470D-01,0.4249D-01,& + &0.4035D-01,0.3836D-01,0.3644D-01,0.3457D-01,0.3283D-01,0.3115D-01,& + &0.2952D-01,0.2801D-01,0.2655D-01,0.2512D-01,0.2381D-01,0.2253D-01,& + &0.2130D-01,0.2016D-01,0.1905D-01,0.1798D-01,0.1698D-01,0.1603D-01,& + &0.1511D-01,0.1424D-01,0.1341D-01,0.1262D-01,0.1187D-01,0.1116D-01,& + &0.1049D-01,0.9841D-02,0.9231D-02,0.8659D-02,0.8117D-02,0.7599D-02,& + &0.7111D-02,0.6679D-02,0.6237D-02,0.5829D-02,0.5456D-02,0.5100D-02,& + &0.4761D-02,0.4448D-02,0.4155D-02,0.3882D-02,0.3626D-02,0.3388D-02,& + &0.3157D-02,0.2947D-02,0.2749D-02,0.2560D-02,0.2381D-02,0.2208D-02,& + &0.2041D-02,0.1879D-02,0.1722D-02,0.1566D-02,0.1413D-02,0.1263D-02,& + &0.1119D-02,0.9814D-03,0.8540D-03,0.7401D-03,0.6436D-03,0.5684D-03,& + &0.5183D-03,0.4963D-03,0.5046D-03,0.5445D-03,0.6168D-03,0.7197D-03,& + &0.7326D-03,0.7455D-03,0.7585D-03,0.7712D-03,0.7840D-03,0.7964D-03,& + &0.8087D-03,0.8205D-03,0.8319D-03,0.8426D-03,0.8525D-03,0.8614D-03,& + &0.8691D-03,0.8752D-03,0.8793D-03,0.8807D-03,0.8787D-03,0.8717D-03,& + &0.8570D-03,0.8420D-03,0.7795D-03,0.6128D-03/ + DATA (XPV(I,4,4),I=1,100)/ & + &0.7282D-01,0.6943D-01,0.6613D-01,0.6293D-01,0.5995D-01,0.5705D-01,& + &0.5425D-01,0.5164D-01,0.4911D-01,0.4664D-01,0.4436D-01,0.4214D-01,& + &0.3998D-01,0.3798D-01,0.3604D-01,0.3416D-01,0.3240D-01,0.3071D-01,& + &0.2906D-01,0.2753D-01,0.2605D-01,0.2461D-01,0.2328D-01,0.2198D-01,& + &0.2073D-01,0.1957D-01,0.1844D-01,0.1735D-01,0.1633D-01,0.1535D-01,& + &0.1441D-01,0.1352D-01,0.1267D-01,0.1186D-01,0.1108D-01,0.1035D-01,& + &0.9656D-02,0.8988D-02,0.8358D-02,0.7765D-02,0.7204D-02,0.6669D-02,& + &0.6164D-02,0.5715D-02,0.5262D-02,0.4844D-02,0.4464D-02,0.4105D-02,& + &0.3767D-02,0.3460D-02,0.3177D-02,0.2920D-02,0.2687D-02,0.2479D-02,& + &0.2287D-02,0.2123D-02,0.1980D-02,0.1856D-02,0.1752D-02,0.1664D-02,& + &0.1592D-02,0.1534D-02,0.1490D-02,0.1456D-02,0.1432D-02,0.1417D-02,& + &0.1410D-02,0.1411D-02,0.1420D-02,0.1440D-02,0.1475D-02,0.1528D-02,& + &0.1609D-02,0.1726D-02,0.1895D-02,0.2133D-02,0.2459D-02,0.2886D-02,& + &0.2938D-02,0.2991D-02,0.3043D-02,0.3095D-02,0.3146D-02,0.3196D-02,& + &0.3246D-02,0.3294D-02,0.3340D-02,0.3382D-02,0.3423D-02,0.3458D-02,& + &0.3490D-02,0.3514D-02,0.3531D-02,0.3537D-02,0.3529D-02,0.3502D-02,& + &0.3443D-02,0.3384D-02,0.3138D-02,0.2476D-02/ + DATA (XPV(I,5,0),I=1,100)/ & + &0.5090D+01,0.4807D+01,0.4532D+01,0.4269D+01,0.4025D+01,0.3790D+01,& + &0.3565D+01,0.3357D+01,0.3158D+01,0.2966D+01,0.2789D+01,0.2619D+01,& + &0.2456D+01,0.2306D+01,0.2162D+01,0.2024D+01,0.1896D+01,0.1775D+01,& + &0.1658D+01,0.1551D+01,0.1449D+01,0.1350D+01,0.1260D+01,0.1174D+01,& + &0.1092D+01,0.1017D+01,0.9446D+00,0.8759D+00,0.8129D+00,0.7532D+00,& + &0.6963D+00,0.6436D+00,0.5942D+00,0.5475D+00,0.5035D+00,0.4630D+00,& + &0.4248D+00,0.3887D+00,0.3552D+00,0.3241D+00,0.2952D+00,0.2679D+00,& + &0.2425D+00,0.2201D+00,0.1979D+00,0.1776D+00,0.1591D+00,0.1419D+00,& + &0.1258D+00,0.1112D+00,0.9780D-01,0.8557D-01,0.7444D-01,0.6440D-01,& + &0.5515D-01,0.4707D-01,0.3992D-01,0.3359D-01,0.2809D-01,0.2335D-01,& + &0.1929D-01,0.1591D-01,0.1311D-01,0.1080D-01,0.8928D-02,0.7425D-02,& + &0.6231D-02,0.5269D-02,0.4486D-02,0.3833D-02,0.3270D-02,0.2770D-02,& + &0.2314D-02,0.1893D-02,0.1501D-02,0.1135D-02,0.7972D-03,0.4881D-03,& + &0.4561D-03,0.4250D-03,0.3947D-03,0.3653D-03,0.3368D-03,0.3092D-03,& + &0.2821D-03,0.2562D-03,0.2311D-03,0.2068D-03,0.1835D-03,0.1611D-03,& + &0.1396D-03,0.1192D-03,0.9970D-04,0.8133D-04,0.6411D-04,0.4814D-04,& + &0.3357D-04,0.2049D-04,0.9589D-05,0.1523D-05/ + DATA (XPV(I,5,1),I=1,100)/ & + &0.1266D+00,0.1201D+00,0.1139D+00,0.1078D+00,0.1022D+00,0.9680D-01,& + &0.9156D-01,0.8670D-01,0.8201D-01,0.7747D-01,0.7327D-01,0.6921D-01,& + &0.6529D-01,0.6166D-01,0.5816D-01,0.5478D-01,0.5165D-01,0.4863D-01,& + &0.4572D-01,0.4302D-01,0.4044D-01,0.3792D-01,0.3561D-01,0.3338D-01,& + &0.3124D-01,0.2925D-01,0.2735D-01,0.2551D-01,0.2381D-01,0.2218D-01,& + &0.2062D-01,0.1916D-01,0.1779D-01,0.1647D-01,0.1522D-01,0.1406D-01,& + &0.1296D-01,0.1192D-01,0.1094D-01,0.1003D-01,0.9174D-02,0.8369D-02,& + &0.7616D-02,0.6954D-02,0.6299D-02,0.5702D-02,0.5167D-02,0.4674D-02,& + &0.4219D-02,0.3817D-02,0.3459D-02,0.3147D-02,0.2878D-02,0.2651D-02,& + &0.2460D-02,0.2315D-02,0.2210D-02,0.2140D-02,0.2107D-02,0.2106D-02,& + &0.2137D-02,0.2196D-02,0.2281D-02,0.2387D-02,0.2512D-02,0.2652D-02,& + &0.2804D-02,0.2964D-02,0.3128D-02,0.3295D-02,0.3463D-02,0.3634D-02,& + &0.3808D-02,0.3993D-02,0.4196D-02,0.4430D-02,0.4706D-02,0.5014D-02,& + &0.5048D-02,0.5080D-02,0.5111D-02,0.5140D-02,0.5168D-02,0.5193D-02,& + &0.5215D-02,0.5233D-02,0.5248D-02,0.5257D-02,0.5261D-02,0.5258D-02,& + &0.5247D-02,0.5225D-02,0.5191D-02,0.5140D-02,0.5069D-02,0.4968D-02,& + &0.4823D-02,0.4671D-02,0.4254D-02,0.3263D-02/ + DATA (XPV(I,5,2),I=1,100)/ & + &0.1266D+00,0.1201D+00,0.1139D+00,0.1078D+00,0.1022D+00,0.9679D-01,& + &0.9156D-01,0.8670D-01,0.8201D-01,0.7747D-01,0.7326D-01,0.6921D-01,& + &0.6528D-01,0.6166D-01,0.5815D-01,0.5477D-01,0.5164D-01,0.4862D-01,& + &0.4571D-01,0.4301D-01,0.4042D-01,0.3790D-01,0.3559D-01,0.3335D-01,& + &0.3121D-01,0.2922D-01,0.2731D-01,0.2547D-01,0.2377D-01,0.2214D-01,& + &0.2058D-01,0.1911D-01,0.1773D-01,0.1641D-01,0.1515D-01,0.1399D-01,& + &0.1288D-01,0.1182D-01,0.1083D-01,0.9913D-02,0.9047D-02,0.8227D-02,& + &0.7461D-02,0.6782D-02,0.6109D-02,0.5493D-02,0.4936D-02,0.4419D-02,& + &0.3940D-02,0.3509D-02,0.3121D-02,0.2776D-02,0.2470D-02,0.2205D-02,& + &0.1972D-02,0.1782D-02,0.1628D-02,0.1507D-02,0.1418D-02,0.1359D-02,& + &0.1328D-02,0.1323D-02,0.1340D-02,0.1377D-02,0.1429D-02,0.1495D-02,& + &0.1570D-02,0.1651D-02,0.1733D-02,0.1813D-02,0.1887D-02,0.1950D-02,& + &0.1998D-02,0.2025D-02,0.2028D-02,0.2000D-02,0.1934D-02,0.1821D-02,& + &0.1805D-02,0.1788D-02,0.1770D-02,0.1751D-02,0.1732D-02,0.1712D-02,& + &0.1691D-02,0.1668D-02,0.1645D-02,0.1620D-02,0.1594D-02,0.1566D-02,& + &0.1536D-02,0.1503D-02,0.1467D-02,0.1428D-02,0.1384D-02,0.1333D-02,& + &0.1271D-02,0.1209D-02,0.1082D-02,0.8147D-03/ + DATA (XPV(I,5,3),I=1,100)/ & + &0.1270D+00,0.1206D+00,0.1143D+00,0.1083D+00,0.1027D+00,0.9728D-01,& + &0.9207D-01,0.8723D-01,0.8256D-01,0.7804D-01,0.7386D-01,0.6983D-01,& + &0.6593D-01,0.6233D-01,0.5885D-01,0.5549D-01,0.5239D-01,0.4939D-01,& + &0.4651D-01,0.4384D-01,0.4128D-01,0.3880D-01,0.3652D-01,0.3431D-01,& + &0.3221D-01,0.3025D-01,0.2838D-01,0.2657D-01,0.2490D-01,0.2331D-01,& + &0.2178D-01,0.2036D-01,0.1901D-01,0.1773D-01,0.1651D-01,0.1538D-01,& + &0.1431D-01,0.1329D-01,0.1233D-01,0.1144D-01,0.1061D-01,0.9815D-02,& + &0.9073D-02,0.8419D-02,0.7762D-02,0.7159D-02,0.6612D-02,0.6098D-02,& + &0.5612D-02,0.5170D-02,0.4761D-02,0.4384D-02,0.4038D-02,0.3721D-02,& + &0.3420D-02,0.3151D-02,0.2904D-02,0.2675D-02,0.2463D-02,0.2266D-02,& + &0.2081D-02,0.1908D-02,0.1746D-02,0.1589D-02,0.1442D-02,0.1302D-02,& + &0.1172D-02,0.1053D-02,0.9463D-03,0.8557D-03,0.7842D-03,0.7348D-03,& + &0.7109D-03,0.7155D-03,0.7513D-03,0.8206D-03,0.9250D-03,0.1061D-02,& + &0.1078D-02,0.1094D-02,0.1110D-02,0.1126D-02,0.1141D-02,0.1156D-02,& + &0.1170D-02,0.1183D-02,0.1196D-02,0.1207D-02,0.1217D-02,0.1225D-02,& + &0.1231D-02,0.1235D-02,0.1235D-02,0.1231D-02,0.1222D-02,0.1205D-02,& + &0.1177D-02,0.1147D-02,0.1049D-02,0.8076D-03/ + DATA (XPV(I,5,4),I=1,100)/ & + &0.1268D+00,0.1203D+00,0.1141D+00,0.1080D+00,0.1024D+00,0.9699D-01,& + &0.9176D-01,0.8691D-01,0.8223D-01,0.7769D-01,0.7350D-01,0.6945D-01,& + &0.6554D-01,0.6192D-01,0.5843D-01,0.5506D-01,0.5194D-01,0.4893D-01,& + &0.4603D-01,0.4334D-01,0.4077D-01,0.3826D-01,0.3597D-01,0.3374D-01,& + &0.3162D-01,0.2964D-01,0.2775D-01,0.2592D-01,0.2423D-01,0.2262D-01,& + &0.2108D-01,0.1963D-01,0.1826D-01,0.1696D-01,0.1572D-01,0.1457D-01,& + &0.1348D-01,0.1245D-01,0.1148D-01,0.1058D-01,0.9728D-02,0.8927D-02,& + &0.8178D-02,0.7517D-02,0.6860D-02,0.6260D-02,0.5718D-02,0.5215D-02,& + &0.4746D-02,0.4325D-02,0.3945D-02,0.3604D-02,0.3300D-02,0.3034D-02,& + &0.2794D-02,0.2595D-02,0.2428D-02,0.2288D-02,0.2176D-02,0.2089D-02,& + &0.2024D-02,0.1980D-02,0.1955D-02,0.1945D-02,0.1948D-02,0.1963D-02,& + &0.1990D-02,0.2028D-02,0.2077D-02,0.2140D-02,0.2220D-02,0.2326D-02,& + &0.2465D-02,0.2653D-02,0.2905D-02,0.3246D-02,0.3695D-02,0.4254D-02,& + &0.4321D-02,0.4386D-02,0.4451D-02,0.4514D-02,0.4577D-02,0.4636D-02,& + &0.4694D-02,0.4748D-02,0.4799D-02,0.4844D-02,0.4884D-02,0.4917D-02,& + &0.4943D-02,0.4957D-02,0.4959D-02,0.4943D-02,0.4907D-02,0.4841D-02,& + &0.4729D-02,0.4609D-02,0.4221D-02,0.3255D-02/ + DATA (XPV(I,6,0),I=1,100)/ & + &0.6237D+01,0.5864D+01,0.5504D+01,0.5161D+01,0.4844D+01,0.4540D+01,& + &0.4250D+01,0.3983D+01,0.3728D+01,0.3484D+01,0.3260D+01,0.3047D+01,& + &0.2842D+01,0.2655D+01,0.2476D+01,0.2305D+01,0.2149D+01,0.2000D+01,& + &0.1859D+01,0.1729D+01,0.1606D+01,0.1488D+01,0.1381D+01,0.1279D+01,& + &0.1183D+01,0.1094D+01,0.1011D+01,0.9315D+00,0.8593D+00,0.7912D+00,& + &0.7268D+00,0.6675D+00,0.6124D+00,0.5606D+00,0.5121D+00,0.4678D+00,& + &0.4264D+00,0.3876D+00,0.3518D+00,0.3190D+00,0.2886D+00,0.2603D+00,& + &0.2341D+00,0.2112D+00,0.1888D+00,0.1684D+00,0.1501D+00,0.1333D+00,& + &0.1177D+00,0.1036D+00,0.9087D-01,0.7939D-01,0.6905D-01,0.5982D-01,& + &0.5142D-01,0.4414D-01,0.3777D-01,0.3217D-01,0.2734D-01,0.2318D-01,& + &0.1963D-01,0.1666D-01,0.1417D-01,0.1208D-01,0.1035D-01,0.8900D-02,& + &0.7693D-02,0.6662D-02,0.5773D-02,0.4987D-02,0.4279D-02,0.3629D-02,& + &0.3029D-02,0.2471D-02,0.1953D-02,0.1472D-02,0.1029D-02,0.6270D-03,& + &0.5855D-03,0.5451D-03,0.5059D-03,0.4679D-03,0.4310D-03,0.3953D-03,& + &0.3604D-03,0.3269D-03,0.2945D-03,0.2634D-03,0.2334D-03,0.2046D-03,& + &0.1771D-03,0.1509D-03,0.1260D-03,0.1026D-03,0.8070D-04,0.6045D-04,& + &0.4202D-04,0.2555D-04,0.1191D-04,0.1897D-05/ + DATA (XPV(I,6,1),I=1,100)/ & + &0.1781D+00,0.1684D+00,0.1591D+00,0.1501D+00,0.1418D+00,0.1337D+00,& + &0.1260D+00,0.1189D+00,0.1120D+00,0.1054D+00,0.9931D-01,0.9344D-01,& + &0.8779D-01,0.8258D-01,0.7757D-01,0.7276D-01,0.6832D-01,0.6405D-01,& + &0.5996D-01,0.5619D-01,0.5258D-01,0.4909D-01,0.4591D-01,0.4283D-01,& + &0.3990D-01,0.3720D-01,0.3462D-01,0.3214D-01,0.2986D-01,0.2770D-01,& + &0.2563D-01,0.2370D-01,0.2190D-01,0.2019D-01,0.1857D-01,0.1708D-01,& + &0.1567D-01,0.1434D-01,0.1310D-01,0.1196D-01,0.1090D-01,0.9901D-02,& + &0.8978D-02,0.8170D-02,0.7379D-02,0.6665D-02,0.6029D-02,0.5448D-02,& + &0.4919D-02,0.4455D-02,0.4047D-02,0.3695D-02,0.3396D-02,0.3149D-02,& + &0.2945D-02,0.2795D-02,0.2690D-02,0.2626D-02,0.2604D-02,0.2618D-02,& + &0.2666D-02,0.2744D-02,0.2850D-02,0.2977D-02,0.3122D-02,0.3283D-02,& + &0.3453D-02,0.3631D-02,0.3813D-02,0.3996D-02,0.4182D-02,0.4372D-02,& + &0.4572D-02,0.4792D-02,0.5045D-02,0.5351D-02,0.5725D-02,0.6156D-02,& + &0.6204D-02,0.6250D-02,0.6295D-02,0.6337D-02,0.6377D-02,0.6413D-02,& + &0.6446D-02,0.6474D-02,0.6498D-02,0.6514D-02,0.6523D-02,0.6523D-02,& + &0.6513D-02,0.6488D-02,0.6447D-02,0.6385D-02,0.6296D-02,0.6169D-02,& + &0.5986D-02,0.5790D-02,0.5259D-02,0.4013D-02/ + DATA (XPV(I,6,2),I=1,100)/ & + &0.1781D+00,0.1684D+00,0.1591D+00,0.1501D+00,0.1418D+00,0.1337D+00,& + &0.1260D+00,0.1189D+00,0.1120D+00,0.1054D+00,0.9930D-01,0.9343D-01,& + &0.8778D-01,0.8257D-01,0.7756D-01,0.7274D-01,0.6830D-01,0.6403D-01,& + &0.5994D-01,0.5617D-01,0.5255D-01,0.4906D-01,0.4587D-01,0.4280D-01,& + &0.3987D-01,0.3716D-01,0.3457D-01,0.3209D-01,0.2981D-01,0.2764D-01,& + &0.2556D-01,0.2363D-01,0.2181D-01,0.2009D-01,0.1846D-01,0.1696D-01,& + &0.1554D-01,0.1420D-01,0.1295D-01,0.1179D-01,0.1071D-01,0.9697D-02,& + &0.8753D-02,0.7923D-02,0.7107D-02,0.6365D-02,0.5699D-02,0.5086D-02,& + &0.4521D-02,0.4018D-02,0.3569D-02,0.3171D-02,0.2823D-02,0.2522D-02,& + &0.2261D-02,0.2049D-02,0.1878D-02,0.1744D-02,0.1647D-02,0.1582D-02,& + &0.1547D-02,0.1538D-02,0.1553D-02,0.1587D-02,0.1636D-02,0.1697D-02,& + &0.1765D-02,0.1837D-02,0.1909D-02,0.1977D-02,0.2038D-02,0.2086D-02,& + &0.2120D-02,0.2137D-02,0.2134D-02,0.2109D-02,0.2062D-02,0.1987D-02,& + &0.1976D-02,0.1965D-02,0.1953D-02,0.1941D-02,0.1928D-02,0.1914D-02,& + &0.1899D-02,0.1884D-02,0.1867D-02,0.1848D-02,0.1828D-02,0.1806D-02,& + &0.1782D-02,0.1754D-02,0.1723D-02,0.1688D-02,0.1646D-02,0.1596D-02,& + &0.1533D-02,0.1467D-02,0.1321D-02,0.9997D-03/ + DATA (XPV(I,6,3),I=1,100)/ & + &0.1785D+00,0.1689D+00,0.1595D+00,0.1506D+00,0.1423D+00,0.1342D+00,& + &0.1266D+00,0.1194D+00,0.1126D+00,0.1060D+00,0.9992D-01,0.9408D-01,& + &0.8845D-01,0.8327D-01,0.7828D-01,0.7350D-01,0.6908D-01,0.6484D-01,& + &0.6078D-01,0.5703D-01,0.5345D-01,0.4999D-01,0.4684D-01,0.4379D-01,& + &0.4090D-01,0.3822D-01,0.3567D-01,0.3322D-01,0.3097D-01,0.2884D-01,& + &0.2680D-01,0.2490D-01,0.2312D-01,0.2144D-01,0.1984D-01,0.1837D-01,& + &0.1699D-01,0.1567D-01,0.1445D-01,0.1332D-01,0.1227D-01,0.1128D-01,& + &0.1035D-01,0.9539D-02,0.8732D-02,0.7995D-02,0.7330D-02,0.6710D-02,& + &0.6131D-02,0.5606D-02,0.5125D-02,0.4686D-02,0.4286D-02,0.3924D-02,& + &0.3584D-02,0.3285D-02,0.3013D-02,0.2764D-02,0.2538D-02,0.2330D-02,& + &0.2139D-02,0.1964D-02,0.1804D-02,0.1652D-02,0.1512D-02,0.1383D-02,& + &0.1266D-02,0.1162D-02,0.1073D-02,0.1000D-02,0.9475D-03,0.9178D-03,& + &0.9140D-03,0.9394D-03,0.9971D-03,0.1091D-02,0.1222D-02,0.1386D-02,& + &0.1405D-02,0.1424D-02,0.1442D-02,0.1460D-02,0.1477D-02,0.1494D-02,& + &0.1510D-02,0.1524D-02,0.1537D-02,0.1549D-02,0.1558D-02,0.1565D-02,& + &0.1570D-02,0.1571D-02,0.1567D-02,0.1558D-02,0.1542D-02,0.1516D-02,& + &0.1476D-02,0.1432D-02,0.1303D-02,0.9967D-03/ + DATA (XPV(I,6,4),I=1,100)/ & + &0.1783D+00,0.1686D+00,0.1592D+00,0.1503D+00,0.1420D+00,0.1339D+00,& + &0.1262D+00,0.1191D+00,0.1122D+00,0.1056D+00,0.9955D-01,0.9369D-01,& + &0.8805D-01,0.8285D-01,0.7785D-01,0.7305D-01,0.6862D-01,0.6436D-01,& + &0.6028D-01,0.5652D-01,0.5292D-01,0.4944D-01,0.4627D-01,0.4321D-01,& + &0.4029D-01,0.3760D-01,0.3503D-01,0.3256D-01,0.3030D-01,0.2814D-01,& + &0.2609D-01,0.2417D-01,0.2238D-01,0.2068D-01,0.1907D-01,0.1759D-01,& + &0.1619D-01,0.1486D-01,0.1363D-01,0.1250D-01,0.1144D-01,0.1044D-01,& + &0.9519D-02,0.8711D-02,0.7914D-02,0.7191D-02,0.6544D-02,0.5949D-02,& + &0.5400D-02,0.4912D-02,0.4476D-02,0.4091D-02,0.3753D-02,0.3461D-02,& + &0.3203D-02,0.2994D-02,0.2824D-02,0.2687D-02,0.2583D-02,0.2509D-02,& + &0.2462D-02,0.2439D-02,0.2438D-02,0.2455D-02,0.2487D-02,0.2534D-02,& + &0.2594D-02,0.2666D-02,0.2752D-02,0.2854D-02,0.2977D-02,0.3129D-02,& + &0.3321D-02,0.3571D-02,0.3898D-02,0.4329D-02,0.4884D-02,0.5555D-02,& + &0.5632D-02,0.5708D-02,0.5783D-02,0.5856D-02,0.5926D-02,0.5993D-02,& + &0.6056D-02,0.6115D-02,0.6168D-02,0.6214D-02,0.6254D-02,0.6283D-02,& + &0.6301D-02,0.6305D-02,0.6291D-02,0.6256D-02,0.6193D-02,0.6090D-02,& + &0.5930D-02,0.5755D-02,0.5242D-02,0.4010D-02/ + DATA (XPV(I,7,0),I=1,100)/ & + &0.7226D+01,0.6770D+01,0.6333D+01,0.5916D+01,0.5533D+01,0.5167D+01,& + &0.4820D+01,0.4501D+01,0.4197D+01,0.3907D+01,0.3643D+01,0.3391D+01,& + &0.3151D+01,0.2932D+01,0.2724D+01,0.2526D+01,0.2345D+01,0.2174D+01,& + &0.2012D+01,0.1864D+01,0.1724D+01,0.1590D+01,0.1470D+01,0.1356D+01,& + &0.1248D+01,0.1150D+01,0.1057D+01,0.9701D+00,0.8910D+00,0.8168D+00,& + &0.7469D+00,0.6829D+00,0.6237D+00,0.5684D+00,0.5169D+00,0.4702D+00,& + &0.4266D+00,0.3861D+00,0.3490D+00,0.3152D+00,0.2841D+00,0.2552D+00,& + &0.2287D+00,0.2056D+00,0.1833D+00,0.1631D+00,0.1451D+00,0.1286D+00,& + &0.1134D+00,0.9989D-01,0.8770D-01,0.7678D-01,0.6701D-01,0.5835D-01,& + &0.5051D-01,0.4375D-01,0.3785D-01,0.3267D-01,0.2821D-01,0.2435D-01,& + &0.2104D-01,0.1823D-01,0.1585D-01,0.1380D-01,0.1205D-01,0.1054D-01,& + &0.9237D-02,0.8080D-02,0.7048D-02,0.6110D-02,0.5249D-02,0.4452D-02,& + &0.3711D-02,0.3023D-02,0.2385D-02,0.1794D-02,0.1252D-02,0.7601D-03,& + &0.7095D-03,0.6603D-03,0.6126D-03,0.5662D-03,0.5213D-03,0.4779D-03,& + &0.4354D-03,0.3948D-03,0.3555D-03,0.3177D-03,0.2813D-03,0.2465D-03,& + &0.2131D-03,0.1814D-03,0.1514D-03,0.1231D-03,0.9674D-04,0.7237D-04,& + &0.5023D-04,0.3050D-04,0.1418D-04,0.2263D-05/ + DATA (XPV(I,7,1),I=1,100)/ & + &0.2263D+00,0.2134D+00,0.2010D+00,0.1891D+00,0.1781D+00,0.1675D+00,& + &0.1573D+00,0.1480D+00,0.1390D+00,0.1304D+00,0.1225D+00,0.1149D+00,& + &0.1076D+00,0.1009D+00,0.9446D-01,0.8830D-01,0.8265D-01,0.7723D-01,& + &0.7206D-01,0.6730D-01,0.6277D-01,0.5840D-01,0.5443D-01,0.5061D-01,& + &0.4699D-01,0.4365D-01,0.4048D-01,0.3745D-01,0.3468D-01,0.3205D-01,& + &0.2955D-01,0.2724D-01,0.2508D-01,0.2304D-01,0.2112D-01,0.1936D-01,& + &0.1771D-01,0.1615D-01,0.1472D-01,0.1340D-01,0.1217D-01,0.1103D-01,& + &0.9985D-02,0.9072D-02,0.8184D-02,0.7387D-02,0.6683D-02,0.6045D-02,& + &0.5467D-02,0.4966D-02,0.4530D-02,0.4157D-02,0.3846D-02,0.3593D-02,& + &0.3387D-02,0.3241D-02,0.3146D-02,0.3095D-02,0.3088D-02,0.3119D-02,& + &0.3187D-02,0.3286D-02,0.3412D-02,0.3561D-02,0.3727D-02,0.3908D-02,& + &0.4098D-02,0.4295D-02,0.4495D-02,0.4698D-02,0.4903D-02,0.5117D-02,& + &0.5346D-02,0.5605D-02,0.5913D-02,0.6292D-02,0.6763D-02,0.7310D-02,& + &0.7371D-02,0.7430D-02,0.7487D-02,0.7541D-02,0.7592D-02,0.7638D-02,& + &0.7681D-02,0.7717D-02,0.7747D-02,0.7769D-02,0.7783D-02,0.7784D-02,& + &0.7772D-02,0.7743D-02,0.7695D-02,0.7620D-02,0.7512D-02,0.7358D-02,& + &0.7137D-02,0.6896D-02,0.6255D-02,0.4763D-02/ + DATA (XPV(I,7,2),I=1,100)/ & + &0.2263D+00,0.2134D+00,0.2010D+00,0.1891D+00,0.1780D+00,0.1675D+00,& + &0.1573D+00,0.1480D+00,0.1390D+00,0.1304D+00,0.1225D+00,0.1149D+00,& + &0.1076D+00,0.1009D+00,0.9444D-01,0.8828D-01,0.8263D-01,0.7721D-01,& + &0.7203D-01,0.6727D-01,0.6273D-01,0.5836D-01,0.5439D-01,0.5056D-01,& + &0.4694D-01,0.4360D-01,0.4042D-01,0.3738D-01,0.3460D-01,0.3197D-01,& + &0.2946D-01,0.2714D-01,0.2497D-01,0.2291D-01,0.2098D-01,0.1921D-01,& + &0.1754D-01,0.1597D-01,0.1451D-01,0.1317D-01,0.1193D-01,0.1076D-01,& + &0.9687D-02,0.8745D-02,0.7825D-02,0.6993D-02,0.6250D-02,0.5570D-02,& + &0.4947D-02,0.4395D-02,0.3905D-02,0.3475D-02,0.3100D-02,0.2779D-02,& + &0.2500D-02,0.2276D-02,0.2097D-02,0.1957D-02,0.1856D-02,0.1789D-02,& + &0.1752D-02,0.1742D-02,0.1755D-02,0.1786D-02,0.1832D-02,0.1888D-02,& + &0.1951D-02,0.2017D-02,0.2081D-02,0.2140D-02,0.2190D-02,0.2230D-02,& + &0.2256D-02,0.2268D-02,0.2266D-02,0.2252D-02,0.2228D-02,0.2192D-02,& + &0.2187D-02,0.2181D-02,0.2175D-02,0.2168D-02,0.2160D-02,0.2152D-02,& + &0.2143D-02,0.2132D-02,0.2120D-02,0.2107D-02,0.2091D-02,0.2074D-02,& + &0.2053D-02,0.2029D-02,0.2000D-02,0.1966D-02,0.1924D-02,0.1872D-02,& + &0.1804D-02,0.1733D-02,0.1564D-02,0.1186D-02/ + DATA (XPV(I,7,3),I=1,100)/ & + &0.2267D+00,0.2139D+00,0.2014D+00,0.1896D+00,0.1786D+00,0.1680D+00,& + &0.1579D+00,0.1485D+00,0.1396D+00,0.1310D+00,0.1231D+00,0.1155D+00,& + &0.1083D+00,0.1016D+00,0.9519D-01,0.8906D-01,0.8343D-01,0.7804D-01,& + &0.7290D-01,0.6817D-01,0.6366D-01,0.5932D-01,0.5538D-01,0.5158D-01,& + &0.4799D-01,0.4469D-01,0.4154D-01,0.3854D-01,0.3579D-01,0.3319D-01,& + &0.3072D-01,0.2843D-01,0.2629D-01,0.2427D-01,0.2237D-01,0.2063D-01,& + &0.1899D-01,0.1745D-01,0.1602D-01,0.1470D-01,0.1348D-01,0.1233D-01,& + &0.1127D-01,0.1034D-01,0.9420D-02,0.8586D-02,0.7837D-02,0.7144D-02,& + &0.6498D-02,0.5917D-02,0.5388D-02,0.4909D-02,0.4474D-02,0.4084D-02,& + &0.3720D-02,0.3402D-02,0.3116D-02,0.2856D-02,0.2623D-02,0.2412D-02,& + &0.2219D-02,0.2045D-02,0.1888D-02,0.1743D-02,0.1611D-02,0.1491D-02,& + &0.1385D-02,0.1294D-02,0.1218D-02,0.1160D-02,0.1123D-02,0.1110D-02,& + &0.1122D-02,0.1165D-02,0.1242D-02,0.1357D-02,0.1512D-02,0.1701D-02,& + &0.1723D-02,0.1744D-02,0.1765D-02,0.1785D-02,0.1804D-02,0.1822D-02,& + &0.1839D-02,0.1854D-02,0.1868D-02,0.1880D-02,0.1889D-02,0.1895D-02,& + &0.1898D-02,0.1896D-02,0.1889D-02,0.1876D-02,0.1853D-02,0.1819D-02,& + &0.1768D-02,0.1711D-02,0.1554D-02,0.1185D-02/ + DATA (XPV(I,7,4),I=1,100)/ & + &0.2265D+00,0.2136D+00,0.2012D+00,0.1893D+00,0.1783D+00,0.1677D+00,& + &0.1575D+00,0.1482D+00,0.1392D+00,0.1306D+00,0.1227D+00,0.1151D+00,& + &0.1078D+00,0.1012D+00,0.9474D-01,0.8860D-01,0.8296D-01,0.7755D-01,& + &0.7239D-01,0.6764D-01,0.6312D-01,0.5876D-01,0.5480D-01,0.5099D-01,& + &0.4738D-01,0.4406D-01,0.4090D-01,0.3788D-01,0.3512D-01,0.3250D-01,& + &0.3002D-01,0.2771D-01,0.2556D-01,0.2353D-01,0.2162D-01,0.1987D-01,& + &0.1822D-01,0.1667D-01,0.1524D-01,0.1392D-01,0.1270D-01,0.1156D-01,& + &0.1051D-01,0.9590D-02,0.8693D-02,0.7884D-02,0.7166D-02,0.6509D-02,& + &0.5909D-02,0.5380D-02,0.4911D-02,0.4502D-02,0.4147D-02,0.3845D-02,& + &0.3583D-02,0.3375D-02,0.3211D-02,0.3085D-02,0.2996D-02,0.2940D-02,& + &0.2914D-02,0.2914D-02,0.2939D-02,0.2982D-02,0.3044D-02,0.3121D-02,& + &0.3212D-02,0.3318D-02,0.3438D-02,0.3577D-02,0.3739D-02,0.3934D-02,& + &0.4176D-02,0.4483D-02,0.4880D-02,0.5394D-02,0.6046D-02,0.6819D-02,& + &0.6907D-02,0.6993D-02,0.7077D-02,0.7157D-02,0.7235D-02,0.7308D-02,& + &0.7377D-02,0.7439D-02,0.7495D-02,0.7542D-02,0.7580D-02,0.7605D-02,& + &0.7617D-02,0.7611D-02,0.7584D-02,0.7530D-02,0.7441D-02,0.7306D-02,& + &0.7101D-02,0.6875D-02,0.6245D-02,0.4762D-02/ + +!..fetching pdfs + DO 5 IP=-6,6 + XPDF(IP)=ZEROD + 5 END DO + DO 2 I=1,IX + ENT(I)=LOG10(XT(I)) + 2 END DO + NA(1)=IX + NA(2)=IQ + DO 3 I=1,IQ + ENT(IX+I)=LOG10(Q2T(I)) + 3 END DO + ARG(1)=LOG10(X) + ARG(2)=LOG10(Q2) +!..VARIOUS FLAVOURS (u-->2,d-->1) + XPDF(0)=DBFINT(NARG,ARG,NA,ENT,XPV(1,1,0)) + XPDF(1)=DBFINT(NARG,ARG,NA,ENT,XPV(1,1,2)) + XPDF(2)=DBFINT(NARG,ARG,NA,ENT,XPV(1,1,1)) + XPDF(3)=DBFINT(NARG,ARG,NA,ENT,XPV(1,1,3)) + XPDF(4)=DBFINT(NARG,ARG,NA,ENT,XPV(1,1,4)) + DO 21 JF=1,4 + XPDF(-JF)=XPDF(JF) + 21 END DO + RETURN + END +!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + DOUBLE PRECISION FUNCTION DBFINT(NARG,ARG,NA,ENT,TABLE) + implicit real*8 (a-h,o-z) + INTEGER NA(NARG), INDEX(32) + double precision & + & ARG(NARG),ENT(10),TABLE(10),WEIGHT(32) + DATA ZEROD/0.D0/ONED/1.D0/ +! + DBFINT = ZEROD + IF(NARG .LT. 1 .OR. NARG .GT. 5) RETURN +! + LMAX = 0 + ISTEP = 1 + KNOTS = 1 + INDEX(1) = 1 + WEIGHT(1) = ONED + DO 100 N = 1, NARG + X = ARG(N) + NDIM = NA(N) + LOCA = LMAX + LMIN = LMAX + 1 + LMAX = LMAX + NDIM + IF(NDIM .GT. 2) GOTO 10 + IF(NDIM .EQ. 1) GOTO 100 + H = X - ENT(LMIN) + IF(H .EQ. ZEROD) GOTO 90 + ISHIFT = ISTEP + IF(X-ENT(LMIN+1) .EQ. ZEROD) GOTO 21 + ISHIFT = 0 + ETA = H / (ENT(LMIN+1) - ENT(LMIN)) + GOTO 30 + 10 LOCB = LMAX + 1 + 11 LOCC = (LOCA+LOCB) / 2 + IF((X-ENT(LOCC)).LT.0) THEN + GOTO 12 + ELSE IF ((X-ENT(LOCC)).EQ.0) THEN + GOTO 20 + ELSE + GOTO 13 + ENDIF + 12 LOCB = LOCC + GOTO 14 + 13 LOCA = LOCC + 14 IF(LOCB-LOCA .GT. 1) GOTO 11 + LOCA = MIN ( MAX (LOCA,LMIN), LMAX-1 ) + ISHIFT = (LOCA - LMIN) * ISTEP + ETA = (X - ENT(LOCA)) / (ENT(LOCA+1) - ENT(LOCA)) + GOTO 30 + 20 ISHIFT = (LOCC - LMIN) * ISTEP + 21 DO 22 K = 1, KNOTS + INDEX(K) = INDEX(K) + ISHIFT + 22 CONTINUE + GOTO 90 + 30 DO 31 K = 1, KNOTS + INDEX(K) = INDEX(K) + ISHIFT + INDEX(K+KNOTS) = INDEX(K) + ISTEP + WEIGHT(K+KNOTS) = WEIGHT(K) * ETA + WEIGHT(K) = WEIGHT(K) - WEIGHT(K+KNOTS) + 31 CONTINUE + KNOTS = 2*KNOTS + 90 ISTEP = ISTEP * NDIM + 100 CONTINUE + DO 200 K = 1, KNOTS + I = INDEX(K) + DBFINT = DBFINT + WEIGHT(K) * TABLE(I) + 200 CONTINUE + RETURN + END +!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +!------------------------------------------------------------- + SUBROUTINE PHLAC2(X,Q2,XPDF) + implicit real*8 (A-H,O-Z) + PARAMETER(IX=100,IQ=7,NARG=2,NFUN=4) + DOUBLE PRECISION & + & DBFINT, & + & XT(IX),Q2T(IQ),ARG(NARG),ENT(IX+IQ), & + & XPV(IX,IQ,0:NFUN),XPDF(-6:6) + DIMENSION NA(NARG) + DATA ZEROD/0.D0/ +!...100 x valuse; in (D-4,.77) log spaced (78 points) +!... in (.78,.995) lineary spaced (22 points) + DATA Q2T/4.,10.,50.,1.D2,1.D3,1.D4,1.D5/ + DATA XT/ & + &0.1000D-03,0.1123D-03,0.1262D-03,0.1417D-03,0.1592D-03,0.1789D-03,& + &0.2009D-03,0.2257D-03,0.2535D-03,0.2848D-03,0.3199D-03,0.3593D-03,& + &0.4037D-03,0.4534D-03,0.5093D-03,0.5722D-03,0.6427D-03,0.7220D-03,& + &0.8110D-03,0.9110D-03,0.1023D-02,0.1150D-02,0.1291D-02,0.1451D-02,& + &0.1629D-02,0.1830D-02,0.2056D-02,0.2310D-02,0.2594D-02,0.2914D-02,& + &0.3274D-02,0.3677D-02,0.4131D-02,0.4640D-02,0.5212D-02,0.5855D-02,& + &0.6577D-02,0.7388D-02,0.8299D-02,0.9323D-02,0.1047D-01,0.1176D-01,& + &0.1321D-01,0.1484D-01,0.1667D-01,0.1873D-01,0.2104D-01,0.2363D-01,& + &0.2655D-01,0.2982D-01,0.3350D-01,0.3763D-01,0.4227D-01,0.4748D-01,& + &0.5334D-01,0.5992D-01,0.6731D-01,0.7560D-01,0.8493D-01,0.9540D-01,& + &0.1072D+00,0.1204D+00,0.1352D+00,0.1519D+00,0.1706D+00,0.1917D+00,& + &0.2153D+00,0.2419D+00,0.2717D+00,0.3052D+00,0.3428D+00,0.3851D+00,& + &0.4326D+00,0.4859D+00,0.5458D+00,0.6131D+00,0.6887D+00,0.7737D+00,& + &0.7837D+00,0.7937D+00,0.8037D+00,0.8137D+00,0.8237D+00,0.8337D+00,& + &0.8437D+00,0.8537D+00,0.8637D+00,0.8737D+00,0.8837D+00,0.8937D+00,& + &0.9037D+00,0.9137D+00,0.9237D+00,0.9337D+00,0.9437D+00,0.9537D+00,& + &0.9637D+00,0.9737D+00,0.9837D+00,0.9937D+00/ + +!...place for DATA blocks + DATA (XPV(I,1,0),I=1,100)/ & + &0.2589D+00,0.2589D+00,0.2588D+00,0.2587D+00,0.2587D+00,0.2586D+00,& + &0.2584D+00,0.2584D+00,0.2583D+00,0.2581D+00,0.2580D+00,0.2578D+00,& + &0.2576D+00,0.2574D+00,0.2572D+00,0.2568D+00,0.2566D+00,0.2562D+00,& + &0.2558D+00,0.2554D+00,0.2549D+00,0.2543D+00,0.2537D+00,0.2530D+00,& + &0.2522D+00,0.2514D+00,0.2504D+00,0.2492D+00,0.2480D+00,0.2467D+00,& + &0.2451D+00,0.2433D+00,0.2414D+00,0.2392D+00,0.2368D+00,0.2341D+00,& + &0.2312D+00,0.2278D+00,0.2241D+00,0.2201D+00,0.2157D+00,0.2108D+00,& + &0.2054D+00,0.2001D+00,0.1934D+00,0.1864D+00,0.1791D+00,0.1711D+00,& + &0.1623D+00,0.1531D+00,0.1433D+00,0.1330D+00,0.1223D+00,0.1113D+00,& + &0.9973D-01,0.8835D-01,0.7705D-01,0.6593D-01,0.5527D-01,0.4522D-01,& + &0.3597D-01,0.2775D-01,0.2067D-01,0.1471D-01,0.9973D-02,0.6363D-02,& + &0.3799D-02,0.2083D-02,0.1036D-02,0.4560D-03,0.1731D-03,0.5432D-04,& + &0.1340D-04,0.2403D-05,0.2784D-06,0.1701D-07,0.3872D-09,0.1511D-11,& + &0.6880D-12,0.3018D-12,0.1271D-12,0.5114D-13,0.1959D-13,0.7089D-14,& + &0.2386D-14,0.7514D-15,0.2177D-15,0.5781D-16,0.1392D-16,0.2956D-17,& + &0.5413D-18,0.8284D-19,0.1017D-19,0.9439D-21,0.6099D-22,0.2408D-23,& + &0.4675D-25,0.2960D-27,0.2410D-30,0.0000D+00/ + DATA (XPV(I,1,1),I=1,100)/ & + &0.3845D-05,0.4208D-05,0.4608D-05,0.5043D-05,0.5522D-05,0.6047D-05,& + &0.6619D-05,0.7247D-05,0.7934D-05,0.8688D-05,0.9512D-05,0.1041D-04,& + &0.1141D-04,0.1249D-04,0.1367D-04,0.1498D-04,0.1640D-04,0.1796D-04,& + &0.1967D-04,0.2154D-04,0.2359D-04,0.2585D-04,0.2830D-04,0.3102D-04,& + &0.3396D-04,0.3720D-04,0.4076D-04,0.4466D-04,0.4891D-04,0.5358D-04,& + &0.5871D-04,0.6431D-04,0.7047D-04,0.7720D-04,0.8457D-04,0.9266D-04,& + &0.1015D-03,0.1112D-03,0.1219D-03,0.1335D-03,0.1462D-03,0.1602D-03,& + &0.1755D-03,0.1923D-03,0.2106D-03,0.2306D-03,0.2526D-03,0.2766D-03,& + &0.3028D-03,0.3314D-03,0.3627D-03,0.3968D-03,0.4340D-03,0.4744D-03,& + &0.5184D-03,0.5662D-03,0.6182D-03,0.6743D-03,0.7351D-03,0.8007D-03,& + &0.8715D-03,0.9472D-03,0.1028D-02,0.1115D-02,0.1206D-02,0.1303D-02,& + &0.1404D-02,0.1510D-02,0.1619D-02,0.1731D-02,0.1844D-02,0.1957D-02,& + &0.2068D-02,0.2173D-02,0.2271D-02,0.2355D-02,0.2418D-02,0.2443D-02,& + &0.2442D-02,0.2440D-02,0.2437D-02,0.2432D-02,0.2426D-02,0.2419D-02,& + &0.2410D-02,0.2400D-02,0.2387D-02,0.2372D-02,0.2355D-02,0.2335D-02,& + &0.2312D-02,0.2285D-02,0.2253D-02,0.2216D-02,0.2172D-02,0.2119D-02,& + &0.2054D-02,0.1973D-02,0.2027D-02,0.1319D-02/ + DATA (XPV(I,1,2),I=1,100)/ & + &0.3745D-05,0.4096D-05,0.4482D-05,0.4901D-05,0.5362D-05,0.5868D-05,& + &0.6418D-05,0.7021D-05,0.7680D-05,0.8403D-05,0.9192D-05,0.1005D-04,& + &0.1100D-04,0.1203D-04,0.1317D-04,0.1440D-04,0.1576D-04,0.1724D-04,& + &0.1886D-04,0.2063D-04,0.2257D-04,0.2471D-04,0.2702D-04,0.2957D-04,& + &0.3233D-04,0.3538D-04,0.3871D-04,0.4236D-04,0.4633D-04,0.5068D-04,& + &0.5546D-04,0.6066D-04,0.6637D-04,0.7260D-04,0.7941D-04,0.8687D-04,& + &0.9503D-04,0.1039D-03,0.1137D-03,0.1243D-03,0.1360D-03,0.1487D-03,& + &0.1626D-03,0.1779D-03,0.1944D-03,0.2126D-03,0.2325D-03,0.2540D-03,& + &0.2776D-03,0.3033D-03,0.3313D-03,0.3619D-03,0.3951D-03,0.4312D-03,& + &0.4704D-03,0.5130D-03,0.5593D-03,0.6092D-03,0.6634D-03,0.7217D-03,& + &0.7848D-03,0.8522D-03,0.9245D-03,0.1002D-02,0.1084D-02,0.1171D-02,& + &0.1262D-02,0.1357D-02,0.1455D-02,0.1555D-02,0.1656D-02,0.1754D-02,& + &0.1847D-02,0.1930D-02,0.1995D-02,0.2033D-02,0.2025D-02,0.1941D-02,& + &0.1924D-02,0.1906D-02,0.1887D-02,0.1865D-02,0.1842D-02,0.1817D-02,& + &0.1789D-02,0.1759D-02,0.1727D-02,0.1692D-02,0.1654D-02,0.1612D-02,& + &0.1566D-02,0.1516D-02,0.1460D-02,0.1399D-02,0.1329D-02,0.1251D-02,& + &0.1159D-02,0.1050D-02,0.9681D-03,0.5785D-03/ + DATA (XPV(I,1,3),I=1,100)/ & + &0.3363D-03,0.3490D-03,0.3624D-03,0.3761D-03,0.3904D-03,0.4053D-03,& + &0.4206D-03,0.4367D-03,0.4532D-03,0.4704D-03,0.4882D-03,0.5067D-03,& + &0.5259D-03,0.5458D-03,0.5664D-03,0.5878D-03,0.6100D-03,0.6330D-03,& + &0.6567D-03,0.6814D-03,0.7069D-03,0.7334D-03,0.7606D-03,0.7890D-03,& + &0.8180D-03,0.8483D-03,0.8795D-03,0.9116D-03,0.9447D-03,0.9788D-03,& + &0.1014D-02,0.1050D-02,0.1087D-02,0.1125D-02,0.1164D-02,0.1203D-02,& + &0.1244D-02,0.1284D-02,0.1326D-02,0.1368D-02,0.1410D-02,0.1452D-02,& + &0.1494D-02,0.1538D-02,0.1577D-02,0.1616D-02,0.1655D-02,0.1692D-02,& + &0.1724D-02,0.1754D-02,0.1780D-02,0.1800D-02,0.1816D-02,0.1825D-02,& + &0.1823D-02,0.1815D-02,0.1797D-02,0.1768D-02,0.1727D-02,0.1673D-02,& + &0.1605D-02,0.1524D-02,0.1431D-02,0.1322D-02,0.1203D-02,0.1073D-02,& + &0.9373D-03,0.7978D-03,0.6600D-03,0.5285D-03,0.4089D-03,0.3059D-03,& + &0.2241D-03,0.1662D-03,0.1329D-03,0.1233D-03,0.1354D-03,0.1682D-03,& + &0.1731D-03,0.1782D-03,0.1836D-03,0.1891D-03,0.1949D-03,0.2008D-03,& + &0.2070D-03,0.2134D-03,0.2200D-03,0.2268D-03,0.2339D-03,0.2411D-03,& + &0.2486D-03,0.2563D-03,0.2643D-03,0.2724D-03,0.2808D-03,0.2895D-03,& + &0.2984D-03,0.3075D-03,0.3530D-03,0.2469D-03/ + DATA (XPV(I,1,4),I=1,100)/ & + &0.1032D-03,0.1071D-03,0.1112D-03,0.1155D-03,0.1199D-03,0.1245D-03,& + &0.1292D-03,0.1341D-03,0.1392D-03,0.1445D-03,0.1501D-03,0.1558D-03,& + &0.1617D-03,0.1679D-03,0.1743D-03,0.1809D-03,0.1878D-03,0.1949D-03,& + &0.2023D-03,0.2100D-03,0.2179D-03,0.2262D-03,0.2348D-03,0.2437D-03,& + &0.2528D-03,0.2623D-03,0.2721D-03,0.2823D-03,0.2928D-03,0.3036D-03,& + &0.3148D-03,0.3264D-03,0.3383D-03,0.3505D-03,0.3631D-03,0.3760D-03,& + &0.3892D-03,0.4027D-03,0.4165D-03,0.4306D-03,0.4448D-03,0.4592D-03,& + &0.4737D-03,0.4892D-03,0.5033D-03,0.5177D-03,0.5324D-03,0.5463D-03,& + &0.5595D-03,0.5723D-03,0.5841D-03,0.5949D-03,0.6045D-03,0.6125D-03,& + &0.6179D-03,0.6219D-03,0.6234D-03,0.6220D-03,0.6177D-03,0.6100D-03,& + &0.5989D-03,0.5841D-03,0.5662D-03,0.5443D-03,0.5194D-03,0.4919D-03,& + &0.4629D-03,0.4332D-03,0.4045D-03,0.3785D-03,0.3573D-03,0.3434D-03,& + &0.3399D-03,0.3503D-03,0.3796D-03,0.4345D-03,0.5257D-03,0.6703D-03,& + &0.6906D-03,0.7115D-03,0.7333D-03,0.7557D-03,0.7789D-03,0.8029D-03,& + &0.8279D-03,0.8535D-03,0.8800D-03,0.9073D-03,0.9354D-03,0.9645D-03,& + &0.9944D-03,0.1025D-02,0.1057D-02,0.1090D-02,0.1123D-02,0.1158D-02,& + &0.1193D-02,0.1230D-02,0.1412D-02,0.9878D-03/ + DATA (XPV(I,2,0),I=1,100)/ & + &0.6395D+00,0.6278D+00,0.6160D+00,0.6041D+00,0.5928D+00,0.5814D+00,& + &0.5700D+00,0.5591D+00,0.5481D+00,0.5371D+00,0.5266D+00,0.5160D+00,& + &0.5053D+00,0.4952D+00,0.4850D+00,0.4747D+00,0.4649D+00,0.4551D+00,& + &0.4451D+00,0.4357D+00,0.4261D+00,0.4164D+00,0.4073D+00,0.3979D+00,& + &0.3886D+00,0.3795D+00,0.3704D+00,0.3612D+00,0.3523D+00,0.3433D+00,& + &0.3342D+00,0.3252D+00,0.3163D+00,0.3072D+00,0.2980D+00,0.2889D+00,& + &0.2796D+00,0.2702D+00,0.2607D+00,0.2511D+00,0.2413D+00,0.2313D+00,& + &0.2212D+00,0.2115D+00,0.2006D+00,0.1898D+00,0.1790D+00,0.1679D+00,& + &0.1563D+00,0.1447D+00,0.1330D+00,0.1213D+00,0.1095D+00,0.9788D-01,& + &0.8613D-01,0.7497D-01,0.6426D-01,0.5408D-01,0.4462D-01,0.3598D-01,& + &0.2826D-01,0.2161D-01,0.1605D-01,0.1149D-01,0.7956D-02,0.5325D-02,& + &0.3488D-02,0.2266D-02,0.1508D-02,0.1060D-02,0.8015D-03,0.6446D-03,& + &0.5352D-03,0.4451D-03,0.3626D-03,0.2837D-03,0.2078D-03,0.1348D-03,& + &0.1269D-03,0.1193D-03,0.1117D-03,0.1043D-03,0.9709D-04,0.9000D-04,& + &0.8299D-04,0.7618D-04,0.6953D-04,0.6302D-04,0.5666D-04,0.5047D-04,& + &0.4444D-04,0.3859D-04,0.3291D-04,0.2744D-04,0.2219D-04,0.1717D-04,& + &0.1243D-04,0.7989D-05,0.3996D-05,0.6174D-06/ + DATA (XPV(I,2,1),I=1,100)/ & + &0.5642D-02,0.5571D-02,0.5499D-02,0.5424D-02,0.5354D-02,0.5281D-02,& + &0.5207D-02,0.5136D-02,0.5064D-02,0.4989D-02,0.4918D-02,0.4845D-02,& + &0.4770D-02,0.4698D-02,0.4624D-02,0.4547D-02,0.4473D-02,0.4397D-02,& + &0.4319D-02,0.4243D-02,0.4164D-02,0.4083D-02,0.4004D-02,0.3922D-02,& + &0.3837D-02,0.3754D-02,0.3668D-02,0.3579D-02,0.3491D-02,0.3401D-02,& + &0.3308D-02,0.3214D-02,0.3120D-02,0.3022D-02,0.2923D-02,0.2824D-02,& + &0.2723D-02,0.2620D-02,0.2517D-02,0.2414D-02,0.2311D-02,0.2207D-02,& + &0.2103D-02,0.2008D-02,0.1905D-02,0.1806D-02,0.1713D-02,0.1622D-02,& + &0.1534D-02,0.1452D-02,0.1377D-02,0.1309D-02,0.1250D-02,0.1201D-02,& + &0.1160D-02,0.1132D-02,0.1117D-02,0.1114D-02,0.1126D-02,0.1151D-02,& + &0.1190D-02,0.1242D-02,0.1308D-02,0.1385D-02,0.1472D-02,0.1569D-02,& + &0.1672D-02,0.1782D-02,0.1895D-02,0.2009D-02,0.2124D-02,0.2239D-02,& + &0.2351D-02,0.2460D-02,0.2567D-02,0.2671D-02,0.2770D-02,0.2853D-02,& + &0.2860D-02,0.2865D-02,0.2870D-02,0.2874D-02,0.2877D-02,0.2878D-02,& + &0.2878D-02,0.2876D-02,0.2872D-02,0.2865D-02,0.2856D-02,0.2843D-02,& + &0.2826D-02,0.2805D-02,0.2777D-02,0.2743D-02,0.2699D-02,0.2643D-02,& + &0.2566D-02,0.2487D-02,0.2308D-02,0.1892D-02/ + DATA (XPV(I,2,2),I=1,100)/ & + &0.5642D-02,0.5571D-02,0.5498D-02,0.5424D-02,0.5353D-02,0.5281D-02,& + &0.5206D-02,0.5136D-02,0.5063D-02,0.4989D-02,0.4917D-02,0.4844D-02,& + &0.4769D-02,0.4697D-02,0.4622D-02,0.4546D-02,0.4472D-02,0.4395D-02,& + &0.4317D-02,0.4240D-02,0.4162D-02,0.4080D-02,0.4000D-02,0.3918D-02,& + &0.3833D-02,0.3749D-02,0.3663D-02,0.3573D-02,0.3485D-02,0.3394D-02,& + &0.3300D-02,0.3205D-02,0.3109D-02,0.3011D-02,0.2910D-02,0.2810D-02,& + &0.2707D-02,0.2603D-02,0.2497D-02,0.2392D-02,0.2286D-02,0.2179D-02,& + &0.2072D-02,0.1974D-02,0.1866D-02,0.1763D-02,0.1665D-02,0.1569D-02,& + &0.1475D-02,0.1387D-02,0.1304D-02,0.1229D-02,0.1161D-02,0.1102D-02,& + &0.1050D-02,0.1012D-02,0.9843D-03,0.9685D-03,0.9656D-03,0.9754D-03,& + &0.9981D-03,0.1033D-02,0.1080D-02,0.1138D-02,0.1206D-02,0.1282D-02,& + &0.1364D-02,0.1451D-02,0.1541D-02,0.1631D-02,0.1719D-02,0.1803D-02,& + &0.1878D-02,0.1939D-02,0.1980D-02,0.1991D-02,0.1957D-02,0.1849D-02,& + &0.1831D-02,0.1811D-02,0.1790D-02,0.1767D-02,0.1743D-02,0.1717D-02,& + &0.1688D-02,0.1658D-02,0.1625D-02,0.1590D-02,0.1553D-02,0.1512D-02,& + &0.1468D-02,0.1420D-02,0.1367D-02,0.1309D-02,0.1244D-02,0.1172D-02,& + &0.1087D-02,0.9940D-03,0.8584D-03,0.6289D-03/ + DATA (XPV(I,2,3),I=1,100)/ & + &0.5990D-02,0.5932D-02,0.5873D-02,0.5812D-02,0.5755D-02,0.5698D-02,& + &0.5639D-02,0.5584D-02,0.5528D-02,0.5471D-02,0.5417D-02,0.5362D-02,& + &0.5305D-02,0.5253D-02,0.5198D-02,0.5142D-02,0.5090D-02,0.5035D-02,& + &0.4979D-02,0.4926D-02,0.4871D-02,0.4814D-02,0.4760D-02,0.4703D-02,& + &0.4645D-02,0.4588D-02,0.4530D-02,0.4468D-02,0.4409D-02,0.4347D-02,& + &0.4283D-02,0.4218D-02,0.4153D-02,0.4085D-02,0.4015D-02,0.3945D-02,& + &0.3872D-02,0.3797D-02,0.3721D-02,0.3644D-02,0.3565D-02,0.3483D-02,& + &0.3401D-02,0.3326D-02,0.3236D-02,0.3148D-02,0.3063D-02,0.2974D-02,& + &0.2882D-02,0.2790D-02,0.2696D-02,0.2602D-02,0.2506D-02,0.2410D-02,& + &0.2307D-02,0.2208D-02,0.2106D-02,0.2001D-02,0.1894D-02,0.1784D-02,& + &0.1669D-02,0.1551D-02,0.1430D-02,0.1303D-02,0.1172D-02,0.1039D-02,& + &0.9062D-03,0.7748D-03,0.6491D-03,0.5328D-03,0.4303D-03,0.3456D-03,& + &0.2823D-03,0.2428D-03,0.2282D-03,0.2383D-03,0.2730D-03,0.3327D-03,& + &0.3409D-03,0.3492D-03,0.3578D-03,0.3664D-03,0.3754D-03,0.3844D-03,& + &0.3936D-03,0.4028D-03,0.4122D-03,0.4214D-03,0.4309D-03,0.4400D-03,& + &0.4492D-03,0.4580D-03,0.4665D-03,0.4743D-03,0.4813D-03,0.4872D-03,& + &0.4894D-03,0.4958D-03,0.4830D-03,0.4112D-03/ + DATA (XPV(I,2,4),I=1,100)/ & + &0.5746D-02,0.5678D-02,0.5610D-02,0.5539D-02,0.5472D-02,0.5404D-02,& + &0.5334D-02,0.5268D-02,0.5200D-02,0.5130D-02,0.5064D-02,0.4996D-02,& + &0.4925D-02,0.4858D-02,0.4789D-02,0.4718D-02,0.4650D-02,0.4579D-02,& + &0.4506D-02,0.4436D-02,0.4363D-02,0.4287D-02,0.4214D-02,0.4138D-02,& + &0.4060D-02,0.3982D-02,0.3902D-02,0.3819D-02,0.3737D-02,0.3653D-02,& + &0.3565D-02,0.3476D-02,0.3386D-02,0.3294D-02,0.3198D-02,0.3103D-02,& + &0.3005D-02,0.2905D-02,0.2803D-02,0.2701D-02,0.2597D-02,0.2491D-02,& + &0.2384D-02,0.2285D-02,0.2175D-02,0.2067D-02,0.1964D-02,0.1859D-02,& + &0.1754D-02,0.1653D-02,0.1555D-02,0.1459D-02,0.1368D-02,0.1282D-02,& + &0.1198D-02,0.1122D-02,0.1052D-02,0.9883D-03,0.9310D-03,0.8798D-03,& + &0.8347D-03,0.7955D-03,0.7619D-03,0.7321D-03,0.7064D-03,0.6839D-03,& + &0.6649D-03,0.6491D-03,0.6373D-03,0.6309D-03,0.6320D-03,0.6435D-03,& + &0.6699D-03,0.7168D-03,0.7928D-03,0.9097D-03,0.1084D-02,0.1336D-02,& + &0.1369D-02,0.1403D-02,0.1438D-02,0.1473D-02,0.1510D-02,0.1546D-02,& + &0.1583D-02,0.1621D-02,0.1658D-02,0.1696D-02,0.1734D-02,0.1771D-02,& + &0.1808D-02,0.1843D-02,0.1877D-02,0.1908D-02,0.1936D-02,0.1958D-02,& + &0.1969D-02,0.1988D-02,0.1933D-02,0.1674D-02/ + DATA (XPV(I,3,0),I=1,100)/ & + &0.1386D+01,0.1342D+01,0.1299D+01,0.1256D+01,0.1215D+01,0.1174D+01,& + &0.1134D+01,0.1096D+01,0.1059D+01,0.1022D+01,0.9870D+00,0.9524D+00,& + &0.9181D+00,0.8858D+00,0.8538D+00,0.8222D+00,0.7924D+00,0.7628D+00,& + &0.7337D+00,0.7062D+00,0.6791D+00,0.6520D+00,0.6268D+00,0.6016D+00,& + &0.5770D+00,0.5536D+00,0.5305D+00,0.5077D+00,0.4861D+00,0.4649D+00,& + &0.4439D+00,0.4238D+00,0.4042D+00,0.3849D+00,0.3660D+00,0.3479D+00,& + &0.3300D+00,0.3124D+00,0.2953D+00,0.2787D+00,0.2625D+00,0.2464D+00,& + &0.2306D+00,0.2161D+00,0.2007D+00,0.1859D+00,0.1717D+00,0.1576D+00,& + &0.1437D+00,0.1303D+00,0.1173D+00,0.1047D+00,0.9264D-01,0.8116D-01,& + &0.7004D-01,0.5986D-01,0.5046D-01,0.4185D-01,0.3414D-01,0.2734D-01,& + &0.2148D-01,0.1659D-01,0.1262D-01,0.9443D-02,0.7030D-02,0.5248D-02,& + &0.3988D-02,0.3111D-02,0.2508D-02,0.2082D-02,0.1760D-02,0.1496D-02,& + &0.1262D-02,0.1046D-02,0.8417D-03,0.6478D-03,0.4647D-03,0.2925D-03,& + &0.2744D-03,0.2566D-03,0.2393D-03,0.2224D-03,0.2059D-03,0.1898D-03,& + &0.1740D-03,0.1587D-03,0.1439D-03,0.1295D-03,0.1155D-03,0.1020D-03,& + &0.8898D-04,0.7644D-04,0.6443D-04,0.5299D-04,0.4215D-04,0.3199D-04,& + &0.2259D-04,0.1402D-04,0.6692D-05,0.1051D-05/ + DATA (XPV(I,3,1),I=1,100)/ & + &0.2133D-01,0.2081D-01,0.2030D-01,0.1978D-01,0.1929D-01,0.1880D-01,& + &0.1831D-01,0.1784D-01,0.1738D-01,0.1691D-01,0.1646D-01,0.1602D-01,& + &0.1557D-01,0.1515D-01,0.1472D-01,0.1430D-01,0.1389D-01,0.1348D-01,& + &0.1308D-01,0.1269D-01,0.1229D-01,0.1190D-01,0.1152D-01,0.1114D-01,& + &0.1076D-01,0.1040D-01,0.1003D-01,0.9657D-02,0.9299D-02,0.8941D-02,& + &0.8582D-02,0.8229D-02,0.7881D-02,0.7532D-02,0.7185D-02,0.6846D-02,& + &0.6509D-02,0.6172D-02,0.5842D-02,0.5519D-02,0.5201D-02,0.4886D-02,& + &0.4579D-02,0.4296D-02,0.4000D-02,0.3718D-02,0.3455D-02,0.3201D-02,& + &0.2956D-02,0.2729D-02,0.2520D-02,0.2329D-02,0.2158D-02,0.2010D-02,& + &0.1879D-02,0.1777D-02,0.1699D-02,0.1646D-02,0.1618D-02,0.1614D-02,& + &0.1634D-02,0.1676D-02,0.1738D-02,0.1817D-02,0.1911D-02,0.2016D-02,& + &0.2129D-02,0.2248D-02,0.2370D-02,0.2492D-02,0.2615D-02,0.2736D-02,& + &0.2859D-02,0.2984D-02,0.3117D-02,0.3264D-02,0.3430D-02,0.3609D-02,& + &0.3628D-02,0.3646D-02,0.3663D-02,0.3678D-02,0.3693D-02,0.3706D-02,& + &0.3716D-02,0.3725D-02,0.3731D-02,0.3733D-02,0.3732D-02,0.3726D-02,& + &0.3714D-02,0.3695D-02,0.3669D-02,0.3631D-02,0.3579D-02,0.3508D-02,& + &0.3406D-02,0.3304D-02,0.3023D-02,0.2344D-02/ + DATA (XPV(I,3,2),I=1,100)/ & + &0.2133D-01,0.2081D-01,0.2030D-01,0.1978D-01,0.1929D-01,0.1880D-01,& + &0.1831D-01,0.1784D-01,0.1737D-01,0.1691D-01,0.1646D-01,0.1602D-01,& + &0.1557D-01,0.1515D-01,0.1472D-01,0.1430D-01,0.1389D-01,0.1348D-01,& + &0.1307D-01,0.1268D-01,0.1229D-01,0.1189D-01,0.1151D-01,0.1113D-01,& + &0.1075D-01,0.1038D-01,0.1001D-01,0.9643D-02,0.9283D-02,0.8924D-02,& + &0.8563D-02,0.8208D-02,0.7857D-02,0.7506D-02,0.7155D-02,0.6813D-02,& + &0.6473D-02,0.6132D-02,0.5797D-02,0.5469D-02,0.5146D-02,0.4825D-02,& + &0.4510D-02,0.4221D-02,0.3916D-02,0.3626D-02,0.3352D-02,0.3087D-02,& + &0.2830D-02,0.2590D-02,0.2366D-02,0.2159D-02,0.1971D-02,0.1803D-02,& + &0.1652D-02,0.1527D-02,0.1425D-02,0.1346D-02,0.1290D-02,0.1257D-02,& + &0.1245D-02,0.1254D-02,0.1281D-02,0.1324D-02,0.1379D-02,0.1445D-02,& + &0.1517D-02,0.1594D-02,0.1672D-02,0.1748D-02,0.1819D-02,0.1882D-02,& + &0.1933D-02,0.1969D-02,0.1983D-02,0.1969D-02,0.1915D-02,0.1799D-02,& + &0.1781D-02,0.1762D-02,0.1741D-02,0.1720D-02,0.1697D-02,0.1672D-02,& + &0.1646D-02,0.1618D-02,0.1588D-02,0.1556D-02,0.1522D-02,0.1486D-02,& + &0.1446D-02,0.1403D-02,0.1356D-02,0.1304D-02,0.1247D-02,0.1181D-02,& + &0.1105D-02,0.1025D-02,0.8897D-03,0.6390D-03/ + DATA (XPV(I,3,3),I=1,100)/ & + &0.2170D-01,0.2120D-01,0.2069D-01,0.2019D-01,0.1972D-01,0.1924D-01,& + &0.1877D-01,0.1832D-01,0.1787D-01,0.1742D-01,0.1699D-01,0.1657D-01,& + &0.1614D-01,0.1573D-01,0.1533D-01,0.1492D-01,0.1454D-01,0.1415D-01,& + &0.1377D-01,0.1340D-01,0.1303D-01,0.1266D-01,0.1231D-01,0.1195D-01,& + &0.1160D-01,0.1126D-01,0.1092D-01,0.1057D-01,0.1024D-01,0.9910D-02,& + &0.9576D-02,0.9250D-02,0.8928D-02,0.8605D-02,0.8283D-02,0.7969D-02,& + &0.7655D-02,0.7340D-02,0.7030D-02,0.6725D-02,0.6424D-02,0.6122D-02,& + &0.5826D-02,0.5553D-02,0.5258D-02,0.4974D-02,0.4704D-02,0.4437D-02,& + &0.4170D-02,0.3915D-02,0.3668D-02,0.3430D-02,0.3202D-02,0.2984D-02,& + &0.2768D-02,0.2570D-02,0.2382D-02,0.2202D-02,0.2032D-02,0.1870D-02,& + &0.1715D-02,0.1568D-02,0.1427D-02,0.1289D-02,0.1156D-02,0.1027D-02,& + &0.9038D-03,0.7871D-03,0.6800D-03,0.5851D-03,0.5058D-03,0.4453D-03,& + &0.4065D-03,0.3917D-03,0.4024D-03,0.4400D-03,0.5058D-03,0.6008D-03,& + &0.6130D-03,0.6252D-03,0.6375D-03,0.6499D-03,0.6623D-03,0.6745D-03,& + &0.6867D-03,0.6987D-03,0.7104D-03,0.7216D-03,0.7325D-03,0.7425D-03,& + &0.7518D-03,0.7598D-03,0.7664D-03,0.7709D-03,0.7727D-03,0.7706D-03,& + &0.7622D-03,0.7542D-03,0.7051D-03,0.5640D-03/ + DATA (XPV(I,3,4),I=1,100)/ & + &0.2144D-01,0.2093D-01,0.2041D-01,0.1990D-01,0.1942D-01,0.1893D-01,& + &0.1844D-01,0.1798D-01,0.1752D-01,0.1706D-01,0.1662D-01,0.1618D-01,& + &0.1574D-01,0.1532D-01,0.1490D-01,0.1448D-01,0.1408D-01,0.1367D-01,& + &0.1327D-01,0.1288D-01,0.1250D-01,0.1211D-01,0.1174D-01,0.1136D-01,& + &0.1099D-01,0.1063D-01,0.1026D-01,0.9898D-02,0.9545D-02,0.9192D-02,& + &0.8837D-02,0.8488D-02,0.8143D-02,0.7798D-02,0.7453D-02,0.7116D-02,& + &0.6779D-02,0.6443D-02,0.6112D-02,0.5786D-02,0.5465D-02,0.5145D-02,& + &0.4831D-02,0.4541D-02,0.4234D-02,0.3939D-02,0.3661D-02,0.3389D-02,& + &0.3122D-02,0.2871D-02,0.2632D-02,0.2409D-02,0.2200D-02,0.2009D-02,& + &0.1830D-02,0.1675D-02,0.1538D-02,0.1418D-02,0.1319D-02,0.1236D-02,& + &0.1171D-02,0.1122D-02,0.1087D-02,0.1064D-02,0.1051D-02,0.1047D-02,& + &0.1050D-02,0.1061D-02,0.1079D-02,0.1105D-02,0.1142D-02,0.1194D-02,& + &0.1267D-02,0.1372D-02,0.1520D-02,0.1729D-02,0.2019D-02,0.2410D-02,& + &0.2459D-02,0.2509D-02,0.2559D-02,0.2609D-02,0.2659D-02,0.2708D-02,& + &0.2757D-02,0.2805D-02,0.2853D-02,0.2898D-02,0.2942D-02,0.2982D-02,& + &0.3020D-02,0.3052D-02,0.3079D-02,0.3097D-02,0.3105D-02,0.3097D-02,& + &0.3063D-02,0.3033D-02,0.2839D-02,0.2269D-02/ + DATA (XPV(I,4,0),I=1,100)/ & + &0.1713D+01,0.1653D+01,0.1593D+01,0.1534D+01,0.1478D+01,0.1423D+01,& + &0.1369D+01,0.1318D+01,0.1268D+01,0.1219D+01,0.1172D+01,0.1126D+01,& + &0.1081D+01,0.1038D+01,0.9964D+00,0.9552D+00,0.9163D+00,0.8781D+00,& + &0.8407D+00,0.8054D+00,0.7708D+00,0.7365D+00,0.7045D+00,0.6729D+00,& + &0.6421D+00,0.6129D+00,0.5844D+00,0.5563D+00,0.5298D+00,0.5040D+00,& + &0.4786D+00,0.4543D+00,0.4309D+00,0.4080D+00,0.3857D+00,0.3645D+00,& + &0.3437D+00,0.3235D+00,0.3039D+00,0.2850D+00,0.2668D+00,0.2489D+00,& + &0.2315D+00,0.2155D+00,0.1989D+00,0.1830D+00,0.1679D+00,0.1532D+00,& + &0.1388D+00,0.1250D+00,0.1118D+00,0.9925D-01,0.8729D-01,0.7605D-01,& + &0.6530D-01,0.5557D-01,0.4669D-01,0.3863D-01,0.3151D-01,0.2530D-01,& + &0.1999D-01,0.1560D-01,0.1206D-01,0.9245D-02,0.7105D-02,0.5513D-02,& + &0.4368D-02,0.3544D-02,0.2948D-02,0.2497D-02,0.2133D-02,0.1819D-02,& + &0.1533D-02,0.1267D-02,0.1016D-02,0.7782D-03,0.5551D-03,0.3467D-03,& + &0.3248D-03,0.3035D-03,0.2826D-03,0.2623D-03,0.2426D-03,0.2233D-03,& + &0.2044D-03,0.1862D-03,0.1685D-03,0.1514D-03,0.1348D-03,0.1188D-03,& + &0.1033D-03,0.8856D-04,0.7444D-04,0.6102D-04,0.4836D-04,0.3654D-04,& + &0.2566D-04,0.1580D-04,0.7467D-05,0.1177D-05/ + DATA (XPV(I,4,1),I=1,100)/ & + &0.2961D-01,0.2879D-01,0.2797D-01,0.2716D-01,0.2638D-01,0.2562D-01,& + &0.2485D-01,0.2413D-01,0.2341D-01,0.2269D-01,0.2201D-01,0.2134D-01,& + &0.2066D-01,0.2003D-01,0.1939D-01,0.1875D-01,0.1815D-01,0.1755D-01,& + &0.1695D-01,0.1638D-01,0.1582D-01,0.1525D-01,0.1471D-01,0.1417D-01,& + &0.1363D-01,0.1311D-01,0.1260D-01,0.1209D-01,0.1159D-01,0.1110D-01,& + &0.1061D-01,0.1014D-01,0.9670D-02,0.9205D-02,0.8745D-02,0.8300D-02,& + &0.7859D-02,0.7423D-02,0.6997D-02,0.6583D-02,0.6178D-02,0.5780D-02,& + &0.5394D-02,0.5041D-02,0.4673D-02,0.4326D-02,0.4002D-02,0.3692D-02,& + &0.3395D-02,0.3121D-02,0.2869D-02,0.2641D-02,0.2438D-02,0.2262D-02,& + &0.2107D-02,0.1986D-02,0.1894D-02,0.1830D-02,0.1795D-02,0.1787D-02,& + &0.1806D-02,0.1849D-02,0.1914D-02,0.1997D-02,0.2095D-02,0.2205D-02,& + &0.2323D-02,0.2447D-02,0.2573D-02,0.2700D-02,0.2827D-02,0.2953D-02,& + &0.3082D-02,0.3216D-02,0.3362D-02,0.3530D-02,0.3726D-02,0.3944D-02,& + &0.3968D-02,0.3990D-02,0.4012D-02,0.4032D-02,0.4051D-02,0.4068D-02,& + &0.4083D-02,0.4095D-02,0.4104D-02,0.4109D-02,0.4110D-02,0.4106D-02,& + &0.4095D-02,0.4076D-02,0.4048D-02,0.4007D-02,0.3951D-02,0.3872D-02,& + &0.3759D-02,0.3643D-02,0.3325D-02,0.2555D-02/ + DATA (XPV(I,4,2),I=1,100)/ & + &0.2961D-01,0.2879D-01,0.2797D-01,0.2715D-01,0.2638D-01,0.2561D-01,& + &0.2485D-01,0.2413D-01,0.2341D-01,0.2269D-01,0.2201D-01,0.2133D-01,& + &0.2066D-01,0.2002D-01,0.1938D-01,0.1875D-01,0.1815D-01,0.1754D-01,& + &0.1695D-01,0.1637D-01,0.1581D-01,0.1524D-01,0.1470D-01,0.1415D-01,& + &0.1362D-01,0.1310D-01,0.1258D-01,0.1207D-01,0.1157D-01,0.1108D-01,& + &0.1059D-01,0.1011D-01,0.9639D-02,0.9172D-02,0.8708D-02,0.8258D-02,& + &0.7813D-02,0.7372D-02,0.6940D-02,0.6520D-02,0.6109D-02,0.5703D-02,& + &0.5308D-02,0.4946D-02,0.4568D-02,0.4209D-02,0.3874D-02,0.3550D-02,& + &0.3237D-02,0.2948D-02,0.2678D-02,0.2430D-02,0.2205D-02,0.2006D-02,& + &0.1826D-02,0.1678D-02,0.1556D-02,0.1460D-02,0.1392D-02,0.1348D-02,& + &0.1329D-02,0.1332D-02,0.1354D-02,0.1393D-02,0.1446D-02,0.1508D-02,& + &0.1578D-02,0.1651D-02,0.1724D-02,0.1795D-02,0.1860D-02,0.1916D-02,& + &0.1960D-02,0.1988D-02,0.1995D-02,0.1975D-02,0.1918D-02,0.1805D-02,& + &0.1788D-02,0.1770D-02,0.1750D-02,0.1729D-02,0.1708D-02,0.1684D-02,& + &0.1660D-02,0.1633D-02,0.1605D-02,0.1575D-02,0.1543D-02,0.1508D-02,& + &0.1471D-02,0.1430D-02,0.1385D-02,0.1336D-02,0.1281D-02,0.1218D-02,& + &0.1144D-02,0.1067D-02,0.9312D-03,0.6726D-03/ + DATA (XPV(I,4,3),I=1,100)/ & + &0.2998D-01,0.2918D-01,0.2837D-01,0.2758D-01,0.2682D-01,0.2607D-01,& + &0.2532D-01,0.2461D-01,0.2391D-01,0.2321D-01,0.2255D-01,0.2189D-01,& + &0.2124D-01,0.2062D-01,0.2000D-01,0.1939D-01,0.1881D-01,0.1823D-01,& + &0.1765D-01,0.1711D-01,0.1656D-01,0.1602D-01,0.1550D-01,0.1499D-01,& + &0.1447D-01,0.1398D-01,0.1350D-01,0.1301D-01,0.1254D-01,0.1208D-01,& + &0.1161D-01,0.1116D-01,0.1072D-01,0.1028D-01,0.9842D-02,0.9419D-02,& + &0.9000D-02,0.8583D-02,0.8174D-02,0.7776D-02,0.7384D-02,0.6996D-02,& + &0.6616D-02,0.6268D-02,0.5896D-02,0.5541D-02,0.5206D-02,0.4876D-02,& + &0.4551D-02,0.4242D-02,0.3945D-02,0.3662D-02,0.3393D-02,0.3138D-02,& + &0.2890D-02,0.2664D-02,0.2453D-02,0.2253D-02,0.2067D-02,0.1893D-02,& + &0.1730D-02,0.1576D-02,0.1432D-02,0.1293D-02,0.1161D-02,0.1035D-02,& + &0.9167D-03,0.8059D-03,0.7058D-03,0.6185D-03,0.5474D-03,0.4952D-03,& + &0.4650D-03,0.4588D-03,0.4786D-03,0.5261D-03,0.6032D-03,0.7103D-03,& + &0.7238D-03,0.7373D-03,0.7508D-03,0.7642D-03,0.7777D-03,0.7909D-03,& + &0.8039D-03,0.8165D-03,0.8288D-03,0.8404D-03,0.8514D-03,0.8613D-03,& + &0.8702D-03,0.8774D-03,0.8828D-03,0.8855D-03,0.8849D-03,0.8794D-03,& + &0.8664D-03,0.8526D-03,0.7906D-03,0.6244D-03/ + DATA (XPV(I,4,4),I=1,100)/ & + &0.2972D-01,0.2890D-01,0.2809D-01,0.2728D-01,0.2651D-01,0.2575D-01,& + &0.2499D-01,0.2427D-01,0.2356D-01,0.2284D-01,0.2217D-01,0.2150D-01,& + &0.2083D-01,0.2019D-01,0.1956D-01,0.1893D-01,0.1834D-01,0.1774D-01,& + &0.1715D-01,0.1658D-01,0.1602D-01,0.1546D-01,0.1492D-01,0.1439D-01,& + &0.1386D-01,0.1335D-01,0.1284D-01,0.1233D-01,0.1184D-01,0.1135D-01,& + &0.1087D-01,0.1039D-01,0.9930D-02,0.9468D-02,0.9010D-02,0.8565D-02,& + &0.8125D-02,0.7688D-02,0.7260D-02,0.6843D-02,0.6433D-02,0.6029D-02,& + &0.5635D-02,0.5273D-02,0.4893D-02,0.4531D-02,0.4191D-02,0.3861D-02,& + &0.3540D-02,0.3240D-02,0.2958D-02,0.2695D-02,0.2452D-02,0.2232D-02,& + &0.2027D-02,0.1851D-02,0.1698D-02,0.1567D-02,0.1459D-02,0.1373D-02,& + &0.1307D-02,0.1259D-02,0.1229D-02,0.1211D-02,0.1206D-02,0.1212D-02,& + &0.1226D-02,0.1247D-02,0.1277D-02,0.1316D-02,0.1368D-02,0.1436D-02,& + &0.1529D-02,0.1656D-02,0.1832D-02,0.2076D-02,0.2410D-02,0.2849D-02,& + &0.2903D-02,0.2958D-02,0.3013D-02,0.3067D-02,0.3121D-02,0.3174D-02,& + &0.3227D-02,0.3278D-02,0.3327D-02,0.3374D-02,0.3419D-02,0.3459D-02,& + &0.3494D-02,0.3524D-02,0.3546D-02,0.3557D-02,0.3555D-02,0.3534D-02,& + &0.3481D-02,0.3429D-02,0.3184D-02,0.2507D-02/ + DATA (XPV(I,5,0),I=1,100)/ & + &0.2770D+01,0.2649D+01,0.2529D+01,0.2413D+01,0.2304D+01,0.2198D+01,& + &0.2094D+01,0.1997D+01,0.1902D+01,0.1810D+01,0.1724D+01,0.1640D+01,& + &0.1558D+01,0.1481D+01,0.1407D+01,0.1334D+01,0.1266D+01,0.1201D+01,& + &0.1137D+01,0.1077D+01,0.1019D+01,0.9629D+00,0.9107D+00,0.8597D+00,& + &0.8105D+00,0.7646D+00,0.7201D+00,0.6769D+00,0.6367D+00,0.5980D+00,& + &0.5605D+00,0.5252D+00,0.4916D+00,0.4592D+00,0.4281D+00,0.3990D+00,& + &0.3711D+00,0.3442D+00,0.3187D+00,0.2947D+00,0.2718D+00,0.2498D+00,& + &0.2289D+00,0.2101D+00,0.1910D+00,0.1731D+00,0.1566D+00,0.1408D+00,& + &0.1257D+00,0.1117D+00,0.9867D-01,0.8653D-01,0.7529D-01,0.6501D-01,& + &0.5545D-01,0.4701D-01,0.3952D-01,0.3288D-01,0.2715D-01,0.2225D-01,& + &0.1814D-01,0.1478D-01,0.1208D-01,0.9909D-02,0.8219D-02,0.6899D-02,& + &0.5872D-02,0.5047D-02,0.4368D-02,0.3783D-02,0.3261D-02,0.2780D-02,& + &0.2333D-02,0.1914D-02,0.1522D-02,0.1155D-02,0.8143D-03,0.5006D-03,& + &0.4680D-03,0.4362D-03,0.4053D-03,0.3753D-03,0.3461D-03,0.3178D-03,& + &0.2901D-03,0.2634D-03,0.2377D-03,0.2128D-03,0.1888D-03,0.1657D-03,& + &0.1436D-03,0.1225D-03,0.1025D-03,0.8355D-04,0.6581D-04,0.4937D-04,& + &0.3437D-04,0.2094D-04,0.9768D-05,0.1553D-05/ + DATA (XPV(I,5,1),I=1,100)/ & + &0.6050D-01,0.5833D-01,0.5619D-01,0.5409D-01,0.5210D-01,0.5014D-01,& + &0.4822D-01,0.4640D-01,0.4462D-01,0.4287D-01,0.4121D-01,0.3959D-01,& + &0.3799D-01,0.3648D-01,0.3500D-01,0.3354D-01,0.3216D-01,0.3080D-01,& + &0.2947D-01,0.2822D-01,0.2698D-01,0.2576D-01,0.2462D-01,0.2348D-01,& + &0.2237D-01,0.2132D-01,0.2029D-01,0.1927D-01,0.1830D-01,0.1736D-01,& + &0.1643D-01,0.1554D-01,0.1468D-01,0.1384D-01,0.1301D-01,0.1223D-01,& + &0.1147D-01,0.1072D-01,0.1001D-01,0.9326D-02,0.8669D-02,0.8032D-02,& + &0.7423D-02,0.6873D-02,0.6313D-02,0.5792D-02,0.5314D-02,0.4862D-02,& + &0.4437D-02,0.4053D-02,0.3705D-02,0.3395D-02,0.3124D-02,0.2892D-02,& + &0.2694D-02,0.2542D-02,0.2430D-02,0.2354D-02,0.2316D-02,0.2312D-02,& + &0.2341D-02,0.2397D-02,0.2478D-02,0.2579D-02,0.2696D-02,0.2825D-02,& + &0.2961D-02,0.3102D-02,0.3244D-02,0.3387D-02,0.3531D-02,0.3677D-02,& + &0.3831D-02,0.3999D-02,0.4196D-02,0.4435D-02,0.4730D-02,0.5071D-02,& + &0.5109D-02,0.5145D-02,0.5181D-02,0.5214D-02,0.5246D-02,0.5274D-02,& + &0.5300D-02,0.5322D-02,0.5340D-02,0.5352D-02,0.5358D-02,0.5357D-02,& + &0.5347D-02,0.5325D-02,0.5291D-02,0.5238D-02,0.5164D-02,0.5059D-02,& + &0.4907D-02,0.4746D-02,0.4309D-02,0.3281D-02/ + DATA (XPV(I,5,2),I=1,100)/ & + &0.6050D-01,0.5833D-01,0.5619D-01,0.5408D-01,0.5209D-01,0.5014D-01,& + &0.4822D-01,0.4640D-01,0.4462D-01,0.4286D-01,0.4121D-01,0.3958D-01,& + &0.3798D-01,0.3647D-01,0.3499D-01,0.3353D-01,0.3215D-01,0.3079D-01,& + &0.2946D-01,0.2820D-01,0.2697D-01,0.2574D-01,0.2460D-01,0.2346D-01,& + &0.2235D-01,0.2129D-01,0.2026D-01,0.1924D-01,0.1827D-01,0.1732D-01,& + &0.1639D-01,0.1549D-01,0.1463D-01,0.1378D-01,0.1295D-01,0.1216D-01,& + &0.1139D-01,0.1063D-01,0.9910D-02,0.9216D-02,0.8547D-02,0.7898D-02,& + &0.7274D-02,0.6709D-02,0.6132D-02,0.5593D-02,0.5094D-02,0.4620D-02,& + &0.4170D-02,0.3759D-02,0.3382D-02,0.3040D-02,0.2734D-02,0.2465D-02,& + &0.2226D-02,0.2030D-02,0.1871D-02,0.1746D-02,0.1654D-02,0.1594D-02,& + &0.1562D-02,0.1555D-02,0.1571D-02,0.1603D-02,0.1649D-02,0.1705D-02,& + &0.1765D-02,0.1828D-02,0.1889D-02,0.1946D-02,0.1994D-02,0.2033D-02,& + &0.2060D-02,0.2071D-02,0.2065D-02,0.2038D-02,0.1987D-02,0.1896D-02,& + &0.1883D-02,0.1868D-02,0.1853D-02,0.1837D-02,0.1820D-02,0.1802D-02,& + &0.1783D-02,0.1762D-02,0.1739D-02,0.1715D-02,0.1689D-02,0.1661D-02,& + &0.1629D-02,0.1595D-02,0.1556D-02,0.1513D-02,0.1464D-02,0.1406D-02,& + &0.1336D-02,0.1263D-02,0.1120D-02,0.8288D-03/ + DATA (XPV(I,5,3),I=1,100)/ & + &0.6090D-01,0.5875D-01,0.5662D-01,0.5453D-01,0.5256D-01,0.5062D-01,& + &0.4871D-01,0.4691D-01,0.4515D-01,0.4341D-01,0.4178D-01,0.4017D-01,& + &0.3859D-01,0.3710D-01,0.3564D-01,0.3420D-01,0.3284D-01,0.3151D-01,& + &0.3020D-01,0.2897D-01,0.2776D-01,0.2656D-01,0.2544D-01,0.2433D-01,& + &0.2324D-01,0.2221D-01,0.2120D-01,0.2021D-01,0.1926D-01,0.1834D-01,& + &0.1744D-01,0.1657D-01,0.1572D-01,0.1490D-01,0.1410D-01,0.1333D-01,& + &0.1258D-01,0.1185D-01,0.1114D-01,0.1046D-01,0.9808D-02,0.9169D-02,& + &0.8554D-02,0.7996D-02,0.7417D-02,0.6872D-02,0.6364D-02,0.5875D-02,& + &0.5402D-02,0.4961D-02,0.4545D-02,0.4157D-02,0.3795D-02,0.3461D-02,& + &0.3143D-02,0.2860D-02,0.2602D-02,0.2365D-02,0.2152D-02,0.1957D-02,& + &0.1780D-02,0.1620D-02,0.1474D-02,0.1339D-02,0.1214D-02,0.1100D-02,& + &0.9956D-03,0.9020D-03,0.8211D-03,0.7547D-03,0.7054D-03,0.6757D-03,& + &0.6684D-03,0.6859D-03,0.7308D-03,0.8062D-03,0.9148D-03,0.1055D-02,& + &0.1072D-02,0.1089D-02,0.1105D-02,0.1121D-02,0.1137D-02,0.1153D-02,& + &0.1167D-02,0.1182D-02,0.1195D-02,0.1207D-02,0.1217D-02,0.1226D-02,& + &0.1233D-02,0.1237D-02,0.1239D-02,0.1235D-02,0.1227D-02,0.1211D-02,& + &0.1184D-02,0.1153D-02,0.1055D-02,0.8147D-03/ + DATA (XPV(I,5,4),I=1,100)/ & + &0.6062D-01,0.5845D-01,0.5631D-01,0.5421D-01,0.5223D-01,0.5028D-01,& + &0.4836D-01,0.4655D-01,0.4478D-01,0.4302D-01,0.4138D-01,0.3976D-01,& + &0.3816D-01,0.3666D-01,0.3518D-01,0.3372D-01,0.3235D-01,0.3100D-01,& + &0.2967D-01,0.2842D-01,0.2719D-01,0.2597D-01,0.2484D-01,0.2371D-01,& + &0.2260D-01,0.2155D-01,0.2052D-01,0.1951D-01,0.1855D-01,0.1761D-01,& + &0.1668D-01,0.1579D-01,0.1493D-01,0.1409D-01,0.1327D-01,0.1248D-01,& + &0.1172D-01,0.1097D-01,0.1025D-01,0.9561D-02,0.8895D-02,0.8249D-02,& + &0.7629D-02,0.7067D-02,0.6490D-02,0.5951D-02,0.5451D-02,0.4976D-02,& + &0.4523D-02,0.4107D-02,0.3724D-02,0.3375D-02,0.3059D-02,0.2780D-02,& + &0.2527D-02,0.2317D-02,0.2141D-02,0.1997D-02,0.1886D-02,0.1803D-02,& + &0.1748D-02,0.1717D-02,0.1709D-02,0.1717D-02,0.1741D-02,0.1778D-02,& + &0.1825D-02,0.1883D-02,0.1951D-02,0.2031D-02,0.2127D-02,0.2246D-02,& + &0.2396D-02,0.2592D-02,0.2852D-02,0.3200D-02,0.3657D-02,0.4230D-02,& + &0.4298D-02,0.4365D-02,0.4432D-02,0.4498D-02,0.4563D-02,0.4625D-02,& + &0.4685D-02,0.4741D-02,0.4795D-02,0.4843D-02,0.4887D-02,0.4923D-02,& + &0.4951D-02,0.4968D-02,0.4973D-02,0.4961D-02,0.4927D-02,0.4864D-02,& + &0.4754D-02,0.4636D-02,0.4245D-02,0.3267D-02/ + DATA (XPV(I,6,0),I=1,100)/ & + &0.3742D+01,0.3556D+01,0.3375D+01,0.3200D+01,0.3037D+01,0.2878D+01,& + &0.2725D+01,0.2582D+01,0.2444D+01,0.2310D+01,0.2185D+01,0.2065D+01,& + &0.1949D+01,0.1840D+01,0.1736D+01,0.1635D+01,0.1541D+01,0.1451D+01,& + &0.1364D+01,0.1283D+01,0.1205D+01,0.1130D+01,0.1061D+01,0.9934D+00,& + &0.9293D+00,0.8698D+00,0.8128D+00,0.7578D+00,0.7071D+00,0.6586D+00,& + &0.6121D+00,0.5687D+00,0.5278D+00,0.4887D+00,0.4517D+00,0.4173D+00,& + &0.3846D+00,0.3535D+00,0.3244D+00,0.2973D+00,0.2717D+00,0.2475D+00,& + &0.2247D+00,0.2045D+00,0.1843D+00,0.1656D+00,0.1486D+00,0.1327D+00,& + &0.1176D+00,0.1039D+00,0.9130D-01,0.7978D-01,0.6928D-01,0.5984D-01,& + &0.5118D-01,0.4366D-01,0.3707D-01,0.3131D-01,0.2638D-01,0.2219D-01,& + &0.1867D-01,0.1577D-01,0.1341D-01,0.1147D-01,0.9882D-02,0.8574D-02,& + &0.7485D-02,0.6547D-02,0.5722D-02,0.4975D-02,0.4289D-02,0.3649D-02,& + &0.3052D-02,0.2495D-02,0.1975D-02,0.1492D-02,0.1045D-02,0.6378D-03,& + &0.5956D-03,0.5547D-03,0.5148D-03,0.4761D-03,0.4386D-03,0.4023D-03,& + &0.3667D-03,0.3326D-03,0.2997D-03,0.2679D-03,0.2373D-03,0.2080D-03,& + &0.1800D-03,0.1533D-03,0.1280D-03,0.1041D-03,0.8181D-04,0.6122D-04,& + &0.4250D-04,0.2581D-04,0.1200D-04,0.1914D-05/ + DATA (XPV(I,6,1),I=1,100)/ & + &0.9375D-01,0.8988D-01,0.8607D-01,0.8236D-01,0.7887D-01,0.7546D-01,& + &0.7213D-01,0.6901D-01,0.6596D-01,0.6297D-01,0.6018D-01,0.5745D-01,& + &0.5478D-01,0.5228D-01,0.4984D-01,0.4745D-01,0.4522D-01,0.4304D-01,& + &0.4091D-01,0.3892D-01,0.3697D-01,0.3506D-01,0.3329D-01,0.3155D-01,& + &0.2986D-01,0.2827D-01,0.2672D-01,0.2520D-01,0.2378D-01,0.2241D-01,& + &0.2106D-01,0.1979D-01,0.1857D-01,0.1738D-01,0.1624D-01,0.1516D-01,& + &0.1412D-01,0.1312D-01,0.1217D-01,0.1127D-01,0.1041D-01,0.9586D-02,& + &0.8807D-02,0.8113D-02,0.7414D-02,0.6771D-02,0.6188D-02,0.5645D-02,& + &0.5140D-02,0.4689D-02,0.4287D-02,0.3934D-02,0.3630D-02,0.3376D-02,& + &0.3163D-02,0.3005D-02,0.2894D-02,0.2825D-02,0.2798D-02,0.2809D-02,& + &0.2854D-02,0.2930D-02,0.3031D-02,0.3152D-02,0.3289D-02,0.3437D-02,& + &0.3593D-02,0.3752D-02,0.3913D-02,0.4075D-02,0.4238D-02,0.4408D-02,& + &0.4592D-02,0.4800D-02,0.5051D-02,0.5364D-02,0.5755D-02,0.6211D-02,& + &0.6262D-02,0.6311D-02,0.6359D-02,0.6403D-02,0.6446D-02,0.6484D-02,& + &0.6519D-02,0.6549D-02,0.6574D-02,0.6591D-02,0.6601D-02,0.6601D-02,& + &0.6590D-02,0.6564D-02,0.6521D-02,0.6456D-02,0.6363D-02,0.6231D-02,& + &0.6041D-02,0.5835D-02,0.5289D-02,0.4021D-02/ + DATA (XPV(I,6,2),I=1,100)/ & + &0.9375D-01,0.8987D-01,0.8607D-01,0.8236D-01,0.7887D-01,0.7545D-01,& + &0.7213D-01,0.6900D-01,0.6595D-01,0.6296D-01,0.6017D-01,0.5744D-01,& + &0.5477D-01,0.5227D-01,0.4983D-01,0.4744D-01,0.4520D-01,0.4302D-01,& + &0.4089D-01,0.3889D-01,0.3695D-01,0.3504D-01,0.3326D-01,0.3151D-01,& + &0.2982D-01,0.2823D-01,0.2667D-01,0.2515D-01,0.2373D-01,0.2235D-01,& + &0.2100D-01,0.1972D-01,0.1849D-01,0.1729D-01,0.1614D-01,0.1505D-01,& + &0.1400D-01,0.1299D-01,0.1202D-01,0.1110D-01,0.1023D-01,0.9390D-02,& + &0.8591D-02,0.7874D-02,0.7152D-02,0.6483D-02,0.5870D-02,0.5295D-02,& + &0.4756D-02,0.4268D-02,0.3824D-02,0.3427D-02,0.3075D-02,0.2770D-02,& + &0.2501D-02,0.2282D-02,0.2106D-02,0.1968D-02,0.1869D-02,0.1802D-02,& + &0.1766D-02,0.1756D-02,0.1768D-02,0.1797D-02,0.1838D-02,0.1888D-02,& + &0.1942D-02,0.1997D-02,0.2048D-02,0.2094D-02,0.2132D-02,0.2160D-02,& + &0.2176D-02,0.2180D-02,0.2171D-02,0.2150D-02,0.2114D-02,0.2055D-02,& + &0.2046D-02,0.2037D-02,0.2026D-02,0.2015D-02,0.2003D-02,0.1990D-02,& + &0.1976D-02,0.1960D-02,0.1943D-02,0.1924D-02,0.1903D-02,0.1879D-02,& + &0.1852D-02,0.1822D-02,0.1788D-02,0.1748D-02,0.1701D-02,0.1644D-02,& + &0.1574D-02,0.1500D-02,0.1342D-02,0.1006D-02/ + DATA (XPV(I,6,3),I=1,100)/ & + &0.9417D-01,0.9031D-01,0.8652D-01,0.8282D-01,0.7935D-01,0.7595D-01,& + &0.7264D-01,0.6954D-01,0.6651D-01,0.6354D-01,0.6076D-01,0.5805D-01,& + &0.5540D-01,0.5292D-01,0.5050D-01,0.4814D-01,0.4593D-01,0.4376D-01,& + &0.4166D-01,0.3968D-01,0.3777D-01,0.3588D-01,0.3413D-01,0.3240D-01,& + &0.3074D-01,0.2917D-01,0.2764D-01,0.2614D-01,0.2474D-01,0.2339D-01,& + &0.2206D-01,0.2080D-01,0.1960D-01,0.1843D-01,0.1730D-01,0.1623D-01,& + &0.1520D-01,0.1420D-01,0.1324D-01,0.1234D-01,0.1147D-01,0.1064D-01,& + &0.9841D-02,0.9125D-02,0.8394D-02,0.7713D-02,0.7085D-02,0.6486D-02,& + &0.5916D-02,0.5390D-02,0.4900D-02,0.4449D-02,0.4033D-02,0.3655D-02,& + &0.3301D-02,0.2989D-02,0.2709D-02,0.2456D-02,0.2232D-02,0.2031D-02,& + &0.1851D-02,0.1692D-02,0.1550D-02,0.1421D-02,0.1305D-02,0.1201D-02,& + &0.1109D-02,0.1030D-02,0.9637D-03,0.9133D-03,0.8806D-03,0.8682D-03,& + &0.8786D-03,0.9148D-03,0.9803D-03,0.1079D-02,0.1214D-02,0.1381D-02,& + &0.1401D-02,0.1420D-02,0.1439D-02,0.1457D-02,0.1475D-02,0.1492D-02,& + &0.1508D-02,0.1523D-02,0.1537D-02,0.1549D-02,0.1559D-02,0.1567D-02,& + &0.1572D-02,0.1573D-02,0.1570D-02,0.1562D-02,0.1546D-02,0.1521D-02,& + &0.1481D-02,0.1437D-02,0.1308D-02,0.1001D-02/ + DATA (XPV(I,6,4),I=1,100)/ & + &0.9387D-01,0.9000D-01,0.8620D-01,0.8249D-01,0.7901D-01,0.7560D-01,& + &0.7228D-01,0.6916D-01,0.6611D-01,0.6313D-01,0.6034D-01,0.5762D-01,& + &0.5495D-01,0.5246D-01,0.5002D-01,0.4764D-01,0.4541D-01,0.4324D-01,& + &0.4112D-01,0.3912D-01,0.3719D-01,0.3528D-01,0.3351D-01,0.3177D-01,& + &0.3009D-01,0.2850D-01,0.2695D-01,0.2544D-01,0.2402D-01,0.2265D-01,& + &0.2131D-01,0.2003D-01,0.1881D-01,0.1763D-01,0.1648D-01,0.1540D-01,& + &0.1436D-01,0.1335D-01,0.1239D-01,0.1148D-01,0.1061D-01,0.9775D-02,& + &0.8982D-02,0.8272D-02,0.7555D-02,0.6890D-02,0.6283D-02,0.5712D-02,& + &0.5175D-02,0.4690D-02,0.4249D-02,0.3854D-02,0.3504D-02,0.3199D-02,& + &0.2930D-02,0.2712D-02,0.2536D-02,0.2398D-02,0.2298D-02,0.2232D-02,& + &0.2197D-02,0.2189D-02,0.2207D-02,0.2243D-02,0.2296D-02,0.2364D-02,& + &0.2444D-02,0.2535D-02,0.2639D-02,0.2757D-02,0.2893D-02,0.3057D-02,& + &0.3260D-02,0.3518D-02,0.3853D-02,0.4291D-02,0.4854D-02,0.5537D-02,& + &0.5617D-02,0.5695D-02,0.5771D-02,0.5846D-02,0.5918D-02,0.5987D-02,& + &0.6052D-02,0.6113D-02,0.6168D-02,0.6217D-02,0.6258D-02,0.6289D-02,& + &0.6309D-02,0.6315D-02,0.6304D-02,0.6270D-02,0.6208D-02,0.6107D-02,& + &0.5948D-02,0.5772D-02,0.5256D-02,0.4016D-02/ + DATA (XPV(I,7,0),I=1,100)/ & + &0.4620D+01,0.4371D+01,0.4130D+01,0.3898D+01,0.3682D+01,0.3473D+01,& + &0.3273D+01,0.3087D+01,0.2908D+01,0.2735D+01,0.2576D+01,0.2422D+01,& + &0.2274D+01,0.2137D+01,0.2006D+01,0.1879D+01,0.1763D+01,0.1651D+01,& + &0.1544D+01,0.1444D+01,0.1350D+01,0.1258D+01,0.1175D+01,0.1095D+01,& + &0.1018D+01,0.9480D+00,0.8808D+00,0.8166D+00,0.7576D+00,0.7016D+00,& + &0.6483D+00,0.5987D+00,0.5524D+00,0.5085D+00,0.4671D+00,0.4289D+00,& + &0.3930D+00,0.3591D+00,0.3276D+00,0.2984D+00,0.2712D+00,0.2456D+00,& + &0.2218D+00,0.2008D+00,0.1801D+00,0.1612D+00,0.1440D+00,0.1281D+00,& + &0.1133D+00,0.9995D-01,0.8778D-01,0.7678D-01,0.6687D-01,0.5803D-01,& + &0.5000D-01,0.4309D-01,0.3706D-01,0.3181D-01,0.2732D-01,0.2349D-01,& + &0.2025D-01,0.1754D-01,0.1529D-01,0.1336D-01,0.1174D-01,0.1033D-01,& + &0.9116D-02,0.8022D-02,0.7032D-02,0.6118D-02,0.5270D-02,0.4476D-02,& + &0.3736D-02,0.3047D-02,0.2407D-02,0.1812D-02,0.1266D-02,0.7693D-03,& + &0.7181D-03,0.6683D-03,0.6199D-03,0.5730D-03,0.5276D-03,0.4835D-03,& + &0.4405D-03,0.3993D-03,0.3595D-03,0.3212D-03,0.2843D-03,0.2490D-03,& + &0.2153D-03,0.1832D-03,0.1528D-03,0.1242D-03,0.9750D-04,0.7288D-04,& + &0.5054D-04,0.3065D-04,0.1424D-04,0.2274D-05/ + DATA (XPV(I,7,1),I=1,100)/ & + &0.1273D+00,0.1215D+00,0.1159D+00,0.1104D+00,0.1052D+00,0.1002D+00,& + &0.9538D-01,0.9084D-01,0.8644D-01,0.8214D-01,0.7814D-01,0.7426D-01,& + &0.7047D-01,0.6695D-01,0.6352D-01,0.6020D-01,0.5710D-01,0.5408D-01,& + &0.5116D-01,0.4843D-01,0.4580D-01,0.4321D-01,0.4083D-01,0.3850D-01,& + &0.3626D-01,0.3416D-01,0.3213D-01,0.3016D-01,0.2832D-01,0.2655D-01,& + &0.2484D-01,0.2322D-01,0.2168D-01,0.2020D-01,0.1878D-01,0.1745D-01,& + &0.1618D-01,0.1496D-01,0.1381D-01,0.1273D-01,0.1172D-01,0.1075D-01,& + &0.9841D-02,0.9037D-02,0.8237D-02,0.7506D-02,0.6849D-02,0.6244D-02,& + &0.5686D-02,0.5195D-02,0.4761D-02,0.4386D-02,0.4068D-02,0.3807D-02,& + &0.3592D-02,0.3439D-02,0.3337D-02,0.3281D-02,0.3270D-02,0.3299D-02,& + &0.3364D-02,0.3460D-02,0.3582D-02,0.3724D-02,0.3881D-02,0.4050D-02,& + &0.4225D-02,0.4404D-02,0.4584D-02,0.4766D-02,0.4952D-02,0.5148D-02,& + &0.5364D-02,0.5615D-02,0.5922D-02,0.6309D-02,0.6796D-02,0.7362D-02,& + &0.7425D-02,0.7486D-02,0.7545D-02,0.7600D-02,0.7653D-02,0.7701D-02,& + &0.7744D-02,0.7781D-02,0.7812D-02,0.7833D-02,0.7846D-02,0.7846D-02,& + &0.7833D-02,0.7803D-02,0.7751D-02,0.7673D-02,0.7561D-02,0.7402D-02,& + &0.7174D-02,0.6925D-02,0.6273D-02,0.4767D-02/ + DATA (XPV(I,7,2),I=1,100)/ & + &0.1273D+00,0.1215D+00,0.1158D+00,0.1104D+00,0.1052D+00,0.1002D+00,& + &0.9537D-01,0.9083D-01,0.8643D-01,0.8213D-01,0.7813D-01,0.7424D-01,& + &0.7046D-01,0.6693D-01,0.6351D-01,0.6018D-01,0.5707D-01,0.5406D-01,& + &0.5113D-01,0.4840D-01,0.4576D-01,0.4318D-01,0.4079D-01,0.3846D-01,& + &0.3621D-01,0.3411D-01,0.3207D-01,0.3009D-01,0.2825D-01,0.2647D-01,& + &0.2475D-01,0.2312D-01,0.2157D-01,0.2008D-01,0.1865D-01,0.1730D-01,& + &0.1602D-01,0.1478D-01,0.1362D-01,0.1252D-01,0.1148D-01,0.1049D-01,& + &0.9553D-02,0.8720D-02,0.7889D-02,0.7124D-02,0.6429D-02,0.5782D-02,& + &0.5181D-02,0.4640D-02,0.4154D-02,0.3722D-02,0.3342D-02,0.3014D-02,& + &0.2728D-02,0.2498D-02,0.2314D-02,0.2171D-02,0.2067D-02,0.1998D-02,& + &0.1960D-02,0.1948D-02,0.1958D-02,0.1984D-02,0.2021D-02,0.2066D-02,& + &0.2114D-02,0.2162D-02,0.2206D-02,0.2245D-02,0.2275D-02,0.2296D-02,& + &0.2307D-02,0.2309D-02,0.2304D-02,0.2293D-02,0.2279D-02,0.2254D-02,& + &0.2250D-02,0.2244D-02,0.2239D-02,0.2232D-02,0.2225D-02,0.2216D-02,& + &0.2207D-02,0.2195D-02,0.2183D-02,0.2168D-02,0.2151D-02,0.2131D-02,& + &0.2108D-02,0.2081D-02,0.2049D-02,0.2010D-02,0.1964D-02,0.1906D-02,& + &0.1832D-02,0.1753D-02,0.1576D-02,0.1190D-02/ + DATA (XPV(I,7,3),I=1,100)/ & + &0.1277D+00,0.1220D+00,0.1163D+00,0.1108D+00,0.1057D+00,0.1007D+00,& + &0.9591D-01,0.9139D-01,0.8700D-01,0.8272D-01,0.7874D-01,0.7488D-01,& + &0.7111D-01,0.6761D-01,0.6420D-01,0.6090D-01,0.5781D-01,0.5482D-01,& + &0.5192D-01,0.4921D-01,0.4660D-01,0.4403D-01,0.4167D-01,0.3937D-01,& + &0.3714D-01,0.3506D-01,0.3305D-01,0.3110D-01,0.2928D-01,0.2752D-01,& + &0.2582D-01,0.2422D-01,0.2269D-01,0.2122D-01,0.1980D-01,0.1848D-01,& + &0.1721D-01,0.1598D-01,0.1483D-01,0.1374D-01,0.1270D-01,0.1171D-01,& + &0.1077D-01,0.9936D-02,0.9091D-02,0.8309D-02,0.7592D-02,0.6916D-02,& + &0.6277D-02,0.5693D-02,0.5155D-02,0.4662D-02,0.4213D-02,0.3808D-02,& + &0.3432D-02,0.3104D-02,0.2813D-02,0.2553D-02,0.2325D-02,0.2122D-02,& + &0.1944D-02,0.1788D-02,0.1651D-02,0.1528D-02,0.1420D-02,0.1325D-02,& + &0.1243D-02,0.1175D-02,0.1122D-02,0.1084D-02,0.1065D-02,0.1067D-02,& + &0.1092D-02,0.1144D-02,0.1228D-02,0.1347D-02,0.1506D-02,0.1698D-02,& + &0.1720D-02,0.1741D-02,0.1763D-02,0.1783D-02,0.1803D-02,0.1821D-02,& + &0.1838D-02,0.1854D-02,0.1868D-02,0.1880D-02,0.1890D-02,0.1897D-02,& + &0.1900D-02,0.1898D-02,0.1892D-02,0.1878D-02,0.1856D-02,0.1823D-02,& + &0.1771D-02,0.1715D-02,0.1557D-02,0.1187D-02/ + DATA (XPV(I,7,4),I=1,100)/ & + &0.1274D+00,0.1216D+00,0.1160D+00,0.1105D+00,0.1054D+00,0.1004D+00,& + &0.9553D-01,0.9099D-01,0.8660D-01,0.8231D-01,0.7831D-01,0.7443D-01,& + &0.7065D-01,0.6713D-01,0.6371D-01,0.6039D-01,0.5729D-01,0.5428D-01,& + &0.5137D-01,0.4864D-01,0.4601D-01,0.4343D-01,0.4105D-01,0.3873D-01,& + &0.3649D-01,0.3439D-01,0.3236D-01,0.3039D-01,0.2856D-01,0.2679D-01,& + &0.2507D-01,0.2345D-01,0.2191D-01,0.2043D-01,0.1901D-01,0.1767D-01,& + &0.1640D-01,0.1517D-01,0.1401D-01,0.1293D-01,0.1190D-01,0.1091D-01,& + &0.9989D-02,0.9167D-02,0.8345D-02,0.7590D-02,0.6907D-02,0.6271D-02,& + &0.5680D-02,0.5152D-02,0.4677D-02,0.4258D-02,0.3891D-02,0.3578D-02,& + &0.3306D-02,0.3092D-02,0.2925D-02,0.2801D-02,0.2718D-02,0.2672D-02,& + &0.2660D-02,0.2677D-02,0.2720D-02,0.2784D-02,0.2866D-02,0.2964D-02,& + &0.3075D-02,0.3198D-02,0.3335D-02,0.3488D-02,0.3663D-02,0.3870D-02,& + &0.4121D-02,0.4436D-02,0.4840D-02,0.5361D-02,0.6022D-02,0.6806D-02,& + &0.6896D-02,0.6983D-02,0.7069D-02,0.7151D-02,0.7230D-02,0.7305D-02,& + &0.7376D-02,0.7439D-02,0.7497D-02,0.7546D-02,0.7585D-02,0.7612D-02,& + &0.7625D-02,0.7620D-02,0.7595D-02,0.7541D-02,0.7454D-02,0.7319D-02,& + &0.7113D-02,0.6886D-02,0.6254D-02,0.4765D-02/ + +!..fetching pdfs + DO 5 IP=-6,6 + XPDF(IP)=ZEROD + 5 END DO + DO 2 I=1,IX + ENT(I)=LOG10(XT(I)) + 2 END DO + NA(1)=IX + NA(2)=IQ + DO 3 I=1,IQ + ENT(IX+I)=LOG10(Q2T(I)) + 3 END DO + ARG(1)=LOG10(X) + ARG(2)=LOG10(Q2) +!..VARIOUS FLAVOURS (u-->2,d-->1) + XPDF(0)=DBFINT(NARG,ARG,NA,ENT,XPV(1,1,0)) + XPDF(1)=DBFINT(NARG,ARG,NA,ENT,XPV(1,1,2)) + XPDF(2)=DBFINT(NARG,ARG,NA,ENT,XPV(1,1,1)) + XPDF(3)=DBFINT(NARG,ARG,NA,ENT,XPV(1,1,3)) + XPDF(4)=DBFINT(NARG,ARG,NA,ENT,XPV(1,1,4)) + DO 21 JF=1,4 + XPDF(-JF)=XPDF(JF) + 21 END DO + RETURN + END +!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +!-------------------------------------------------------------- + SUBROUTINE PHLAC3(X,Q2,XPDF) + implicit real*8 (a-h,o-z) + PARAMETER(IX=100,IQ=7,NARG=2,NFUN=4) + double precision & + & DBFINT, & + & XT(IX),Q2T(IQ),ARG(NARG),ENT(IX+IQ), & + & XPV(IX,IQ,0:NFUN),XPDF(-6:6) + DIMENSION NA(NARG) + DATA ZEROD/0.D0/ +!...100 x valuse; in (D-4,.77) log spaced (78 points) +!... in (.78,.995) lineary spaced (22 points) + DATA Q2T/1.,10.,50.,1.D2,1.D3,1.D4,1.D5/ + DATA XT/ & + &0.1000D-03,0.1123D-03,0.1262D-03,0.1417D-03,0.1592D-03,0.1789D-03,& + &0.2009D-03,0.2257D-03,0.2535D-03,0.2848D-03,0.3199D-03,0.3593D-03,& + &0.4037D-03,0.4534D-03,0.5093D-03,0.5722D-03,0.6427D-03,0.7220D-03,& + &0.8110D-03,0.9110D-03,0.1023D-02,0.1150D-02,0.1291D-02,0.1451D-02,& + &0.1629D-02,0.1830D-02,0.2056D-02,0.2310D-02,0.2594D-02,0.2914D-02,& + &0.3274D-02,0.3677D-02,0.4131D-02,0.4640D-02,0.5212D-02,0.5855D-02,& + &0.6577D-02,0.7388D-02,0.8299D-02,0.9323D-02,0.1047D-01,0.1176D-01,& + &0.1321D-01,0.1484D-01,0.1667D-01,0.1873D-01,0.2104D-01,0.2363D-01,& + &0.2655D-01,0.2982D-01,0.3350D-01,0.3763D-01,0.4227D-01,0.4748D-01,& + &0.5334D-01,0.5992D-01,0.6731D-01,0.7560D-01,0.8493D-01,0.9540D-01,& + &0.1072D+00,0.1204D+00,0.1352D+00,0.1519D+00,0.1706D+00,0.1917D+00,& + &0.2153D+00,0.2419D+00,0.2717D+00,0.3052D+00,0.3428D+00,0.3851D+00,& + &0.4326D+00,0.4859D+00,0.5458D+00,0.6131D+00,0.6887D+00,0.7737D+00,& + &0.7837D+00,0.7937D+00,0.8037D+00,0.8137D+00,0.8237D+00,0.8337D+00,& + &0.8437D+00,0.8537D+00,0.8637D+00,0.8737D+00,0.8837D+00,0.8937D+00,& + &0.9037D+00,0.9137D+00,0.9237D+00,0.9337D+00,0.9437D+00,0.9537D+00,& + &0.9637D+00,0.9737D+00,0.9837D+00,0.9937D+00/ + +!...place for DATA blocks + DATA (XPV(I,1,0),I=1,100)/ & + &0.1007D-27,0.2075D-27,0.4426D-27,0.1128D-26,0.2333D-26,0.4999D-26,& + &0.1271D-25,0.2627D-25,0.5632D-25,0.1431D-24,0.2954D-24,0.6358D-24,& + &0.1610D-23,0.3324D-23,0.7182D-23,0.1813D-22,0.3751D-22,0.8117D-22,& + &0.2043D-21,0.4240D-21,0.9144D-21,0.2316D-20,0.4799D-20,0.1038D-19,& + &0.2610D-19,0.5465D-19,0.1173D-18,0.2878D-18,0.6255D-18,0.1334D-17,& + &0.3132D-17,0.7205D-17,0.1536D-16,0.3447D-16,0.8339D-16,0.1787D-15,& + &0.3904D-15,0.9044D-15,0.2099D-14,0.4566D-14,0.1007D-13,0.2303D-13,& + &0.5384D-13,0.1169D-12,0.2617D-12,0.5847D-12,0.1299D-11,0.2924D-11,& + &0.6607D-11,0.1484D-10,0.3329D-10,0.7451D-10,0.1668D-09,0.3728D-09,& + &0.8458D-09,0.1887D-08,0.4199D-08,0.9410D-08,0.2093D-07,0.4670D-07,& + &0.1044D-06,0.2319D-06,0.5128D-06,0.1139D-05,0.2523D-05,0.5592D-05,& + &0.1232D-04,0.2713D-04,0.5944D-04,0.1298D-03,0.2819D-03,0.6094D-03,& + &0.1307D-02,0.2770D-02,0.5792D-02,0.1188D-01,0.2357D-01,0.4425D-01,& + &0.4717D-01,0.5016D-01,0.5322D-01,0.5631D-01,0.5943D-01,0.6254D-01,& + &0.6564D-01,0.6864D-01,0.7153D-01,0.7424D-01,0.7672D-01,0.7888D-01,& + &0.8063D-01,0.8185D-01,0.8240D-01,0.8208D-01,0.8066D-01,0.7779D-01,& + &0.7302D-01,0.6561D-01,0.5572D-01,0.3029D-01/ + DATA (XPV(I,1,1),I=1,100)/ & + &0.3424D-05,0.3802D-05,0.4225D-05,0.4691D-05,0.5211D-05,0.5789D-05,& + &0.6428D-05,0.7141D-05,0.7930D-05,0.8809D-05,0.9783D-05,0.1086D-04,& + &0.1207D-04,0.1340D-04,0.1488D-04,0.1653D-04,0.1836D-04,0.2039D-04,& + &0.2264D-04,0.2513D-04,0.2790D-04,0.3099D-04,0.3439D-04,0.3819D-04,& + &0.4236D-04,0.4701D-04,0.5217D-04,0.5789D-04,0.6419D-04,0.7118D-04,& + &0.7893D-04,0.8747D-04,0.9693D-04,0.1073D-03,0.1188D-03,0.1315D-03,& + &0.1455D-03,0.1608D-03,0.1777D-03,0.1962D-03,0.2163D-03,0.2384D-03,& + &0.2625D-03,0.2888D-03,0.3171D-03,0.3478D-03,0.3809D-03,0.4162D-03,& + &0.4540D-03,0.4939D-03,0.5361D-03,0.5801D-03,0.6258D-03,0.6727D-03,& + &0.7196D-03,0.7668D-03,0.8129D-03,0.8568D-03,0.8974D-03,0.9335D-03,& + &0.9636D-03,0.9862D-03,0.1001D-02,0.1005D-02,0.9999D-03,0.9845D-03,& + &0.9605D-03,0.9293D-03,0.8945D-03,0.8601D-03,0.8315D-03,0.8149D-03,& + &0.8173D-03,0.8465D-03,0.9115D-03,0.1023D-02,0.1196D-02,0.1446D-02,& + &0.1479D-02,0.1512D-02,0.1545D-02,0.1579D-02,0.1613D-02,0.1648D-02,& + &0.1682D-02,0.1716D-02,0.1750D-02,0.1784D-02,0.1816D-02,0.1848D-02,& + &0.1878D-02,0.1905D-02,0.1930D-02,0.1951D-02,0.1967D-02,0.1975D-02,& + &0.1973D-02,0.1954D-02,0.2080D-02,0.1381D-02/ + DATA (XPV(I,1,2),I=1,100)/ & + &0.3137D-05,0.3480D-05,0.3862D-05,0.4284D-05,0.4753D-05,0.5276D-05,& + &0.5851D-05,0.6493D-05,0.7202D-05,0.7991D-05,0.8865D-05,0.9833D-05,& + &0.1091D-04,0.1210D-04,0.1342D-04,0.1489D-04,0.1651D-04,0.1831D-04,& + &0.2031D-04,0.2252D-04,0.2496D-04,0.2770D-04,0.3069D-04,0.3403D-04,& + &0.3770D-04,0.4178D-04,0.4629D-04,0.5128D-04,0.5678D-04,0.6286D-04,& + &0.6959D-04,0.7699D-04,0.8517D-04,0.9415D-04,0.1040D-03,0.1149D-03,& + &0.1269D-03,0.1400D-03,0.1543D-03,0.1699D-03,0.1870D-03,0.2055D-03,& + &0.2256D-03,0.2475D-03,0.2709D-03,0.2962D-03,0.3232D-03,0.3518D-03,& + &0.3821D-03,0.4137D-03,0.4468D-03,0.4807D-03,0.5153D-03,0.5499D-03,& + &0.5835D-03,0.6162D-03,0.6464D-03,0.6732D-03,0.6954D-03,0.7116D-03,& + &0.7207D-03,0.7212D-03,0.7125D-03,0.6928D-03,0.6625D-03,0.6217D-03,& + &0.5720D-03,0.5149D-03,0.4540D-03,0.3931D-03,0.3368D-03,0.2895D-03,& + &0.2557D-03,0.2384D-03,0.2393D-03,0.2595D-03,0.2999D-03,0.3616D-03,& + &0.3697D-03,0.3780D-03,0.3863D-03,0.3948D-03,0.4033D-03,0.4119D-03,& + &0.4205D-03,0.4291D-03,0.4376D-03,0.4459D-03,0.4541D-03,0.4619D-03,& + &0.4694D-03,0.4763D-03,0.4825D-03,0.4878D-03,0.4917D-03,0.4938D-03,& + &0.4932D-03,0.4886D-03,0.5200D-03,0.3453D-03/ + DATA (XPV(I,1,3),I=1,100)/ & + &0.2308D-04,0.2495D-04,0.2699D-04,0.2918D-04,0.3156D-04,0.3413D-04,& + &0.3690D-04,0.3990D-04,0.4315D-04,0.4666D-04,0.5045D-04,0.5454D-04,& + &0.5898D-04,0.6376D-04,0.6894D-04,0.7454D-04,0.8058D-04,0.8711D-04,& + &0.9416D-04,0.1018D-03,0.1100D-03,0.1189D-03,0.1284D-03,0.1388D-03,& + &0.1499D-03,0.1620D-03,0.1749D-03,0.1889D-03,0.2039D-03,0.2201D-03,& + &0.2376D-03,0.2562D-03,0.2763D-03,0.2979D-03,0.3210D-03,0.3457D-03,& + &0.3721D-03,0.4003D-03,0.4303D-03,0.4623D-03,0.4961D-03,0.5318D-03,& + &0.5697D-03,0.6100D-03,0.6513D-03,0.6947D-03,0.7400D-03,0.7864D-03,& + &0.8337D-03,0.8816D-03,0.9298D-03,0.9773D-03,0.1024D-02,0.1068D-02,& + &0.1107D-02,0.1144D-02,0.1174D-02,0.1196D-02,0.1210D-02,0.1213D-02,& + &0.1203D-02,0.1180D-02,0.1144D-02,0.1091D-02,0.1024D-02,0.9420D-03,& + &0.8495D-03,0.7483D-03,0.6436D-03,0.5407D-03,0.4459D-03,0.3649D-03,& + &0.3034D-03,0.2653D-03,0.2522D-03,0.2644D-03,0.3011D-03,0.3617D-03,& + &0.3698D-03,0.3781D-03,0.3864D-03,0.3948D-03,0.4034D-03,0.4119D-03,& + &0.4205D-03,0.4291D-03,0.4376D-03,0.4459D-03,0.4541D-03,0.4619D-03,& + &0.4694D-03,0.4763D-03,0.4825D-03,0.4878D-03,0.4917D-03,0.4938D-03,& + &0.4932D-03,0.4886D-03,0.5200D-03,0.3453D-03/ + DATA (XPV(I,1,4),I=1,100)/ & + &0.0000D+00,0.0000D+00,0.0000D+00,0.0000D+00,0.0000D+00,0.0000D+00,& + &0.0000D+00,0.0000D+00,0.0000D+00,0.0000D+00,0.0000D+00,0.0000D+00,& + &0.0000D+00,0.0000D+00,0.0000D+00,0.0000D+00,0.0000D+00,0.0000D+00,& + &0.0000D+00,0.0000D+00,0.0000D+00,0.0000D+00,0.0000D+00,0.0000D+00,& + &0.0000D+00,0.0000D+00,0.0000D+00,0.0000D+00,0.0000D+00,0.0000D+00,& + &0.0000D+00,0.0000D+00,0.0000D+00,0.0000D+00,0.0000D+00,0.0000D+00,& + &0.0000D+00,0.0000D+00,0.0000D+00,0.0000D+00,0.0000D+00,0.0000D+00,& + &0.0000D+00,0.0000D+00,0.0000D+00,0.0000D+00,0.0000D+00,0.0000D+00,& + &0.0000D+00,0.0000D+00,0.0000D+00,0.0000D+00,0.0000D+00,0.0000D+00,& + &0.0000D+00,0.0000D+00,0.0000D+00,0.0000D+00,0.0000D+00,0.0000D+00,& + &0.0000D+00,0.0000D+00,0.0000D+00,0.0000D+00,0.0000D+00,0.0000D+00,& + &0.0000D+00,0.0000D+00,0.0000D+00,0.0000D+00,0.0000D+00,0.0000D+00,& + &0.0000D+00,0.0000D+00,0.0000D+00,0.0000D+00,0.0000D+00,0.0000D+00,& + &0.0000D+00,0.0000D+00,0.0000D+00,0.0000D+00,0.0000D+00,0.0000D+00,& + &0.0000D+00,0.0000D+00,0.0000D+00,0.0000D+00,0.0000D+00,0.0000D+00,& + &0.0000D+00,0.0000D+00,0.0000D+00,0.0000D+00,0.0000D+00,0.0000D+00,& + &0.0000D+00,0.0000D+00,0.0000D+00,0.0000D+00/ + DATA (XPV(I,2,0),I=1,100)/ & + &0.1356D+00,0.1323D+00,0.1291D+00,0.1259D+00,0.1228D+00,0.1197D+00,& + &0.1167D+00,0.1138D+00,0.1109D+00,0.1080D+00,0.1053D+00,0.1026D+00,& + &0.9987D-01,0.9730D-01,0.9474D-01,0.9219D-01,0.8977D-01,0.8736D-01,& + &0.8497D-01,0.8269D-01,0.8043D-01,0.7816D-01,0.7603D-01,0.7390D-01,& + &0.7178D-01,0.6977D-01,0.6777D-01,0.6577D-01,0.6388D-01,0.6200D-01,& + &0.6014D-01,0.5833D-01,0.5657D-01,0.5483D-01,0.5311D-01,0.5146D-01,& + &0.4983D-01,0.4821D-01,0.4664D-01,0.4512D-01,0.4362D-01,0.4214D-01,& + &0.4069D-01,0.3940D-01,0.3797D-01,0.3660D-01,0.3532D-01,0.3404D-01,& + &0.3275D-01,0.3151D-01,0.3030D-01,0.2912D-01,0.2796D-01,0.2684D-01,& + &0.2569D-01,0.2463D-01,0.2359D-01,0.2257D-01,0.2160D-01,0.2066D-01,& + &0.1976D-01,0.1891D-01,0.1812D-01,0.1738D-01,0.1671D-01,0.1612D-01,& + &0.1563D-01,0.1526D-01,0.1503D-01,0.1498D-01,0.1516D-01,0.1561D-01,& + &0.1641D-01,0.1763D-01,0.1929D-01,0.2127D-01,0.2302D-01,0.2306D-01,& + &0.2284D-01,0.2255D-01,0.2220D-01,0.2178D-01,0.2128D-01,0.2071D-01,& + &0.2004D-01,0.1930D-01,0.1846D-01,0.1753D-01,0.1651D-01,0.1539D-01,& + &0.1417D-01,0.1285D-01,0.1144D-01,0.9945D-02,0.8364D-02,0.6719D-02,& + &0.5030D-02,0.3305D-02,0.1711D-02,0.2728D-03/ + DATA (XPV(I,2,1),I=1,100)/ & + &0.1580D-02,0.1552D-02,0.1523D-02,0.1495D-02,0.1467D-02,0.1440D-02,& + &0.1413D-02,0.1387D-02,0.1362D-02,0.1336D-02,0.1312D-02,0.1288D-02,& + &0.1264D-02,0.1241D-02,0.1219D-02,0.1197D-02,0.1176D-02,0.1155D-02,& + &0.1135D-02,0.1117D-02,0.1098D-02,0.1080D-02,0.1064D-02,0.1049D-02,& + &0.1034D-02,0.1020D-02,0.1008D-02,0.9958D-03,0.9857D-03,0.9769D-03,& + &0.9690D-03,0.9629D-03,0.9585D-03,0.9556D-03,0.9542D-03,0.9553D-03,& + &0.9582D-03,0.9630D-03,0.9702D-03,0.9801D-03,0.9924D-03,0.1007D-02,& + &0.1025D-02,0.1048D-02,0.1070D-02,0.1097D-02,0.1127D-02,0.1160D-02,& + &0.1196D-02,0.1235D-02,0.1276D-02,0.1320D-02,0.1366D-02,0.1414D-02,& + &0.1462D-02,0.1511D-02,0.1560D-02,0.1607D-02,0.1653D-02,0.1695D-02,& + &0.1734D-02,0.1768D-02,0.1797D-02,0.1821D-02,0.1840D-02,0.1856D-02,& + &0.1870D-02,0.1884D-02,0.1902D-02,0.1930D-02,0.1971D-02,0.2031D-02,& + &0.2118D-02,0.2236D-02,0.2391D-02,0.2582D-02,0.2803D-02,0.3029D-02,& + &0.3052D-02,0.3073D-02,0.3094D-02,0.3113D-02,0.3130D-02,0.3145D-02,& + &0.3158D-02,0.3169D-02,0.3176D-02,0.3181D-02,0.3181D-02,0.3178D-02,& + &0.3168D-02,0.3153D-02,0.3129D-02,0.3095D-02,0.3049D-02,0.2984D-02,& + &0.2897D-02,0.2785D-02,0.2548D-02,0.2093D-02/ + DATA (XPV(I,2,2),I=1,100)/ & + &0.1579D-02,0.1550D-02,0.1522D-02,0.1493D-02,0.1465D-02,0.1438D-02,& + &0.1410D-02,0.1384D-02,0.1358D-02,0.1332D-02,0.1308D-02,0.1283D-02,& + &0.1259D-02,0.1236D-02,0.1213D-02,0.1190D-02,0.1168D-02,0.1147D-02,& + &0.1126D-02,0.1107D-02,0.1087D-02,0.1068D-02,0.1051D-02,0.1033D-02,& + &0.1017D-02,0.1001D-02,0.9867D-03,0.9726D-03,0.9600D-03,0.9484D-03,& + &0.9374D-03,0.9279D-03,0.9197D-03,0.9125D-03,0.9065D-03,0.9024D-03,& + &0.8996D-03,0.8981D-03,0.8984D-03,0.9006D-03,0.9045D-03,0.9099D-03,& + &0.9175D-03,0.9288D-03,0.9391D-03,0.9521D-03,0.9677D-03,0.9844D-03,& + &0.1002D-02,0.1021D-02,0.1041D-02,0.1062D-02,0.1083D-02,0.1104D-02,& + &0.1122D-02,0.1140D-02,0.1155D-02,0.1167D-02,0.1174D-02,0.1176D-02,& + &0.1172D-02,0.1162D-02,0.1145D-02,0.1122D-02,0.1092D-02,0.1058D-02,& + &0.1021D-02,0.9837D-03,0.9493D-03,0.9211D-03,0.9026D-03,0.8966D-03,& + &0.9045D-03,0.9256D-03,0.9554D-03,0.9845D-03,0.9981D-03,0.9751D-03,& + &0.9694D-03,0.9631D-03,0.9561D-03,0.9485D-03,0.9402D-03,0.9313D-03,& + &0.9217D-03,0.9114D-03,0.9006D-03,0.8890D-03,0.8766D-03,0.8634D-03,& + &0.8493D-03,0.8341D-03,0.8175D-03,0.7990D-03,0.7783D-03,0.7539D-03,& + &0.7241D-03,0.6938D-03,0.6252D-03,0.4746D-03/ + DATA (XPV(I,2,3),I=1,100)/ & + &0.1607D-02,0.1581D-02,0.1554D-02,0.1528D-02,0.1503D-02,0.1478D-02,& + &0.1454D-02,0.1431D-02,0.1408D-02,0.1386D-02,0.1365D-02,0.1344D-02,& + &0.1324D-02,0.1306D-02,0.1288D-02,0.1270D-02,0.1254D-02,0.1239D-02,& + &0.1224D-02,0.1211D-02,0.1198D-02,0.1186D-02,0.1177D-02,0.1168D-02,& + &0.1160D-02,0.1154D-02,0.1149D-02,0.1145D-02,0.1143D-02,0.1142D-02,& + &0.1143D-02,0.1145D-02,0.1150D-02,0.1156D-02,0.1163D-02,0.1173D-02,& + &0.1185D-02,0.1198D-02,0.1214D-02,0.1231D-02,0.1250D-02,0.1271D-02,& + &0.1294D-02,0.1321D-02,0.1346D-02,0.1373D-02,0.1403D-02,0.1432D-02,& + &0.1461D-02,0.1490D-02,0.1518D-02,0.1545D-02,0.1570D-02,0.1592D-02,& + &0.1607D-02,0.1620D-02,0.1626D-02,0.1625D-02,0.1616D-02,0.1598D-02,& + &0.1569D-02,0.1531D-02,0.1485D-02,0.1427D-02,0.1362D-02,0.1290D-02,& + &0.1216D-02,0.1143D-02,0.1074D-02,0.1015D-02,0.9689D-03,0.9403D-03,& + &0.9308D-03,0.9395D-03,0.9616D-03,0.9867D-03,0.9986D-03,0.9752D-03,& + &0.9695D-03,0.9631D-03,0.9561D-03,0.9485D-03,0.9402D-03,0.9313D-03,& + &0.9217D-03,0.9114D-03,0.9006D-03,0.8890D-03,0.8766D-03,0.8634D-03,& + &0.8493D-03,0.8341D-03,0.8175D-03,0.7990D-03,0.7783D-03,0.7539D-03,& + &0.7241D-03,0.6938D-03,0.6252D-03,0.4746D-03/ + DATA (XPV(I,2,4),I=1,100)/ & + &0.1415D-02,0.1387D-02,0.1359D-02,0.1331D-02,0.1305D-02,0.1278D-02,& + &0.1251D-02,0.1225D-02,0.1199D-02,0.1173D-02,0.1149D-02,0.1124D-02,& + &0.1099D-02,0.1076D-02,0.1052D-02,0.1028D-02,0.1006D-02,0.9831D-03,& + &0.9605D-03,0.9389D-03,0.9174D-03,0.8956D-03,0.8752D-03,0.8546D-03,& + &0.8341D-03,0.8146D-03,0.7951D-03,0.7757D-03,0.7572D-03,0.7389D-03,& + &0.7206D-03,0.7031D-03,0.6861D-03,0.6692D-03,0.6527D-03,0.6371D-03,& + &0.6218D-03,0.6068D-03,0.5925D-03,0.5789D-03,0.5660D-03,0.5535D-03,& + &0.5418D-03,0.5324D-03,0.5217D-03,0.5124D-03,0.5048D-03,0.4977D-03,& + &0.4913D-03,0.4863D-03,0.4825D-03,0.4799D-03,0.4788D-03,0.4791D-03,& + &0.4802D-03,0.4834D-03,0.4882D-03,0.4945D-03,0.5024D-03,0.5120D-03,& + &0.5231D-03,0.5359D-03,0.5503D-03,0.5660D-03,0.5831D-03,0.6017D-03,& + &0.6218D-03,0.6436D-03,0.6672D-03,0.6934D-03,0.7230D-03,0.7576D-03,& + &0.7992D-03,0.8507D-03,0.9158D-03,0.9997D-03,0.1110D-02,0.1257D-02,& + &0.1276D-02,0.1296D-02,0.1316D-02,0.1336D-02,0.1357D-02,0.1378D-02,& + &0.1400D-02,0.1421D-02,0.1443D-02,0.1465D-02,0.1488D-02,0.1509D-02,& + &0.1531D-02,0.1551D-02,0.1571D-02,0.1589D-02,0.1603D-02,0.1614D-02,& + &0.1612D-02,0.1626D-02,0.1559D-02,0.1269D-02/ + DATA (XPV(I,3,0),I=1,100)/ & + &0.3292D+00,0.3189D+00,0.3087D+00,0.2986D+00,0.2890D+00,0.2796D+00,& + &0.2703D+00,0.2615D+00,0.2529D+00,0.2443D+00,0.2363D+00,0.2283D+00,& + &0.2205D+00,0.2131D+00,0.2058D+00,0.1986D+00,0.1918D+00,0.1851D+00,& + &0.1785D+00,0.1722D+00,0.1661D+00,0.1600D+00,0.1544D+00,0.1487D+00,& + &0.1432D+00,0.1380D+00,0.1329D+00,0.1278D+00,0.1231D+00,0.1184D+00,& + &0.1138D+00,0.1094D+00,0.1051D+00,0.1010D+00,0.9689D-01,0.9302D-01,& + &0.8924D-01,0.8553D-01,0.8196D-01,0.7853D-01,0.7521D-01,0.7196D-01,& + &0.6881D-01,0.6600D-01,0.6297D-01,0.6010D-01,0.5743D-01,0.5479D-01,& + &0.5218D-01,0.4969D-01,0.4729D-01,0.4498D-01,0.4274D-01,0.4060D-01,& + &0.3844D-01,0.3644D-01,0.3453D-01,0.3267D-01,0.3091D-01,0.2922D-01,& + &0.2762D-01,0.2611D-01,0.2471D-01,0.2338D-01,0.2216D-01,0.2105D-01,& + &0.2007D-01,0.1922D-01,0.1851D-01,0.1795D-01,0.1755D-01,0.1732D-01,& + &0.1724D-01,0.1727D-01,0.1727D-01,0.1699D-01,0.1590D-01,0.1312D-01,& + &0.1266D-01,0.1217D-01,0.1165D-01,0.1110D-01,0.1053D-01,0.9921D-02,& + &0.9286D-02,0.8628D-02,0.7952D-02,0.7250D-02,0.6536D-02,0.5804D-02,& + &0.5069D-02,0.4328D-02,0.3596D-02,0.2876D-02,0.2183D-02,0.1530D-02,& + &0.9314D-03,0.4198D-03,0.1184D-03,0.0000D+00/ + DATA (XPV(I,3,1),I=1,100)/ & + &0.5070D-02,0.4938D-02,0.4806D-02,0.4675D-02,0.4552D-02,0.4429D-02,& + &0.4308D-02,0.4193D-02,0.4079D-02,0.3966D-02,0.3860D-02,0.3755D-02,& + &0.3650D-02,0.3552D-02,0.3454D-02,0.3358D-02,0.3268D-02,0.3178D-02,& + &0.3090D-02,0.3008D-02,0.2926D-02,0.2846D-02,0.2771D-02,0.2698D-02,& + &0.2626D-02,0.2559D-02,0.2494D-02,0.2430D-02,0.2371D-02,0.2315D-02,& + &0.2261D-02,0.2210D-02,0.2163D-02,0.2118D-02,0.2077D-02,0.2040D-02,& + &0.2006D-02,0.1975D-02,0.1948D-02,0.1926D-02,0.1907D-02,0.1892D-02,& + &0.1882D-02,0.1880D-02,0.1876D-02,0.1879D-02,0.1887D-02,0.1899D-02,& + &0.1914D-02,0.1934D-02,0.1958D-02,0.1986D-02,0.2017D-02,0.2051D-02,& + &0.2085D-02,0.2123D-02,0.2163D-02,0.2202D-02,0.2240D-02,0.2278D-02,& + &0.2314D-02,0.2347D-02,0.2379D-02,0.2407D-02,0.2433D-02,0.2459D-02,& + &0.2485D-02,0.2515D-02,0.2551D-02,0.2597D-02,0.2657D-02,0.2738D-02,& + &0.2843D-02,0.2978D-02,0.3148D-02,0.3354D-02,0.3592D-02,0.3839D-02,& + &0.3864D-02,0.3888D-02,0.3911D-02,0.3931D-02,0.3950D-02,0.3967D-02,& + &0.3980D-02,0.3991D-02,0.3999D-02,0.4002D-02,0.4000D-02,0.3993D-02,& + &0.3978D-02,0.3956D-02,0.3922D-02,0.3876D-02,0.3812D-02,0.3724D-02,& + &0.3606D-02,0.3465D-02,0.3134D-02,0.2451D-02/ + DATA (XPV(I,3,2),I=1,100)/ & + &0.5067D-02,0.4935D-02,0.4803D-02,0.4672D-02,0.4548D-02,0.4425D-02,& + &0.4303D-02,0.4188D-02,0.4074D-02,0.3960D-02,0.3853D-02,0.3747D-02,& + &0.3642D-02,0.3543D-02,0.3445D-02,0.3347D-02,0.3256D-02,0.3165D-02,& + &0.3075D-02,0.2991D-02,0.2908D-02,0.2826D-02,0.2749D-02,0.2673D-02,& + &0.2599D-02,0.2529D-02,0.2461D-02,0.2393D-02,0.2331D-02,0.2270D-02,& + &0.2211D-02,0.2155D-02,0.2102D-02,0.2052D-02,0.2003D-02,0.1958D-02,& + &0.1916D-02,0.1876D-02,0.1839D-02,0.1805D-02,0.1774D-02,0.1746D-02,& + &0.1720D-02,0.1702D-02,0.1681D-02,0.1664D-02,0.1651D-02,0.1640D-02,& + &0.1629D-02,0.1622D-02,0.1616D-02,0.1612D-02,0.1608D-02,0.1605D-02,& + &0.1598D-02,0.1593D-02,0.1586D-02,0.1577D-02,0.1564D-02,0.1547D-02,& + &0.1525D-02,0.1499D-02,0.1470D-02,0.1434D-02,0.1396D-02,0.1355D-02,& + &0.1314D-02,0.1274D-02,0.1240D-02,0.1211D-02,0.1192D-02,0.1184D-02,& + &0.1185D-02,0.1194D-02,0.1206D-02,0.1211D-02,0.1198D-02,0.1157D-02,& + &0.1150D-02,0.1143D-02,0.1135D-02,0.1127D-02,0.1119D-02,0.1110D-02,& + &0.1101D-02,0.1091D-02,0.1081D-02,0.1070D-02,0.1059D-02,0.1046D-02,& + &0.1033D-02,0.1018D-02,0.1001D-02,0.9817D-03,0.9590D-03,0.9316D-03,& + &0.8950D-03,0.8607D-03,0.7722D-03,0.5564D-03/ + DATA (XPV(I,3,3),I=1,100)/ & + &0.5100D-02,0.4971D-02,0.4841D-02,0.4713D-02,0.4592D-02,0.4472D-02,& + &0.4353D-02,0.4242D-02,0.4131D-02,0.4022D-02,0.3919D-02,0.3817D-02,& + &0.3716D-02,0.3622D-02,0.3529D-02,0.3438D-02,0.3352D-02,0.3268D-02,& + &0.3185D-02,0.3108D-02,0.3032D-02,0.2958D-02,0.2889D-02,0.2822D-02,& + &0.2757D-02,0.2696D-02,0.2638D-02,0.2582D-02,0.2530D-02,0.2481D-02,& + &0.2433D-02,0.2390D-02,0.2350D-02,0.2312D-02,0.2277D-02,0.2246D-02,& + &0.2218D-02,0.2192D-02,0.2169D-02,0.2150D-02,0.2133D-02,0.2119D-02,& + &0.2108D-02,0.2104D-02,0.2095D-02,0.2090D-02,0.2089D-02,0.2088D-02,& + &0.2086D-02,0.2085D-02,0.2084D-02,0.2082D-02,0.2079D-02,0.2073D-02,& + &0.2061D-02,0.2047D-02,0.2028D-02,0.2003D-02,0.1971D-02,0.1931D-02,& + &0.1884D-02,0.1830D-02,0.1769D-02,0.1701D-02,0.1628D-02,0.1553D-02,& + &0.1478D-02,0.1406D-02,0.1341D-02,0.1286D-02,0.1244D-02,0.1217D-02,& + &0.1205D-02,0.1204D-02,0.1210D-02,0.1212D-02,0.1199D-02,0.1157D-02,& + &0.1150D-02,0.1143D-02,0.1135D-02,0.1127D-02,0.1119D-02,0.1110D-02,& + &0.1101D-02,0.1091D-02,0.1081D-02,0.1070D-02,0.1059D-02,0.1046D-02,& + &0.1033D-02,0.1018D-02,0.1001D-02,0.9817D-03,0.9590D-03,0.9316D-03,& + &0.8950D-03,0.8607D-03,0.7722D-03,0.5564D-03/ + DATA (XPV(I,3,4),I=1,100)/ & + &0.4904D-02,0.4772D-02,0.4641D-02,0.4511D-02,0.4387D-02,0.4264D-02,& + &0.4143D-02,0.4028D-02,0.3914D-02,0.3800D-02,0.3692D-02,0.3586D-02,& + &0.3480D-02,0.3380D-02,0.3281D-02,0.3182D-02,0.3089D-02,0.2997D-02,& + &0.2905D-02,0.2819D-02,0.2733D-02,0.2648D-02,0.2568D-02,0.2488D-02,& + &0.2409D-02,0.2335D-02,0.2261D-02,0.2189D-02,0.2120D-02,0.2052D-02,& + &0.1986D-02,0.1922D-02,0.1860D-02,0.1800D-02,0.1741D-02,0.1686D-02,& + &0.1632D-02,0.1579D-02,0.1529D-02,0.1481D-02,0.1435D-02,0.1391D-02,& + &0.1350D-02,0.1315D-02,0.1276D-02,0.1242D-02,0.1212D-02,0.1184D-02,& + &0.1157D-02,0.1135D-02,0.1115D-02,0.1098D-02,0.1085D-02,0.1075D-02,& + &0.1067D-02,0.1064D-02,0.1064D-02,0.1068D-02,0.1076D-02,0.1087D-02,& + &0.1101D-02,0.1119D-02,0.1141D-02,0.1165D-02,0.1193D-02,0.1223D-02,& + &0.1256D-02,0.1292D-02,0.1332D-02,0.1375D-02,0.1424D-02,0.1482D-02,& + &0.1551D-02,0.1637D-02,0.1748D-02,0.1896D-02,0.2095D-02,0.2365D-02,& + &0.2400D-02,0.2434D-02,0.2470D-02,0.2506D-02,0.2542D-02,0.2578D-02,& + &0.2614D-02,0.2649D-02,0.2685D-02,0.2718D-02,0.2752D-02,0.2783D-02,& + &0.2812D-02,0.2837D-02,0.2858D-02,0.2872D-02,0.2878D-02,0.2872D-02,& + &0.2841D-02,0.2821D-02,0.2656D-02,0.2138D-02/ + DATA (XPV(I,4,0),I=1,100)/ & + &0.4299D+00,0.4154D+00,0.4011D+00,0.3870D+00,0.3736D+00,0.3605D+00,& + &0.3476D+00,0.3355D+00,0.3236D+00,0.3118D+00,0.3007D+00,0.2898D+00,& + &0.2791D+00,0.2690D+00,0.2591D+00,0.2494D+00,0.2402D+00,0.2312D+00,& + &0.2223D+00,0.2140D+00,0.2059D+00,0.1978D+00,0.1902D+00,0.1828D+00,& + &0.1755D+00,0.1687D+00,0.1619D+00,0.1553D+00,0.1491D+00,0.1430D+00,& + &0.1371D+00,0.1314D+00,0.1259D+00,0.1206D+00,0.1154D+00,0.1104D+00,& + &0.1056D+00,0.1009D+00,0.9641D-01,0.9210D-01,0.8793D-01,0.8386D-01,& + &0.7994D-01,0.7643D-01,0.7269D-01,0.6916D-01,0.6587D-01,0.6264D-01,& + &0.5946D-01,0.5644D-01,0.5353D-01,0.5074D-01,0.4805D-01,0.4548D-01,& + &0.4290D-01,0.4053D-01,0.3826D-01,0.3607D-01,0.3399D-01,0.3201D-01,& + &0.3012D-01,0.2836D-01,0.2672D-01,0.2516D-01,0.2372D-01,0.2241D-01,& + &0.2123D-01,0.2018D-01,0.1927D-01,0.1850D-01,0.1787D-01,0.1737D-01,& + &0.1696D-01,0.1658D-01,0.1608D-01,0.1522D-01,0.1354D-01,0.1041D-01,& + &0.9954D-02,0.9473D-02,0.8976D-02,0.8461D-02,0.7931D-02,0.7386D-02,& + &0.6825D-02,0.6255D-02,0.5681D-02,0.5098D-02,0.4516D-02,0.3934D-02,& + &0.3362D-02,0.2799D-02,0.2258D-02,0.1742D-02,0.1262D-02,0.8280D-03,& + &0.4482D-03,0.1620D-03,0.2992D-04,0.0000D+00/ + DATA (XPV(I,4,1),I=1,100)/ & + &0.7160D-02,0.6955D-02,0.6751D-02,0.6550D-02,0.6360D-02,0.6172D-02,& + &0.5986D-02,0.5810D-02,0.5637D-02,0.5466D-02,0.5304D-02,0.5145D-02,& + &0.4987D-02,0.4839D-02,0.4693D-02,0.4548D-02,0.4413D-02,0.4279D-02,& + &0.4148D-02,0.4024D-02,0.3903D-02,0.3783D-02,0.3672D-02,0.3563D-02,& + &0.3456D-02,0.3356D-02,0.3259D-02,0.3163D-02,0.3075D-02,0.2990D-02,& + &0.2908D-02,0.2831D-02,0.2758D-02,0.2689D-02,0.2624D-02,0.2565D-02,& + &0.2509D-02,0.2458D-02,0.2411D-02,0.2370D-02,0.2334D-02,0.2302D-02,& + &0.2275D-02,0.2259D-02,0.2241D-02,0.2229D-02,0.2226D-02,0.2226D-02,& + &0.2229D-02,0.2239D-02,0.2253D-02,0.2272D-02,0.2295D-02,0.2322D-02,& + &0.2348D-02,0.2381D-02,0.2415D-02,0.2449D-02,0.2485D-02,0.2519D-02,& + &0.2554D-02,0.2586D-02,0.2618D-02,0.2648D-02,0.2676D-02,0.2705D-02,& + &0.2736D-02,0.2770D-02,0.2812D-02,0.2864D-02,0.2931D-02,0.3017D-02,& + &0.3129D-02,0.3270D-02,0.3447D-02,0.3662D-02,0.3913D-02,0.4178D-02,& + &0.4205D-02,0.4231D-02,0.4256D-02,0.4279D-02,0.4299D-02,0.4318D-02,& + &0.4333D-02,0.4345D-02,0.4353D-02,0.4357D-02,0.4355D-02,0.4348D-02,& + &0.4332D-02,0.4307D-02,0.4271D-02,0.4220D-02,0.4151D-02,0.4055D-02,& + &0.3924D-02,0.3774D-02,0.3409D-02,0.2626D-02/ + DATA (XPV(I,4,2),I=1,100)/ & + &0.7157D-02,0.6952D-02,0.6748D-02,0.6546D-02,0.6356D-02,0.6167D-02,& + &0.5981D-02,0.5805D-02,0.5631D-02,0.5458D-02,0.5296D-02,0.5136D-02,& + &0.4978D-02,0.4828D-02,0.4681D-02,0.4535D-02,0.4398D-02,0.4263D-02,& + &0.4130D-02,0.4005D-02,0.3882D-02,0.3760D-02,0.3646D-02,0.3534D-02,& + &0.3424D-02,0.3321D-02,0.3220D-02,0.3120D-02,0.3028D-02,0.2938D-02,& + &0.2850D-02,0.2767D-02,0.2688D-02,0.2612D-02,0.2538D-02,0.2470D-02,& + &0.2405D-02,0.2343D-02,0.2285D-02,0.2231D-02,0.2181D-02,0.2133D-02,& + &0.2090D-02,0.2055D-02,0.2017D-02,0.1983D-02,0.1956D-02,0.1929D-02,& + &0.1905D-02,0.1883D-02,0.1864D-02,0.1846D-02,0.1830D-02,0.1815D-02,& + &0.1797D-02,0.1781D-02,0.1764D-02,0.1744D-02,0.1722D-02,0.1696D-02,& + &0.1666D-02,0.1633D-02,0.1597D-02,0.1556D-02,0.1513D-02,0.1468D-02,& + &0.1425D-02,0.1383D-02,0.1346D-02,0.1316D-02,0.1295D-02,0.1283D-02,& + &0.1281D-02,0.1284D-02,0.1288D-02,0.1286D-02,0.1269D-02,0.1228D-02,& + &0.1222D-02,0.1215D-02,0.1208D-02,0.1201D-02,0.1194D-02,0.1186D-02,& + &0.1177D-02,0.1169D-02,0.1159D-02,0.1149D-02,0.1139D-02,0.1127D-02,& + &0.1114D-02,0.1100D-02,0.1083D-02,0.1063D-02,0.1040D-02,0.1012D-02,& + &0.9728D-03,0.9358D-03,0.8403D-03,0.6078D-03/ + DATA (XPV(I,4,3),I=1,100)/ & + &0.7192D-02,0.6990D-02,0.6788D-02,0.6589D-02,0.6402D-02,0.6216D-02,& + &0.6033D-02,0.5861D-02,0.5691D-02,0.5523D-02,0.5365D-02,0.5209D-02,& + &0.5055D-02,0.4912D-02,0.4770D-02,0.4630D-02,0.4499D-02,0.4370D-02,& + &0.4244D-02,0.4126D-02,0.4011D-02,0.3896D-02,0.3791D-02,0.3688D-02,& + &0.3587D-02,0.3494D-02,0.3403D-02,0.3314D-02,0.3233D-02,0.3154D-02,& + &0.3078D-02,0.3008D-02,0.2941D-02,0.2878D-02,0.2818D-02,0.2764D-02,& + &0.2713D-02,0.2664D-02,0.2620D-02,0.2581D-02,0.2544D-02,0.2510D-02,& + &0.2480D-02,0.2460D-02,0.2433D-02,0.2411D-02,0.2394D-02,0.2377D-02,& + &0.2359D-02,0.2343D-02,0.2328D-02,0.2312D-02,0.2295D-02,0.2276D-02,& + &0.2251D-02,0.2225D-02,0.2195D-02,0.2158D-02,0.2116D-02,0.2067D-02,& + &0.2012D-02,0.1950D-02,0.1883D-02,0.1810D-02,0.1733D-02,0.1655D-02,& + &0.1578D-02,0.1505D-02,0.1440D-02,0.1385D-02,0.1342D-02,0.1314D-02,& + &0.1298D-02,0.1293D-02,0.1292D-02,0.1288D-02,0.1269D-02,0.1228D-02,& + &0.1222D-02,0.1215D-02,0.1208D-02,0.1201D-02,0.1194D-02,0.1186D-02,& + &0.1177D-02,0.1169D-02,0.1159D-02,0.1149D-02,0.1139D-02,0.1127D-02,& + &0.1114D-02,0.1100D-02,0.1083D-02,0.1063D-02,0.1040D-02,0.1012D-02,& + &0.9728D-03,0.9358D-03,0.8403D-03,0.6078D-03/ + DATA (XPV(I,4,4),I=1,100)/ & + &0.6994D-02,0.6789D-02,0.6586D-02,0.6385D-02,0.6194D-02,0.6006D-02,& + &0.5820D-02,0.5644D-02,0.5470D-02,0.5297D-02,0.5135D-02,0.4974D-02,& + &0.4815D-02,0.4665D-02,0.4516D-02,0.4369D-02,0.4231D-02,0.4094D-02,& + &0.3959D-02,0.3831D-02,0.3705D-02,0.3580D-02,0.3463D-02,0.3347D-02,& + &0.3233D-02,0.3125D-02,0.3019D-02,0.2914D-02,0.2815D-02,0.2718D-02,& + &0.2623D-02,0.2532D-02,0.2444D-02,0.2359D-02,0.2276D-02,0.2197D-02,& + &0.2121D-02,0.2047D-02,0.1976D-02,0.1909D-02,0.1845D-02,0.1784D-02,& + &0.1726D-02,0.1676D-02,0.1623D-02,0.1575D-02,0.1532D-02,0.1492D-02,& + &0.1455D-02,0.1422D-02,0.1393D-02,0.1368D-02,0.1348D-02,0.1332D-02,& + &0.1318D-02,0.1311D-02,0.1309D-02,0.1310D-02,0.1316D-02,0.1327D-02,& + &0.1342D-02,0.1361D-02,0.1385D-02,0.1412D-02,0.1443D-02,0.1477D-02,& + &0.1514D-02,0.1556D-02,0.1601D-02,0.1650D-02,0.1706D-02,0.1772D-02,& + &0.1851D-02,0.1951D-02,0.2081D-02,0.2254D-02,0.2490D-02,0.2807D-02,& + &0.2848D-02,0.2888D-02,0.2930D-02,0.2971D-02,0.3012D-02,0.3053D-02,& + &0.3094D-02,0.3133D-02,0.3173D-02,0.3210D-02,0.3246D-02,0.3278D-02,& + &0.3308D-02,0.3332D-02,0.3351D-02,0.3361D-02,0.3360D-02,0.3343D-02,& + &0.3298D-02,0.3256D-02,0.3045D-02,0.2439D-02/ + DATA (XPV(I,5,0),I=1,100)/ & + &0.8093D+00,0.7773D+00,0.7460D+00,0.7153D+00,0.6865D+00,0.6584D+00,& + &0.6309D+00,0.6051D+00,0.5800D+00,0.5553D+00,0.5323D+00,0.5098D+00,& + &0.4878D+00,0.4672D+00,0.4471D+00,0.4274D+00,0.4091D+00,0.3911D+00,& + &0.3737D+00,0.3573D+00,0.3414D+00,0.3257D+00,0.3112D+00,0.2970D+00,& + &0.2832D+00,0.2703D+00,0.2577D+00,0.2454D+00,0.2339D+00,0.2228D+00,& + &0.2120D+00,0.2017D+00,0.1919D+00,0.1824D+00,0.1732D+00,0.1646D+00,& + &0.1562D+00,0.1481D+00,0.1404D+00,0.1331D+00,0.1261D+00,0.1193D+00,& + &0.1128D+00,0.1070D+00,0.1010D+00,0.9529D-01,0.9002D-01,0.8489D-01,& + &0.7989D-01,0.7519D-01,0.7070D-01,0.6643D-01,0.6235D-01,0.5848D-01,& + &0.5466D-01,0.5115D-01,0.4783D-01,0.4465D-01,0.4164D-01,0.3880D-01,& + &0.3612D-01,0.3361D-01,0.3128D-01,0.2906D-01,0.2701D-01,0.2510D-01,& + &0.2335D-01,0.2174D-01,0.2025D-01,0.1888D-01,0.1761D-01,0.1640D-01,& + &0.1519D-01,0.1391D-01,0.1244D-01,0.1063D-01,0.8288D-02,0.5319D-02,& + &0.4959D-02,0.4600D-02,0.4241D-02,0.3887D-02,0.3536D-02,0.3192D-02,& + &0.2851D-02,0.2522D-02,0.2202D-02,0.1896D-02,0.1603D-02,0.1327D-02,& + &0.1069D-02,0.8328D-03,0.6188D-03,0.4316D-03,0.2725D-03,0.1444D-03,& + &0.4859D-04,0.5429D-05,0.0000D+00,0.1955D-04/ + DATA (XPV(I,5,1),I=1,100)/ & + &0.1593D-01,0.1538D-01,0.1484D-01,0.1431D-01,0.1382D-01,0.1333D-01,& + &0.1285D-01,0.1239D-01,0.1195D-01,0.1151D-01,0.1110D-01,0.1070D-01,& + &0.1031D-01,0.9936D-02,0.9572D-02,0.9216D-02,0.8882D-02,0.8554D-02,& + &0.8234D-02,0.7934D-02,0.7641D-02,0.7352D-02,0.7084D-02,0.6821D-02,& + &0.6565D-02,0.6326D-02,0.6094D-02,0.5867D-02,0.5655D-02,0.5452D-02,& + &0.5254D-02,0.5067D-02,0.4891D-02,0.4722D-02,0.4560D-02,0.4411D-02,& + &0.4269D-02,0.4134D-02,0.4008D-02,0.3894D-02,0.3787D-02,0.3688D-02,& + &0.3598D-02,0.3527D-02,0.3450D-02,0.3386D-02,0.3335D-02,0.3289D-02,& + &0.3249D-02,0.3219D-02,0.3197D-02,0.3182D-02,0.3175D-02,0.3175D-02,& + &0.3176D-02,0.3186D-02,0.3202D-02,0.3221D-02,0.3244D-02,0.3270D-02,& + &0.3298D-02,0.3328D-02,0.3361D-02,0.3394D-02,0.3429D-02,0.3468D-02,& + &0.3511D-02,0.3560D-02,0.3617D-02,0.3686D-02,0.3770D-02,0.3875D-02,& + &0.4005D-02,0.4169D-02,0.4375D-02,0.4632D-02,0.4943D-02,0.5288D-02,& + &0.5325D-02,0.5361D-02,0.5394D-02,0.5426D-02,0.5455D-02,0.5481D-02,& + &0.5503D-02,0.5521D-02,0.5534D-02,0.5542D-02,0.5542D-02,0.5535D-02,& + &0.5517D-02,0.5487D-02,0.5443D-02,0.5379D-02,0.5292D-02,0.5171D-02,& + &0.5002D-02,0.4819D-02,0.4353D-02,0.3292D-02/ + DATA (XPV(I,5,2),I=1,100)/ & + &0.1593D-01,0.1538D-01,0.1484D-01,0.1431D-01,0.1381D-01,0.1332D-01,& + &0.1284D-01,0.1238D-01,0.1194D-01,0.1150D-01,0.1109D-01,0.1069D-01,& + &0.1029D-01,0.9919D-02,0.9554D-02,0.9196D-02,0.8860D-02,0.8530D-02,& + &0.8207D-02,0.7904D-02,0.7608D-02,0.7315D-02,0.7045D-02,0.6777D-02,& + &0.6517D-02,0.6273D-02,0.6035D-02,0.5802D-02,0.5584D-02,0.5373D-02,& + &0.5168D-02,0.4973D-02,0.4787D-02,0.4607D-02,0.4434D-02,0.4272D-02,& + &0.4116D-02,0.3966D-02,0.3825D-02,0.3692D-02,0.3565D-02,0.3445D-02,& + &0.3331D-02,0.3234D-02,0.3130D-02,0.3035D-02,0.2951D-02,0.2869D-02,& + &0.2790D-02,0.2718D-02,0.2650D-02,0.2586D-02,0.2526D-02,0.2469D-02,& + &0.2409D-02,0.2356D-02,0.2303D-02,0.2249D-02,0.2195D-02,0.2140D-02,& + &0.2084D-02,0.2027D-02,0.1970D-02,0.1911D-02,0.1852D-02,0.1794D-02,& + &0.1739D-02,0.1688D-02,0.1643D-02,0.1604D-02,0.1574D-02,0.1551D-02,& + &0.1534D-02,0.1523D-02,0.1512D-02,0.1500D-02,0.1483D-02,0.1462D-02,& + &0.1459D-02,0.1456D-02,0.1453D-02,0.1450D-02,0.1446D-02,0.1442D-02,& + &0.1438D-02,0.1433D-02,0.1427D-02,0.1421D-02,0.1413D-02,0.1404D-02,& + &0.1393D-02,0.1380D-02,0.1364D-02,0.1343D-02,0.1318D-02,0.1285D-02,& + &0.1239D-02,0.1192D-02,0.1073D-02,0.7970D-03/ + DATA (XPV(I,5,3),I=1,100)/ & + &0.1597D-01,0.1542D-01,0.1488D-01,0.1436D-01,0.1386D-01,0.1337D-01,& + &0.1290D-01,0.1245D-01,0.1201D-01,0.1157D-01,0.1117D-01,0.1077D-01,& + &0.1038D-01,0.1001D-01,0.9654D-02,0.9302D-02,0.8972D-02,0.8649D-02,& + &0.8334D-02,0.8038D-02,0.7750D-02,0.7466D-02,0.7204D-02,0.6946D-02,& + &0.6696D-02,0.6462D-02,0.6234D-02,0.6012D-02,0.5805D-02,0.5606D-02,& + &0.5412D-02,0.5230D-02,0.5056D-02,0.4889D-02,0.4729D-02,0.4580D-02,& + &0.4438D-02,0.4301D-02,0.4173D-02,0.4053D-02,0.3939D-02,0.3831D-02,& + &0.3729D-02,0.3644D-02,0.3549D-02,0.3463D-02,0.3387D-02,0.3312D-02,& + &0.3238D-02,0.3168D-02,0.3101D-02,0.3036D-02,0.2971D-02,0.2907D-02,& + &0.2838D-02,0.2771D-02,0.2702D-02,0.2630D-02,0.2555D-02,0.2476D-02,& + &0.2393D-02,0.2308D-02,0.2221D-02,0.2130D-02,0.2040D-02,0.1951D-02,& + &0.1867D-02,0.1788D-02,0.1718D-02,0.1659D-02,0.1610D-02,0.1574D-02,& + &0.1547D-02,0.1529D-02,0.1515D-02,0.1501D-02,0.1484D-02,0.1462D-02,& + &0.1459D-02,0.1456D-02,0.1453D-02,0.1450D-02,0.1446D-02,0.1442D-02,& + &0.1438D-02,0.1433D-02,0.1427D-02,0.1421D-02,0.1413D-02,0.1404D-02,& + &0.1393D-02,0.1380D-02,0.1364D-02,0.1343D-02,0.1318D-02,0.1285D-02,& + &0.1239D-02,0.1192D-02,0.1073D-02,0.7970D-03/ + DATA (XPV(I,5,4),I=1,100)/ & + &0.1576D-01,0.1522D-01,0.1468D-01,0.1415D-01,0.1365D-01,0.1316D-01,& + &0.1268D-01,0.1222D-01,0.1178D-01,0.1134D-01,0.1093D-01,0.1052D-01,& + &0.1013D-01,0.9753D-02,0.9387D-02,0.9027D-02,0.8689D-02,0.8357D-02,& + &0.8032D-02,0.7727D-02,0.7428D-02,0.7132D-02,0.6858D-02,0.6586D-02,& + &0.6323D-02,0.6074D-02,0.5831D-02,0.5593D-02,0.5369D-02,0.5152D-02,& + &0.4939D-02,0.4738D-02,0.4544D-02,0.4357D-02,0.4175D-02,0.4005D-02,& + &0.3840D-02,0.3681D-02,0.3530D-02,0.3388D-02,0.3253D-02,0.3123D-02,& + &0.3000D-02,0.2895D-02,0.2783D-02,0.2682D-02,0.2593D-02,0.2508D-02,& + &0.2428D-02,0.2357D-02,0.2294D-02,0.2239D-02,0.2192D-02,0.2153D-02,& + &0.2118D-02,0.2095D-02,0.2079D-02,0.2071D-02,0.2071D-02,0.2078D-02,& + &0.2093D-02,0.2115D-02,0.2144D-02,0.2178D-02,0.2219D-02,0.2264D-02,& + &0.2316D-02,0.2372D-02,0.2434D-02,0.2502D-02,0.2580D-02,0.2672D-02,& + &0.2784D-02,0.2928D-02,0.3119D-02,0.3377D-02,0.3729D-02,0.4189D-02,& + &0.4246D-02,0.4303D-02,0.4359D-02,0.4415D-02,0.4470D-02,0.4524D-02,& + &0.4576D-02,0.4626D-02,0.4674D-02,0.4717D-02,0.4757D-02,0.4790D-02,& + &0.4817D-02,0.4835D-02,0.4841D-02,0.4833D-02,0.4805D-02,0.4749D-02,& + &0.4653D-02,0.4545D-02,0.4183D-02,0.3280D-02/ + DATA (XPV(I,6,0),I=1,100)/ & + &0.1231D+01,0.1178D+01,0.1126D+01,0.1075D+01,0.1027D+01,0.9810D+00,& + &0.9360D+00,0.8939D+00,0.8530D+00,0.8132D+00,0.7760D+00,0.7400D+00,& + &0.7048D+00,0.6721D+00,0.6402D+00,0.6093D+00,0.5805D+00,0.5525D+00,& + &0.5253D+00,0.5000D+00,0.4755D+00,0.4515D+00,0.4294D+00,0.4078D+00,& + &0.3869D+00,0.3675D+00,0.3487D+00,0.3304D+00,0.3134D+00,0.2970D+00,& + &0.2811D+00,0.2662D+00,0.2519D+00,0.2382D+00,0.2250D+00,0.2127D+00,& + &0.2008D+00,0.1894D+00,0.1786D+00,0.1684D+00,0.1587D+00,0.1493D+00,& + &0.1404D+00,0.1325D+00,0.1242D+00,0.1166D+00,0.1095D+00,0.1026D+00,& + &0.9603D-01,0.8984D-01,0.8397D-01,0.7840D-01,0.7313D-01,0.6816D-01,& + &0.6329D-01,0.5884D-01,0.5463D-01,0.5064D-01,0.4689D-01,0.4336D-01,& + &0.4003D-01,0.3692D-01,0.3405D-01,0.3131D-01,0.2878D-01,0.2641D-01,& + &0.2422D-01,0.2217D-01,0.2026D-01,0.1847D-01,0.1676D-01,0.1509D-01,& + &0.1343D-01,0.1172D-01,0.9883D-02,0.7845D-02,0.5581D-02,0.3172D-02,& + &0.2910D-02,0.2656D-02,0.2408D-02,0.2169D-02,0.1937D-02,0.1717D-02,& + &0.1503D-02,0.1304D-02,0.1115D-02,0.9399D-03,0.7768D-03,0.6289D-03,& + &0.4947D-03,0.3769D-03,0.2741D-03,0.1885D-03,0.1190D-03,0.6665D-04,& + &0.2993D-04,0.1309D-04,0.5951D-05,0.8951D-05/ + DATA (XPV(I,6,1),I=1,100)/ & + &0.2693D-01,0.2590D-01,0.2489D-01,0.2390D-01,0.2298D-01,0.2207D-01,& + &0.2118D-01,0.2035D-01,0.1954D-01,0.1874D-01,0.1800D-01,0.1728D-01,& + &0.1656D-01,0.1590D-01,0.1525D-01,0.1462D-01,0.1402D-01,0.1344D-01,& + &0.1288D-01,0.1235D-01,0.1184D-01,0.1134D-01,0.1087D-01,0.1041D-01,& + &0.9974D-02,0.9562D-02,0.9162D-02,0.8773D-02,0.8412D-02,0.8064D-02,& + &0.7726D-02,0.7409D-02,0.7109D-02,0.6821D-02,0.6545D-02,0.6290D-02,& + &0.6047D-02,0.5816D-02,0.5600D-02,0.5401D-02,0.5215D-02,0.5039D-02,& + &0.4878D-02,0.4745D-02,0.4605D-02,0.4483D-02,0.4379D-02,0.4284D-02,& + &0.4198D-02,0.4126D-02,0.4065D-02,0.4016D-02,0.3978D-02,0.3950D-02,& + &0.3926D-02,0.3916D-02,0.3914D-02,0.3919D-02,0.3932D-02,0.3950D-02,& + &0.3974D-02,0.4003D-02,0.4038D-02,0.4077D-02,0.4120D-02,0.4169D-02,& + &0.4224D-02,0.4287D-02,0.4360D-02,0.4445D-02,0.4547D-02,0.4671D-02,& + &0.4824D-02,0.5016D-02,0.5261D-02,0.5573D-02,0.5961D-02,0.6401D-02,& + &0.6449D-02,0.6495D-02,0.6539D-02,0.6580D-02,0.6619D-02,0.6653D-02,& + &0.6683D-02,0.6708D-02,0.6727D-02,0.6738D-02,0.6742D-02,0.6735D-02,& + &0.6716D-02,0.6682D-02,0.6630D-02,0.6554D-02,0.6450D-02,0.6305D-02,& + &0.6100D-02,0.5879D-02,0.5316D-02,0.4016D-02/ + DATA (XPV(I,6,2),I=1,100)/ & + &0.2692D-01,0.2589D-01,0.2488D-01,0.2389D-01,0.2297D-01,0.2206D-01,& + &0.2117D-01,0.2034D-01,0.1953D-01,0.1873D-01,0.1798D-01,0.1726D-01,& + &0.1654D-01,0.1588D-01,0.1522D-01,0.1459D-01,0.1399D-01,0.1341D-01,& + &0.1284D-01,0.1231D-01,0.1180D-01,0.1129D-01,0.1082D-01,0.1036D-01,& + &0.9909D-02,0.9490D-02,0.9083D-02,0.8686D-02,0.8316D-02,0.7959D-02,& + &0.7611D-02,0.7283D-02,0.6970D-02,0.6668D-02,0.6378D-02,0.6106D-02,& + &0.5845D-02,0.5595D-02,0.5358D-02,0.5135D-02,0.4923D-02,0.4720D-02,& + &0.4529D-02,0.4363D-02,0.4187D-02,0.4026D-02,0.3880D-02,0.3739D-02,& + &0.3603D-02,0.3478D-02,0.3360D-02,0.3248D-02,0.3143D-02,0.3044D-02,& + &0.2944D-02,0.2853D-02,0.2766D-02,0.2680D-02,0.2597D-02,0.2515D-02,& + &0.2435D-02,0.2356D-02,0.2280D-02,0.2204D-02,0.2130D-02,0.2060D-02,& + &0.1995D-02,0.1934D-02,0.1881D-02,0.1834D-02,0.1795D-02,0.1764D-02,& + &0.1739D-02,0.1720D-02,0.1706D-02,0.1698D-02,0.1697D-02,0.1707D-02,& + &0.1708D-02,0.1709D-02,0.1711D-02,0.1711D-02,0.1712D-02,0.1712D-02,& + &0.1712D-02,0.1710D-02,0.1708D-02,0.1704D-02,0.1700D-02,0.1692D-02,& + &0.1683D-02,0.1670D-02,0.1653D-02,0.1631D-02,0.1603D-02,0.1564D-02,& + &0.1512D-02,0.1455D-02,0.1312D-02,0.9886D-03/ + DATA (XPV(I,6,3),I=1,100)/ & + &0.2696D-01,0.2594D-01,0.2493D-01,0.2395D-01,0.2302D-01,0.2212D-01,& + &0.2124D-01,0.2041D-01,0.1960D-01,0.1881D-01,0.1807D-01,0.1735D-01,& + &0.1664D-01,0.1598D-01,0.1533D-01,0.1470D-01,0.1411D-01,0.1354D-01,& + &0.1298D-01,0.1246D-01,0.1195D-01,0.1145D-01,0.1099D-01,0.1054D-01,& + &0.1010D-01,0.9691D-02,0.9294D-02,0.8909D-02,0.8550D-02,0.8204D-02,& + &0.7868D-02,0.7552D-02,0.7251D-02,0.6962D-02,0.6684D-02,0.6425D-02,& + &0.6177D-02,0.5939D-02,0.5714D-02,0.5503D-02,0.5303D-02,0.5111D-02,& + &0.4930D-02,0.4774D-02,0.4606D-02,0.4452D-02,0.4312D-02,0.4176D-02,& + &0.4042D-02,0.3918D-02,0.3798D-02,0.3683D-02,0.3571D-02,0.3464D-02,& + &0.3351D-02,0.3245D-02,0.3141D-02,0.3035D-02,0.2930D-02,0.2823D-02,& + &0.2716D-02,0.2609D-02,0.2504D-02,0.2398D-02,0.2295D-02,0.2196D-02,& + &0.2104D-02,0.2019D-02,0.1944D-02,0.1879D-02,0.1825D-02,0.1782D-02,& + &0.1749D-02,0.1725D-02,0.1708D-02,0.1698D-02,0.1697D-02,0.1707D-02,& + &0.1708D-02,0.1709D-02,0.1711D-02,0.1711D-02,0.1712D-02,0.1712D-02,& + &0.1712D-02,0.1710D-02,0.1708D-02,0.1704D-02,0.1700D-02,0.1692D-02,& + &0.1683D-02,0.1670D-02,0.1653D-02,0.1631D-02,0.1603D-02,0.1564D-02,& + &0.1512D-02,0.1455D-02,0.1312D-02,0.9886D-03/ + DATA (XPV(I,6,4),I=1,100)/ & + &0.2676D-01,0.2573D-01,0.2472D-01,0.2373D-01,0.2280D-01,0.2189D-01,& + &0.2101D-01,0.2018D-01,0.1936D-01,0.1857D-01,0.1782D-01,0.1709D-01,& + &0.1638D-01,0.1571D-01,0.1506D-01,0.1442D-01,0.1382D-01,0.1324D-01,& + &0.1267D-01,0.1213D-01,0.1161D-01,0.1110D-01,0.1063D-01,0.1016D-01,& + &0.9714D-02,0.9291D-02,0.8880D-02,0.8479D-02,0.8104D-02,0.7741D-02,& + &0.7388D-02,0.7054D-02,0.6735D-02,0.6427D-02,0.6131D-02,0.5854D-02,& + &0.5587D-02,0.5331D-02,0.5088D-02,0.4860D-02,0.4644D-02,0.4438D-02,& + &0.4244D-02,0.4076D-02,0.3901D-02,0.3742D-02,0.3601D-02,0.3468D-02,& + &0.3343D-02,0.3232D-02,0.3133D-02,0.3046D-02,0.2971D-02,0.2908D-02,& + &0.2852D-02,0.2812D-02,0.2784D-02,0.2766D-02,0.2760D-02,0.2764D-02,& + &0.2779D-02,0.2803D-02,0.2838D-02,0.2881D-02,0.2931D-02,0.2989D-02,& + &0.3054D-02,0.3126D-02,0.3205D-02,0.3293D-02,0.3394D-02,0.3513D-02,& + &0.3660D-02,0.3850D-02,0.4103D-02,0.4446D-02,0.4907D-02,0.5494D-02,& + &0.5564D-02,0.5634D-02,0.5703D-02,0.5770D-02,0.5836D-02,0.5899D-02,& + &0.5960D-02,0.6016D-02,0.6069D-02,0.6115D-02,0.6155D-02,0.6187D-02,& + &0.6208D-02,0.6216D-02,0.6209D-02,0.6180D-02,0.6125D-02,0.6033D-02,& + &0.5886D-02,0.5722D-02,0.5226D-02,0.4038D-02/ + DATA (XPV(I,7,0),I=1,100)/ & + &0.1677D+01,0.1599D+01,0.1523D+01,0.1449D+01,0.1381D+01,0.1314D+01,& + &0.1249D+01,0.1189D+01,0.1131D+01,0.1074D+01,0.1022D+01,0.9709D+00,& + &0.9215D+00,0.8757D+00,0.8313D+00,0.7884D+00,0.7484D+00,0.7098D+00,& + &0.6725D+00,0.6378D+00,0.6043D+00,0.5717D+00,0.5418D+00,0.5126D+00,& + &0.4847D+00,0.4586D+00,0.4335D+00,0.4092D+00,0.3867D+00,0.3651D+00,& + &0.3443D+00,0.3247D+00,0.3062D+00,0.2884D+00,0.2714D+00,0.2555D+00,& + &0.2403D+00,0.2257D+00,0.2120D+00,0.1991D+00,0.1868D+00,0.1751D+00,& + &0.1640D+00,0.1541D+00,0.1439D+00,0.1345D+00,0.1258D+00,0.1174D+00,& + &0.1094D+00,0.1019D+00,0.9482D-01,0.8815D-01,0.8185D-01,0.7594D-01,& + &0.7018D-01,0.6493D-01,0.5999D-01,0.5532D-01,0.5095D-01,0.4685D-01,& + &0.4299D-01,0.3941D-01,0.3609D-01,0.3294D-01,0.3001D-01,0.2728D-01,& + &0.2475D-01,0.2237D-01,0.2014D-01,0.1804D-01,0.1603D-01,0.1408D-01,& + &0.1216D-01,0.1023D-01,0.8245D-02,0.6190D-02,0.4106D-02,0.2133D-02,& + &0.1935D-02,0.1745D-02,0.1564D-02,0.1393D-02,0.1230D-02,0.1078D-02,& + &0.9340D-03,0.8018D-03,0.6796D-03,0.5685D-03,0.4677D-03,0.3782D-03,& + &0.2992D-03,0.2312D-03,0.1736D-03,0.1264D-03,0.8864D-04,0.6022D-04,& + &0.3944D-04,0.2460D-04,0.1450D-04,0.2966D-05/ + DATA (XPV(I,7,1),I=1,100)/ & + &0.3968D-01,0.3804D-01,0.3644D-01,0.3488D-01,0.3341D-01,0.3198D-01,& + &0.3060D-01,0.2930D-01,0.2803D-01,0.2680D-01,0.2565D-01,0.2453D-01,& + &0.2343D-01,0.2242D-01,0.2142D-01,0.2046D-01,0.1956D-01,0.1868D-01,& + &0.1783D-01,0.1704D-01,0.1627D-01,0.1552D-01,0.1483D-01,0.1415D-01,& + &0.1350D-01,0.1289D-01,0.1231D-01,0.1174D-01,0.1121D-01,0.1070D-01,& + &0.1021D-01,0.9747D-02,0.9311D-02,0.8894D-02,0.8496D-02,0.8127D-02,& + &0.7777D-02,0.7443D-02,0.7132D-02,0.6844D-02,0.6574D-02,0.6320D-02,& + &0.6086D-02,0.5889D-02,0.5684D-02,0.5503D-02,0.5347D-02,0.5204D-02,& + &0.5072D-02,0.4959D-02,0.4862D-02,0.4780D-02,0.4712D-02,0.4660D-02,& + &0.4612D-02,0.4585D-02,0.4569D-02,0.4563D-02,0.4568D-02,0.4582D-02,& + &0.4605D-02,0.4636D-02,0.4677D-02,0.4723D-02,0.4776D-02,0.4838D-02,& + &0.4908D-02,0.4987D-02,0.5076D-02,0.5180D-02,0.5302D-02,0.5448D-02,& + &0.5628D-02,0.5855D-02,0.6147D-02,0.6522D-02,0.6993D-02,0.7534D-02,& + &0.7594D-02,0.7651D-02,0.7705D-02,0.7756D-02,0.7805D-02,0.7847D-02,& + &0.7886D-02,0.7917D-02,0.7942D-02,0.7958D-02,0.7964D-02,0.7958D-02,& + &0.7937D-02,0.7898D-02,0.7839D-02,0.7751D-02,0.7629D-02,0.7460D-02,& + &0.7219D-02,0.6959D-02,0.6295D-02,0.4764D-02/ + DATA (XPV(I,7,2),I=1,100)/ & + &0.3967D-01,0.3803D-01,0.3643D-01,0.3486D-01,0.3340D-01,0.3197D-01,& + &0.3058D-01,0.2928D-01,0.2801D-01,0.2678D-01,0.2562D-01,0.2450D-01,& + &0.2341D-01,0.2239D-01,0.2139D-01,0.2042D-01,0.1952D-01,0.1864D-01,& + &0.1779D-01,0.1699D-01,0.1622D-01,0.1546D-01,0.1476D-01,0.1408D-01,& + &0.1342D-01,0.1280D-01,0.1221D-01,0.1163D-01,0.1109D-01,0.1057D-01,& + &0.1006D-01,0.9587D-02,0.9136D-02,0.8701D-02,0.8285D-02,0.7896D-02,& + &0.7524D-02,0.7166D-02,0.6828D-02,0.6511D-02,0.6211D-02,0.5923D-02,& + &0.5651D-02,0.5414D-02,0.5166D-02,0.4937D-02,0.4730D-02,0.4531D-02,& + &0.4339D-02,0.4161D-02,0.3994D-02,0.3837D-02,0.3689D-02,0.3551D-02,& + &0.3412D-02,0.3287D-02,0.3168D-02,0.3053D-02,0.2944D-02,0.2838D-02,& + &0.2736D-02,0.2639D-02,0.2547D-02,0.2456D-02,0.2371D-02,0.2290D-02,& + &0.2216D-02,0.2149D-02,0.2089D-02,0.2036D-02,0.1992D-02,0.1956D-02,& + &0.1927D-02,0.1907D-02,0.1898D-02,0.1901D-02,0.1923D-02,0.1966D-02,& + &0.1971D-02,0.1977D-02,0.1982D-02,0.1987D-02,0.1991D-02,0.1995D-02,& + &0.1998D-02,0.1999D-02,0.2000D-02,0.1999D-02,0.1996D-02,0.1990D-02,& + &0.1981D-02,0.1968D-02,0.1951D-02,0.1927D-02,0.1894D-02,0.1851D-02,& + &0.1790D-02,0.1723D-02,0.1556D-02,0.1179D-02/ + DATA (XPV(I,7,3),I=1,100)/ & + &0.3972D-01,0.3809D-01,0.3648D-01,0.3492D-01,0.3346D-01,0.3204D-01,& + &0.3065D-01,0.2936D-01,0.2810D-01,0.2686D-01,0.2572D-01,0.2460D-01,& + &0.2351D-01,0.2250D-01,0.2151D-01,0.2055D-01,0.1965D-01,0.1878D-01,& + &0.1793D-01,0.1714D-01,0.1638D-01,0.1563D-01,0.1494D-01,0.1427D-01,& + &0.1362D-01,0.1301D-01,0.1243D-01,0.1186D-01,0.1133D-01,0.1082D-01,& + &0.1033D-01,0.9865D-02,0.9426D-02,0.9004D-02,0.8600D-02,0.8223D-02,& + &0.7863D-02,0.7517D-02,0.7191D-02,0.6885D-02,0.6594D-02,0.6316D-02,& + &0.6054D-02,0.5826D-02,0.5584D-02,0.5361D-02,0.5158D-02,0.4962D-02,& + &0.4770D-02,0.4591D-02,0.4421D-02,0.4258D-02,0.4102D-02,0.3953D-02,& + &0.3801D-02,0.3660D-02,0.3523D-02,0.3387D-02,0.3255D-02,0.3124D-02,& + &0.2996D-02,0.2871D-02,0.2751D-02,0.2632D-02,0.2519D-02,0.2411D-02,& + &0.2313D-02,0.2223D-02,0.2143D-02,0.2074D-02,0.2017D-02,0.1971D-02,& + &0.1935D-02,0.1911D-02,0.1899D-02,0.1901D-02,0.1923D-02,0.1966D-02,& + &0.1971D-02,0.1977D-02,0.1982D-02,0.1987D-02,0.1991D-02,0.1995D-02,& + &0.1998D-02,0.1999D-02,0.2000D-02,0.1999D-02,0.1996D-02,0.1990D-02,& + &0.1981D-02,0.1968D-02,0.1951D-02,0.1927D-02,0.1894D-02,0.1851D-02,& + &0.1790D-02,0.1723D-02,0.1556D-02,0.1179D-02/ + DATA (XPV(I,7,4),I=1,100)/ & + &0.3951D-01,0.3787D-01,0.3626D-01,0.3470D-01,0.3324D-01,0.3181D-01,& + &0.3042D-01,0.2912D-01,0.2785D-01,0.2661D-01,0.2546D-01,0.2434D-01,& + &0.2324D-01,0.2222D-01,0.2122D-01,0.2025D-01,0.1935D-01,0.1847D-01,& + &0.1761D-01,0.1681D-01,0.1604D-01,0.1528D-01,0.1458D-01,0.1389D-01,& + &0.1323D-01,0.1261D-01,0.1201D-01,0.1142D-01,0.1088D-01,0.1036D-01,& + &0.9848D-02,0.9370D-02,0.8915D-02,0.8477D-02,0.8057D-02,0.7665D-02,& + &0.7290D-02,0.6930D-02,0.6592D-02,0.6274D-02,0.5975D-02,0.5689D-02,& + &0.5422D-02,0.5191D-02,0.4951D-02,0.4734D-02,0.4541D-02,0.4361D-02,& + &0.4191D-02,0.4042D-02,0.3908D-02,0.3791D-02,0.3689D-02,0.3604D-02,& + &0.3528D-02,0.3474D-02,0.3435D-02,0.3410D-02,0.3400D-02,0.3403D-02,& + &0.3420D-02,0.3450D-02,0.3493D-02,0.3545D-02,0.3608D-02,0.3680D-02,& + &0.3761D-02,0.3850D-02,0.3949D-02,0.4059D-02,0.4184D-02,0.4334D-02,& + &0.4519D-02,0.4757D-02,0.5073D-02,0.5499D-02,0.6065D-02,0.6768D-02,& + &0.6851D-02,0.6932D-02,0.7012D-02,0.7089D-02,0.7164D-02,0.7236D-02,& + &0.7303D-02,0.7366D-02,0.7422D-02,0.7470D-02,0.7510D-02,0.7539D-02,& + &0.7554D-02,0.7553D-02,0.7532D-02,0.7484D-02,0.7404D-02,0.7276D-02,& + &0.7082D-02,0.6866D-02,0.6248D-02,0.4789D-02/ + +!..fetching pdfs + DO 5 IP=-6,6 + XPDF(IP)=ZEROD + 5 END DO + DO 2 I=1,IX + ENT(I)=LOG10(XT(I)) + 2 END DO + NA(1)=IX + NA(2)=IQ + DO 3 I=1,IQ + ENT(IX+I)=LOG10(Q2T(I)) + 3 END DO + ARG(1)=LOG10(X) + ARG(2)=LOG10(Q2) +!..VARIOUS FLAVOURS (u-->2,d-->1) + XPDF(0)=DBFINT(NARG,ARG,NA,ENT,XPV(1,1,0)) + XPDF(1)=DBFINT(NARG,ARG,NA,ENT,XPV(1,1,2)) + XPDF(2)=DBFINT(NARG,ARG,NA,ENT,XPV(1,1,1)) + XPDF(3)=DBFINT(NARG,ARG,NA,ENT,XPV(1,1,3)) + XPDF(4)=DBFINT(NARG,ARG,NA,ENT,XPV(1,1,4)) + DO 21 JF=1,4 + XPDF(-JF)=XPDF(JF) + 21 END DO + RETURN + END +!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + SUBROUTINE PHGAL(X,Q2,XPDF) + implicit real*8 (a-h,o-z) + PARAMETER(IX=100,IQ=7,NARG=2,NFUN=4) + double precision & + & DBFINT, & + & XT(IX),Q2T(IQ),ARG(NARG),ENT(IX+IQ), & + & XPV(IX,IQ,0:NFUN),XPDF(-6:6) + DIMENSION NA(NARG) + DATA ZEROD/0.D0/ +!...100 x values; in (D-4,.77) log spaced (78 points) +!... in (.78,.995) lineary spaced (22 points) + DATA Q2T/4.D0,10.D0,50.D0,1.D2,1.D3,1.D4,1.D5/ + DATA XT/ & + &0.1000D-03,0.1123D-03,0.1262D-03,0.1417D-03,0.1592D-03,0.1789D-03,& + &0.2009D-03,0.2257D-03,0.2535D-03,0.2848D-03,0.3199D-03,0.3593D-03,& + &0.4037D-03,0.4534D-03,0.5093D-03,0.5722D-03,0.6427D-03,0.7220D-03,& + &0.8110D-03,0.9110D-03,0.1023D-02,0.1150D-02,0.1291D-02,0.1451D-02,& + &0.1629D-02,0.1830D-02,0.2056D-02,0.2310D-02,0.2594D-02,0.2914D-02,& + &0.3274D-02,0.3677D-02,0.4131D-02,0.4640D-02,0.5212D-02,0.5855D-02,& + &0.6577D-02,0.7388D-02,0.8299D-02,0.9323D-02,0.1047D-01,0.1176D-01,& + &0.1321D-01,0.1484D-01,0.1667D-01,0.1873D-01,0.2104D-01,0.2363D-01,& + &0.2655D-01,0.2982D-01,0.3350D-01,0.3763D-01,0.4227D-01,0.4748D-01,& + &0.5334D-01,0.5992D-01,0.6731D-01,0.7560D-01,0.8493D-01,0.9540D-01,& + &0.1072D+00,0.1204D+00,0.1352D+00,0.1519D+00,0.1706D+00,0.1917D+00,& + &0.2153D+00,0.2419D+00,0.2717D+00,0.3052D+00,0.3428D+00,0.3851D+00,& + &0.4326D+00,0.4859D+00,0.5458D+00,0.6131D+00,0.6887D+00,0.7737D+00,& + &0.7837D+00,0.7937D+00,0.8037D+00,0.8137D+00,0.8237D+00,0.8337D+00,& + &0.8437D+00,0.8537D+00,0.8637D+00,0.8737D+00,0.8837D+00,0.8937D+00,& + &0.9037D+00,0.9137D+00,0.9237D+00,0.9337D+00,0.9437D+00,0.9537D+00,& + &0.9637D+00,0.9737D+00,0.9837D+00,0.9937D+00/ + +!...place for DATA blocks + DATA (XPV(I,1,0),I=1,100)/ & + &0.6632D-01,0.6536D-01,0.6390D-01,0.6196D-01,0.5952D-01,0.5663D-01,& + &0.5339D-01,0.5124D-01,0.5029D-01,0.4893D-01,0.4718D-01,0.4505D-01,& + &0.4259D-01,0.4038D-01,0.3966D-01,0.3860D-01,0.3721D-01,0.3551D-01,& + &0.3354D-01,0.3206D-01,0.3134D-01,0.3031D-01,0.2902D-01,0.2747D-01,& + &0.2608D-01,0.2543D-01,0.2451D-01,0.2335D-01,0.2202D-01,0.2132D-01,& + &0.2051D-01,0.1950D-01,0.1851D-01,0.1783D-01,0.1696D-01,0.1609D-01,& + &0.1539D-01,0.1454D-01,0.1386D-01,0.1310D-01,0.1242D-01,0.1169D-01,& + &0.1104D-01,0.1036D-01,0.9694D-02,0.9046D-02,0.8400D-02,0.7792D-02,& + &0.7173D-02,0.6573D-02,0.5978D-02,0.5411D-02,0.4853D-02,0.4307D-02,& + &0.3791D-02,0.3292D-02,0.2818D-02,0.2382D-02,0.1976D-02,0.1606D-02,& + &0.1275D-02,0.9866D-03,0.7403D-03,0.5351D-03,0.3713D-03,0.2450D-03,& + &0.1524D-03,0.8849D-04,0.4730D-04,0.2278D-04,0.9707D-05,0.3518D-05,& + &0.1041D-05,0.2356D-06,0.3682D-07,0.3365D-08,0.1333D-09,0.1188D-11,& + &0.6095D-12,0.3031D-12,0.1457D-12,0.6733D-13,0.2986D-13,0.1262D-13,& + &0.5060D-14,0.1912D-14,0.6734D-15,0.2199D-15,0.6498D-16,0.1729D-16,& + &0.4059D-17,0.8091D-18,0.1324D-18,0.1691D-19,0.1518D-20,0.8785D-22,& + &0.2519D-23,0.2197D-25,0.2840D-28,0.1908D-33/ + DATA (XPV(I,1,1),I=1,100)/ & + &0.5848D-03,0.5838D-03,0.5793D-03,0.5713D-03,0.5597D-03,0.5447D-03,& + &0.5270D-03,0.5167D-03,0.5143D-03,0.5087D-03,0.4998D-03,0.4879D-03,& + &0.4731D-03,0.4599D-03,0.4584D-03,0.4538D-03,0.4461D-03,0.4355D-03,& + &0.4223D-03,0.4133D-03,0.4109D-03,0.4053D-03,0.3970D-03,0.3859D-03,& + &0.3763D-03,0.3739D-03,0.3686D-03,0.3605D-03,0.3504D-03,0.3473D-03,& + &0.3426D-03,0.3355D-03,0.3286D-03,0.3253D-03,0.3196D-03,0.3138D-03,& + &0.3102D-03,0.3047D-03,0.3014D-03,0.2971D-03,0.2939D-03,0.2901D-03,& + &0.2875D-03,0.2849D-03,0.2824D-03,0.2805D-03,0.2787D-03,0.2780D-03,& + &0.2772D-03,0.2771D-03,0.2773D-03,0.2784D-03,0.2799D-03,0.2820D-03,& + &0.2850D-03,0.2886D-03,0.2930D-03,0.2985D-03,0.3050D-03,0.3126D-03,& + &0.3215D-03,0.3316D-03,0.3432D-03,0.3564D-03,0.3714D-03,0.3883D-03,& + &0.4073D-03,0.4287D-03,0.4526D-03,0.4794D-03,0.5092D-03,0.5425D-03,& + &0.5796D-03,0.6207D-03,0.6664D-03,0.7171D-03,0.7733D-03,0.8356D-03,& + &0.8429D-03,0.8502D-03,0.8574D-03,0.8647D-03,0.8719D-03,0.8791D-03,& + &0.8863D-03,0.8935D-03,0.9007D-03,0.9079D-03,0.9151D-03,0.9222D-03,& + &0.9294D-03,0.9365D-03,0.9436D-03,0.9508D-03,0.9579D-03,0.9650D-03,& + &0.9720D-03,0.9791D-03,0.9862D-03,0.9932D-03/ + DATA (XPV(I,1,2),I=1,100)/ & + &0.2339D-02,0.2335D-02,0.2317D-02,0.2285D-02,0.2239D-02,0.2179D-02,& + &0.2108D-02,0.2067D-02,0.2057D-02,0.2035D-02,0.1999D-02,0.1951D-02,& + &0.1892D-02,0.1840D-02,0.1833D-02,0.1815D-02,0.1784D-02,0.1742D-02,& + &0.1689D-02,0.1653D-02,0.1643D-02,0.1621D-02,0.1588D-02,0.1544D-02,& + &0.1505D-02,0.1496D-02,0.1474D-02,0.1442D-02,0.1402D-02,0.1389D-02,& + &0.1370D-02,0.1342D-02,0.1314D-02,0.1301D-02,0.1278D-02,0.1255D-02,& + &0.1241D-02,0.1219D-02,0.1205D-02,0.1188D-02,0.1176D-02,0.1160D-02,& + &0.1150D-02,0.1139D-02,0.1130D-02,0.1122D-02,0.1115D-02,0.1112D-02,& + &0.1109D-02,0.1108D-02,0.1109D-02,0.1114D-02,0.1120D-02,0.1128D-02,& + &0.1140D-02,0.1154D-02,0.1172D-02,0.1194D-02,0.1220D-02,0.1251D-02,& + &0.1286D-02,0.1326D-02,0.1373D-02,0.1426D-02,0.1485D-02,0.1553D-02,& + &0.1629D-02,0.1715D-02,0.1811D-02,0.1917D-02,0.2037D-02,0.2170D-02,& + &0.2318D-02,0.2483D-02,0.2666D-02,0.2868D-02,0.3093D-02,0.3342D-02,& + &0.3372D-02,0.3401D-02,0.3430D-02,0.3459D-02,0.3488D-02,0.3517D-02,& + &0.3545D-02,0.3574D-02,0.3603D-02,0.3632D-02,0.3660D-02,0.3689D-02,& + &0.3717D-02,0.3746D-02,0.3775D-02,0.3803D-02,0.3831D-02,0.3860D-02,& + &0.3888D-02,0.3916D-02,0.3945D-02,0.3973D-02/ + DATA (XPV(I,1,3),I=1,100)/ & + &0.1755D-03,0.1751D-03,0.1738D-03,0.1714D-03,0.1679D-03,0.1634D-03,& + &0.1581D-03,0.1550D-03,0.1543D-03,0.1526D-03,0.1499D-03,0.1464D-03,& + &0.1419D-03,0.1380D-03,0.1375D-03,0.1361D-03,0.1338D-03,0.1306D-03,& + &0.1267D-03,0.1240D-03,0.1233D-03,0.1216D-03,0.1191D-03,0.1158D-03,& + &0.1129D-03,0.1122D-03,0.1106D-03,0.1082D-03,0.1051D-03,0.1042D-03,& + &0.1028D-03,0.1006D-03,0.9857D-04,0.9759D-04,0.9587D-04,0.9414D-04,& + &0.9305D-04,0.9140D-04,0.9041D-04,0.8912D-04,0.8817D-04,0.8702D-04,& + &0.8626D-04,0.8546D-04,0.8472D-04,0.8415D-04,0.8362D-04,0.8339D-04,& + &0.8317D-04,0.8312D-04,0.8318D-04,0.8352D-04,0.8398D-04,0.8459D-04,& + &0.8550D-04,0.8658D-04,0.8789D-04,0.8956D-04,0.9151D-04,0.9379D-04,& + &0.9644D-04,0.9948D-04,0.1030D-03,0.1069D-03,0.1114D-03,0.1165D-03,& + &0.1222D-03,0.1286D-03,0.1358D-03,0.1438D-03,0.1528D-03,0.1628D-03,& + &0.1739D-03,0.1862D-03,0.1999D-03,0.2151D-03,0.2320D-03,0.2507D-03,& + &0.2529D-03,0.2551D-03,0.2572D-03,0.2594D-03,0.2616D-03,0.2637D-03,& + &0.2659D-03,0.2681D-03,0.2702D-03,0.2724D-03,0.2745D-03,0.2767D-03,& + &0.2788D-03,0.2810D-03,0.2831D-03,0.2852D-03,0.2874D-03,0.2895D-03,& + &0.2916D-03,0.2937D-03,0.2959D-03,0.2980D-03/ + DATA (XPV(I,1,4),I=1,100)/ & + &0.7018D-03,0.7006D-03,0.6951D-03,0.6855D-03,0.6716D-03,0.6537D-03,& + &0.6324D-03,0.6200D-03,0.6172D-03,0.6104D-03,0.5998D-03,0.5854D-03,& + &0.5677D-03,0.5519D-03,0.5500D-03,0.5445D-03,0.5353D-03,0.5226D-03,& + &0.5068D-03,0.4960D-03,0.4930D-03,0.4864D-03,0.4764D-03,0.4631D-03,& + &0.4516D-03,0.4487D-03,0.4423D-03,0.4326D-03,0.4205D-03,0.4167D-03,& + &0.4111D-03,0.4026D-03,0.3943D-03,0.3903D-03,0.3835D-03,0.3765D-03,& + &0.3722D-03,0.3656D-03,0.3616D-03,0.3565D-03,0.3527D-03,0.3481D-03,& + &0.3450D-03,0.3418D-03,0.3389D-03,0.3366D-03,0.3345D-03,0.3336D-03,& + &0.3327D-03,0.3325D-03,0.3327D-03,0.3341D-03,0.3359D-03,0.3383D-03,& + &0.3420D-03,0.3463D-03,0.3516D-03,0.3582D-03,0.3660D-03,0.3752D-03,& + &0.3858D-03,0.3979D-03,0.4118D-03,0.4277D-03,0.4456D-03,0.4660D-03,& + &0.4887D-03,0.5145D-03,0.5432D-03,0.5752D-03,0.6111D-03,0.6510D-03,& + &0.6955D-03,0.7448D-03,0.7997D-03,0.8605D-03,0.9280D-03,0.1003D-02,& + &0.1011D-02,0.1020D-02,0.1029D-02,0.1038D-02,0.1046D-02,0.1055D-02,& + &0.1064D-02,0.1072D-02,0.1081D-02,0.1089D-02,0.1098D-02,0.1107D-02,& + &0.1115D-02,0.1124D-02,0.1132D-02,0.1141D-02,0.1149D-02,0.1158D-02,& + &0.1166D-02,0.1175D-02,0.1183D-02,0.1192D-02/ + DATA (XPV(I,2,0),I=1,100)/ & + &0.1024D+00,0.1007D+00,0.9821D-01,0.9497D-01,0.9093D-01,0.8617D-01,& + &0.8086D-01,0.7731D-01,0.7566D-01,0.7338D-01,0.7048D-01,0.6700D-01,& + &0.6300D-01,0.5939D-01,0.5814D-01,0.5638D-01,0.5410D-01,0.5135D-01,& + &0.4819D-01,0.4580D-01,0.4460D-01,0.4293D-01,0.4087D-01,0.3843D-01,& + &0.3624D-01,0.3517D-01,0.3372D-01,0.3192D-01,0.2988D-01,0.2879D-01,& + &0.2755D-01,0.2602D-01,0.2454D-01,0.2352D-01,0.2224D-01,0.2097D-01,& + &0.1995D-01,0.1875D-01,0.1779D-01,0.1673D-01,0.1580D-01,0.1480D-01,& + &0.1393D-01,0.1305D-01,0.1218D-01,0.1136D-01,0.1055D-01,0.9801D-02,& + &0.9052D-02,0.8337D-02,0.7641D-02,0.6989D-02,0.6357D-02,0.5747D-02,& + &0.5179D-02,0.4637D-02,0.4127D-02,0.3663D-02,0.3232D-02,0.2840D-02,& + &0.2487D-02,0.2174D-02,0.1901D-02,0.1662D-02,0.1459D-02,0.1285D-02,& + &0.1137D-02,0.1010D-02,0.9006D-03,0.8023D-03,0.7126D-03,0.6276D-03,& + &0.5458D-03,0.4661D-03,0.3876D-03,0.3101D-03,0.2334D-03,0.1570D-03,& + &0.1486D-03,0.1404D-03,0.1322D-03,0.1242D-03,0.1162D-03,0.1084D-03,& + &0.1007D-03,0.9304D-04,0.8554D-04,0.7817D-04,0.7086D-04,0.6372D-04,& + &0.5670D-04,0.4982D-04,0.4307D-04,0.3647D-04,0.3005D-04,0.2382D-04,& + &0.1781D-04,0.1208D-04,0.6720D-05,0.1928D-05/ + DATA (XPV(I,2,1),I=1,100)/ & + &0.1449D-02,0.1433D-02,0.1407D-02,0.1370D-02,0.1324D-02,0.1268D-02,& + &0.1204D-02,0.1163D-02,0.1147D-02,0.1123D-02,0.1089D-02,0.1048D-02,& + &0.1000D-02,0.9567D-03,0.9446D-03,0.9250D-03,0.8981D-03,0.8642D-03,& + &0.8244D-03,0.7951D-03,0.7821D-03,0.7623D-03,0.7362D-03,0.7043D-03,& + &0.6759D-03,0.6640D-03,0.6459D-03,0.6223D-03,0.5945D-03,0.5817D-03,& + &0.5660D-03,0.5455D-03,0.5256D-03,0.5132D-03,0.4963D-03,0.4794D-03,& + &0.4669D-03,0.4510D-03,0.4394D-03,0.4261D-03,0.4151D-03,0.4031D-03,& + &0.3934D-03,0.3838D-03,0.3747D-03,0.3666D-03,0.3591D-03,0.3533D-03,& + &0.3477D-03,0.3433D-03,0.3397D-03,0.3376D-03,0.3364D-03,0.3361D-03,& + &0.3375D-03,0.3399D-03,0.3437D-03,0.3492D-03,0.3562D-03,0.3648D-03,& + &0.3751D-03,0.3871D-03,0.4009D-03,0.4167D-03,0.4344D-03,0.4543D-03,& + &0.4760D-03,0.5003D-03,0.5268D-03,0.5558D-03,0.5876D-03,0.6226D-03,& + &0.6610D-03,0.7035D-03,0.7509D-03,0.8041D-03,0.8638D-03,0.9294D-03,& + &0.9367D-03,0.9440D-03,0.9511D-03,0.9581D-03,0.9648D-03,0.9714D-03,& + &0.9776D-03,0.9836D-03,0.9891D-03,0.9942D-03,0.9987D-03,0.1003D-02,& + &0.1006D-02,0.1008D-02,0.1008D-02,0.1007D-02,0.1004D-02,0.9977D-03,& + &0.9868D-03,0.9681D-03,0.9347D-03,0.8678D-03/ + DATA (XPV(I,2,2),I=1,100)/ & + &0.3175D-02,0.3156D-02,0.3117D-02,0.3057D-02,0.2976D-02,0.2876D-02,& + &0.2760D-02,0.2689D-02,0.2666D-02,0.2625D-02,0.2566D-02,0.2489D-02,& + &0.2398D-02,0.2316D-02,0.2299D-02,0.2266D-02,0.2217D-02,0.2152D-02,& + &0.2073D-02,0.2018D-02,0.1998D-02,0.1962D-02,0.1911D-02,0.1847D-02,& + &0.1791D-02,0.1773D-02,0.1739D-02,0.1692D-02,0.1636D-02,0.1614D-02,& + &0.1586D-02,0.1545D-02,0.1506D-02,0.1485D-02,0.1452D-02,0.1420D-02,& + &0.1398D-02,0.1368D-02,0.1348D-02,0.1324D-02,0.1306D-02,0.1285D-02,& + &0.1271D-02,0.1256D-02,0.1243D-02,0.1233D-02,0.1224D-02,0.1220D-02,& + &0.1217D-02,0.1217D-02,0.1220D-02,0.1227D-02,0.1237D-02,0.1249D-02,& + &0.1267D-02,0.1288D-02,0.1313D-02,0.1345D-02,0.1381D-02,0.1422D-02,& + &0.1469D-02,0.1522D-02,0.1582D-02,0.1648D-02,0.1722D-02,0.1804D-02,& + &0.1893D-02,0.1992D-02,0.2099D-02,0.2216D-02,0.2345D-02,0.2486D-02,& + &0.2641D-02,0.2812D-02,0.3002D-02,0.3216D-02,0.3455D-02,0.3718D-02,& + &0.3748D-02,0.3777D-02,0.3806D-02,0.3833D-02,0.3861D-02,0.3887D-02,& + &0.3912D-02,0.3936D-02,0.3958D-02,0.3978D-02,0.3996D-02,0.4012D-02,& + &0.4024D-02,0.4032D-02,0.4035D-02,0.4031D-02,0.4018D-02,0.3993D-02,& + &0.3949D-02,0.3875D-02,0.3741D-02,0.3474D-02/ + DATA (XPV(I,2,3),I=1,100)/ & + &0.1046D-02,0.1031D-02,0.1008D-02,0.9768D-03,0.9381D-03,0.8923D-03,& + &0.8410D-03,0.8074D-03,0.7928D-03,0.7720D-03,0.7450D-03,0.7121D-03,& + &0.6741D-03,0.6398D-03,0.6287D-03,0.6123D-03,0.5906D-03,0.5640D-03,& + &0.5332D-03,0.5101D-03,0.4988D-03,0.4827D-03,0.4624D-03,0.4380D-03,& + &0.4161D-03,0.4059D-03,0.3914D-03,0.3732D-03,0.3524D-03,0.3416D-03,& + &0.3290D-03,0.3133D-03,0.2981D-03,0.2878D-03,0.2747D-03,0.2616D-03,& + &0.2515D-03,0.2392D-03,0.2296D-03,0.2191D-03,0.2100D-03,0.2004D-03,& + &0.1923D-03,0.1842D-03,0.1764D-03,0.1694D-03,0.1627D-03,0.1571D-03,& + &0.1517D-03,0.1469D-03,0.1427D-03,0.1394D-03,0.1367D-03,0.1345D-03,& + &0.1333D-03,0.1327D-03,0.1329D-03,0.1340D-03,0.1360D-03,0.1387D-03,& + &0.1424D-03,0.1469D-03,0.1522D-03,0.1584D-03,0.1654D-03,0.1733D-03,& + &0.1819D-03,0.1915D-03,0.2019D-03,0.2132D-03,0.2257D-03,0.2396D-03,& + &0.2553D-03,0.2737D-03,0.2956D-03,0.3227D-03,0.3570D-03,0.4009D-03,& + &0.4064D-03,0.4119D-03,0.4175D-03,0.4231D-03,0.4287D-03,0.4344D-03,& + &0.4400D-03,0.4457D-03,0.4512D-03,0.4567D-03,0.4621D-03,0.4673D-03,& + &0.4723D-03,0.4769D-03,0.4811D-03,0.4848D-03,0.4875D-03,0.4891D-03,& + &0.4888D-03,0.4853D-03,0.4756D-03,0.4518D-03/ + DATA (XPV(I,2,4),I=1,100)/ & + &0.1564D-02,0.1548D-02,0.1521D-02,0.1483D-02,0.1434D-02,0.1375D-02,& + &0.1308D-02,0.1265D-02,0.1249D-02,0.1223D-02,0.1188D-02,0.1145D-02,& + &0.1094D-02,0.1048D-02,0.1035D-02,0.1015D-02,0.9868D-03,0.9509D-03,& + &0.9086D-03,0.8776D-03,0.8644D-03,0.8436D-03,0.8161D-03,0.7822D-03,& + &0.7521D-03,0.7400D-03,0.7212D-03,0.6963D-03,0.6669D-03,0.6538D-03,& + &0.6377D-03,0.6163D-03,0.5956D-03,0.5832D-03,0.5658D-03,0.5486D-03,& + &0.5363D-03,0.5203D-03,0.5091D-03,0.4962D-03,0.4859D-03,0.4746D-03,& + &0.4661D-03,0.4578D-03,0.4502D-03,0.4441D-03,0.4387D-03,0.4355D-03,& + &0.4329D-03,0.4318D-03,0.4320D-03,0.4342D-03,0.4379D-03,0.4429D-03,& + &0.4503D-03,0.4594D-03,0.4704D-03,0.4839D-03,0.4996D-03,0.5177D-03,& + &0.5383D-03,0.5613D-03,0.5869D-03,0.6152D-03,0.6462D-03,0.6802D-03,& + &0.7167D-03,0.7565D-03,0.7995D-03,0.8461D-03,0.8972D-03,0.9538D-03,& + &0.1018D-02,0.1092D-02,0.1181D-02,0.1290D-02,0.1428D-02,0.1604D-02,& + &0.1626D-02,0.1649D-02,0.1671D-02,0.1694D-02,0.1716D-02,0.1739D-02,& + &0.1762D-02,0.1784D-02,0.1806D-02,0.1828D-02,0.1850D-02,0.1871D-02,& + &0.1891D-02,0.1909D-02,0.1926D-02,0.1941D-02,0.1952D-02,0.1958D-02,& + &0.1957D-02,0.1943D-02,0.1905D-02,0.1811D-02/ + DATA (XPV(I,3,0),I=1,100)/ & + &0.1761D+00,0.1728D+00,0.1680D+00,0.1619D+00,0.1544D+00,0.1456D+00,& + &0.1358D+00,0.1292D+00,0.1260D+00,0.1218D+00,0.1165D+00,0.1101D+00,& + &0.1029D+00,0.9643D-01,0.9409D-01,0.9087D-01,0.8680D-01,0.8192D-01,& + &0.7638D-01,0.7217D-01,0.7000D-01,0.6708D-01,0.6352D-01,0.5934D-01,& + &0.5561D-01,0.5375D-01,0.5129D-01,0.4829D-01,0.4491D-01,0.4309D-01,& + &0.4104D-01,0.3857D-01,0.3618D-01,0.3454D-01,0.3252D-01,0.3053D-01,& + &0.2896D-01,0.2712D-01,0.2565D-01,0.2407D-01,0.2268D-01,0.2123D-01,& + &0.1997D-01,0.1870D-01,0.1748D-01,0.1634D-01,0.1523D-01,0.1422D-01,& + &0.1321D-01,0.1227D-01,0.1137D-01,0.1053D-01,0.9723D-02,0.8952D-02,& + &0.8241D-02,0.7563D-02,0.6926D-02,0.6345D-02,0.5801D-02,0.5298D-02,& + &0.4833D-02,0.4407D-02,0.4017D-02,0.3657D-02,0.3327D-02,0.3021D-02,& + &0.2735D-02,0.2469D-02,0.2217D-02,0.1976D-02,0.1746D-02,0.1522D-02,& + &0.1307D-02,0.1098D-02,0.8959D-03,0.7002D-03,0.5112D-03,0.3292D-03,& + &0.3097D-03,0.2906D-03,0.2718D-03,0.2534D-03,0.2354D-03,0.2178D-03,& + &0.2005D-03,0.1836D-03,0.1672D-03,0.1511D-03,0.1354D-03,0.1203D-03,& + &0.1055D-03,0.9128D-04,0.7756D-04,0.6440D-04,0.5185D-04,0.3998D-04,& + &0.2891D-04,0.1876D-04,0.9776D-05,0.2464D-05/ + DATA (XPV(I,3,1),I=1,100)/ & + &0.3351D-02,0.3297D-02,0.3217D-02,0.3112D-02,0.2981D-02,0.2828D-02,& + &0.2656D-02,0.2543D-02,0.2493D-02,0.2422D-02,0.2332D-02,0.2223D-02,& + &0.2097D-02,0.1984D-02,0.1946D-02,0.1892D-02,0.1821D-02,0.1734D-02,& + &0.1635D-02,0.1560D-02,0.1523D-02,0.1471D-02,0.1406D-02,0.1329D-02,& + &0.1260D-02,0.1228D-02,0.1182D-02,0.1126D-02,0.1061D-02,0.1028D-02,& + &0.9902D-03,0.9426D-03,0.8967D-03,0.8664D-03,0.8274D-03,0.7890D-03,& + &0.7596D-03,0.7240D-03,0.6969D-03,0.6671D-03,0.6417D-03,0.6149D-03,& + &0.5928D-03,0.5708D-03,0.5502D-03,0.5317D-03,0.5144D-03,0.5002D-03,& + &0.4867D-03,0.4753D-03,0.4655D-03,0.4582D-03,0.4526D-03,0.4487D-03,& + &0.4475D-03,0.4480D-03,0.4506D-03,0.4559D-03,0.4632D-03,0.4729D-03,& + &0.4849D-03,0.4991D-03,0.5155D-03,0.5343D-03,0.5552D-03,0.5783D-03,& + &0.6033D-03,0.6307D-03,0.6600D-03,0.6915D-03,0.7256D-03,0.7626D-03,& + &0.8031D-03,0.8482D-03,0.8993D-03,0.9582D-03,0.1026D-02,0.1099D-02,& + &0.1107D-02,0.1115D-02,0.1122D-02,0.1129D-02,0.1136D-02,0.1142D-02,& + &0.1148D-02,0.1152D-02,0.1156D-02,0.1159D-02,0.1161D-02,0.1161D-02,& + &0.1160D-02,0.1156D-02,0.1150D-02,0.1141D-02,0.1127D-02,0.1107D-02,& + &0.1078D-02,0.1036D-02,0.9685D-03,0.8413D-03/ + DATA (XPV(I,3,2),I=1,100)/ & + &0.5039D-02,0.4982D-02,0.4889D-02,0.4761D-02,0.4597D-02,0.4401D-02,& + &0.4179D-02,0.4036D-02,0.3979D-02,0.3893D-02,0.3777D-02,0.3634D-02,& + &0.3466D-02,0.3315D-02,0.3273D-02,0.3206D-02,0.3114D-02,0.2997D-02,& + &0.2860D-02,0.2760D-02,0.2717D-02,0.2650D-02,0.2562D-02,0.2454D-02,& + &0.2359D-02,0.2321D-02,0.2262D-02,0.2184D-02,0.2092D-02,0.2052D-02,& + &0.2003D-02,0.1938D-02,0.1875D-02,0.1839D-02,0.1787D-02,0.1736D-02,& + &0.1700D-02,0.1653D-02,0.1622D-02,0.1585D-02,0.1557D-02,0.1526D-02,& + &0.1504D-02,0.1483D-02,0.1464D-02,0.1450D-02,0.1438D-02,0.1433D-02,& + &0.1430D-02,0.1432D-02,0.1438D-02,0.1450D-02,0.1466D-02,0.1487D-02,& + &0.1515D-02,0.1547D-02,0.1585D-02,0.1631D-02,0.1683D-02,0.1742D-02,& + &0.1808D-02,0.1880D-02,0.1960D-02,0.2048D-02,0.2142D-02,0.2245D-02,& + &0.2354D-02,0.2471D-02,0.2596D-02,0.2729D-02,0.2872D-02,0.3025D-02,& + &0.3193D-02,0.3378D-02,0.3587D-02,0.3827D-02,0.4100D-02,0.4397D-02,& + &0.4429D-02,0.4461D-02,0.4490D-02,0.4519D-02,0.4545D-02,0.4570D-02,& + &0.4592D-02,0.4611D-02,0.4627D-02,0.4639D-02,0.4646D-02,0.4647D-02,& + &0.4642D-02,0.4628D-02,0.4604D-02,0.4566D-02,0.4510D-02,0.4431D-02,& + &0.4317D-02,0.4147D-02,0.3877D-02,0.3370D-02/ + DATA (XPV(I,3,3),I=1,100)/ & + &0.2958D-02,0.2904D-02,0.2827D-02,0.2727D-02,0.2604D-02,0.2461D-02,& + &0.2301D-02,0.2195D-02,0.2146D-02,0.2079D-02,0.1995D-02,0.1894D-02,& + &0.1778D-02,0.1674D-02,0.1637D-02,0.1586D-02,0.1520D-02,0.1440D-02,& + &0.1349D-02,0.1280D-02,0.1245D-02,0.1197D-02,0.1138D-02,0.1068D-02,& + &0.1005D-02,0.9742D-03,0.9325D-03,0.8812D-03,0.8233D-03,0.7922D-03,& + &0.7568D-03,0.7138D-03,0.6722D-03,0.6438D-03,0.6084D-03,0.5735D-03,& + &0.5460D-03,0.5138D-03,0.4883D-03,0.4609D-03,0.4371D-03,0.4123D-03,& + &0.3912D-03,0.3704D-03,0.3507D-03,0.3327D-03,0.3158D-03,0.3012D-03,& + &0.2873D-03,0.2751D-03,0.2641D-03,0.2551D-03,0.2474D-03,0.2410D-03,& + &0.2365D-03,0.2334D-03,0.2318D-03,0.2321D-03,0.2339D-03,0.2372D-03,& + &0.2421D-03,0.2485D-03,0.2562D-03,0.2652D-03,0.2755D-03,0.2870D-03,& + &0.2995D-03,0.3131D-03,0.3278D-03,0.3438D-03,0.3615D-03,0.3814D-03,& + &0.4046D-03,0.4328D-03,0.4682D-03,0.5142D-03,0.5747D-03,0.6529D-03,& + &0.6625D-03,0.6722D-03,0.6819D-03,0.6916D-03,0.7012D-03,0.7107D-03,& + &0.7200D-03,0.7292D-03,0.7380D-03,0.7464D-03,0.7544D-03,0.7617D-03,& + &0.7681D-03,0.7735D-03,0.7776D-03,0.7798D-03,0.7796D-03,0.7761D-03,& + &0.7676D-03,0.7510D-03,0.7195D-03,0.6522D-03/ + DATA (XPV(I,3,4),I=1,100)/ & + &0.3464D-02,0.3410D-02,0.3329D-02,0.3222D-02,0.3090D-02,0.2933D-02,& + &0.2758D-02,0.2643D-02,0.2593D-02,0.2521D-02,0.2430D-02,0.2318D-02,& + &0.2190D-02,0.2075D-02,0.2037D-02,0.1982D-02,0.1910D-02,0.1821D-02,& + &0.1720D-02,0.1643D-02,0.1607D-02,0.1554D-02,0.1489D-02,0.1410D-02,& + &0.1340D-02,0.1308D-02,0.1262D-02,0.1205D-02,0.1140D-02,0.1108D-02,& + &0.1070D-02,0.1023D-02,0.9772D-03,0.9482D-03,0.9103D-03,0.8732D-03,& + &0.8458D-03,0.8121D-03,0.7877D-03,0.7607D-03,0.7388D-03,0.7157D-03,& + &0.6981D-03,0.6812D-03,0.6662D-03,0.6540D-03,0.6438D-03,0.6377D-03,& + &0.6331D-03,0.6316D-03,0.6326D-03,0.6376D-03,0.6453D-03,0.6560D-03,& + &0.6708D-03,0.6887D-03,0.7102D-03,0.7361D-03,0.7656D-03,0.7991D-03,& + &0.8365D-03,0.8777D-03,0.9226D-03,0.9714D-03,0.1024D-02,0.1080D-02,& + &0.1138D-02,0.1201D-02,0.1267D-02,0.1338D-02,0.1415D-02,0.1501D-02,& + &0.1599D-02,0.1717D-02,0.1863D-02,0.2051D-02,0.2296D-02,0.2612D-02,& + &0.2650D-02,0.2689D-02,0.2729D-02,0.2767D-02,0.2806D-02,0.2844D-02,& + &0.2882D-02,0.2919D-02,0.2954D-02,0.2988D-02,0.3020D-02,0.3049D-02,& + &0.3075D-02,0.3097D-02,0.3114D-02,0.3123D-02,0.3122D-02,0.3108D-02,& + &0.3074D-02,0.3008D-02,0.2881D-02,0.2614D-02/ + DATA (XPV(I,4,0),I=1,100)/ & + &0.2113D+00,0.2071D+00,0.2012D+00,0.1936D+00,0.1844D+00,0.1736D+00,& + &0.1616D+00,0.1536D+00,0.1497D+00,0.1445D+00,0.1380D+00,0.1303D+00,& + &0.1215D+00,0.1136D+00,0.1108D+00,0.1069D+00,0.1019D+00,0.9605D-01,& + &0.8939D-01,0.8432D-01,0.8171D-01,0.7821D-01,0.7395D-01,0.6897D-01,& + &0.6452D-01,0.6231D-01,0.5938D-01,0.5583D-01,0.5185D-01,0.4969D-01,& + &0.4728D-01,0.4438D-01,0.4158D-01,0.3967D-01,0.3731D-01,0.3500D-01,& + &0.3318D-01,0.3105D-01,0.2936D-01,0.2754D-01,0.2595D-01,0.2429D-01,& + &0.2285D-01,0.2141D-01,0.2003D-01,0.1874D-01,0.1749D-01,0.1635D-01,& + &0.1523D-01,0.1418D-01,0.1317D-01,0.1223D-01,0.1134D-01,0.1048D-01,& + &0.9692D-02,0.8938D-02,0.8227D-02,0.7578D-02,0.6967D-02,0.6398D-02,& + &0.5867D-02,0.5377D-02,0.4922D-02,0.4497D-02,0.4101D-02,0.3730D-02,& + &0.3379D-02,0.3048D-02,0.2732D-02,0.2429D-02,0.2139D-02,0.1858D-02,& + &0.1588D-02,0.1328D-02,0.1077D-02,0.8361D-03,0.6052D-03,0.3850D-03,& + &0.3616D-03,0.3387D-03,0.3162D-03,0.2943D-03,0.2728D-03,0.2518D-03,& + &0.2314D-03,0.2114D-03,0.1919D-03,0.1731D-03,0.1546D-03,0.1369D-03,& + &0.1197D-03,0.1032D-03,0.8729D-04,0.7214D-04,0.5778D-04,0.4429D-04,& + &0.3179D-04,0.2044D-04,0.1053D-04,0.2601D-05/ + DATA (XPV(I,4,1),I=1,100)/ & + &0.4299D-02,0.4223D-02,0.4115D-02,0.3974D-02,0.3799D-02,0.3595D-02,& + &0.3367D-02,0.3216D-02,0.3148D-02,0.3054D-02,0.2934D-02,0.2790D-02,& + &0.2625D-02,0.2476D-02,0.2426D-02,0.2353D-02,0.2260D-02,0.2147D-02,& + &0.2018D-02,0.1920D-02,0.1871D-02,0.1804D-02,0.1720D-02,0.1620D-02,& + &0.1532D-02,0.1489D-02,0.1431D-02,0.1359D-02,0.1277D-02,0.1234D-02,& + &0.1185D-02,0.1125D-02,0.1067D-02,0.1028D-02,0.9791D-03,0.9308D-03,& + &0.8936D-03,0.8491D-03,0.8150D-03,0.7777D-03,0.7459D-03,0.7125D-03,& + &0.6849D-03,0.6575D-03,0.6318D-03,0.6088D-03,0.5872D-03,0.5693D-03,& + &0.5524D-03,0.5380D-03,0.5254D-03,0.5159D-03,0.5084D-03,0.5028D-03,& + &0.5003D-03,0.4998D-03,0.5017D-03,0.5066D-03,0.5139D-03,0.5237D-03,& + &0.5360D-03,0.5508D-03,0.5679D-03,0.5875D-03,0.6093D-03,0.6334D-03,& + &0.6593D-03,0.6876D-03,0.7177D-03,0.7500D-03,0.7848D-03,0.8225D-03,& + &0.8639D-03,0.9103D-03,0.9634D-03,0.1025D-02,0.1097D-02,0.1174D-02,& + &0.1183D-02,0.1191D-02,0.1199D-02,0.1206D-02,0.1212D-02,0.1219D-02,& + &0.1224D-02,0.1229D-02,0.1232D-02,0.1235D-02,0.1236D-02,0.1235D-02,& + &0.1232D-02,0.1227D-02,0.1219D-02,0.1207D-02,0.1190D-02,0.1167D-02,& + &0.1133D-02,0.1085D-02,0.1009D-02,0.8680D-03/ + DATA (XPV(I,4,2),I=1,100)/ & + &0.5972D-02,0.5895D-02,0.5773D-02,0.5610D-02,0.5402D-02,0.5156D-02,& + &0.4878D-02,0.4698D-02,0.4623D-02,0.4513D-02,0.4369D-02,0.4191D-02,& + &0.3984D-02,0.3798D-02,0.3743D-02,0.3659D-02,0.3544D-02,0.3402D-02,& + &0.3235D-02,0.3113D-02,0.3058D-02,0.2976D-02,0.2870D-02,0.2740D-02,& + &0.2626D-02,0.2578D-02,0.2507D-02,0.2414D-02,0.2305D-02,0.2257D-02,& + &0.2198D-02,0.2121D-02,0.2046D-02,0.2003D-02,0.1942D-02,0.1882D-02,& + &0.1840D-02,0.1786D-02,0.1749D-02,0.1707D-02,0.1674D-02,0.1639D-02,& + &0.1613D-02,0.1589D-02,0.1567D-02,0.1551D-02,0.1538D-02,0.1533D-02,& + &0.1530D-02,0.1533D-02,0.1540D-02,0.1554D-02,0.1573D-02,0.1597D-02,& + &0.1628D-02,0.1665D-02,0.1709D-02,0.1760D-02,0.1818D-02,0.1884D-02,& + &0.1957D-02,0.2038D-02,0.2125D-02,0.2221D-02,0.2324D-02,0.2434D-02,& + &0.2551D-02,0.2676D-02,0.2807D-02,0.2946D-02,0.3095D-02,0.3254D-02,& + &0.3428D-02,0.3621D-02,0.3839D-02,0.4092D-02,0.4382D-02,0.4698D-02,& + &0.4731D-02,0.4764D-02,0.4795D-02,0.4824D-02,0.4851D-02,0.4876D-02,& + &0.4898D-02,0.4917D-02,0.4931D-02,0.4941D-02,0.4945D-02,0.4943D-02,& + &0.4933D-02,0.4913D-02,0.4881D-02,0.4833D-02,0.4766D-02,0.4671D-02,& + &0.4538D-02,0.4344D-02,0.4039D-02,0.3475D-02/ + DATA (XPV(I,4,3),I=1,100)/ & + &0.3908D-02,0.3834D-02,0.3728D-02,0.3592D-02,0.3425D-02,0.3231D-02,& + &0.3015D-02,0.2871D-02,0.2804D-02,0.2714D-02,0.2600D-02,0.2464D-02,& + &0.2309D-02,0.2169D-02,0.2119D-02,0.2050D-02,0.1962D-02,0.1855D-02,& + &0.1735D-02,0.1643D-02,0.1596D-02,0.1532D-02,0.1453D-02,0.1361D-02,& + &0.1278D-02,0.1237D-02,0.1183D-02,0.1116D-02,0.1040D-02,0.9992D-03,& + &0.9531D-03,0.8972D-03,0.8434D-03,0.8065D-03,0.7608D-03,0.7159D-03,& + &0.6806D-03,0.6392D-03,0.6067D-03,0.5717D-03,0.5414D-03,0.5098D-03,& + &0.4831D-03,0.4567D-03,0.4317D-03,0.4090D-03,0.3877D-03,0.3693D-03,& + &0.3517D-03,0.3363D-03,0.3224D-03,0.3109D-03,0.3010D-03,0.2928D-03,& + &0.2869D-03,0.2826D-03,0.2801D-03,0.2799D-03,0.2814D-03,0.2848D-03,& + &0.2899D-03,0.2967D-03,0.3051D-03,0.3151D-03,0.3263D-03,0.3390D-03,& + &0.3528D-03,0.3678D-03,0.3841D-03,0.4018D-03,0.4214D-03,0.4437D-03,& + &0.4700D-03,0.5022D-03,0.5431D-03,0.5965D-03,0.6670D-03,0.7574D-03,& + &0.7684D-03,0.7795D-03,0.7905D-03,0.8015D-03,0.8124D-03,0.8230D-03,& + &0.8335D-03,0.8436D-03,0.8533D-03,0.8624D-03,0.8708D-03,0.8784D-03,& + &0.8849D-03,0.8901D-03,0.8934D-03,0.8945D-03,0.8925D-03,0.8863D-03,& + &0.8739D-03,0.8517D-03,0.8113D-03,0.7282D-03/ + DATA (XPV(I,4,4),I=1,100)/ & + &0.4411D-02,0.4336D-02,0.4226D-02,0.4084D-02,0.3907D-02,0.3700D-02,& + &0.3469D-02,0.3316D-02,0.3248D-02,0.3153D-02,0.3032D-02,0.2886D-02,& + &0.2718D-02,0.2567D-02,0.2516D-02,0.2444D-02,0.2349D-02,0.2235D-02,& + &0.2103D-02,0.2004D-02,0.1956D-02,0.1888D-02,0.1804D-02,0.1703D-02,& + &0.1613D-02,0.1571D-02,0.1514D-02,0.1441D-02,0.1359D-02,0.1317D-02,& + &0.1269D-02,0.1210D-02,0.1153D-02,0.1116D-02,0.1069D-02,0.1022D-02,& + &0.9882D-03,0.9465D-03,0.9161D-03,0.8828D-03,0.8558D-03,0.8276D-03,& + &0.8060D-03,0.7854D-03,0.7672D-03,0.7526D-03,0.7404D-03,0.7330D-03,& + &0.7277D-03,0.7261D-03,0.7277D-03,0.7338D-03,0.7434D-03,0.7565D-03,& + &0.7745D-03,0.7963D-03,0.8222D-03,0.8532D-03,0.8886D-03,0.9283D-03,& + &0.9728D-03,0.1021D-02,0.1074D-02,0.1131D-02,0.1192D-02,0.1257D-02,& + &0.1325D-02,0.1397D-02,0.1473D-02,0.1554D-02,0.1642D-02,0.1739D-02,& + &0.1852D-02,0.1988D-02,0.2158D-02,0.2377D-02,0.2664D-02,0.3029D-02,& + &0.3074D-02,0.3119D-02,0.3163D-02,0.3207D-02,0.3251D-02,0.3294D-02,& + &0.3336D-02,0.3377D-02,0.3416D-02,0.3452D-02,0.3486D-02,0.3517D-02,& + &0.3543D-02,0.3564D-02,0.3578D-02,0.3582D-02,0.3574D-02,0.3549D-02,& + &0.3500D-02,0.3411D-02,0.3249D-02,0.2916D-02/ + DATA (XPV(I,5,0),I=1,100)/ & + &0.3395D+00,0.3321D+00,0.3219D+00,0.3090D+00,0.2933D+00,0.2751D+00,& + &0.2550D+00,0.2414D+00,0.2348D+00,0.2261D+00,0.2153D+00,0.2025D+00,& + &0.1881D+00,0.1751D+00,0.1704D+00,0.1640D+00,0.1559D+00,0.1464D+00,& + &0.1357D+00,0.1276D+00,0.1233D+00,0.1178D+00,0.1110D+00,0.1032D+00,& + &0.9616D-01,0.9268D-01,0.8813D-01,0.8262D-01,0.7648D-01,0.7317D-01,& + &0.6948D-01,0.6506D-01,0.6083D-01,0.5795D-01,0.5442D-01,0.5097D-01,& + &0.4827D-01,0.4513D-01,0.4265D-01,0.4000D-01,0.3769D-01,0.3529D-01,& + &0.3322D-01,0.3117D-01,0.2920D-01,0.2737D-01,0.2561D-01,0.2402D-01,& + &0.2245D-01,0.2098D-01,0.1958D-01,0.1829D-01,0.1704D-01,0.1585D-01,& + &0.1476D-01,0.1370D-01,0.1270D-01,0.1178D-01,0.1090D-01,0.1007D-01,& + &0.9286D-02,0.8547D-02,0.7848D-02,0.7182D-02,0.6551D-02,0.5949D-02,& + &0.5372D-02,0.4823D-02,0.4298D-02,0.3794D-02,0.3314D-02,0.2852D-02,& + &0.2413D-02,0.1995D-02,0.1599D-02,0.1223D-02,0.8693D-03,0.5397D-03,& + &0.5052D-03,0.4716D-03,0.4388D-03,0.4068D-03,0.3757D-03,0.3454D-03,& + &0.3160D-03,0.2875D-03,0.2599D-03,0.2332D-03,0.2073D-03,0.1825D-03,& + &0.1587D-03,0.1359D-03,0.1142D-03,0.9370D-04,0.7445D-04,0.5655D-04,& + &0.4018D-04,0.2553D-04,0.1296D-04,0.3149D-05/ + DATA (XPV(I,5,1),I=1,100)/ & + &0.7886D-02,0.7728D-02,0.7505D-02,0.7221D-02,0.6873D-02,0.6469D-02,& + &0.6022D-02,0.5723D-02,0.5585D-02,0.5398D-02,0.5164D-02,0.4885D-02,& + &0.4568D-02,0.4283D-02,0.4181D-02,0.4041D-02,0.3864D-02,0.3650D-02,& + &0.3408D-02,0.3225D-02,0.3131D-02,0.3005D-02,0.2850D-02,0.2668D-02,& + &0.2506D-02,0.2427D-02,0.2321D-02,0.2191D-02,0.2045D-02,0.1968D-02,& + &0.1880D-02,0.1774D-02,0.1672D-02,0.1604D-02,0.1519D-02,0.1435D-02,& + &0.1371D-02,0.1295D-02,0.1236D-02,0.1172D-02,0.1118D-02,0.1062D-02,& + &0.1015D-02,0.9690D-03,0.9257D-03,0.8867D-03,0.8503D-03,0.8197D-03,& + &0.7906D-03,0.7655D-03,0.7432D-03,0.7255D-03,0.7107D-03,0.6987D-03,& + &0.6911D-03,0.6864D-03,0.6850D-03,0.6876D-03,0.6934D-03,0.7025D-03,& + &0.7147D-03,0.7300D-03,0.7482D-03,0.7692D-03,0.7926D-03,0.8187D-03,& + &0.8465D-03,0.8768D-03,0.9089D-03,0.9431D-03,0.9801D-03,0.1020D-02,& + &0.1065D-02,0.1116D-02,0.1177D-02,0.1250D-02,0.1336D-02,0.1431D-02,& + &0.1441D-02,0.1451D-02,0.1460D-02,0.1468D-02,0.1476D-02,0.1483D-02,& + &0.1489D-02,0.1494D-02,0.1497D-02,0.1499D-02,0.1499D-02,0.1497D-02,& + &0.1492D-02,0.1483D-02,0.1471D-02,0.1454D-02,0.1430D-02,0.1398D-02,& + &0.1354D-02,0.1291D-02,0.1195D-02,0.1022D-02/ + DATA (XPV(I,5,2),I=1,100)/ & + &0.9523D-02,0.9362D-02,0.9127D-02,0.8821D-02,0.8442D-02,0.7997D-02,& + &0.7501D-02,0.7174D-02,0.7029D-02,0.6828D-02,0.6569D-02,0.6258D-02,& + &0.5901D-02,0.5579D-02,0.5475D-02,0.5323D-02,0.5125D-02,0.4884D-02,& + &0.4606D-02,0.4399D-02,0.4301D-02,0.4162D-02,0.3986D-02,0.3776D-02,& + &0.3590D-02,0.3508D-02,0.3391D-02,0.3242D-02,0.3073D-02,0.2992D-02,& + &0.2897D-02,0.2777D-02,0.2663D-02,0.2592D-02,0.2499D-02,0.2408D-02,& + &0.2344D-02,0.2263D-02,0.2207D-02,0.2144D-02,0.2095D-02,0.2043D-02,& + &0.2005D-02,0.1970D-02,0.1939D-02,0.1917D-02,0.1898D-02,0.1891D-02,& + &0.1887D-02,0.1891D-02,0.1901D-02,0.1921D-02,0.1948D-02,0.1981D-02,& + &0.2025D-02,0.2076D-02,0.2134D-02,0.2204D-02,0.2281D-02,0.2367D-02,& + &0.2463D-02,0.2566D-02,0.2678D-02,0.2798D-02,0.2925D-02,0.3060D-02,& + &0.3199D-02,0.3347D-02,0.3500D-02,0.3659D-02,0.3827D-02,0.4007D-02,& + &0.4203D-02,0.4424D-02,0.4679D-02,0.4981D-02,0.5336D-02,0.5723D-02,& + &0.5764D-02,0.5803D-02,0.5840D-02,0.5875D-02,0.5906D-02,0.5934D-02,& + &0.5959D-02,0.5978D-02,0.5992D-02,0.6000D-02,0.6000D-02,0.5991D-02,& + &0.5971D-02,0.5938D-02,0.5890D-02,0.5821D-02,0.5726D-02,0.5597D-02,& + &0.5419D-02,0.5166D-02,0.4781D-02,0.4089D-02/ + DATA (XPV(I,5,3),I=1,100)/ & + &0.7505D-02,0.7347D-02,0.7127D-02,0.6848D-02,0.6508D-02,0.6113D-02,& + &0.5677D-02,0.5385D-02,0.5248D-02,0.5065D-02,0.4837D-02,0.4566D-02,& + &0.4259D-02,0.3982D-02,0.3881D-02,0.3744D-02,0.3571D-02,0.3365D-02,& + &0.3131D-02,0.2953D-02,0.2861D-02,0.2738D-02,0.2589D-02,0.2414D-02,& + &0.2257D-02,0.2179D-02,0.2077D-02,0.1952D-02,0.1812D-02,0.1736D-02,& + &0.1651D-02,0.1549D-02,0.1451D-02,0.1384D-02,0.1302D-02,0.1222D-02,& + &0.1159D-02,0.1086D-02,0.1028D-02,0.9666D-03,0.9136D-03,0.8587D-03,& + &0.8123D-03,0.7666D-03,0.7236D-03,0.6846D-03,0.6479D-03,0.6163D-03,& + &0.5861D-03,0.5595D-03,0.5354D-03,0.5152D-03,0.4975D-03,0.4824D-03,& + &0.4710D-03,0.4620D-03,0.4558D-03,0.4530D-03,0.4527D-03,0.4552D-03,& + &0.4601D-03,0.4675D-03,0.4771D-03,0.4889D-03,0.5026D-03,0.5181D-03,& + &0.5351D-03,0.5540D-03,0.5746D-03,0.5972D-03,0.6228D-03,0.6525D-03,& + &0.6882D-03,0.7329D-03,0.7908D-03,0.8669D-03,0.9668D-03,0.1092D-02,& + &0.1106D-02,0.1121D-02,0.1136D-02,0.1150D-02,0.1164D-02,0.1178D-02,& + &0.1191D-02,0.1203D-02,0.1214D-02,0.1225D-02,0.1234D-02,0.1242D-02,& + &0.1247D-02,0.1250D-02,0.1251D-02,0.1247D-02,0.1239D-02,0.1224D-02,& + &0.1199D-02,0.1159D-02,0.1093D-02,0.9633D-03/ + DATA (XPV(I,5,4),I=1,100)/ & + &0.7997D-02,0.7838D-02,0.7615D-02,0.7329D-02,0.6980D-02,0.6573D-02,& + &0.6123D-02,0.5823D-02,0.5684D-02,0.5497D-02,0.5261D-02,0.4981D-02,& + &0.4662D-02,0.4375D-02,0.4274D-02,0.4134D-02,0.3955D-02,0.3741D-02,& + &0.3497D-02,0.3313D-02,0.3221D-02,0.3095D-02,0.2940D-02,0.2758D-02,& + &0.2596D-02,0.2518D-02,0.2414D-02,0.2285D-02,0.2140D-02,0.2065D-02,& + &0.1981D-02,0.1877D-02,0.1779D-02,0.1715D-02,0.1634D-02,0.1555D-02,& + &0.1497D-02,0.1427D-02,0.1376D-02,0.1320D-02,0.1276D-02,0.1229D-02,& + &0.1194D-02,0.1161D-02,0.1131D-02,0.1108D-02,0.1089D-02,0.1077D-02,& + &0.1069D-02,0.1067D-02,0.1070D-02,0.1080D-02,0.1095D-02,0.1116D-02,& + &0.1144D-02,0.1178D-02,0.1218D-02,0.1265D-02,0.1318D-02,0.1378D-02,& + &0.1444D-02,0.1516D-02,0.1594D-02,0.1677D-02,0.1764D-02,0.1858D-02,& + &0.1954D-02,0.2056D-02,0.2162D-02,0.2275D-02,0.2398D-02,0.2536D-02,& + &0.2696D-02,0.2890D-02,0.3134D-02,0.3450D-02,0.3859D-02,0.4365D-02,& + &0.4425D-02,0.4485D-02,0.4544D-02,0.4602D-02,0.4658D-02,0.4713D-02,& + &0.4765D-02,0.4815D-02,0.4861D-02,0.4903D-02,0.4940D-02,0.4970D-02,& + &0.4993D-02,0.5007D-02,0.5008D-02,0.4994D-02,0.4961D-02,0.4900D-02,& + &0.4801D-02,0.4642D-02,0.4373D-02,0.3853D-02/ + DATA (XPV(I,6,0),I=1,100)/ & + &0.4823D+00,0.4713D+00,0.4562D+00,0.4371D+00,0.4141D+00,0.3874D+00,& + &0.3580D+00,0.3381D+00,0.3284D+00,0.3157D+00,0.3000D+00,0.2816D+00,& + &0.2609D+00,0.2422D+00,0.2354D+00,0.2262D+00,0.2147D+00,0.2012D+00,& + &0.1860D+00,0.1744D+00,0.1685D+00,0.1606D+00,0.1511D+00,0.1401D+00,& + &0.1304D+00,0.1255D+00,0.1192D+00,0.1116D+00,0.1031D+00,0.9852D-01,& + &0.9345D-01,0.8740D-01,0.8162D-01,0.7769D-01,0.7289D-01,0.6822D-01,& + &0.6457D-01,0.6033D-01,0.5700D-01,0.5343D-01,0.5035D-01,0.4714D-01,& + &0.4439D-01,0.4166D-01,0.3905D-01,0.3663D-01,0.3429D-01,0.3219D-01,& + &0.3012D-01,0.2819D-01,0.2634D-01,0.2464D-01,0.2300D-01,0.2142D-01,& + &0.1997D-01,0.1857D-01,0.1723D-01,0.1600D-01,0.1482D-01,0.1370D-01,& + &0.1263D-01,0.1162D-01,0.1065D-01,0.9734D-02,0.8858D-02,0.8020D-02,& + &0.7218D-02,0.6455D-02,0.5727D-02,0.5031D-02,0.4372D-02,0.3743D-02,& + &0.3148D-02,0.2587D-02,0.2059D-02,0.1563D-02,0.1101D-02,0.6756D-03,& + &0.6315D-03,0.5886D-03,0.5468D-03,0.5062D-03,0.4667D-03,0.4284D-03,& + &0.3913D-03,0.3553D-03,0.3206D-03,0.2871D-03,0.2547D-03,0.2238D-03,& + &0.1942D-03,0.1660D-03,0.1392D-03,0.1139D-03,0.9030D-04,0.6843D-04,& + &0.4849D-04,0.3074D-04,0.1557D-04,0.3784D-05/ + DATA (XPV(I,6,1),I=1,100)/ & + &0.1205D-01,0.1178D-01,0.1142D-01,0.1096D-01,0.1041D-01,0.9763D-02,& + &0.9053D-02,0.8577D-02,0.8354D-02,0.8057D-02,0.7688D-02,0.7251D-02,& + &0.6756D-02,0.6310D-02,0.6149D-02,0.5929D-02,0.5654D-02,0.5325D-02,& + &0.4953D-02,0.4670D-02,0.4526D-02,0.4332D-02,0.4097D-02,0.3822D-02,& + &0.3577D-02,0.3456D-02,0.3297D-02,0.3102D-02,0.2885D-02,0.2769D-02,& + &0.2639D-02,0.2483D-02,0.2333D-02,0.2232D-02,0.2107D-02,0.1985D-02,& + &0.1891D-02,0.1781D-02,0.1696D-02,0.1604D-02,0.1526D-02,0.1445D-02,& + &0.1377D-02,0.1310D-02,0.1248D-02,0.1192D-02,0.1139D-02,0.1094D-02,& + &0.1052D-02,0.1015D-02,0.9816D-03,0.9544D-03,0.9311D-03,0.9114D-03,& + &0.8975D-03,0.8872D-03,0.8810D-03,0.8801D-03,0.8830D-03,0.8899D-03,& + &0.9007D-03,0.9151D-03,0.9330D-03,0.9541D-03,0.9781D-03,0.1005D-02,& + &0.1034D-02,0.1065D-02,0.1099D-02,0.1135D-02,0.1174D-02,0.1217D-02,& + &0.1266D-02,0.1323D-02,0.1392D-02,0.1478D-02,0.1581D-02,0.1696D-02,& + &0.1708D-02,0.1720D-02,0.1731D-02,0.1741D-02,0.1751D-02,0.1759D-02,& + &0.1766D-02,0.1772D-02,0.1776D-02,0.1778D-02,0.1778D-02,0.1775D-02,& + &0.1769D-02,0.1759D-02,0.1744D-02,0.1723D-02,0.1695D-02,0.1657D-02,& + &0.1604D-02,0.1530D-02,0.1417D-02,0.1218D-02/ + DATA (XPV(I,6,2),I=1,100)/ & + &0.1365D-01,0.1339D-01,0.1302D-01,0.1254D-01,0.1195D-01,0.1127D-01,& + &0.1051D-01,0.1001D-01,0.9777D-02,0.9465D-02,0.9073D-02,0.8604D-02,& + &0.8069D-02,0.7589D-02,0.7425D-02,0.7195D-02,0.6900D-02,0.6544D-02,& + &0.6138D-02,0.5834D-02,0.5686D-02,0.5481D-02,0.5226D-02,0.4925D-02,& + &0.4658D-02,0.4536D-02,0.4367D-02,0.4157D-02,0.3918D-02,0.3801D-02,& + &0.3667D-02,0.3499D-02,0.3340D-02,0.3241D-02,0.3112D-02,0.2987D-02,& + &0.2897D-02,0.2787D-02,0.2709D-02,0.2624D-02,0.2557D-02,0.2487D-02,& + &0.2436D-02,0.2387D-02,0.2346D-02,0.2315D-02,0.2290D-02,0.2279D-02,& + &0.2273D-02,0.2277D-02,0.2289D-02,0.2313D-02,0.2346D-02,0.2387D-02,& + &0.2441D-02,0.2503D-02,0.2575D-02,0.2660D-02,0.2755D-02,0.2859D-02,& + &0.2974D-02,0.3099D-02,0.3232D-02,0.3374D-02,0.3523D-02,0.3680D-02,& + &0.3841D-02,0.4010D-02,0.4183D-02,0.4363D-02,0.4552D-02,0.4754D-02,& + &0.4976D-02,0.5229D-02,0.5526D-02,0.5885D-02,0.6313D-02,0.6782D-02,& + &0.6832D-02,0.6879D-02,0.6924D-02,0.6966D-02,0.7004D-02,0.7038D-02,& + &0.7067D-02,0.7091D-02,0.7108D-02,0.7117D-02,0.7116D-02,0.7105D-02,& + &0.7081D-02,0.7041D-02,0.6982D-02,0.6899D-02,0.6786D-02,0.6631D-02,& + &0.6421D-02,0.6123D-02,0.5672D-02,0.4871D-02/ + DATA (XPV(I,6,3),I=1,100)/ & + &0.1167D-01,0.1141D-01,0.1105D-01,0.1060D-01,0.1005D-01,0.9414D-02,& + &0.8715D-02,0.8245D-02,0.8024D-02,0.7730D-02,0.7367D-02,0.6937D-02,& + &0.6451D-02,0.6013D-02,0.5853D-02,0.5637D-02,0.5366D-02,0.5044D-02,& + &0.4680D-02,0.4403D-02,0.4259D-02,0.4069D-02,0.3839D-02,0.3571D-02,& + &0.3331D-02,0.3212D-02,0.3055D-02,0.2866D-02,0.2654D-02,0.2540D-02,& + &0.2413D-02,0.2260D-02,0.2114D-02,0.2014D-02,0.1892D-02,0.1773D-02,& + &0.1680D-02,0.1572D-02,0.1488D-02,0.1398D-02,0.1320D-02,0.1240D-02,& + &0.1173D-02,0.1106D-02,0.1044D-02,0.9874D-03,0.9342D-03,0.8881D-03,& + &0.8442D-03,0.8052D-03,0.7698D-03,0.7399D-03,0.7134D-03,0.6903D-03,& + &0.6722D-03,0.6574D-03,0.6463D-03,0.6397D-03,0.6365D-03,0.6368D-03,& + &0.6405D-03,0.6473D-03,0.6570D-03,0.6695D-03,0.6844D-03,0.7019D-03,& + &0.7213D-03,0.7431D-03,0.7673D-03,0.7943D-03,0.8253D-03,0.8617D-03,& + &0.9063D-03,0.9627D-03,0.1036D-02,0.1133D-02,0.1259D-02,0.1412D-02,& + &0.1430D-02,0.1448D-02,0.1465D-02,0.1482D-02,0.1499D-02,0.1514D-02,& + &0.1529D-02,0.1543D-02,0.1556D-02,0.1567D-02,0.1576D-02,0.1583D-02,& + &0.1587D-02,0.1588D-02,0.1586D-02,0.1578D-02,0.1563D-02,0.1539D-02,& + &0.1504D-02,0.1448D-02,0.1358D-02,0.1189D-02/ + DATA (XPV(I,6,4),I=1,100)/ & + &0.1216D-01,0.1189D-01,0.1153D-01,0.1107D-01,0.1051D-01,0.9868D-02,& + &0.9154D-02,0.8677D-02,0.8454D-02,0.8157D-02,0.7787D-02,0.7349D-02,& + &0.6851D-02,0.6404D-02,0.6244D-02,0.6025D-02,0.5749D-02,0.5420D-02,& + &0.5047D-02,0.4764D-02,0.4621D-02,0.4429D-02,0.4195D-02,0.3920D-02,& + &0.3677D-02,0.3559D-02,0.3402D-02,0.3211D-02,0.2996D-02,0.2884D-02,& + &0.2759D-02,0.2608D-02,0.2463D-02,0.2369D-02,0.2251D-02,0.2138D-02,& + &0.2053D-02,0.1952D-02,0.1879D-02,0.1800D-02,0.1736D-02,0.1670D-02,& + &0.1619D-02,0.1572D-02,0.1531D-02,0.1498D-02,0.1470D-02,0.1454D-02,& + &0.1442D-02,0.1439D-02,0.1442D-02,0.1455D-02,0.1475D-02,0.1502D-02,& + &0.1539D-02,0.1584D-02,0.1637D-02,0.1699D-02,0.1769D-02,0.1847D-02,& + &0.1934D-02,0.2027D-02,0.2128D-02,0.2235D-02,0.2348D-02,0.2468D-02,& + &0.2591D-02,0.2721D-02,0.2857D-02,0.3001D-02,0.3158D-02,0.3333D-02,& + &0.3538D-02,0.3788D-02,0.4102D-02,0.4506D-02,0.5022D-02,0.5648D-02,& + &0.5720D-02,0.5792D-02,0.5862D-02,0.5931D-02,0.5997D-02,0.6060D-02,& + &0.6120D-02,0.6176D-02,0.6226D-02,0.6271D-02,0.6308D-02,0.6337D-02,& + &0.6354D-02,0.6359D-02,0.6348D-02,0.6316D-02,0.6257D-02,0.6163D-02,& + &0.6019D-02,0.5797D-02,0.5436D-02,0.4755D-02/ + DATA (XPV(I,7,0),I=1,100)/ & + &0.6367D+00,0.6216D+00,0.6010D+00,0.5752D+00,0.5440D+00,0.5081D+00,& + &0.4686D+00,0.4418D+00,0.4287D+00,0.4116D+00,0.3907D+00,0.3662D+00,& + &0.3385D+00,0.3137D+00,0.3045D+00,0.2923D+00,0.2772D+00,0.2594D+00,& + &0.2393D+00,0.2241D+00,0.2163D+00,0.2060D+00,0.1936D+00,0.1792D+00,& + &0.1665D+00,0.1602D+00,0.1520D+00,0.1421D+00,0.1311D+00,0.1252D+00,& + &0.1187D+00,0.1109D+00,0.1035D+00,0.9842D-01,0.9228D-01,0.8630D-01,& + &0.8164D-01,0.7624D-01,0.7200D-01,0.6747D-01,0.6355D-01,0.5948D-01,& + &0.5601D-01,0.5255D-01,0.4926D-01,0.4620D-01,0.4326D-01,0.4061D-01,& + &0.3801D-01,0.3557D-01,0.3324D-01,0.3109D-01,0.2903D-01,0.2705D-01,& + &0.2521D-01,0.2344D-01,0.2175D-01,0.2018D-01,0.1868D-01,0.1725D-01,& + &0.1589D-01,0.1460D-01,0.1337D-01,0.1219D-01,0.1107D-01,0.9999D-02,& + &0.8975D-02,0.8003D-02,0.7079D-02,0.6199D-02,0.5369D-02,0.4581D-02,& + &0.3839D-02,0.3144D-02,0.2492D-02,0.1883D-02,0.1320D-02,0.8054D-03,& + &0.7523D-03,0.7006D-03,0.6504D-03,0.6016D-03,0.5543D-03,0.5084D-03,& + &0.4640D-03,0.4210D-03,0.3796D-03,0.3397D-03,0.3011D-03,0.2644D-03,& + &0.2292D-03,0.1957D-03,0.1640D-03,0.1342D-03,0.1063D-03,0.8046D-04,& + &0.5699D-04,0.3611D-04,0.1829D-04,0.4453D-05/ + DATA (XPV(I,7,1),I=1,100)/ & + &0.1667D-01,0.1629D-01,0.1577D-01,0.1511D-01,0.1431D-01,0.1340D-01,& + &0.1239D-01,0.1171D-01,0.1139D-01,0.1097D-01,0.1045D-01,0.9835D-02,& + &0.9139D-02,0.8514D-02,0.8286D-02,0.7979D-02,0.7594D-02,0.7137D-02,& + &0.6621D-02,0.6230D-02,0.6029D-02,0.5762D-02,0.5438D-02,0.5061D-02,& + &0.4726D-02,0.4560D-02,0.4342D-02,0.4078D-02,0.3784D-02,0.3626D-02,& + &0.3451D-02,0.3240D-02,0.3038D-02,0.2902D-02,0.2735D-02,0.2572D-02,& + &0.2446D-02,0.2299D-02,0.2185D-02,0.2064D-02,0.1960D-02,0.1852D-02,& + &0.1762D-02,0.1673D-02,0.1591D-02,0.1516D-02,0.1446D-02,0.1386D-02,& + &0.1329D-02,0.1278D-02,0.1233D-02,0.1195D-02,0.1162D-02,0.1134D-02,& + &0.1113D-02,0.1096D-02,0.1084D-02,0.1078D-02,0.1077D-02,0.1081D-02,& + &0.1090D-02,0.1103D-02,0.1119D-02,0.1140D-02,0.1164D-02,0.1191D-02,& + &0.1220D-02,0.1253D-02,0.1288D-02,0.1325D-02,0.1367D-02,0.1413D-02,& + &0.1466D-02,0.1530D-02,0.1609D-02,0.1708D-02,0.1830D-02,0.1967D-02,& + &0.1981D-02,0.1995D-02,0.2008D-02,0.2021D-02,0.2032D-02,0.2042D-02,& + &0.2051D-02,0.2058D-02,0.2063D-02,0.2066D-02,0.2066D-02,0.2063D-02,& + &0.2057D-02,0.2045D-02,0.2029D-02,0.2005D-02,0.1973D-02,0.1929D-02,& + &0.1869D-02,0.1784D-02,0.1655D-02,0.1427D-02/ + DATA (XPV(I,7,2),I=1,100)/ & + &0.1825D-01,0.1787D-01,0.1734D-01,0.1666D-01,0.1584D-01,0.1488D-01,& + &0.1382D-01,0.1312D-01,0.1280D-01,0.1236D-01,0.1182D-01,0.1117D-01,& + &0.1044D-01,0.9780D-02,0.9550D-02,0.9233D-02,0.8830D-02,0.8348D-02,& + &0.7799D-02,0.7387D-02,0.7184D-02,0.6906D-02,0.6565D-02,0.6163D-02,& + &0.5808D-02,0.5642D-02,0.5418D-02,0.5140D-02,0.4827D-02,0.4670D-02,& + &0.4493D-02,0.4274D-02,0.4067D-02,0.3936D-02,0.3769D-02,0.3607D-02,& + &0.3489D-02,0.3347D-02,0.3246D-02,0.3136D-02,0.3050D-02,0.2959D-02,& + &0.2893D-02,0.2830D-02,0.2777D-02,0.2736D-02,0.2703D-02,0.2687D-02,& + &0.2678D-02,0.2680D-02,0.2693D-02,0.2720D-02,0.2757D-02,0.2805D-02,& + &0.2867D-02,0.2940D-02,0.3024D-02,0.3123D-02,0.3233D-02,0.3355D-02,& + &0.3489D-02,0.3632D-02,0.3785D-02,0.3948D-02,0.4118D-02,0.4297D-02,& + &0.4479D-02,0.4668D-02,0.4863D-02,0.5063D-02,0.5274D-02,0.5499D-02,& + &0.5750D-02,0.6038D-02,0.6381D-02,0.6800D-02,0.7306D-02,0.7864D-02,& + &0.7924D-02,0.7980D-02,0.8034D-02,0.8085D-02,0.8131D-02,0.8172D-02,& + &0.8208D-02,0.8236D-02,0.8258D-02,0.8270D-02,0.8271D-02,0.8259D-02,& + &0.8233D-02,0.8188D-02,0.8122D-02,0.8027D-02,0.7897D-02,0.7721D-02,& + &0.7480D-02,0.7139D-02,0.6624D-02,0.5709D-02/ + DATA (XPV(I,7,3),I=1,100)/ & + &0.1630D-01,0.1592D-01,0.1540D-01,0.1475D-01,0.1396D-01,0.1305D-01,& + &0.1205D-01,0.1138D-01,0.1107D-01,0.1065D-01,0.1013D-01,0.9526D-02,& + &0.8839D-02,0.8222D-02,0.7995D-02,0.7690D-02,0.7310D-02,0.6860D-02,& + &0.6352D-02,0.5966D-02,0.5766D-02,0.5502D-02,0.5183D-02,0.4813D-02,& + &0.4483D-02,0.4318D-02,0.4103D-02,0.3844D-02,0.3555D-02,0.3399D-02,& + &0.3225D-02,0.3018D-02,0.2820D-02,0.2685D-02,0.2521D-02,0.2360D-02,& + &0.2235D-02,0.2091D-02,0.1978D-02,0.1857D-02,0.1754D-02,0.1647D-02,& + &0.1557D-02,0.1468D-02,0.1385D-02,0.1310D-02,0.1239D-02,0.1177D-02,& + &0.1118D-02,0.1066D-02,0.1018D-02,0.9774D-03,0.9411D-03,0.9091D-03,& + &0.8835D-03,0.8619D-03,0.8450D-03,0.8338D-03,0.8268D-03,0.8242D-03,& + &0.8257D-03,0.8312D-03,0.8403D-03,0.8529D-03,0.8686D-03,0.8875D-03,& + &0.9087D-03,0.9331D-03,0.9605D-03,0.9915D-03,0.1028D-02,0.1070D-02,& + &0.1124D-02,0.1191D-02,0.1279D-02,0.1395D-02,0.1545D-02,0.1725D-02,& + &0.1746D-02,0.1766D-02,0.1786D-02,0.1805D-02,0.1823D-02,0.1841D-02,& + &0.1857D-02,0.1872D-02,0.1886D-02,0.1897D-02,0.1907D-02,0.1913D-02,& + &0.1916D-02,0.1915D-02,0.1909D-02,0.1897D-02,0.1877D-02,0.1846D-02,& + &0.1799D-02,0.1729D-02,0.1618D-02,0.1411D-02/ + DATA (XPV(I,7,4),I=1,100)/ & + &0.1678D-01,0.1640D-01,0.1587D-01,0.1522D-01,0.1442D-01,0.1350D-01,& + &0.1249D-01,0.1181D-01,0.1149D-01,0.1107D-01,0.1055D-01,0.9935D-02,& + &0.9238D-02,0.8611D-02,0.8385D-02,0.8078D-02,0.7694D-02,0.7237D-02,& + &0.6721D-02,0.6331D-02,0.6132D-02,0.5867D-02,0.5545D-02,0.5170D-02,& + &0.4837D-02,0.4676D-02,0.4462D-02,0.4202D-02,0.3912D-02,0.3761D-02,& + &0.3592D-02,0.3388D-02,0.3194D-02,0.3068D-02,0.2911D-02,0.2759D-02,& + &0.2646D-02,0.2513D-02,0.2415D-02,0.2310D-02,0.2226D-02,0.2139D-02,& + &0.2072D-02,0.2010D-02,0.1955D-02,0.1911D-02,0.1875D-02,0.1852D-02,& + &0.1836D-02,0.1830D-02,0.1833D-02,0.1848D-02,0.1872D-02,0.1905D-02,& + &0.1950D-02,0.2004D-02,0.2069D-02,0.2145D-02,0.2231D-02,0.2327D-02,& + &0.2432D-02,0.2547D-02,0.2669D-02,0.2800D-02,0.2937D-02,0.3082D-02,& + &0.3232D-02,0.3389D-02,0.3553D-02,0.3727D-02,0.3917D-02,0.4130D-02,& + &0.4378D-02,0.4681D-02,0.5061D-02,0.5547D-02,0.6163D-02,0.6897D-02,& + &0.6981D-02,0.7063D-02,0.7144D-02,0.7221D-02,0.7296D-02,0.7367D-02,& + &0.7433D-02,0.7494D-02,0.7548D-02,0.7595D-02,0.7632D-02,0.7658D-02,& + &0.7671D-02,0.7667D-02,0.7644D-02,0.7595D-02,0.7513D-02,0.7388D-02,& + &0.7203D-02,0.6923D-02,0.6476D-02,0.5646D-02/ + +!..fetching pdfs + DO 5 IP=-6,6 + XPDF(IP)=ZEROD + 5 END DO + DO 2 I=1,IX + ENT(I)=LOG10(XT(I)) + 2 END DO + NA(1)=IX + NA(2)=IQ + DO 3 I=1,IQ + ENT(IX+I)=LOG10(Q2T(I)) + 3 END DO + ARG(1)=LOG10(X) + ARG(2)=LOG10(Q2) +!..VARIOUS FLAVOURS (u-->2,d-->1) + XPDF(0)=DBFINT(NARG,ARG,NA,ENT,XPV(1,1,0)) + XPDF(1)=DBFINT(NARG,ARG,NA,ENT,XPV(1,1,1)) + XPDF(2)=DBFINT(NARG,ARG,NA,ENT,XPV(1,1,2)) + XPDF(3)=DBFINT(NARG,ARG,NA,ENT,XPV(1,1,3)) + XPDF(4)=DBFINT(NARG,ARG,NA,ENT,XPV(1,1,4)) + DO 21 JF=1,4 + XPDF(-JF)=XPDF(JF) + 21 END DO + RETURN + END diff --git a/LHAPDF/lhapdf-5.9.1/src/wrapmrst-lite.f b/LHAPDF/lhapdf-5.9.1/src/wrapmrst-lite.f new file mode 100644 index 00000000000..2de1a78aea3 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/wrapmrst-lite.f @@ -0,0 +1,291 @@ +! -*- F90 -*- + + + subroutine MRSTevolve(x,Q,pdf) + implicit real*8(a-h,o-z) + include 'parmsetup.inc' + character*16 name(nmxset) + character*80 line + character*512 setpath + integer nmem(nmxset),ndef(nmxset),mmem +! integer member(nmxset) + integer nset,iset,mem + common/NAME/name,nmem,ndef,mmem + parameter(nx=49,nq=37,np=8,nqc0=2,nqb0=11,nqc=35,nqb=26, & + &nhess=0) + double precision gridx(nmxgridx),gridq(nmxgridq) + integer ngridx,ngridq,jx,jq + real*8 pdf(-6:6) + real*8 f1(nx,nq) & + &,f2(nx,nq) & + &,f3(nx,nq) & + &,f4(nx,nq) & + &,f5(nx,nq) & + &,f6(nx,nq) & + &,f7(nx,nq) & + &,f8(nx,nq) & + &,fc(nx,nqc),fb(nx,nqb) + real*8 qq(nq),xx(nx), & + &cc1(0:nhess,nx,nq,4,4,nmxset),cc2(0:nhess,nx,nq,4,4,nmxset), & + &cc3(0:nhess,nx,nq,4,4,nmxset),cc4(0:nhess,nx,nq,4,4,nmxset), & + &cc6(0:nhess,nx,nq,4,4,nmxset),cc8(0:nhess,nx,nq,4,4,nmxset), & + &ccc(0:nhess,nx,nqc,4,4,nmxset),ccb(0:nhess,nx,nqb,4,4,nmxset) + real*8 xxl(nx),qql(nq),qqlc(nqc),qqlb(nqb) + data xx/1d-5,2d-5,4d-5,6d-5,8d-5, & + & 1d-4,2d-4,4d-4,6d-4,8d-4, & + & 1d-3,2d-3,4d-3,6d-3,8d-3, & + & 1d-2,1.4d-2,2d-2,3d-2,4d-2,6d-2,8d-2, & + & .1d0,.125d0,.15d0,.175d0,.2d0,.225d0,.25d0,.275d0, & + & .3d0,.325d0,.35d0,.375d0,.4d0,.425d0,.45d0,.475d0, & + & .5d0,.525d0,.55d0,.575d0,.6d0,.65d0,.7d0,.75d0, & + & .8d0,.9d0,1d0/ + data qq/1.25d0,1.5d0,2d0,2.5d0,3.2d0,4d0,5d0,6.4d0,8d0,1d1, & + & 1.2d1,1.8d1,2.6d1,4d1,6.4d1,1d2, & + & 1.6d2,2.4d2,4d2,6.4d2,1d3,1.8d3,3.2d3,5.6d3,1d4, & + & 1.8d4,3.2d4,5.6d4,1d5,1.8d5,3.2d5,5.6d5,1d6, & + & 1.8d6,3.2d6,5.6d6,1d7/ + data xmin,xmax,qsqmin,qsqmax/1d-5,1d0,1.25d0,1d7/ + save + + xsave=x + qsq = q*q + q2save=qsq + + xlog=dlog(x) + qsqlog=dlog(qsq) + + call getnset(iset) +! imem=member(iset) + call getnmem(iset,imem) + + ! G.W. 24/04/2008 + if (qsq.lt.qsqmin) then + qsqlog=dlog(1.01D0*qsqmin) + call jeppe2(0,xlog,qsqlog,nx,nq,xxl,qql, & + & cc1(0,1,1,1,1,iset),upv1) + call jeppe2(0,xlog,qsqlog,nx,nq,xxl,qql, & + & cc2(0,1,1,1,1,iset),dnv1) + call jeppe2(0,xlog,qsqlog,nx,nq,xxl,qql, & + & cc3(0,1,1,1,1,iset),glu1) + call jeppe2(0,xlog,qsqlog,nx,nq,xxl,qql, & + & cc4(0,1,1,1,1,iset),usea1) + call jeppe2(0,xlog,qsqlog,nx,nq,xxl,qql, & + & cc6(0,1,1,1,1,iset),str1) + call jeppe2(0,xlog,qsqlog,nx,nq,xxl,qql, & + & cc8(0,1,1,1,1,iset),dsea1) + qsqlog=dlog(qsqmin) + end if + call jeppe2(0,xlog,qsqlog,nx,nq,xxl,qql, & + &cc1(0,1,1,1,1,iset),upv) + call jeppe2(0,xlog,qsqlog,nx,nq,xxl,qql, & + &cc2(0,1,1,1,1,iset),dnv) + call jeppe2(0,xlog,qsqlog,nx,nq,xxl,qql, & + &cc3(0,1,1,1,1,iset),glu) + call jeppe2(0,xlog,qsqlog,nx,nq,xxl,qql, & + &cc4(0,1,1,1,1,iset),usea) + call jeppe2(0,xlog,qsqlog,nx,nq,xxl,qql, & + &cc6(0,1,1,1,1,iset),str) + call jeppe2(0,xlog,qsqlog,nx,nq,xxl,qql, & + &cc8(0,1,1,1,1,iset),dsea) + ! G.W. 24/04/2008 + if (qsq.lt.qsqmin) then +!-- Calculate the anomalous dimension, dlog(xf)/dlog(qsq), +!-- evaluated at qsqmin. Then extrapolate the PDFs to low +!-- qsq < qsqmin by interpolating the anomalous dimenion between +!-- the value at qsqmin and a value of 1 for qsq << qsqmin. +!-- If value of PDF at qsqmin is very small, just set +!-- anomalous dimension to 1 to prevent rounding errors. + if (abs(upv).lt.1.D-4) then + anom = 1.D0 + else + anom = (upv1-upv)/upv/0.01D0 + endif + upv = upv*(qsq/qsqmin)**(anom*qsq/qsqmin+1.D0-qsq/qsqmin) + if (abs(dnv).lt.1.D-4) then + anom = 1.D0 + else + anom = (dnv1-dnv)/dnv/0.01D0 + endif + dnv = dnv*(qsq/qsqmin)**(anom*qsq/qsqmin+1.D0-qsq/qsqmin) + if (abs(glu).lt.1.D-4) then + anom = 1.D0 + else + anom = (glu1-glu)/glu/0.01D0 + endif + glu = glu*(qsq/qsqmin)**(anom*qsq/qsqmin+1.D0-qsq/qsqmin) + if (abs(usea).lt.1.D-4) then + anom = 1.D0 + else + anom = (usea1-usea)/usea/0.01D0 + endif + usea = usea*(qsq/qsqmin)**(anom*qsq/qsqmin+1.D0-qsq/qsqmin) + if (abs(str).lt.1.D-4) then + anom = 1.D0 + else + anom = (str1-str)/str/0.01D0 + endif + str = str*(qsq/qsqmin)**(anom*qsq/qsqmin+1.D0-qsq/qsqmin) + if (abs(dsea).lt.1.D-4) then + anom = 1.D0 + else + anom = (dsea1-dsea)/dsea/0.01D0 + endif + dsea = dsea*(qsq/qsqmin)**(anom*qsq/qsqmin+1.D0-qsq/qsqmin) + end if + + + + chm=0.d0 + if(qsq.gt.emc2) then + call jeppe2(0,xlog,qsqlog,nx,nqc,xxl,qqlc, & + &ccc(0,1,1,1,1,iset),chm) + endif + + bot=0.d0 + if(qsq.gt.emb2) then + call jeppe2(0,xlog,qsqlog,nx,nqb,xxl,qqlb, & + &ccb(0,1,1,1,1,iset),bot) + endif + + pdf(0) = glu + pdf(1) = dnv+dsea + pdf(-1) = dsea + pdf(2) = upv+usea + pdf(-2) = usea + pdf(3) = str + pdf(-3) = str + pdf(4) = chm + pdf(-4) = chm + pdf(5) = bot + pdf(-5) = bot + pdf(6) = 0.0d0 + pdf(-6) = 0.0d0 + + x=xsave + qsq=q2save + return + + entry MRSTgetgrid(nset,ngridx,ngridq,gridx,gridq) + do jx=1,nx + gridx(jx)=xx(jx) + enddo + do jq=1,nq + gridq(jq)=qq(jq) + enddo + ngridx=nx + ngridq=nq + return +! + entry MRSTread(nset) +! - dummy read in to get to End: (stream 1 is still open) + read(1,*)nmem(nset),ndef(nset) + + do i=0,nmem(nset) + do n=1,nx-1 + do m=1,nq + read(1,'(a)'),line + enddo + enddo + enddo + + do n=1,nx + xxl(n)=dlog(xx(n)) + enddo + do m=1,nq + qql(m)=dlog(qq(m)) + enddo + return +! + + entry MRSTalfa(nflav,alfas,Qalfa) + call getnset(iset) +! mem = member(iset) +! call setnmem(member(iset)) + call alphamrs(nflav,alfas,Qalfa) + return +! + entry MRSTinit(Eorder,Q2fit) + return +! + entry MRSTpdf(mem) +! if(mem.eq.0) mem=ndef +! imem = mem + call getnset(iset) +! member(iset)=mem + call setnmem(iset,mem) + +! have to reopen stream 1 + call getsetpath(setpath) + open(1,file=setpath(1:len_trim(setpath)),action='READ') + line = '' + do while (line(2:11).ne.'Evolution:') + read(1,'(a)'),line + enddo + read(1,'(a)'),line + read(1,'(a)'),line + + read(1,*)nmem(iset),ndef(iset) + +! - dummy read up to the member requested + do i=0,mem-1 + do n=1,nx-1 + do m=1,nq + read(1,'(a)')line + enddo + enddo + enddo + + +!- read in the data of the requested member + do 20 n=1,nx-1 + do 20 m=1,nq + read(1,50)f1(n,m),f2(n,m),f3(n,m),f4(n,m), & + & f5(n,m),f7(n,m),f6(n,m),f8(n,m) +! notation: 1=uval 2=val 3=glue 4=usea 5=chm 6=str 7=btm 8=dsea + 20 continue +! write(*,*)'PDF set ',nm,' first element ',f1(1,1) + + do 40 m=1,nq + f1(nx,m)=0.d0 + f2(nx,m)=0.d0 + f3(nx,m)=0.d0 + f4(nx,m)=0.d0 + f5(nx,m)=0.d0 + f6(nx,m)=0.d0 + f7(nx,m)=0.d0 + f8(nx,m)=0.d0 + 40 continue + + call jeppe1(0,nx,nq,xxl,qql,f1,cc1(0,1,1,1,1,iset)) + call jeppe1(0,nx,nq,xxl,qql,f2,cc2(0,1,1,1,1,iset)) + call jeppe1(0,nx,nq,xxl,qql,f3,cc3(0,1,1,1,1,iset)) + call jeppe1(0,nx,nq,xxl,qql,f4,cc4(0,1,1,1,1,iset)) + call jeppe1(0,nx,nq,xxl,qql,f6,cc6(0,1,1,1,1,iset)) + call jeppe1(0,nx,nq,xxl,qql,f8,cc8(0,1,1,1,1,iset)) + + emc2=2.045 + emb2=18.5 + + do 44 m=1,nqc + qqlc(m)=qql(m+nqc0) + do 44 n=1,nx + fc(n,m)=f5(n,m+nqc0) + 44 continue + qqlc(1)=dlog(emc2) + call jeppe1(0,nx,nqc,xxl,qqlc,fc,ccc(0,1,1,1,1,iset)) + + do 45 m=1,nqb + qqlb(m)=qql(m+nqb0) + do 45 n=1,nx + fb(n,m)=f7(n,m+nqb0) + 45 continue + qqlb(1)=dlog(emb2) + call jeppe1(0,nx,nqb,xxl,qqlb,fb,ccb(0,1,1,1,1,iset)) + + close(1) + 50 format(8f10.5) + + + return +! + END diff --git a/LHAPDF/lhapdf-5.9.1/src/wrapmrst.f b/LHAPDF/lhapdf-5.9.1/src/wrapmrst.f new file mode 100644 index 00000000000..b87664f6133 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/wrapmrst.f @@ -0,0 +1,258 @@ +! -*- F90 -*- + + + subroutine MRSTevolve(x,Q,pdf) + implicit real*8(a-h,o-z) + include 'parmsetup.inc' + character*16 name(nmxset) + integer nmem(nmxset),ndef(nmxset),mmem +! integer member(nmxset) + integer nset,iset + common/NAME/name,nmem,ndef,mmem + parameter(nx=49,nq=37,np=8,nqc0=2,nqb0=11,nqc=35,nqb=26, & + &nhess=30) + real*8 pdf(-6:6) + double precision gridx(nmxgridx),gridq(nmxgridq) + integer ngridx,ngridq,jx,jq + real*8 f1(nx,nq) & + &,f2(nx,nq) & + &,f3(nx,nq) & + &,f4(nx,nq) & + &,f5(nx,nq) & + &,f6(nx,nq) & + &,f7(nx,nq) & + &,f8(nx,nq) & + &,fc(nx,nqc),fb(nx,nqb) + real*8 qq(nq),xx(nx), & + &cc1(0:nhess,nx,nq,4,4,nmxset),cc2(0:nhess,nx,nq,4,4,nmxset), & + &cc3(0:nhess,nx,nq,4,4,nmxset),cc4(0:nhess,nx,nq,4,4,nmxset), & + &cc6(0:nhess,nx,nq,4,4,nmxset),cc8(0:nhess,nx,nq,4,4,nmxset), & + &ccc(0:nhess,nx,nqc,4,4,nmxset),ccb(0:nhess,nx,nqb,4,4,nmxset) + real*8 xxl(nx),qql(nq),qqlc(nqc),qqlb(nqb) + data xx/1d-5,2d-5,4d-5,6d-5,8d-5, & + & 1d-4,2d-4,4d-4,6d-4,8d-4, & + & 1d-3,2d-3,4d-3,6d-3,8d-3, & + & 1d-2,1.4d-2,2d-2,3d-2,4d-2,6d-2,8d-2, & + & .1d0,.125d0,.15d0,.175d0,.2d0,.225d0,.25d0,.275d0, & + & .3d0,.325d0,.35d0,.375d0,.4d0,.425d0,.45d0,.475d0, & + & .5d0,.525d0,.55d0,.575d0,.6d0,.65d0,.7d0,.75d0, & + & .8d0,.9d0,1d0/ + data qq/1.25d0,1.5d0,2d0,2.5d0,3.2d0,4d0,5d0,6.4d0,8d0,1d1, & + & 1.2d1,1.8d1,2.6d1,4d1,6.4d1,1d2, & + & 1.6d2,2.4d2,4d2,6.4d2,1d3,1.8d3,3.2d3,5.6d3,1d4, & + & 1.8d4,3.2d4,5.6d4,1d5,1.8d5,3.2d5,5.6d5,1d6, & + & 1.8d6,3.2d6,5.6d6,1d7/ + data xmin,xmax,qsqmin,qsqmax/1d-5,1d0,1.25d0,1d7/ + save + + xsave=x + qsq = q*q + q2save=qsq + + xlog=dlog(x) + qsqlog=dlog(qsq) + + call getnset(iset) +! imem=member(iset) + call getnmem(iset,imem) + + ! G.W. 24/04/2008 + if (qsq.lt.qsqmin) then + qsqlog=dlog(1.01D0*qsqmin) + call jeppe2(imem,xlog,qsqlog,nx,nq,xxl,qql, & + & cc1(0,1,1,1,1,iset),upv1) + call jeppe2(imem,xlog,qsqlog,nx,nq,xxl,qql, & + & cc2(0,1,1,1,1,iset),dnv1) + call jeppe2(imem,xlog,qsqlog,nx,nq,xxl,qql, & + & cc3(0,1,1,1,1,iset),glu1) + call jeppe2(imem,xlog,qsqlog,nx,nq,xxl,qql, & + & cc4(0,1,1,1,1,iset),usea1) + call jeppe2(imem,xlog,qsqlog,nx,nq,xxl,qql, & + & cc6(0,1,1,1,1,iset),str1) + call jeppe2(imem,xlog,qsqlog,nx,nq,xxl,qql, & + & cc8(0,1,1,1,1,iset),dsea1) + qsqlog=dlog(qsqmin) + end if + call jeppe2(imem,xlog,qsqlog,nx,nq,xxl,qql, & + &cc1(0,1,1,1,1,iset),upv) + call jeppe2(imem,xlog,qsqlog,nx,nq,xxl,qql, & + &cc2(0,1,1,1,1,iset),dnv) + call jeppe2(imem,xlog,qsqlog,nx,nq,xxl,qql, & + &cc3(0,1,1,1,1,iset),glu) + call jeppe2(imem,xlog,qsqlog,nx,nq,xxl,qql, & + &cc4(0,1,1,1,1,iset),usea) + call jeppe2(imem,xlog,qsqlog,nx,nq,xxl,qql, & + &cc6(0,1,1,1,1,iset),str) + call jeppe2(imem,xlog,qsqlog,nx,nq,xxl,qql, & + &cc8(0,1,1,1,1,iset),dsea) + ! G.W. 24/04/2008 + if (qsq.lt.qsqmin) then +!-- Calculate the anomalous dimension, dlog(xf)/dlog(qsq), +!-- evaluated at qsqmin. Then extrapolate the PDFs to low +!-- qsq < qsqmin by interpolating the anomalous dimenion between +!-- the value at qsqmin and a value of 1 for qsq << qsqmin. +!-- If value of PDF at qsqmin is very small, just set +!-- anomalous dimension to 1 to prevent rounding errors. + if (abs(upv).lt.1.D-4) then + anom = 1.D0 + else + anom = (upv1-upv)/upv/0.01D0 + endif + upv = upv*(qsq/qsqmin)**(anom*qsq/qsqmin+1.D0-qsq/qsqmin) + if (abs(dnv).lt.1.D-4) then + anom = 1.D0 + else + anom = (dnv1-dnv)/dnv/0.01D0 + endif + dnv = dnv*(qsq/qsqmin)**(anom*qsq/qsqmin+1.D0-qsq/qsqmin) + if (abs(glu).lt.1.D-4) then + anom = 1.D0 + else + anom = (glu1-glu)/glu/0.01D0 + endif + glu = glu*(qsq/qsqmin)**(anom*qsq/qsqmin+1.D0-qsq/qsqmin) + if (abs(usea).lt.1.D-4) then + anom = 1.D0 + else + anom = (usea1-usea)/usea/0.01D0 + endif + usea = usea*(qsq/qsqmin)**(anom*qsq/qsqmin+1.D0-qsq/qsqmin) + if (abs(str).lt.1.D-4) then + anom = 1.D0 + else + anom = (str1-str)/str/0.01D0 + endif + str = str*(qsq/qsqmin)**(anom*qsq/qsqmin+1.D0-qsq/qsqmin) + if (abs(dsea).lt.1.D-4) then + anom = 1.D0 + else + anom = (dsea1-dsea)/dsea/0.01D0 + endif + dsea = dsea*(qsq/qsqmin)**(anom*qsq/qsqmin+1.D0-qsq/qsqmin) + end if + + + + chm=0.d0 + if(qsq.gt.emc2) then + call jeppe2(imem,xlog,qsqlog,nx,nqc,xxl,qqlc, & + &ccc(0,1,1,1,1,iset),chm) + endif + + bot=0.d0 + if(qsq.gt.emb2) then + call jeppe2(imem,xlog,qsqlog,nx,nqb,xxl,qqlb, & + &ccb(0,1,1,1,1,iset),bot) + endif + + pdf(0) = glu + pdf(1) = dnv+dsea + pdf(-1) = dsea + pdf(2) = upv+usea + pdf(-2) = usea + pdf(3) = str + pdf(-3) = str + pdf(4) = chm + pdf(-4) = chm + pdf(5) = bot + pdf(-5) = bot + pdf(6) = 0.0d0 + pdf(-6) = 0.0d0 + + x=xsave + qsq=q2save + return +! + entry MRSTgetgrid(nset,ngridx,ngridq,gridx,gridq) + do jx=1,nx + gridx(jx)=xx(jx) + enddo + do jq=1,nq + gridq(jq)=qq(jq) + enddo + ngridx=nx + ngridq=nq + return + + entry MRSTread(nset) + read(1,*)nmem(nset),ndef(nset) +! print *,nmem(nset),ndef(nset) +! do nm = 0,nmem-1 + do nm = 0,nmem(nset) + do 20 n=1,nx-1 + do 20 m=1,nq + read(1,50)f1(n,m),f2(n,m),f3(n,m),f4(n,m), & + & f5(n,m),f7(n,m),f6(n,m),f8(n,m) +! notation: 1=uval 2=val 3=glue 4=usea 5=chm 6=str 7=btm 8=dsea + 20 continue +! write(*,*)'PDF set ',nm,' first element ',f1(1,1) + do 40 m=1,nq + f1(nx,m)=0.d0 + f2(nx,m)=0.d0 + f3(nx,m)=0.d0 + f4(nx,m)=0.d0 + f5(nx,m)=0.d0 + f6(nx,m)=0.d0 + f7(nx,m)=0.d0 + f8(nx,m)=0.d0 + 40 continue + + do n=1,nx + xxl(n)=dlog(xx(n)) + enddo + do m=1,nq + qql(m)=dlog(qq(m)) + enddo + + call jeppe1(nm,nx,nq,xxl,qql,f1,cc1(0,1,1,1,1,nset)) + call jeppe1(nm,nx,nq,xxl,qql,f2,cc2(0,1,1,1,1,nset)) + call jeppe1(nm,nx,nq,xxl,qql,f3,cc3(0,1,1,1,1,nset)) + call jeppe1(nm,nx,nq,xxl,qql,f4,cc4(0,1,1,1,1,nset)) + call jeppe1(nm,nx,nq,xxl,qql,f6,cc6(0,1,1,1,1,nset)) + call jeppe1(nm,nx,nq,xxl,qql,f8,cc8(0,1,1,1,1,nset)) + + emc2=2.045 + emb2=18.5 + + do 44 m=1,nqc + qqlc(m)=qql(m+nqc0) + do 44 n=1,nx + fc(n,m)=f5(n,m+nqc0) + 44 continue + qqlc(1)=dlog(emc2) + call jeppe1(nm,nx,nqc,xxl,qqlc,fc,ccc(0,1,1,1,1,nset)) + + do 45 m=1,nqb + qqlb(m)=qql(m+nqb0) + do 45 n=1,nx + fb(n,m)=f7(n,m+nqb0) + 45 continue + qqlb(1)=dlog(emb2) + call jeppe1(nm,nx,nqb,xxl,qqlb,fb,ccb(0,1,1,1,1,nset)) + + + enddo + 50 format(8f10.5) + return +! + + entry MRSTalfa(nflav,alfas,Qalfa) + call getnset(iset) +! mem = member(iset) +! call setnmem(member(iset)) + call alphamrs(nflav,alfas,Qalfa) + return +! + entry MRSTinit(Eorder,Q2fit) + return +! + entry MRSTpdf(mem) +! if(mem.eq.0) mem=ndef +! imem = mem + call getnset(iset) +! member(iset)=mem + call setnmem(iset,mem) + + return +! + END diff --git a/LHAPDF/lhapdf-5.9.1/src/wrapmrst2006-lite.f b/LHAPDF/lhapdf-5.9.1/src/wrapmrst2006-lite.f new file mode 100644 index 00000000000..2c478a13cd6 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/wrapmrst2006-lite.f @@ -0,0 +1,449 @@ +! -*- F90 -*- + + +subroutine MRST2006evolve(x,Q,pdf) + implicit none + ! implicit real*8 (a-h,o-z) + include 'parmsetup.inc' + character*16 name(nmxset) + character*80 line + character*512 setpath + integer i,f,nhess,nx,nq,np,nqc0,nqb0,nqc,nqb,n,m,io + double precision x,q,xmin,xmax,qsqmin,qsqmax,emc2,emb2,eps,dummy,qsq, & + xlog,qsqlog,res,ExtrapLHAPDF,InterpLHAPDF + double precision emc2minuseps,emb2minuseps + double precision xsave,q2save + double precision gridx(nmxgridx),gridq(nmxgridq) + integer ngridx,ngridq,jx,jq + double precision pdf(-6:6),alfas,Qalfa,Q2fit,eorder + double precision upv,dnv,glu,usea,str,dsea,sbar,chm,bot + integer iset,nflav,mem,nset,nmem(nmxset),ndef(nmxset),mmem,imem + common/NAME/name,nmem,ndef,mmem + parameter(nx=64,nq=48,np=9,nqc0=4,nqb0=14,nqc=nq-nqc0,nqb=nq-nqb0) + parameter(xmin=1d-6,xmax=1d0,qsqmin=1d0,qsqmax=1d9,eps=1d-6) + parameter(nhess=0,emc2=1.43d0**2,emb2=4.3d0**2) ! MRST 2006 NNLO + parameter(emc2minuseps=emc2-eps,emb2minuseps=emb2-eps) + double precision f1(nx,nq),f2(nx,nq),f3(nx,nq),f4(nx,nq),f5(nx,nq), & + f6(nx,nq),f7(nx,nq),f8(nx,nq),fc(nx,nqc),fb(nx,nqb),f9(nx,nq) + double precision qq(nq),xx(nx),cc1(0:nhess,nx,nq,4,4),cc2(0:nhess,nx,nq,4,4), & + cc3(0:nhess,nx,nq,4,4),cc4(0:nhess,nx,nq,4,4),cc6(0:nhess,nx,nq,4,4), & + cc8(0:nhess,nx,nq,4,4),cc9(0:nhess,nx,nq,4,4),ccc(0:nhess,nx,nqc,4,4), & + ccb(0:nhess,nx,nqb,4,4) + double precision xxl(nx),qql(nq),qqlc(nqc),qqlb(nqb) + data xx/1d-6,2d-6,4d-6,6d-6,8d-6,1d-5,2d-5,4d-5,6d-5,8d-5,1d-4,2d-4,4d-4,6d-4, & + 8d-4,1d-3,2d-3,4d-3,6d-3,8d-3,1d-2,1.4d-2,2d-2,3d-2,4d-2,6d-2,8d-2, & + .1d0,.125d0,.15d0,.175d0,.2d0,.225d0,.25d0,.275d0,.3d0,.325d0,.35d0,.375d0, & + .4d0,.425d0,.45d0,.475d0,.5d0,.525d0,.55d0,.575d0,.6d0,.625d0,.65d0,.675d0, & + .7d0,.725d0,.75d0,.775d0,.8d0,.825d0,.85d0,.875d0,.9d0,.925d0,.95d0,.975d0,1d0/ + data qq/1.d0,1.25d0,1.5d0,emc2minuseps,emc2,2.5d0,3.2d0,4d0,5d0,6.4d0,8d0,1d1,1.2d1, & + emb2minuseps,emb2,2.6d1,4d1,6.4d1,1d2,1.6d2,2.4d2,4d2,6.4d2,1d3,1.8d3,3.2d3,5.6d3, & + 1d4,1.8d4,3.2d4,5.6d4,1d5,1.8d5,3.2d5,5.6d5,1d6,1.8d6,3.2d6,5.6d6,1d7,1.8d7,3.2d7, & + 5.6d7,1d8,1.8d8,3.2d8,5.6d8,1d9/ + save + + xsave=x + qsq=q*q + q2save=qsq + + if (qsq.gt.qq(nqc0).and.qsq.lt.qq(nqc0+1)) qsq = qq(nqc0) + if (qsq.gt.qq(nqb0).and.qsq.lt.qq(nqb0+1)) qsq = qq(nqb0) + + xlog=log10(x) + qsqlog=log10(qsq) + + call getnset(iset) + call getnmem(iset,imem) + + upv = 0.d0 + dnv = 0.d0 + glu = 0.d0 + usea = 0.d0 + str = 0.d0 + dsea = 0.d0 + sbar = 0.d0 + chm = 0.d0 + bot = 0.d0 + + if (x.le.0.d0.or.x.gt.xmax.or.qsq.lt.qsqmin) then + print *,"Error in GetOnePDF: x,qsq = ",x,qsq + else if (x.lt.xmin.or.qsq.gt.qsqmax) then ! extrapolate + print *, "Warning in GetOnePDF, extrapolating: f = ",f,", x = ",x,", q = ",q + upv = ExtrapLHAPDF(imem,nhess,xlog,qsqlog,nx,nq,xxl,qql,cc1) + dnv = ExtrapLHAPDF(imem,nhess,xlog,qsqlog,nx,nq,xxl,qql,cc2) + glu = ExtrapLHAPDF(imem,nhess,xlog,qsqlog,nx,nq,xxl,qql,cc3) + usea = ExtrapLHAPDF(imem,nhess,xlog,qsqlog,nx,nq,xxl,qql,cc4) + str = ExtrapLHAPDF(imem,nhess,xlog,qsqlog,nx,nq,xxl,qql,cc6) + dsea = ExtrapLHAPDF(imem,nhess,xlog,qsqlog,nx,nq,xxl,qql,cc8) + sbar = ExtrapLHAPDF(imem,nhess,xlog,qsqlog,nx,nq,xxl,qql,cc9) + if (qsq.ge.emc2) then ! chm + chm = ExtrapLHAPDF(imem,nhess,xlog,qsqlog,nx,nqc,xxl,qqlc,ccc) + endif + if (qsq.ge.emb2) then ! bot + bot = ExtrapLHAPDF(imem,nhess,xlog,qsqlog,nx,nqb,xxl,qqlb,ccb) + endif + else + upv = InterpLHAPDF(imem,nhess,xlog,qsqlog,nx,nq,xxl,qql,cc1) + dnv = InterpLHAPDF(imem,nhess,xlog,qsqlog,nx,nq,xxl,qql,cc2) + glu = InterpLHAPDF(imem,nhess,xlog,qsqlog,nx,nq,xxl,qql,cc3) + usea = InterpLHAPDF(imem,nhess,xlog,qsqlog,nx,nq,xxl,qql,cc4) + str = InterpLHAPDF(imem,nhess,xlog,qsqlog,nx,nq,xxl,qql,cc6) + dsea = InterpLHAPDF(imem,nhess,xlog,qsqlog,nx,nq,xxl,qql,cc8) + sbar = InterpLHAPDF(imem,nhess,xlog,qsqlog,nx,nq,xxl,qql,cc9) + if (qsq.ge.emc2) then ! chm + chm = InterpLHAPDF(imem,nhess,xlog,qsqlog,nx,nqc,xxl,qqlc,ccc) + endif + if (qsq.ge.emb2) then ! bot + bot = InterpLHAPDF(imem,nhess,xlog,qsqlog,nx,nqb,xxl,qqlb,ccb) + endif + + end if + + pdf(0) = glu + pdf(1) = dnv+dsea + pdf(-1) = dsea + pdf(2) = upv+usea + pdf(-2) = usea + pdf(3) = str + pdf(-3) = sbar + pdf(4) = chm + pdf(-4) = chm + pdf(5) = bot + pdf(-5) = bot + pdf(6) = 0.0d0 + pdf(-6) = 0.0d0 + + x=xsave + qsq=q2save + return + + entry MRST2006getgrid(nset,ngridx,ngridq,gridx,gridq) + do jx=1,nx + gridx(jx)=xx(jx) + enddo + do jq=1,nq + gridq(jq)=qq(jq) + enddo + ngridx=nx + ngridq=nq + return + !---------------------------------------------------------------------- + + entry MRST2006read(nset) + ! - dummy read in to get to End: (stream 1 is still open) + read(1,*)nmem(nset),ndef(nset) + + do i=0,nmem(nset) + do n=1,nx-1 + do m=1,nq + read(1,'(a)') line + enddo + enddo + enddo + + + return + !---------------------------------------------------------------------- + + entry MRST2006alfa(nflav,alfas,Qalfa) + ! print *,'MRST2006alfa',nflav,alfas,Qalfa + call getnset(iset) + call alphamrs(nflav,alfas,Qalfa) + ! print *,'MRST2006alfa',nflav,alfas,Qalfa + return + + !---------------------------------------------------------------------- + + entry MRST2006init(Eorder,Q2fit) + return + + !---------------------------------------------------------------------- + + entry MRST2006pdf(mem) + call getnset(iset) + call setnmem(iset,mem) + + ! have to reopen stream 1 + call getsetpath(setpath) + open(1,file=setpath(1:len_trim(setpath)),action='READ') + + line = '' + do while (line(2:11).ne.'Evolution:') + read(1,'(a)'),line + enddo + read(1,'(a)'),line + read(1,'(a)'),line + + read(1,*)nmem(iset),ndef(iset) + + ! - dummy read up to the member requested + do i=0,mem-1 + do n=1,nx-1 + do m=1,nq + read(1,'(a)')line + enddo + enddo + enddo + + + !- read in the data of the requested member + do n=1,nx-1 + do m=1,nq + ! print *,i,n,m + read(1,50) f1(n,m),f2(n,m),f3(n,m),f4(n,m),f5(n,m),f7(n,m),f6(n,m),f8(n,m),f9(n,m) + ! write(6,50) f1(n,m),f2(n,m),f3(n,m),f4(n,m),f5(n,m),f7(n,m),f6(n,m),f8(n,m),f9(n,m) + !-- Notation:1=upv 2=dnv 3=glu 4=usea 5=chm 6=str 7=bot 8=dsea 9=sbar + enddo + enddo + ! write(*,*)'PDF set ',i,' first element ',f1(1,1) + do m=1,nq + f1(nx,m)=0d0 + f2(nx,m)=0d0 + f3(nx,m)=0d0 + f4(nx,m)=0d0 + f5(nx,m)=0d0 + f6(nx,m)=0d0 + f7(nx,m)=0d0 + f8(nx,m)=0d0 + f9(nx,m)=0d0 + enddo + + do n=1,nx + xxl(n)=log10(xx(n)) + enddo + do m=1,nq + qql(m)=log10(qq(m)) + enddo + + call InitialLHAPDF(i,nhess,nx,nq,nqc0,nqb0,xxl,qql,f1,cc1) + call InitialLHAPDF(i,nhess,nx,nq,nqc0,nqb0,xxl,qql,f2,cc2) + call InitialLHAPDF(i,nhess,nx,nq,nqc0,nqb0,xxl,qql,f3,cc3) + call InitialLHAPDF(i,nhess,nx,nq,nqc0,nqb0,xxl,qql,f4,cc4) + call InitialLHAPDF(i,nhess,nx,nq,nqc0,nqb0,xxl,qql,f6,cc6) + call InitialLHAPDF(i,nhess,nx,nq,nqc0,nqb0,xxl,qql,f8,cc8) + call InitialLHAPDF(i,nhess,nx,nq,nqc0,nqb0,xxl,qql,f9,cc9) + + do m=1,nqc + qqlc(m)=qql(m+nqc0) + do n=1,nx + fc(n,m)=f5(n,m+nqc0) + enddo + enddo + call InitialLHAPDF(i,nhess,nx,nqc,nqc0-nqc0,nqb0-nqc0,xxl,qqlc,fc,ccc) + + do m=1,nqb + qqlb(m)=qql(m+nqb0) + do n=1,nx + fb(n,m)=f7(n,m+nqb0) + enddo + enddo + call InitialLHAPDF(i,nhess,nx,nqb,nqc0-nqb0,nqb0-nqb0,xxl,qqlb,fb,ccb) + + close(1) + +50 format(9e13.5) + +end subroutine MRST2006evolve + + +!---------------------------------------------------------------------- + + +subroutine InitialLHAPDF(i,nhess,nx,my,myc0,myb0,xx,yy,ff,cc) + implicit none + integer nhess,i,nx,my,myc0,myb0,j,k,l,m,n + double precision xx(nx),yy(my),ff(nx,my),ff1(nx,my),ff2(nx,my),ff12(nx,my), & + yy0(4),yy1(4),yy2(4),yy12(4),z(16),cl(16),cc(0:nhess,nx,my,4,4), & + iwt(16,16),dx,dy,polderiv,d1,d2,d1d2,xxd + data iwt/1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0, & + -3,0,0,3,0,0,0,0,-2,0,0,-1,0,0,0,0, & + 2,0,0,-2,0,0,0,0,1,0,0,1,0,0,0,0, & + 0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0, & + 0,0,0,0,-3,0,0,3,0,0,0,0,-2,0,0,-1, & + 0,0,0,0,2,0,0,-2,0,0,0,0,1,0,0,1, & + -3,3,0,0,-2,-1,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,-3,3,0,0,-2,-1,0,0, & + 9,-9,9,-9,6,3,-3,-6,6,-6,-3,3,4,2,1,2, & + -6,6,-6,6,-4,-2,2,4,-3,3,3,-3,-2,-1,-1,-2, & + 2,-2,0,0,1,1,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,2,-2,0,0,1,1,0,0, & + -6,6,-6,6,-3,-3,3,3,-4,4,2,-2,-2,-2,-1,-1, & + 4,-4,4,-4,2,2,-2,-2,2,-2,-2,2,1,1,1,1/ + + do m=1,my + dx=xx(2)-xx(1) + ff1(1,m)=(ff(2,m)-ff(1,m))/dx + dx=xx(nx)-xx(nx-1) + ff1(nx,m)=(ff(nx,m)-ff(nx-1,m))/dx + do n=2,nx-1 + ff1(n,m)=polderiv(xx(n-1),xx(n),xx(n+1),ff(n-1,m),ff(n,m),ff(n+1,m)) + enddo + enddo + + !-- Calculate the derivatives at qsq=emc2-eps,emc2,emb2-eps,emb2 + !-- in a similar way as at the endpoints qsqmin and qsqmax. + do n=1,nx + do m = 1, my + if (m.eq.1.or.m.eq.myc0+1.or.m.eq.myb0+1) then + dy=yy(m+1)-yy(m) + ff2(n,m)=(ff(n,m+1)-ff(n,m))/dy + else if (m.eq.my.or.m.eq.myc0.or.m.eq.myb0) then + dy=yy(m)-yy(m-1) + ff2(n,m)=(ff(n,m)-ff(n,m-1))/dy + else + ff2(n,m)=polderiv(yy(m-1),yy(m),yy(m+1),ff(n,m-1),ff(n,m),ff(n,m+1)) + end if + end do + end do + + do m=1,my + dx=xx(2)-xx(1) + ff12(1,m)=(ff2(2,m)-ff2(1,m))/dx + dx=xx(nx)-xx(nx-1) + ff12(nx,m)=(ff2(nx,m)-ff2(nx-1,m))/dx + do n=2,nx-1 + ff12(n,m)=polderiv(xx(n-1),xx(n),xx(n+1),ff2(n-1,m),ff2(n,m),ff2(n+1,m)) + enddo + enddo + + do n=1,nx-1 + do m=1,my-1 + d1=xx(n+1)-xx(n) + d2=yy(m+1)-yy(m) + d1d2=d1*d2 + + yy0(1)=ff(n,m) + yy0(2)=ff(n+1,m) + yy0(3)=ff(n+1,m+1) + yy0(4)=ff(n,m+1) + + yy1(1)=ff1(n,m) + yy1(2)=ff1(n+1,m) + yy1(3)=ff1(n+1,m+1) + yy1(4)=ff1(n,m+1) + + yy2(1)=ff2(n,m) + yy2(2)=ff2(n+1,m) + yy2(3)=ff2(n+1,m+1) + yy2(4)=ff2(n,m+1) + + yy12(1)=ff12(n,m) + yy12(2)=ff12(n+1,m) + yy12(3)=ff12(n+1,m+1) + yy12(4)=ff12(n,m+1) + + do k=1,4 + z(k)=yy0(k) + z(k+4)=yy1(k)*d1 + z(k+8)=yy2(k)*d2 + z(k+12)=yy12(k)*d1d2 + enddo + + do l=1,16 + xxd=0.d0 + do k=1,16 + xxd=xxd+iwt(k,l)*z(k) + enddo + cl(l)=xxd + enddo + l=0 + do k=1,4 + do j=1,4 + l=l+1 + cc(i,n,m,k,j)=cl(l) + enddo + enddo + enddo + enddo + return +end subroutine InitialLHAPDF + + +!---------------------------------------------------------------------- + + +double precision function InterpLHAPDF(i,nhess,x,y,nx,my,xx,yy,cc) + implicit none + integer i,nx,my,nhess,locx,l,m,n + double precision xx(nx),yy(my),cc(0:nhess,nx,my,4,4),x,y,z,t,u + + n=locx(xx,nx,x) + m=locx(yy,my,y) + + t=(x-xx(n))/(xx(n+1)-xx(n)) + u=(y-yy(m))/(yy(m+1)-yy(m)) + + z=0.d0 + do l=4,1,-1 + z = t*z + ((cc(i,n,m,l,4)*u + cc(i,n,m,l,3))*u + cc(i,n,m,l,2))*u + cc(i,n,m,l,1) + enddo + + InterpLHAPDF = z + + return +end function InterpLHAPDF + + +!---------------------------------------------------------------------- + + +double precision function ExtrapLHAPDF(i,nhess,x,y,nx,my,xx,yy,cc) + implicit none + integer i,nx,my,nhess,locx,n,m + double precision xx(nx),yy(my),cc(0:nhess,nx,my,4,4),x,y,z,f0,f1,z0,z1,InterpLHAPDF + + n=locx(xx,nx,x) ! 0: below xmin, nx: above xmax + m=locx(yy,my,y) ! 0: below qsqmin, my: above qsqmax + + !-- If extrapolation in small x only: + if (n.eq.0.and.m.gt.0.and.m.lt.my) then + f0 = InterpLHAPDF(i,nhess,xx(1),y,nx,my,xx,yy,cc) + f1 = InterpLHAPDF(i,nhess,xx(2),y,nx,my,xx,yy,cc) + if (f0.gt.0.d0.and.f1.gt.0.d0) then + z = exp(log(f0)+(log(f1)-log(f0))/(xx(2)-xx(1))*(x-xx(1))) + else + z = f0+(f1-f0)/(xx(2)-xx(1))*(x-xx(1)) + end if + !-- If extrapolation into large q only: + else if (n.gt.0.and.m.eq.my) then + f0 = InterpLHAPDF(i,nhess,x,yy(my),nx,my,xx,yy,cc) + f1 = InterpLHAPDF(i,nhess,x,yy(my-1),nx,my,xx,yy,cc) + if (f0.gt.0.d0.and.f1.gt.0.d0) then + z = exp(log(f0)+(log(f0)-log(f1))/(yy(my)-yy(my-1))*(y-yy(my))) + else + z = f0+(f0-f1)/(yy(my)-yy(my-1))*(y-yy(my)) + end if + !-- If extrapolation into large q AND small x: + else if (n.eq.0.and.m.eq.my) then + f0 = InterpLHAPDF(i,nhess,xx(1),yy(my),nx,my,xx,yy,cc) + f1 = InterpLHAPDF(i,nhess,xx(1),yy(my-1),nx,my,xx,yy,cc) + if (f0.gt.0.d0.and.f1.gt.0.d0) then + z0 = exp(log(f0)+(log(f0)-log(f1))/(yy(my)-yy(my-1))*(y-yy(my))) + else + z0 = f0+(f0-f1)/(yy(my)-yy(my-1))*(y-yy(my)) + end if + f0 = InterpLHAPDF(i,nhess,xx(2),yy(my),nx,my,xx,yy,cc) + f1 = InterpLHAPDF(i,nhess,xx(2),yy(my-1),nx,my,xx,yy,cc) + if (f0.gt.0.d0.and.f1.gt.0.d0) then + z1 = exp(log(f0)+(log(f0)-log(f1))/(yy(my)-yy(my-1))*(y-yy(my))) + else + z1 = f0+(f0-f1)/(yy(my)-yy(my-1))*(y-yy(my)) + end if + if (z0.gt.0.d0.and.z1.gt.0.d0) then + z = exp(log(z0)+(log(z1)-log(z0))/(xx(2)-xx(1))*(x-xx(1))) + else + z = z0+(z1-z0)/(xx(2)-xx(1))*(x-xx(1)) + end if + else + print *,"Error in ExtrapLHAPDF" + stop + end if + + ExtrapLHAPDF = z + + return +end function ExtrapLHAPDF + + +!---------------------------------------------------------------------- diff --git a/LHAPDF/lhapdf-5.9.1/src/wrapmrst2006.f b/LHAPDF/lhapdf-5.9.1/src/wrapmrst2006.f new file mode 100644 index 00000000000..42d14456de1 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/wrapmrst2006.f @@ -0,0 +1,445 @@ +! -*- F90 -*- + + + subroutine MRST2006evolve(x,Q,pdf) + implicit none +! implicit real*8 (a-h,o-z) + include 'parmsetup.inc' + character*16 name(nmxset) + integer i,f,nhess,nx,nq,np,nqc0,nqb0,nqc,nqb,n,m,io + double precision x,q,xmin,xmax,qsqmin,qsqmax,emc2,emb2,eps, & + & dummy,qsq,xlog,qsqlog,res,ExtrapLHAPDF,InterpLHAPDF + double precision emc2minuseps,emb2minuseps + double precision xsave,q2save + double precision gridx(nmxgridx),gridq(nmxgridq) + integer ngridx,ngridq,jx,jq + double precision pdf(-6:6),alfas,Qalfa,Q2fit,eorder + double precision upv,dnv,glu,usea,str,dsea,sbar,chm,bot + integer iset,nflav,mem,nset,nmem(nmxset),ndef(nmxset),mmem,imem + common/NAME/name,nmem,ndef,mmem + parameter(nx=64,nq=48,np=9,nqc0=4,nqb0=14,nqc=nq-nqc0,nqb=nq-nqb0) + parameter(xmin=1d-6,xmax=1d0,qsqmin=1d0,qsqmax=1d9,eps=1d-6) + ! MRST 2006 NNLO + parameter(nhess=30,emc2=1.43d0**2,emb2=4.3d0**2) + parameter(emc2minuseps=emc2-eps,emb2minuseps=emb2-eps) + double precision f1(nx,nq),f2(nx,nq),f3(nx,nq),f4(nx,nq), & + & f5(nx,nq),f6(nx,nq),f7(nx,nq),f8(nx,nq),fc(nx,nqc), & + & fb(nx,nqb),f9(nx,nq) + double precision qq(nq),xx(nx),cc1(0:nhess,nx,nq,4,4), & + & cc2(0:nhess,nx,nq,4,4),cc3(0:nhess,nx,nq,4,4), & + & cc4(0:nhess,nx,nq,4,4),cc6(0:nhess,nx,nq,4,4), & + & cc8(0:nhess,nx,nq,4,4),cc9(0:nhess,nx,nq,4,4), & + & ccc(0:nhess,nx,nqc,4,4),ccb(0:nhess,nx,nqb,4,4) + double precision xxl(nx),qql(nq),qqlc(nqc),qqlb(nqb) + data xx/1d-6,2d-6,4d-6,6d-6,8d-6, & + & 1d-5,2d-5,4d-5,6d-5,8d-5, & + & 1d-4,2d-4,4d-4,6d-4,8d-4, & + & 1d-3,2d-3,4d-3,6d-3,8d-3, & + & 1d-2,1.4d-2,2d-2,3d-2,4d-2,6d-2,8d-2, & + & .1d0,.125d0,.15d0,.175d0,.2d0,.225d0,.25d0,.275d0, & + & .3d0,.325d0,.35d0,.375d0,.4d0,.425d0,.45d0,.475d0, & + & .5d0,.525d0,.55d0,.575d0,.6d0,.625d0,.65d0,.675d0, & + & .7d0,.725d0,.75d0,.775d0,.8d0,.825d0,.85d0,.875d0, & + & .9d0,.925d0,.95d0,.975d0,1d0/ + data qq/1.d0, & + & 1.25d0,1.5d0,emc2minuseps,emc2,2.5d0,3.2d0,4d0,5d0,6.4d0,8d0,& + & 1d1,1.2d1,emb2minuseps,emb2,2.6d1,4d1,6.4d1,1d2, & + & 1.6d2,2.4d2,4d2,6.4d2,1d3,1.8d3,3.2d3,5.6d3,1d4, & + & 1.8d4,3.2d4,5.6d4,1d5,1.8d5,3.2d5,5.6d5,1d6, & + & 1.8d6,3.2d6,5.6d6,1d7,1.8d7,3.2d7,5.6d7,1d8, & + & 1.8d8,3.2d8,5.6d8,1d9/ + save + + xsave=x + qsq=q*q + q2save=qsq + + + if (qsq.gt.qq(nqc0).and.qsq.lt.qq(nqc0+1)) qsq = qq(nqc0) + if (qsq.gt.qq(nqb0).and.qsq.lt.qq(nqb0+1)) qsq = qq(nqb0) + + xlog=log10(x) + qsqlog=log10(qsq) + + call getnset(iset) + call getnmem(iset,imem) + + upv = 0.d0 + dnv = 0.d0 + glu = 0.d0 + usea = 0.d0 + str = 0.d0 + dsea = 0.d0 + sbar = 0.d0 + chm = 0.d0 + bot = 0.d0 + + if (x.le.0.d0.or.x.gt.xmax.or.qsq.lt.qsqmin) then + print *,"Error in GetOnePDF: x,qsq = ",x,qsq + ! extrapolate + else if (x.lt.xmin.or.qsq.gt.qsqmax) then + print *, "Warning in GetOnePDF, extrapolating: f = ",f, & + & ", x = ",x,", q = ",q + upv = ExtrapLHAPDF(imem,nhess,xlog,qsqlog,nx,nq,xxl,qql,cc1) + dnv = ExtrapLHAPDF(imem,nhess,xlog,qsqlog,nx,nq,xxl,qql,cc2) + glu = ExtrapLHAPDF(imem,nhess,xlog,qsqlog,nx,nq,xxl,qql,cc3) + usea = ExtrapLHAPDF(imem,nhess,xlog,qsqlog,nx,nq,xxl,qql,cc4) + str = ExtrapLHAPDF(imem,nhess,xlog,qsqlog,nx,nq,xxl,qql,cc6) + dsea = ExtrapLHAPDF(imem,nhess,xlog,qsqlog,nx,nq,xxl,qql,cc8) + sbar = ExtrapLHAPDF(imem,nhess,xlog,qsqlog,nx,nq,xxl,qql,cc9) + ! chm + if (qsq.ge.emc2) then + chm = ExtrapLHAPDF(imem,nhess,xlog,qsqlog,nx,nqc,xxl,qqlc,ccc) + endif + ! bot + if (qsq.ge.emb2) then + bot = ExtrapLHAPDF(imem,nhess,xlog,qsqlog,nx,nqb,xxl,qqlb,ccb) + endif + else + upv = InterpLHAPDF(imem,nhess,xlog,qsqlog,nx,nq,xxl,qql,cc1) + dnv = InterpLHAPDF(imem,nhess,xlog,qsqlog,nx,nq,xxl,qql,cc2) + glu = InterpLHAPDF(imem,nhess,xlog,qsqlog,nx,nq,xxl,qql,cc3) + usea = InterpLHAPDF(imem,nhess,xlog,qsqlog,nx,nq,xxl,qql,cc4) + str = InterpLHAPDF(imem,nhess,xlog,qsqlog,nx,nq,xxl,qql,cc6) + dsea = InterpLHAPDF(imem,nhess,xlog,qsqlog,nx,nq,xxl,qql,cc8) + sbar = InterpLHAPDF(imem,nhess,xlog,qsqlog,nx,nq,xxl,qql,cc9) + ! chm + if (qsq.ge.emc2) then + chm = InterpLHAPDF(imem,nhess,xlog,qsqlog,nx,nqc,xxl,qqlc,ccc) + endif + ! bot + if (qsq.ge.emb2) then + bot = InterpLHAPDF(imem,nhess,xlog,qsqlog,nx,nqb,xxl,qqlb,ccb) + endif + + end if + + pdf(0) = glu + pdf(1) = dnv+dsea + pdf(-1) = dsea + pdf(2) = upv+usea + pdf(-2) = usea + pdf(3) = str + pdf(-3) = sbar + pdf(4) = chm + pdf(-4) = chm + pdf(5) = bot + pdf(-5) = bot + pdf(6) = 0.0d0 + pdf(-6) = 0.0d0 + + x=xsave + qsq=q2save + return +! + + entry MRST2006getgrid(nset,ngridx,ngridq,gridx,gridq) + do jx=1,nx + gridx(jx)=xx(jx) + enddo + do jq=1,nq + gridq(jq)=qq(jq) + enddo + ngridx=nx + ngridq=nq + return +!---------------------------------------------------------------------- + + entry MRST2006read(nset) + read(1,*)nmem(nset),ndef(nset) + + + do i = 0,nhess + + + do n=1,nx-1 + do m=1,nq +! print *,i,n,m + read(1,50) f1(n,m),f2(n,m),f3(n,m),f4(n,m), & + & f5(n,m),f7(n,m),f6(n,m),f8(n,m),f9(n,m) +! write(6,50) f1(n,m),f2(n,m),f3(n,m),f4(n,m), +! & f5(n,m),f7(n,m),f6(n,m),f8(n,m),f9(n,m) +!-- Notation:1=upv 2=dnv 3=glu 4=usea 5=chm 6=str 7=bot 8=dsea 9=sbar + enddo + enddo +! write(*,*)'PDF set ',i,' first element ',f1(1,1) + do m=1,nq + f1(nx,m)=0d0 + f2(nx,m)=0d0 + f3(nx,m)=0d0 + f4(nx,m)=0d0 + f5(nx,m)=0d0 + f6(nx,m)=0d0 + f7(nx,m)=0d0 + f8(nx,m)=0d0 + f9(nx,m)=0d0 + enddo + + do n=1,nx + xxl(n)=log10(xx(n)) + enddo + do m=1,nq + qql(m)=log10(qq(m)) + enddo + + call InitialLHAPDF(i,nhess,nx,nq,nqc0,nqb0,xxl,qql,f1,cc1) + call InitialLHAPDF(i,nhess,nx,nq,nqc0,nqb0,xxl,qql,f2,cc2) + call InitialLHAPDF(i,nhess,nx,nq,nqc0,nqb0,xxl,qql,f3,cc3) + call InitialLHAPDF(i,nhess,nx,nq,nqc0,nqb0,xxl,qql,f4,cc4) + call InitialLHAPDF(i,nhess,nx,nq,nqc0,nqb0,xxl,qql,f6,cc6) + call InitialLHAPDF(i,nhess,nx,nq,nqc0,nqb0,xxl,qql,f8,cc8) + call InitialLHAPDF(i,nhess,nx,nq,nqc0,nqb0,xxl,qql,f9,cc9) + + do m=1,nqc + qqlc(m)=qql(m+nqc0) + do n=1,nx + fc(n,m)=f5(n,m+nqc0) + enddo + enddo + call InitialLHAPDF(i,nhess,nx,nqc,nqc0-nqc0,nqb0-nqc0, & + & xxl,qqlc,fc,ccc) + + do m=1,nqb + qqlb(m)=qql(m+nqb0) + do n=1,nx + fb(n,m)=f7(n,m+nqb0) + enddo + enddo + call InitialLHAPDF(i,nhess,nx,nqb,nqc0-nqb0,nqb0-nqb0, & + & xxl,qqlb,fb,ccb) + + enddo + + 50 format(9e13.5) + return +!---------------------------------------------------------------------- + + entry MRST2006alfa(nflav,alfas,Qalfa) +! print *,'MRST2006alfa',nflav,alfas,Qalfa + call getnset(iset) + call alphamrs(nflav,alfas,Qalfa) +! print *,'MRST2006alfa',nflav,alfas,Qalfa + return +! +!---------------------------------------------------------------------- + entry MRST2006init(Eorder,Q2fit) + return +!---------------------------------------------------------------------- +! + entry MRST2006pdf(mem) + call getnset(iset) + call setnmem(iset,mem) + return +! + END + +!---------------------------------------------------------------------- + + subroutine InitialLHAPDF(i,nhess,nx,my,myc0,myb0,xx,yy,ff,cc) + implicit none + integer nhess,i,nx,my,myc0,myb0,j,k,l,m,n + double precision xx(nx),yy(my),ff(nx,my), & + & ff1(nx,my),ff2(nx,my), & + & ff12(nx,my),yy0(4),yy1(4),yy2(4),yy12(4),z(16), & + & cl(16),cc(0:nhess,nx,my,4,4),iwt(16,16), & + & dx,dy,polderiv,d1,d2,d1d2,xxd + + data iwt/1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, & + & 0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0, & + & -3,0,0,3,0,0,0,0,-2,0,0,-1,0,0,0,0, & + & 2,0,0,-2,0,0,0,0,1,0,0,1,0,0,0,0, & + & 0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0, & + & 0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0, & + & 0,0,0,0,-3,0,0,3,0,0,0,0,-2,0,0,-1, & + & 0,0,0,0,2,0,0,-2,0,0,0,0,1,0,0,1, & + & -3,3,0,0,-2,-1,0,0,0,0,0,0,0,0,0,0, & + & 0,0,0,0,0,0,0,0,-3,3,0,0,-2,-1,0,0, & + & 9,-9,9,-9,6,3,-3,-6,6,-6,-3,3,4,2,1,2, & + & -6,6,-6,6,-4,-2,2,4,-3,3,3,-3,-2,-1,-1,-2, & + & 2,-2,0,0,1,1,0,0,0,0,0,0,0,0,0,0, & + & 0,0,0,0,0,0,0,0,2,-2,0,0,1,1,0,0, & + & -6,6,-6,6,-3,-3,3,3,-4,4,2,-2,-2,-2,-1,-1, & + & 4,-4,4,-4,2,2,-2,-2,2,-2,-2,2,1,1,1,1/ + + do m=1,my + dx=xx(2)-xx(1) + ff1(1,m)=(ff(2,m)-ff(1,m))/dx + dx=xx(nx)-xx(nx-1) + ff1(nx,m)=(ff(nx,m)-ff(nx-1,m))/dx + do n=2,nx-1 + ff1(n,m)=polderiv(xx(n-1),xx(n),xx(n+1),ff(n-1,m),ff(n,m), & + & ff(n+1,m)) + enddo + enddo + +!-- Calculate the derivatives at qsq=emc2-eps,emc2,emb2-eps,emb2 +!-- in a similar way as at the endpoints qsqmin and qsqmax. + do n=1,nx + do m = 1, my + if (m.eq.1.or.m.eq.myc0+1.or.m.eq.myb0+1) then + dy=yy(m+1)-yy(m) + ff2(n,m)=(ff(n,m+1)-ff(n,m))/dy + else if (m.eq.my.or.m.eq.myc0.or.m.eq.myb0) then + dy=yy(m)-yy(m-1) + ff2(n,m)=(ff(n,m)-ff(n,m-1))/dy + else + ff2(n,m)=polderiv(yy(m-1),yy(m),yy(m+1),ff(n,m-1), & + & ff(n,m),ff(n,m+1)) + end if + end do + end do + + do m=1,my + dx=xx(2)-xx(1) + ff12(1,m)=(ff2(2,m)-ff2(1,m))/dx + dx=xx(nx)-xx(nx-1) + ff12(nx,m)=(ff2(nx,m)-ff2(nx-1,m))/dx + do n=2,nx-1 + ff12(n,m)=polderiv(xx(n-1),xx(n),xx(n+1),ff2(n-1,m), & + & ff2(n,m),ff2(n+1,m)) + enddo + enddo + + do n=1,nx-1 + do m=1,my-1 + d1=xx(n+1)-xx(n) + d2=yy(m+1)-yy(m) + d1d2=d1*d2 + + yy0(1)=ff(n,m) + yy0(2)=ff(n+1,m) + yy0(3)=ff(n+1,m+1) + yy0(4)=ff(n,m+1) + + yy1(1)=ff1(n,m) + yy1(2)=ff1(n+1,m) + yy1(3)=ff1(n+1,m+1) + yy1(4)=ff1(n,m+1) + + yy2(1)=ff2(n,m) + yy2(2)=ff2(n+1,m) + yy2(3)=ff2(n+1,m+1) + yy2(4)=ff2(n,m+1) + + yy12(1)=ff12(n,m) + yy12(2)=ff12(n+1,m) + yy12(3)=ff12(n+1,m+1) + yy12(4)=ff12(n,m+1) + + do k=1,4 + z(k)=yy0(k) + z(k+4)=yy1(k)*d1 + z(k+8)=yy2(k)*d2 + z(k+12)=yy12(k)*d1d2 + enddo + + do l=1,16 + xxd=0.d0 + do k=1,16 + xxd=xxd+iwt(k,l)*z(k) + enddo + cl(l)=xxd + enddo + l=0 + do k=1,4 + do j=1,4 + l=l+1 + cc(i,n,m,k,j)=cl(l) + enddo + enddo + enddo + enddo + return + END + +!---------------------------------------------------------------------- + + double precision function InterpLHAPDF(i,nhess,x,y,nx,my,xx,yy, & + & cc) + implicit none + integer i,nx,my,nhess,locx,l,m,n + double precision xx(nx),yy(my),cc(0:nhess,nx,my,4,4), & + & x,y,z,t,u + + n=locx(xx,nx,x) + m=locx(yy,my,y) + + t=(x-xx(n))/(xx(n+1)-xx(n)) + u=(y-yy(m))/(yy(m+1)-yy(m)) + + z=0.d0 + do l=4,1,-1 + z=t*z+((cc(i,n,m,l,4)*u+cc(i,n,m,l,3))*u & + & +cc(i,n,m,l,2))*u+cc(i,n,m,l,1) + enddo + + InterpLHAPDF = z + + return + END + +!---------------------------------------------------------------------- + + double precision function ExtrapLHAPDF(i,nhess,x,y,nx,my,xx,yy, & + & cc) + implicit none + integer i,nx,my,nhess,locx,n,m + double precision xx(nx),yy(my),cc(0:nhess,nx,my,4,4), & + & x,y,z,f0,f1,z0,z1,InterpLHAPDF + + ! 0: below xmin, nx: above xmax + n=locx(xx,nx,x) + ! 0: below qsqmin, my: above qsqmax + m=locx(yy,my,y) + +!-- If extrapolation in small x only: + if (n.eq.0.and.m.gt.0.and.m.lt.my) then + f0 = InterpLHAPDF(i,nhess,xx(1),y,nx,my,xx,yy,cc) + f1 = InterpLHAPDF(i,nhess,xx(2),y,nx,my,xx,yy,cc) + if (f0.gt.0.d0.and.f1.gt.0.d0) then + z = exp(log(f0)+(log(f1)-log(f0))/(xx(2)-xx(1))*(x-xx(1))) + else + z = f0+(f1-f0)/(xx(2)-xx(1))*(x-xx(1)) + end if +!-- If extrapolation into large q only: + else if (n.gt.0.and.m.eq.my) then + f0 = InterpLHAPDF(i,nhess,x,yy(my),nx,my,xx,yy,cc) + f1 = InterpLHAPDF(i,nhess,x,yy(my-1),nx,my,xx,yy,cc) + if (f0.gt.0.d0.and.f1.gt.0.d0) then + z = exp(log(f0)+(log(f0)-log(f1))/(yy(my)-yy(my-1))* & + & (y-yy(my))) + else + z = f0+(f0-f1)/(yy(my)-yy(my-1))*(y-yy(my)) + end if +!-- If extrapolation into large q AND small x: + else if (n.eq.0.and.m.eq.my) then + f0 = InterpLHAPDF(i,nhess,xx(1),yy(my),nx,my,xx,yy,cc) + f1 = InterpLHAPDF(i,nhess,xx(1),yy(my-1),nx,my,xx,yy,cc) + if (f0.gt.0.d0.and.f1.gt.0.d0) then + z0 = exp(log(f0)+(log(f0)-log(f1))/(yy(my)-yy(my-1))* & + & (y-yy(my))) + else + z0 = f0+(f0-f1)/(yy(my)-yy(my-1))*(y-yy(my)) + end if + f0 = InterpLHAPDF(i,nhess,xx(2),yy(my),nx,my,xx,yy,cc) + f1 = InterpLHAPDF(i,nhess,xx(2),yy(my-1),nx,my,xx,yy,cc) + if (f0.gt.0.d0.and.f1.gt.0.d0) then + z1 = exp(log(f0)+(log(f0)-log(f1))/(yy(my)-yy(my-1))* & + & (y-yy(my))) + else + z1 = f0+(f0-f1)/(yy(my)-yy(my-1))*(y-yy(my)) + end if + if (z0.gt.0.d0.and.z1.gt.0.d0) then + z = exp(log(z0)+(log(z1)-log(z0))/(xx(2)-xx(1))*(x-xx(1))) + else + z = z0+(z1-z0)/(xx(2)-xx(1))*(x-xx(1)) + end if + else + print *,"Error in ExtrapLHAPDF" + stop + end if + + ExtrapLHAPDF = z + + return + END diff --git a/LHAPDF/lhapdf-5.9.1/src/wrapmrst98.f b/LHAPDF/lhapdf-5.9.1/src/wrapmrst98.f new file mode 100644 index 00000000000..47dcdadaa58 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/wrapmrst98.f @@ -0,0 +1,150 @@ +! -*- F90 -*- + + + subroutine MRST98evolve(x,Q,pdf) + implicit real*8(a-h,o-z) + include 'parmsetup.inc' + character*16 name(nmxset) + integer nmem(nmxset),ndef(nmxset),mmem + integer nset + common/NAME/name,nmem,ndef,mmem + parameter(nx=49,nq=37,ntenth=23,np=8,members=5) + double precision gridx(nmxgridx),gridq(nmxgridq) + integer ngridx,ngridq,jx,jq + real*8 pdf(-6:6) + real*8 f(0:members,np,nx,nq+1) + real*8 qq(nq),xx(nx),xxin(nx),g(np),n0(np) + data xxin/1d-5,2d-5,4d-5,6d-5,8d-5, & + & 1d-4,2d-4,4d-4,6d-4,8d-4, & + & 1d-3,2d-3,4d-3,6d-3,8d-3, & + & 1d-2,1.4d-2,2d-2,3d-2,4d-2,6d-2,8d-2, & + & .1d0,.125d0,.15d0,.175d0,.2d0,.225d0,.25d0,.275d0, & + & .3d0,.325d0,.35d0,.375d0,.4d0,.425d0,.45d0,.475d0, & + & .5d0,.525d0,.55d0,.575d0,.6d0,.65d0,.7d0,.75d0, & + & .8d0,.9d0,1d0/ + data qq/1.25d0,1.5d0,2d0,2.5d0,3.2d0,4d0,5d0,6.4d0,8d0,1d1, & + & 1.2d1,1.8d1,2.6d1,4d1,6.4d1,1d2, & + & 1.6d2,2.4d2,4d2,6.4d2,1d3,1.8d3,3.2d3,5.6d3,1d4, & + & 1.8d4,3.2d4,5.6d4,1d5,1.8d5,3.2d5,5.6d5,1d6, & + & 1.8d6,3.2d6,5.6d6,1d7/ + data xmin,xmax,qsqmin,qsqmax/1d-5,1d0,1.25d0,1d7/ + data n0/3,4,5,9,9,9,9,9/ + save +! + xsave=x + qsq = q*q + q2save=qsq +! + if(x.lt.xmin) x=xmin + if(x.gt.xmax) x=xmax + if(qsq.lt.qsqmin) qsq=qsqmin + if(qsq.gt.qsqmax) qsq=qsqmax +! + xxx=x + if(x.lt.xx(ntenth)) xxx=dlog10(x/xx(ntenth))+xx(ntenth) + n=0 + 70 n=n+1 + if(xxx.gt.xx(n+1)) goto 70 + a=(xxx-xx(n))/(xx(n+1)-xx(n)) + m=0 + 80 m=m+1 + if(qsq.gt.qq(m+1)) goto 80 + b=(qsq-qq(m))/(qq(m+1)-qq(m)) + do 60 i=1,np + g(i)= (1d0-a)*(1d0-b)*f(imem,i,n,m)+(1d0-a)*b*f(imem,i,n,m+1) & + & + a*(1d0-b)*f(imem,i,n+1,m)+a*b*f(imem,i,n+1,m+1) + if(n.ge.ntenth) goto 65 + if(i.eq.5.or.i.eq.7) goto 65 + fac=(1d0-b)*f(imem,i,ntenth,m)+b*f(imem,i,ntenth,m+1) + g(i)=fac*10d0**(g(i)-fac) + 65 continue + g(i)=g(i)*(1d0-x)**n0(i) + 60 continue + upv=g(1) + dnv=g(2) + usea=g(4) + dsea=g(8) + str=g(6) + chm=g(5) + glu=g(3) + bot=g(7) +! + pdf(0) = glu + pdf(1) = dnv+dsea + pdf(-1) = dsea + pdf(2) = upv+usea + pdf(-2) = usea + pdf(3) = str + pdf(-3) = str + pdf(4) = chm + pdf(-4) = chm + pdf(5) = bot + pdf(-5) = bot + pdf(6) = 0.0d0 + pdf(-6) = 0.0d0 + + x=xsave + qsq=q2save + return +! + entry MRST98getgrid(nset,ngridx,ngridq,gridx,gridq) + do jx=1,nx + gridx(jx)=xx(jx) + enddo + do jq=1,nq + gridq(jq)=qq(jq) + enddo + ngridx=nx + ngridq=nq + return + + entry MRST98read(nset) + read(1,*)nmem(nset),ndef(nset) +! - first resotre the xx array + do j=1,nx + xx(j)=xxin(j) + enddo +! - next read in the data points + do nm = 0,nmem(nset) + do 20 n=1,nx-1 + do 20 m=1,nq + read(1,50)f(nm,1,n,m),f(nm,2,n,m),f(nm,3,n,m),f(nm,4,n,m), & + & f(nm,5,n,m),f(nm,7,n,m),f(nm,6,n,m),f(nm,8,n,m) +! notation: 1=uval 2=val 3=glue 4=usea 5=chm 6=str 7=btm 8=dsea + do 25 i=1,np + 25 f(nm,i,n,m)=f(nm,i,n,m)/(1d0-xx(n))**n0(i) + 20 continue +! write(*,*)'PDF set ',nm,' first element ',f(nm,1,1,1) + do 31 j=1,ntenth-1 +! xx(j)=dlog10(xx(j)/xx(ntenth))+xx(ntenth) + do 31 i=1,8 + if(i.eq.5.or.i.eq.7) goto 31 + do 30 k=1,nq + 30 f(nm,i,j,k)=dlog10(f(nm,i,j,k)/f(nm,i,ntenth,k)) & + & +f(nm,i,ntenth,k) + 31 continue + 50 format(8f10.5) + do 40 i=1,np + do 40 m=1,nq + 40 f(nm,i,nx,m)=0d0 + enddo + do 32 j=1,ntenth-1 + xx(j)=dlog10(xx(j)/xx(ntenth))+xx(ntenth) + 32 continue + return +! + entry MRST98alfa(alfas,Qalfa) + call alphamrs(5,alfas,Qalfa) + return +! + entry MRST98init(Eorder,Q2fit) + return +! + entry MRST98pdf(mem) +! if(mem.eq.0) mem=ndef + imem = mem +! print *,imem + + return +! + END diff --git a/LHAPDF/lhapdf-5.9.1/src/wrapmrstqed-lite.f b/LHAPDF/lhapdf-5.9.1/src/wrapmrstqed-lite.f new file mode 100644 index 00000000000..abf234c49d3 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/wrapmrstqed-lite.f @@ -0,0 +1,218 @@ +! -*- F90 -*- + + + subroutine MRSTqedevolve(x,Q,pdf,photon) + implicit real*8(a-h,o-z) + include 'parmsetup.inc' + character*16 name(nmxset) + character*80 line + character*512 setpath + integer nmem(nmxset),ndef(nmxset),mmem +! integer member(nmxset) + integer nset,iset + common/NAME/name,nmem,ndef,mmem + parameter(nx=49,nq=37,np=9,nqc0=2,nqb0=11,nqc=35,nqb=26, & + &nhess=0) + double precision gridx(nmxgridx),gridq(nmxgridq) + integer ngridx,ngridq,jx,jq + real*8 pdf(-6:6),photon,phot + real*8 f1(nx,nq) & + &,f2(nx,nq) & + &,f3(nx,nq) & + &,f4(nx,nq) & + &,f5(nx,nq) & + &,f6(nx,nq) & + &,f7(nx,nq) & + &,f8(nx,nq) & + &,f9(nx,nq) & + &,fc(nx,nqc),fb(nx,nqb) + real*8 qq(nq),xx(nx), & + &cc1(0:nhess,nx,nq,4,4,nmxset),cc2(0:nhess,nx,nq,4,4,nmxset), & + &cc3(0:nhess,nx,nq,4,4,nmxset),cc4(0:nhess,nx,nq,4,4,nmxset), & + &cc6(0:nhess,nx,nq,4,4,nmxset),cc8(0:nhess,nx,nq,4,4,nmxset), & + &cc9(0:nhess,nx,nq,4,4,nmxset), & + &ccc(0:nhess,nx,nqc,4,4,nmxset),ccb(0:nhess,nx,nqb,4,4,nmxset) + real*8 xxl(nx),qql(nq),qqlc(nqc),qqlb(nqb) + data xx/1d-5,2d-5,4d-5,6d-5,8d-5, & + & 1d-4,2d-4,4d-4,6d-4,8d-4, & + & 1d-3,2d-3,4d-3,6d-3,8d-3, & + & 1d-2,1.4d-2,2d-2,3d-2,4d-2,6d-2,8d-2, & + & .1d0,.125d0,.15d0,.175d0,.2d0,.225d0,.25d0,.275d0, & + & .3d0,.325d0,.35d0,.375d0,.4d0,.425d0,.45d0,.475d0, & + & .5d0,.525d0,.55d0,.575d0,.6d0,.65d0,.7d0,.75d0, & + & .8d0,.9d0,1d0/ + data qq/1.25d0,1.5d0,2d0,2.5d0,3.2d0,4d0,5d0,6.4d0,8d0,1d1, & + & 1.2d1,1.8d1,2.6d1,4d1,6.4d1,1d2, & + & 1.6d2,2.4d2,4d2,6.4d2,1d3,1.8d3,3.2d3,5.6d3,1d4, & + & 1.8d4,3.2d4,5.6d4,1d5,1.8d5,3.2d5,5.6d5,1d6, & + & 1.8d6,3.2d6,5.6d6,1d7/ + data xmin,xmax,qsqmin,qsqmax/1d-5,1d0,1.25d0,1d7/ + save + + xsave=x + qsq = q*q + q2save=qsq + + xlog=dlog(x) + qsqlog=dlog(qsq) + + call getnset(iset) +! imem=member(iset) + call getnmem(iset,imem) + call jeppe2(imem,xlog,qsqlog,nx,nq,xxl,qql,cc1(0,1,1,1,1,iset),upv) + call jeppe2(imem,xlog,qsqlog,nx,nq,xxl,qql,cc2(0,1,1,1,1,iset),dnv) + call jeppe2(imem,xlog,qsqlog,nx,nq,xxl,qql,cc3(0,1,1,1,1,iset),glu) + call jeppe2(imem,xlog,qsqlog,nx,nq,xxl,qql,cc4(0,1,1,1,1,iset),usea) + call jeppe2(imem,xlog,qsqlog,nx,nq,xxl,qql,cc6(0,1,1,1,1,iset),str) + call jeppe2(imem,xlog,qsqlog,nx,nq,xxl,qql,cc8(0,1,1,1,1,iset),dsea) + call jeppe2(imem,xlog,qsqlog,nx,nq,xxl,qql,cc9(0,1,1,1,1,iset),photon) + + chm=0.d0 + if(qsq.gt.emc2) then + call jeppe2(0,xlog,qsqlog,nx,nqc,xxl,qqlc,ccc(0,1,1,1,1,iset),chm) + endif + + bot=0.d0 + if(qsq.gt.emb2) then + call jeppe2(0,xlog,qsqlog,nx,nqb,xxl,qqlb,ccb(0,1,1,1,1,iset),bot) + endif + + pdf(0) = glu + pdf(1) = dnv+dsea + pdf(-1) = dsea + pdf(2) = upv+usea + pdf(-2) = usea + pdf(3) = str + pdf(-3) = str + pdf(4) = chm + pdf(-4) = chm + pdf(5) = bot + pdf(-5) = bot + pdf(6) = 0.0d0 + pdf(-6) = 0.0d0 + + x=xsave + qsq=q2save + return + + entry MRSTqedgetgrid(nset,ngridx,ngridq,gridx,gridq) + do jx=1,nx + gridx(jx)=xx(jx) + enddo + do jq=1,nq + gridq(jq)=qq(jq) + enddo + ngridx=nx + ngridq=nq + return +! + entry MRSTqedread(nset) +! - dummy read in to get to End: (stream 1 is still open) + read(1,*)nmem(nset),ndef(nset) + + do i=0,nmem(nset) + do n=1,nx-1 + do m=1,nq + read(1,'(a)'),line + enddo + enddo + enddo + + do n=1,nx + xxl(n)=dlog(xx(n)) + enddo + do m=1,nq + qql(m)=dlog(qq(m)) + enddo + + return +! + entry MRSTqedpdf(mem) + call getnset(iset) + call setnmem(iset,mem) + +! have to reopen stream 1 + call getsetpath(setpath) + open(1,file=setpath(1:len_trim(setpath)),action='READ') + line = '' + do while (line(2:11).ne.'Evolution:') + read(1,'(a)'),line + enddo + read(1,'(a)'),line + read(1,'(a)'),line + + read(1,*)nmem(iset),ndef(iset) + +! - dummy read up to the member requested + do i=0,mem-1 + do n=1,nx-1 + do m=1,nq + read(1,'(a)')line + enddo + enddo + enddo + + +!- read in the data of the requested member + do 20 n=1,nx-1 + do 20 m=1,nq + read(1,50)f1(n,m),f2(n,m),f3(n,m),f4(n,m), & + & f5(n,m),f7(n,m),f6(n,m),f8(n,m),f9(n,m) +! notation: 1=uval 2=val 3=glue 4=usea 5=chm 6=str 7=btm 8=dsea 9-photon + 20 continue +! write(*,*)'PDF set ',nm,' first element ',f1(1,1) + + do 40 m=1,nq + f1(nx,m)=0.d0 + f2(nx,m)=0.d0 + f3(nx,m)=0.d0 + f4(nx,m)=0.d0 + f5(nx,m)=0.d0 + f6(nx,m)=0.d0 + f7(nx,m)=0.d0 + f8(nx,m)=0.d0 + f9(nx,m)=0.d0 + 40 continue + + call jeppe1(0,nx,nq,xxl,qql,f1,cc1(0,1,1,1,1,iset)) + call jeppe1(0,nx,nq,xxl,qql,f2,cc2(0,1,1,1,1,iset)) + call jeppe1(0,nx,nq,xxl,qql,f3,cc3(0,1,1,1,1,iset)) + call jeppe1(0,nx,nq,xxl,qql,f4,cc4(0,1,1,1,1,iset)) + call jeppe1(0,nx,nq,xxl,qql,f6,cc6(0,1,1,1,1,iset)) + call jeppe1(0,nx,nq,xxl,qql,f8,cc8(0,1,1,1,1,iset)) + call jeppe1(0,nx,nq,xxl,qql,f9,cc9(0,1,1,1,1,iset)) + + emc2=2.045 + emb2=18.5 + + do 44 m=1,nqc + qqlc(m)=qql(m+nqc0) + do 44 n=1,nx + fc(n,m)=f5(n,m+nqc0) + 44 continue + qqlc(1)=dlog(emc2) + call jeppe1(0,nx,nqc,xxl,qqlc,fc,ccc(0,1,1,1,1,iset)) + + do 45 m=1,nqb + qqlb(m)=qql(m+nqb0) + do 45 n=1,nx + fb(n,m)=f7(n,m+nqb0) + 45 continue + qqlb(1)=dlog(emb2) + call jeppe1(0,nx,nqb,xxl,qqlb,fb,ccb(0,1,1,1,1,iset)) + + close(1) + 50 format(9f10.5) + + + return +! + entry MRSTqedalfa(nflav,alfas,Qalfa) + call getnset(iset) + call alphamrs(nflav,alfas,Qalfa) + return +! + entry MRSTqedinit(Eorder,Q2fit) + return +! + END diff --git a/LHAPDF/lhapdf-5.9.1/src/wrapmrstqed.f b/LHAPDF/lhapdf-5.9.1/src/wrapmrstqed.f new file mode 100644 index 00000000000..c1537d496e8 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/wrapmrstqed.f @@ -0,0 +1,184 @@ +! -*- F90 -*- + + + subroutine MRSTqedevolve(x,Q,pdf,photon) + implicit real*8(a-h,o-z) + include 'parmsetup.inc' + character*16 name(nmxset) + integer nmem(nmxset),ndef(nmxset),mmem +! integer member(nmxset) + integer nset,iset + common/NAME/name,nmem,ndef,mmem + parameter(nx=49,nq=37,np=9,nqc0=2,nqb0=11,nqc=35,nqb=26, & + &nhess=30) + double precision gridx(nmxgridx),gridq(nmxgridq) + integer ngridx,ngridq,jx,jq + real*8 pdf(-6:6),photon,phot + real*8 f1(nx,nq) & + &,f2(nx,nq) & + &,f3(nx,nq) & + &,f4(nx,nq) & + &,f5(nx,nq) & + &,f6(nx,nq) & + &,f7(nx,nq) & + &,f8(nx,nq) & + &,f9(nx,nq) & + &,fc(nx,nqc),fb(nx,nqb) + real*8 qq(nq),xx(nx), & + &cc1(0:nhess,nx,nq,4,4,nmxset),cc2(0:nhess,nx,nq,4,4,nmxset), & + &cc3(0:nhess,nx,nq,4,4,nmxset),cc4(0:nhess,nx,nq,4,4,nmxset), & + &cc6(0:nhess,nx,nq,4,4,nmxset),cc8(0:nhess,nx,nq,4,4,nmxset), & + &cc9(0:nhess,nx,nq,4,4,nmxset), & + &ccc(0:nhess,nx,nqc,4,4,nmxset),ccb(0:nhess,nx,nqb,4,4,nmxset) + real*8 xxl(nx),qql(nq),qqlc(nqc),qqlb(nqb) + data xx/1d-5,2d-5,4d-5,6d-5,8d-5, & + & 1d-4,2d-4,4d-4,6d-4,8d-4, & + & 1d-3,2d-3,4d-3,6d-3,8d-3, & + & 1d-2,1.4d-2,2d-2,3d-2,4d-2,6d-2,8d-2, & + & .1d0,.125d0,.15d0,.175d0,.2d0,.225d0,.25d0,.275d0, & + & .3d0,.325d0,.35d0,.375d0,.4d0,.425d0,.45d0,.475d0, & + & .5d0,.525d0,.55d0,.575d0,.6d0,.65d0,.7d0,.75d0, & + & .8d0,.9d0,1d0/ + data qq/1.25d0,1.5d0,2d0,2.5d0,3.2d0,4d0,5d0,6.4d0,8d0,1d1, & + & 1.2d1,1.8d1,2.6d1,4d1,6.4d1,1d2, & + & 1.6d2,2.4d2,4d2,6.4d2,1d3,1.8d3,3.2d3,5.6d3,1d4, & + & 1.8d4,3.2d4,5.6d4,1d5,1.8d5,3.2d5,5.6d5,1d6, & + & 1.8d6,3.2d6,5.6d6,1d7/ + data xmin,xmax,qsqmin,qsqmax/1d-5,1d0,1.25d0,1d7/ + save + + xsave=x + qsq = q*q + q2save=qsq + + xlog=dlog(x) + qsqlog=dlog(qsq) + + call getnset(iset) +! imem=member(iset) + call getnmem(iset,imem) + call jeppe2(imem,xlog,qsqlog,nx,nq,xxl,qql,cc1(0,1,1,1,1,iset),upv) + call jeppe2(imem,xlog,qsqlog,nx,nq,xxl,qql,cc2(0,1,1,1,1,iset),dnv) + call jeppe2(imem,xlog,qsqlog,nx,nq,xxl,qql,cc3(0,1,1,1,1,iset),glu) + call jeppe2(imem,xlog,qsqlog,nx,nq,xxl,qql,cc4(0,1,1,1,1,iset),usea) + call jeppe2(imem,xlog,qsqlog,nx,nq,xxl,qql,cc6(0,1,1,1,1,iset),str) + call jeppe2(imem,xlog,qsqlog,nx,nq,xxl,qql,cc8(0,1,1,1,1,iset),dsea) + call jeppe2(imem,xlog,qsqlog,nx,nq,xxl,qql,cc9(0,1,1,1,1,iset),photon) + + chm=0.d0 + if(qsq.gt.emc2) then + call jeppe2(imem,xlog,qsqlog,nx,nqc,xxl,qqlc,ccc(0,1,1,1,1,iset),chm) + endif + + bot=0.d0 + if(qsq.gt.emb2) then + call jeppe2(imem,xlog,qsqlog,nx,nqb,xxl,qqlb,ccb(0,1,1,1,1,iset),bot) + endif + + pdf(0) = glu + pdf(1) = dnv+dsea + pdf(-1) = dsea + pdf(2) = upv+usea + pdf(-2) = usea + pdf(3) = str + pdf(-3) = str + pdf(4) = chm + pdf(-4) = chm + pdf(5) = bot + pdf(-5) = bot + pdf(6) = 0.0d0 + pdf(-6) = 0.0d0 + + x=xsave + qsq=q2save + return + + entry MRSTqedgetgrid(nset,ngridx,ngridq,gridx,gridq) + do jx=1,nx + gridx(jx)=xx(jx) + enddo + do jq=1,nq + gridq(jq)=qq(jq) + enddo + ngridx=nx + ngridq=nq + return +! + entry MRSTqedread(nset) + read(1,*)nmem(nset),ndef(nset) +! print *,nmem(nset),ndef(nset) +! do nm = 0,nmem-1 + do nm = 0,nmem(nset) + do 20 n=1,nx-1 + do 20 m=1,nq + read(1,50)f1(n,m),f2(n,m),f3(n,m),f4(n,m), & + & f5(n,m),f7(n,m),f6(n,m),f8(n,m),f9(n,m) +! notation: 1=uval 2=val 3=glue 4=usea 5=chm 6=str 7=btm 8=dsea +9 - pho + 20 continue +! write(*,*)'PDF set ',nm,' first element ',f1(1,1) + do 40 m=1,nq + f1(nx,m)=0.d0 + f2(nx,m)=0.d0 + f3(nx,m)=0.d0 + f4(nx,m)=0.d0 + f5(nx,m)=0.d0 + f6(nx,m)=0.d0 + f7(nx,m)=0.d0 + f8(nx,m)=0.d0 + f9(nx,m)=0.d0 + 40 continue + + do n=1,nx + xxl(n)=dlog(xx(n)) + enddo + do m=1,nq + qql(m)=dlog(qq(m)) + enddo + + call jeppe1(nm,nx,nq,xxl,qql,f1,cc1(0,1,1,1,1,nset)) + call jeppe1(nm,nx,nq,xxl,qql,f2,cc2(0,1,1,1,1,nset)) + call jeppe1(nm,nx,nq,xxl,qql,f3,cc3(0,1,1,1,1,nset)) + call jeppe1(nm,nx,nq,xxl,qql,f4,cc4(0,1,1,1,1,nset)) + call jeppe1(nm,nx,nq,xxl,qql,f6,cc6(0,1,1,1,1,nset)) + call jeppe1(nm,nx,nq,xxl,qql,f8,cc8(0,1,1,1,1,nset)) + call jeppe1(nm,nx,nq,xxl,qql,f9,cc9(0,1,1,1,1,nset)) + + emc2=2.045 + emb2=18.5 + + do 44 m=1,nqc + qqlc(m)=qql(m+nqc0) + do 44 n=1,nx + fc(n,m)=f5(n,m+nqc0) + 44 continue + qqlc(1)=dlog(emc2) + call jeppe1(nm,nx,nqc,xxl,qqlc,fc,ccc(0,1,1,1,1,nset)) + + do 45 m=1,nqb + qqlb(m)=qql(m+nqb0) + do 45 n=1,nx + fb(n,m)=f7(n,m+nqb0) + 45 continue + qqlb(1)=dlog(emb2) + call jeppe1(nm,nx,nqb,xxl,qqlb,fb,ccb(0,1,1,1,1,nset)) + + + enddo + 50 format(9f10.5) + return +! + entry MRSTqedalfa(nflav,alfas,Qalfa) + call getnset(iset) + call alphamrs(nflav,alfas,Qalfa) + return +! + entry MRSTqedinit(Eorder,Q2fit) + return +! + entry MRSTqedpdf(mem) + call getnset(iset) + call setnmem(iset,mem) + + return +! + END diff --git a/LHAPDF/lhapdf-5.9.1/src/wrapmstw-lite.f b/LHAPDF/lhapdf-5.9.1/src/wrapmstw-lite.f new file mode 100644 index 00000000000..b68f8688115 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/wrapmstw-lite.f @@ -0,0 +1,1501 @@ +! -*- F90 -*- + +!-- LHAPDF version of MSTW interpolation code and alphaS routines. +!-- 22/01/2009 by Graeme Watt + +!-- Modified to allow possibility of different heavy-quark masses. +!-- 25/06/2010 by Graeme Watt + +!-- Fix "NaN" bug for q <= m_c when m_c^2 < 1.25 GeV^2. +!-- 25/01/2011 by Graeme Watt + +subroutine MSTWevolve(x,Q,xpdf,xphoton) + implicit none + ! + include 'parmsetup.inc' + character*16 name(nmxset) + character*80 line + character*512 setpath + integer iset,mem,nset,nmem(nmxset),ndef(nmxset),mmem,imem + COMMON/NAME/name,nmem,ndef,mmem + double precision xpdf(-6:6),xvalence(6),xphoton, & + & x,Q,alfas,Qalfa,Eorder,Q2fit,MSTWALPHAS + logical warn,fatal + parameter(warn=.false.,fatal=.true.) + ! Set warn=.true. to turn on warnings when extrapolating. + ! Set fatal=.false. to return zero instead of terminating when + ! invalid input values of x and q are used. + integer ih,f,nhess,nx,nq,np,nqc0,nqb0,n,m,ip,io, & + & nExtraFlavours,i,j + double precision xmin,xmax,qsqmin,qsqmax,mc2,mb2,eps, & + & qsq,xlog,qsqlog,res,res1,anom,ExtrapolateMSTWPDF, & + & InterpolateMSTWPDF + parameter(nx=64,nq=48,np=12) + parameter(xmin=1d-6,xmax=1d0,qsqmin=1d0,qsqmax=1d9,eps=1d-6) + parameter(nhess=0) + character dummyChar,dummyWord*50 + double precision gridx(nmxgridx),gridq(nmxgridq) + integer ngridx,ngridq,jx,jq + double precision ff(np,nx,nq) + double precision qqorig(nq),qq(nq),xx(nx),cc(np,0:nhess,nx,nq,4,4,nmxset) + double precision xxl(nx),qql(nq,nmxset,0:nhess) + ! Store values of distance and tolerance along each eigenvector, + ! heavy-quark masses and alphaS parameters in COMMON block. + ! Allow the possibility of different alphaS parameters and + ! heavy-quark masses for each member of the set. + double precision distance(nmxset,0:nhess),tolerance(nmxset,0:nhess), & + & mCharm(nmxset,0:nhess),mBottom(nmxset,0:nhess), & + & alphaSQ0(nmxset,0:nhess),alphaSMZ(nmxset,0:nhess) + integer alphaSorder(nmxset,0:nhess),alphaSnfmax(nmxset,0:nhess) + common/mstwCommon/distance,tolerance, & + & mCharm,mBottom,alphaSQ0,alphaSMZ,alphaSorder,alphaSnfmax + double precision mCharmSave,mBottomSave,mTopSave + double precision cmass(nmxset),bmass(nmxset),tmass(nmxset) + common/masses_LHA/cmass,bmass,tmass + data xx/1d-6,2d-6,4d-6,6d-6,8d-6, & + & 1d-5,2d-5,4d-5,6d-5,8d-5, & + & 1d-4,2d-4,4d-4,6d-4,8d-4, & + & 1d-3,2d-3,4d-3,6d-3,8d-3, & + & 1d-2,1.4d-2,2d-2,3d-2,4d-2,6d-2,8d-2, & + & .1d0,.125d0,.15d0,.175d0,.2d0,.225d0,.25d0,.275d0, & + & .3d0,.325d0,.35d0,.375d0,.4d0,.425d0,.45d0,.475d0, & + & .5d0,.525d0,.55d0,.575d0,.6d0,.625d0,.65d0,.675d0, & + & .7d0,.725d0,.75d0,.775d0,.8d0,.825d0,.85d0,.875d0, & + & .9d0,.925d0,.95d0,.975d0,1d0/ + data qqorig/1.d0, & + & 1.25d0,1.5d0,0.d0,0.d0,2.5d0,3.2d0,4d0,5d0,6.4d0,8d0, & + & 1d1,1.2d1,0.d0,0.d0,2.6d1,4d1,6.4d1,1d2, & + & 1.6d2,2.4d2,4d2,6.4d2,1d3,1.8d3,3.2d3,5.6d3,1d4, & + & 1.8d4,3.2d4,5.6d4,1d5,1.8d5,3.2d5,5.6d5,1d6, & + & 1.8d6,3.2d6,5.6d6,1d7,1.8d7,3.2d7,5.6d7,1d8, & + & 1.8d8,3.2d8,5.6d8,1d9/ + save + + call getnset(iset) + call getnmem(iset,imem) + ih = 0 + + qsq=q*q + mc2=mCharm(iset,ih)**2 + mb2=mBottom(iset,ih)**2 + ! If mc2 < qsq < mc2+eps, then qsq = mc2+eps. + if (qsq.gt.mc2.and.qsq.lt.mc2+eps) then + qsq = mc2+eps + end if + ! If mb2 < qsq < mb2+eps, then qsq = mb2+eps. + if (qsq.gt.mb2.and.qsq.lt.mb2+eps) then + qsq = mb2+eps + end if + + xlog=log10(x) + qsqlog=log10(qsq) + + do f = 0, 13 ! loop over flavours + + res = 0.d0 + + if (f.eq.0) then ! gluon + ip = 1 + else if (f.ge.1.and.f.le.5) then ! quarks + ip = f+1 + else if (f.le.-1.and.f.ge.-5) then ! antiquarks + ip = -f+1 + else if (f.ge.7.and.f.le.11) then ! valence quarks + ip = f + else if (f.eq.13) then ! photon + ip = 12 + else if (abs(f).ne.6.and.f.ne.12) then + if (warn.or.fatal) print *,"Error in MSTWevolve: f = ",f + if (fatal) stop + end if + + if (x.le.0.d0.or.x.gt.xmax.or.q.le.0.d0) then + + if (warn.or.fatal) print *,"Error in MSTWevolve: x,qsq = ", & + & x,qsq + if (fatal) stop + + else if (abs(f).eq.6.or.f.eq.12) then ! set top quarks to zero + + res = 0.d0 + + else if (qsq.lt.qsqmin) then ! extrapolate to low Q^2 + + if (warn) then + print *, "Warning in MSTWevolve, extrapolating: f = ",f, & + & ", x = ",x,", q = ",q + end if + + if (x.lt.xmin) then ! extrapolate to low x + + res = ExtrapolateMSTWPDF(ip,np,ih,nhess,xlog, & + & log10(qsqmin),nx,nq,xxl,qql(1,iset,ih),cc(1,0,1,1,1,1,iset)) + res1 = ExtrapolateMSTWPDF(ip,np,ih,nhess,xlog, & + & log10(1.01D0*qsqmin),nx,nq,xxl,qql(1,iset,ih),cc(1,0,1,1,1,1,iset)) + if (f.le.-1.and.f.ge.-5) then ! antiquark = quark - valence + res = res - ExtrapolateMSTWPDF(ip+5,np,ih,nhess,xlog, & + & log10(qsqmin),nx,nq,xxl,qql(1,iset,ih),cc(1,0,1,1,1,1,iset)) + res1 = res1 - ExtrapolateMSTWPDF(ip+5,np,ih,nhess,xlog, & + & log10(1.01D0*qsqmin),nx,nq,xxl,qql(1,iset,ih),cc(1,0,1,1,1,1,iset)) + end if + + else ! do usual interpolation + + res = InterpolateMSTWPDF(ip,np,ih,nhess,xlog, & + & log10(qsqmin),nx,nq,xxl,qql(1,iset,ih),cc(1,0,1,1,1,1,iset)) + res1 = InterpolateMSTWPDF(ip,np,ih,nhess,xlog, & + & log10(1.01D0*qsqmin),nx,nq,xxl,qql(1,iset,ih),cc(1,0,1,1,1,1,iset)) + if (f.le.-1.and.f.ge.-5) then ! antiquark = quark - valence + res = res - InterpolateMSTWPDF(ip+5,np,ih,nhess,xlog, & + & log10(qsqmin),nx,nq,xxl,qql(1,iset,ih),cc(1,0,1,1,1,1,iset)) + res1 = res1 - InterpolateMSTWPDF(ip+5,np,ih,nhess,xlog, & + & log10(1.01D0*qsqmin),nx,nq,xxl,qql(1,iset,ih),cc(1,0,1,1,1,1,iset)) + end if + + end if + + ! Calculate the anomalous dimension, dlog(xf)/dlog(qsq), + ! evaluated at qsqmin. Then extrapolate the PDFs to low + ! qsq < qsqmin by interpolating the anomalous dimenion between + ! the value at qsqmin and a value of 1 for qsq << qsqmin. + ! If value of PDF at qsqmin is very small, just set + ! anomalous dimension to 1 to prevent rounding errors. + ! Impose minimum anomalous dimension of -2.5. + if (abs(res).ge.1.D-5) then + anom = max( -2.5D0, (res1-res)/res/0.01D0 ) + else + anom = 1.D0 + end if + res = res*(qsq/qsqmin)**(anom*qsq/qsqmin+1.D0-qsq/qsqmin) + + else if (x.lt.xmin.or.qsq.gt.qsqmax) then ! extrapolate + + if (warn) then + print *, "Warning in MSTWevolve, extrapolating: f = ",f, & + & ", x = ",x,", q = ",q + end if + + res = ExtrapolateMSTWPDF(ip,np,ih,nhess,xlog, & + & qsqlog,nx,nq,xxl,qql(1,iset,ih),cc(1,0,1,1,1,1,iset)) + + if (f.le.-1.and.f.ge.-5) then ! antiquark = quark - valence + res = res - ExtrapolateMSTWPDF(ip+5,np,ih,nhess,xlog, & + & qsqlog,nx,nq,xxl,qql(1,iset,ih),cc(1,0,1,1,1,1,iset)) + end if + + else ! do usual interpolation + + res = InterpolateMSTWPDF(ip,np,ih,nhess,xlog, & + & qsqlog,nx,nq,xxl,qql(1,iset,ih),cc(1,0,1,1,1,1,iset)) + + if (f.le.-1.and.f.ge.-5) then ! antiquark = quark - valence + res = res - InterpolateMSTWPDF(ip+5,np,ih,nhess,xlog, & + & qsqlog,nx,nq,xxl,qql(1,iset,ih),cc(1,0,1,1,1,1,iset)) + end if + + end if + + if (f.ge.7.and.f.le.12) then + xvalence(f-6) = res + else if (f.eq.13) then + xphoton = res + else + xpdf(f) = res + end if + + end do + + do f = 1, 6 + xpdf(-f) = xpdf(f) - xvalence(f) ! antiquarks + end do + + return + ! + entry MSTWgetgrid(nset,ngridx,ngridq,gridx,gridq) + do jx=1,nx + gridx(jx)=xx(jx) + enddo + do jq=1,nq + gridq(jq)=qq(jq) + enddo + ngridx=nx + ngridq=nq + return + + entry MSTWread(nset) + + ! Dummy read to get to the 'End:' (stream 1 is still open) + read(1,*) nmem(nset),ndef(nset) + do ih = 0, nmem(nset) + ! Read header containing heavy-quark masses and alphaS values. + read(1,*) + read(1,*) + read(1,*) dummyChar,dummyWord,dummyWord,dummyChar, & + & distance(nset,0),tolerance(nset,0) + read(1,*) dummyChar,dummyWord,dummyChar,mCharm(nset,0) + read(1,*) dummyChar,dummyWord,dummyChar,mBottom(nset,0) + read(1,*) dummyChar,dummyWord,dummyChar,alphaSQ0(nset,0) + read(1,*) dummyChar,dummyWord,dummyChar,alphaSMZ(nset,0) + read(1,*) dummyChar,dummyWord,dummyWord,dummyChar, & + & alphaSorder(nset,0),alphaSnfmax(nset,0) + read(1,*) dummyChar,dummyWord,dummyChar,nExtraFlavours + read(1,*) + read(1,*) + ! Now read in the grids from the grid file. + do n=1,nx-1 + do m=1,nq + read(1,*,iostat=io) + if (io.ne.0) then + print *,"Error in MSTWevolve reading file" + stop + end if + enddo + enddo + end do + + return + ! + entry MSTWalfa(alfas,Qalfa) + call getnset(iset) + call getnmem(iset,imem) + + ! Check value of Qalfa is below appropriate thresholds. + ! If not, redefine thresholds and reinitialise alphaS. + IF (alphaSnfmax(iset,0).EQ.5) THEN ! maximum of five flavours + IF (Qalfa.GT.mTopSave) THEN + mTopSave = 2.D0*Qalfa + CALL MSTWINITALPHAS(alphaSorder(iset,0), & + & 1.D0,1.D0,alphaSQ0(iset,0), & + & mCharmSave,mBottomSave,mTopSave) + END IF + ELSE IF (alphaSnfmax(iset,0).EQ.4) THEN ! maximum of four flavours + IF (Qalfa.GT.mBottomSave) THEN + mBottomSave = 2.D0*Qalfa + mTopSave = mBottomSave/0.9D0 + CALL MSTWINITALPHAS(alphaSorder(iset,0), & + & 1.D0,1.D0,alphaSQ0(iset,0), & + & mCharmSave,mBottomSave,mTopSave) + END IF + ELSE IF (alphaSnfmax(iset,0).EQ.3) THEN ! maximum of three flavours + IF (Qalfa.GT.mCharmSave) THEN + mCharmSave = 2.D0*Qalfa + mBottomSave = mCharmSave*0.9D0/0.8D0 + mTopSave = mBottomSave/0.9D0 + CALL MSTWINITALPHAS(alphaSorder(iset,0), & + & 1.D0,1.D0,alphaSQ0(iset,0), & + & mCharmSave,mBottomSave,mTopSave) + END IF + END IF + alfas = MSTWALPHAS(Qalfa) + return + ! + entry MSTWinit(nset,Eorder,Q2fit) + return + ! + entry MSTWpdf(mem) + call getnset(iset) + call setnmem(iset,mem) + + ! here is the real read!! + + ! have to reopen stream 1 + call getsetpath(setpath) + open(1,file=setpath(1:len_trim(setpath)),action='READ') + + line = '' + do while (line(2:11).ne.'Evolution:') + read(1,'(a)'),line + enddo + read(1,'(a)'),line + read(1,'(a)'),line + + read(1,*)nmem(iset),ndef(iset) + ! Dummy read up to the member requested + do i=0,mem-1 + do j=1,11 + read(1,*) + enddo + do n=1,nx-1 + do m=1,nq + read(1,'(a)')line + enddo + enddo + enddo + + ih=0 + ! Read header containing heavy-quark masses and alphaS values. + read(1,*) + read(1,*) + read(1,*) dummyChar,dummyWord,dummyWord,dummyChar, & + & distance(iset,ih),tolerance(iset,ih) + read(1,*) dummyChar,dummyWord,dummyChar,mCharm(iset,ih) + read(1,*) dummyChar,dummyWord,dummyChar,mBottom(iset,ih) + read(1,*) dummyChar,dummyWord,dummyChar,alphaSQ0(iset,ih) + read(1,*) dummyChar,dummyWord,dummyChar,alphaSMZ(iset,ih) + read(1,*) dummyChar,dummyWord,dummyWord,dummyChar, & + & alphaSorder(iset,ih),alphaSnfmax(iset,ih) + read(1,*) dummyChar,dummyWord,dummyChar,nExtraFlavours + read(1,*) + read(1,*) + + ! Heavy-quark masses and alphaS values + ! are stored in a COMMON block. + ! WRITE(6,*) "mCharm = ",mCharm(iset,ih), & + ! & ", mBottom = ",mBottom(iset,ih) + ! WRITE(6,*) "alphaS(Q0) = ",alphaSQ0(iset,ih),", alphaS(MZ) = ", & + ! & alphaSMZ(iset,ih),", alphaSorder = ",alphaSorder(iset,ih), & + ! & ", alphaSnfmax = ",alphaSnfmax(iset,ih) + + mc2=mCharm(iset,ih)**2 + mb2=mBottom(iset,ih)**2 + + ! Check that the heavy-quark masses are sensible. + ! Redistribute grid points if not in usual range. + do m=1,nq + qq(m) = qqorig(m) + end do + if (mc2.le.qq(1).or.mc2+eps.ge.qq(8)) then + print *,"Error in MSTWevolve: invalid mCharm = ",mCharm(iset,ih) + stop + else if (mc2.lt.qq(2)) then + nqc0=2 + qq(4)=qq(2) + qq(5)=qq(3) + else if (mc2.lt.qq(3)) then + nqc0=3 + qq(5)=qq(3) + else if (mc2.lt.qq(6)) then + nqc0=4 + else if (mc2.lt.qq(7)) then + nqc0=5 + qq(4)=qq(6) + else + nqc0=6 + qq(4)=qq(6) + qq(5)=qq(7) + end if + if (mb2.le.qq(12).or.mb2+eps.ge.qq(17)) then + print *,"Error in MSTWevolve: invalid mBottom = ",mBottom(iset,ih) + stop + else if (mb2.lt.qq(13)) then + nqb0=13 + qq(15)=qq(13) + else if (mb2.lt.qq(16)) then + nqb0=14 + else + nqb0=15 + qq(14)=qq(16) + end if + qq(nqc0)=mc2 + qq(nqc0+1)=mc2+eps + qq(nqb0)=mb2 + qq(nqb0+1)=mb2+eps + + ! The nExtraFlavours variable is provided to aid compatibility + ! with future grids where, for example, a photon distribution + ! might be provided (cf. the MRST2004QED PDFs). + if (nExtraFlavours.lt.0.or.nExtraFlavours.gt.1) then + print *,"Error in MSTWevolve: invalid nExtraFlavours = ", & + & nExtraFlavours + stop + end if + + ! Now read in the grids from the grid file. + do n=1,nx-1 + do m=1,nq + if (nExtraFlavours.gt.0) then + if (alphaSorder(iset,ih).eq.2) then ! NNLO + read(1,'(12(1pe12.4))',iostat=io) & + & (ff(ip,n,m),ip=1,12) + else ! LO or NLO + ff(10,n,m) = 0.d0 ! = chm-cbar + ff(11,n,m) = 0.d0 ! = bot-bbar + read(1,'(10(1pe12.4))',iostat=io) & + & (ff(ip,n,m),ip=1,9),ff(12,n,m) + end if + else ! nExtraFlavours = 0 + if (alphaSorder(iset,ih).eq.2) then ! NNLO + ff(12,n,m) = 0.d0 ! = photon + read(1,'(11(1pe12.4))',iostat=io) & + & (ff(ip,n,m),ip=1,11) + else ! LO or NLO + ff(10,n,m) = 0.d0 ! = chm-cbar + ff(11,n,m) = 0.d0 ! = bot-bbar + ff(12,n,m) = 0.d0 ! = photon + read(1,'(9(1pe12.4))',iostat=io) & + & (ff(ip,n,m),ip=1,9) + end if + end if + if (io.ne.0) then + print *,"Error in MSTWevolve reading file" + stop + end if + enddo + enddo + + ! PDFs are identically zero at x = 1. + do m=1,nq + do ip=1,np + ff(ip,nx,m)=0d0 + enddo + enddo + + do n=1,nx + xxl(n)=log10(xx(n)) + enddo + do m=1,nq + qql(m,iset,ih)=log10(qq(m)) + enddo + + ! Initialise all parton flavours. + do ip=1,np + call InitialiseMSTWPDF(ip,np,ih,nhess,nx,nq,nqc0,nqb0, & + & xxl,qql(1,iset,ih),ff,cc(1,0,1,1,1,1,iset)) + enddo + ! end of section moved from the read routine + + close(1) + + ! Call the initialisation routine with alpha_S(Q_0). + IF (alphaSnfmax(iset,ih).EQ.5) THEN ! maximum of five flavours + mCharmSave = mCharm(iset,ih) + mBottomSave = mBottom(iset,ih) + mTopSave = 1.D10 + ELSE IF (alphaSnfmax(iset,ih).EQ.4) THEN ! maximum of four flavours + mCharmSave = mCharm(iset,ih) + mBottomSave = 0.9D10 + mTopSave = 1.D10 + ELSE IF (alphaSnfmax(iset,ih).EQ.3) THEN ! maximum of three flavours + mCharmSave = 0.8D10 + mBottomSave = 0.9D10 + mTopSave = 1.D10 + END IF + + ! Update masses stored in common/masses_LHA/. + cmass(iset) = mCharm(iset,ih) + bmass(iset) = mBottom(iset,ih) + tmass(iset) = mTopSave + + CALL MSTWINITALPHAS(alphaSorder(iset,ih),1.D0,1.D0,alphaSQ0(iset,ih), & + & mCharmSave,mBottomSave,mTopSave) + + ! ! Check calculated value of alpha_S(M_Z) matches stored value. + ! WRITE(6,'(" alphaS(MZ) = ",F7.5," = ",F7.5)') & + ! & MSTWALPHAS(91.1876D0),alphaSMZ(iset,ih) + + return + ! +END subroutine MSTWevolve + + + +!---------------------------------------------------------------------- + +subroutine InitialiseMSTWPDF(ip,np,ih,nhess,nx,my,myc0,myb0, & + & xx,yy,ff,cc) + implicit none + integer nhess,ih,nx,my,myc0,myb0,j,k,l,m,n,ip,np + double precision xx(nx),yy(my),ff(np,nx,my), & + & ff1(nx,my),ff2(nx,my),ff12(nx,my),ff21(nx,my), & + & yy0(4),yy1(4),yy2(4),yy12(4),z(16), & + & cl(16),cc(np,0:nhess,nx,my,4,4),iwt(16,16), & + & polderiv1,polderiv2,polderiv3,d1,d2,d1d2,xxd + + data iwt/1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, & + & 0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0, & + & -3,0,0,3,0,0,0,0,-2,0,0,-1,0,0,0,0, & + & 2,0,0,-2,0,0,0,0,1,0,0,1,0,0,0,0, & + & 0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0, & + & 0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0, & + & 0,0,0,0,-3,0,0,3,0,0,0,0,-2,0,0,-1, & + & 0,0,0,0,2,0,0,-2,0,0,0,0,1,0,0,1, & + & -3,3,0,0,-2,-1,0,0,0,0,0,0,0,0,0,0, & + & 0,0,0,0,0,0,0,0,-3,3,0,0,-2,-1,0,0, & + & 9,-9,9,-9,6,3,-3,-6,6,-6,-3,3,4,2,1,2, & + & -6,6,-6,6,-4,-2,2,4,-3,3,3,-3,-2,-1,-1,-2, & + & 2,-2,0,0,1,1,0,0,0,0,0,0,0,0,0,0, & + & 0,0,0,0,0,0,0,0,2,-2,0,0,1,1,0,0, & + & -6,6,-6,6,-3,-3,3,3,-4,4,2,-2,-2,-2,-1,-1, & + & 4,-4,4,-4,2,2,-2,-2,2,-2,-2,2,1,1,1,1/ + + do m=1,my + ff1(1,m)=polderiv1(xx(1),xx(2),xx(3), & + & ff(ip,1,m),ff(ip,2,m),ff(ip,3,m)) + ff1(nx,m)=polderiv3(xx(nx-2),xx(nx-1),xx(nx), & + & ff(ip,nx-2,m),ff(ip,nx-1,m),ff(ip,nx,m)) + do n=2,nx-1 + ff1(n,m)=polderiv2(xx(n-1),xx(n),xx(n+1), & + & ff(ip,n-1,m),ff(ip,n,m),ff(ip,n+1,m)) + enddo + enddo + +!-- Calculate the derivatives at qsq=mc2,mc2+eps,mb2,mb2+eps +!-- in a similar way as at the endpoints qsqmin and qsqmax. + do n=1,nx + do m=1,my + if (myc0.eq.2.and.m.eq.1) then + ff2(n,m)=(ff(ip,n,m+1)-ff(ip,n,m))/(yy(m+1)-yy(m)) + else if (myc0.eq.2.and.m.eq.2) then + ff2(n,m)=(ff(ip,n,m)-ff(ip,n,m-1))/(yy(m)-yy(m-1)) + else if (m.eq.1.or.m.eq.myc0+1.or.m.eq.myb0+1) then + ff2(n,m)=polderiv1(yy(m),yy(m+1),yy(m+2), & + & ff(ip,n,m),ff(ip,n,m+1),ff(ip,n,m+2)) + else if (m.eq.my.or.m.eq.myc0.or.m.eq.myb0) then + ff2(n,m)=polderiv3(yy(m-2),yy(m-1),yy(m), & + & ff(ip,n,m-2),ff(ip,n,m-1),ff(ip,n,m)) + else + ff2(n,m)=polderiv2(yy(m-1),yy(m),yy(m+1), & + & ff(ip,n,m-1),ff(ip,n,m),ff(ip,n,m+1)) + end if + end do + end do + +!-- Calculate the cross derivatives (d/dx)(d/dy). + do m=1,my + ff12(1,m)=polderiv1(xx(1),xx(2),xx(3), & + & ff2(1,m),ff2(2,m),ff2(3,m)) + ff12(nx,m)=polderiv3(xx(nx-2),xx(nx-1),xx(nx), & + & ff2(nx-2,m),ff2(nx-1,m),ff2(nx,m)) + do n=2,nx-1 + ff12(n,m)=polderiv2(xx(n-1),xx(n),xx(n+1), & + & ff2(n-1,m),ff2(n,m),ff2(n+1,m)) + enddo + enddo + +!-- Calculate the cross derivatives (d/dy)(d/dx). + do n=1,nx + do m = 1, my + if (myc0.eq.2.and.m.eq.1) then + ff21(n,m)=(ff1(n,m+1)-ff1(n,m))/(yy(m+1)-yy(m)) + else if (myc0.eq.2.and.m.eq.2) then + ff21(n,m)=(ff1(n,m)-ff1(n,m-1))/(yy(m)-yy(m-1)) + else if (m.eq.1.or.m.eq.myc0+1.or.m.eq.myb0+1) then + ff21(n,m)=polderiv1(yy(m),yy(m+1),yy(m+2), & + & ff1(n,m),ff1(n,m+1),ff1(n,m+2)) + else if (m.eq.my.or.m.eq.myc0.or.m.eq.myb0) then + ff21(n,m)=polderiv3(yy(m-2),yy(m-1),yy(m), & + & ff1(n,m-2),ff1(n,m-1),ff1(n,m)) + else + ff21(n,m)=polderiv2(yy(m-1),yy(m),yy(m+1), & + & ff1(n,m-1),ff1(n,m),ff1(n,m+1)) + end if + end do + end do + +!-- Take the average of (d/dx)(d/dy) and (d/dy)(d/dx). + do n=1,nx + do m = 1, my + ff12(n,m)=0.5*(ff12(n,m)+ff21(n,m)) + end do + end do + + do n=1,nx-1 + do m=1,my-1 + d1=xx(n+1)-xx(n) + d2=yy(m+1)-yy(m) + d1d2=d1*d2 + + yy0(1)=ff(ip,n,m) + yy0(2)=ff(ip,n+1,m) + yy0(3)=ff(ip,n+1,m+1) + yy0(4)=ff(ip,n,m+1) + + yy1(1)=ff1(n,m) + yy1(2)=ff1(n+1,m) + yy1(3)=ff1(n+1,m+1) + yy1(4)=ff1(n,m+1) + + yy2(1)=ff2(n,m) + yy2(2)=ff2(n+1,m) + yy2(3)=ff2(n+1,m+1) + yy2(4)=ff2(n,m+1) + + yy12(1)=ff12(n,m) + yy12(2)=ff12(n+1,m) + yy12(3)=ff12(n+1,m+1) + yy12(4)=ff12(n,m+1) + + do k=1,4 + z(k)=yy0(k) + z(k+4)=yy1(k)*d1 + z(k+8)=yy2(k)*d2 + z(k+12)=yy12(k)*d1d2 + enddo + + do l=1,16 + xxd=0.d0 + do k=1,16 + xxd=xxd+iwt(k,l)*z(k) + enddo + cl(l)=xxd + enddo + l=0 + do k=1,4 + do j=1,4 + l=l+1 + cc(ip,ih,n,m,k,j)=cl(l) + enddo + enddo + enddo + enddo + return + end + +!---------------------------------------------------------------------- + + double precision function InterpolateMSTWPDF(ip,np,ih,nhess,x,y, & + & nx,my,xx,yy,cc) + implicit none + integer ih,nx,my,nhess,MSTWlocx,l,m,n,ip,np + double precision xx(nx),yy(my),cc(np,0:nhess,nx,my,4,4), & + & x,y,z,t,u + + n=MSTWlocx(xx,nx,x) + m=MSTWlocx(yy,my,y) + + t=(x-xx(n))/(xx(n+1)-xx(n)) + u=(y-yy(m))/(yy(m+1)-yy(m)) + + z=0.d0 + do l=4,1,-1 + z=t*z+((cc(ip,ih,n,m,l,4)*u+cc(ip,ih,n,m,l,3))*u & + & +cc(ip,ih,n,m,l,2))*u+cc(ip,ih,n,m,l,1) + enddo + + InterpolateMSTWPDF = z + + return + end + +!---------------------------------------------------------------------- + + double precision function ExtrapolateMSTWPDF(ip,np,ih,nhess,x,y, & + & nx,my,xx,yy,cc) + implicit none + integer ih,nx,my,nhess,MSTWlocx,n,m,ip,np + double precision xx(nx),yy(my),cc(np,0:nhess,nx,my,4,4), & + & x,y,z,f0,f1,z0,z1,InterpolateMSTWPDF + + n=MSTWlocx(xx,nx,x) ! 0: below xmin, nx: above xmax + m=MSTWlocx(yy,my,y) ! 0: below qsqmin, my: above qsqmax + +! If extrapolation in small x only: + if (n.eq.0.and.m.gt.0.and.m.lt.my) then + f0 = InterpolateMSTWPDF(ip,np,ih,nhess,xx(1),y,nx,my,xx,yy,cc) + f1 = InterpolateMSTWPDF(ip,np,ih,nhess,xx(2),y,nx,my,xx,yy,cc) + if (f0.gt.1.d-3.and.f1.gt.1.d-3) then + z = exp(log(f0)+(log(f1)-log(f0))/(xx(2)-xx(1))*(x-xx(1))) + else + z = f0+(f1-f0)/(xx(2)-xx(1))*(x-xx(1)) + end if +! If extrapolation into large q only: + else if (n.gt.0.and.m.eq.my) then + f0 = InterpolateMSTWPDF(ip,np,ih,nhess,x,yy(my),nx,my,xx,yy,cc) + f1 = InterpolateMSTWPDF(ip,np,ih,nhess,x,yy(my-1),nx,my,xx,yy,cc) + if (f0.gt.1.d-3.and.f1.gt.1.d-3) then + z = exp(log(f0)+(log(f0)-log(f1))/(yy(my)-yy(my-1))* & + & (y-yy(my))) + else + z = f0+(f0-f1)/(yy(my)-yy(my-1))*(y-yy(my)) + end if +! If extrapolation into large q AND small x: + else if (n.eq.0.and.m.eq.my) then + f0 = InterpolateMSTWPDF(ip,np,ih,nhess,xx(1),yy(my),nx,my,xx,yy,cc) + f1 = InterpolateMSTWPDF(ip,np,ih,nhess,xx(1),yy(my-1),nx,my,xx,yy, & + & cc) + if (f0.gt.1.d-3.and.f1.gt.1.d-3) then + z0 = exp(log(f0)+(log(f0)-log(f1))/(yy(my)-yy(my-1))* & + & (y-yy(my))) + else + z0 = f0+(f0-f1)/(yy(my)-yy(my-1))*(y-yy(my)) + end if + f0 = InterpolateMSTWPDF(ip,np,ih,nhess,xx(2),yy(my),nx,my,xx,yy,cc) + f1 = InterpolateMSTWPDF(ip,np,ih,nhess,xx(2),yy(my-1),nx,my,xx,yy, & + & cc) + if (f0.gt.1.d-3.and.f1.gt.1.d-3) then + z1 = exp(log(f0)+(log(f0)-log(f1))/(yy(my)-yy(my-1))* & + & (y-yy(my))) + else + z1 = f0+(f0-f1)/(yy(my)-yy(my-1))*(y-yy(my)) + end if + if (z0.gt.1.d-3.and.z1.gt.1.d-3) then + z = exp(log(z0)+(log(z1)-log(z0))/(xx(2)-xx(1))*(x-xx(1))) + else + z = z0+(z1-z0)/(xx(2)-xx(1))*(x-xx(1)) + end if + else + print *,"Error in ExtrapolateMSTWPDF" + stop + end if + + ExtrapolateMSTWPDF = z + + return + end + +!---------------------------------------------------------------------- + + integer function MSTWlocx(xx,nx,x) +! returns an integer j such that x lies inbetween xx(j) and xx(j+1). +! nx is the length of the array with xx(nx) the highest element. + implicit none + integer nx,jl,ju,jm + double precision x,xx(nx) + if(x.eq.xx(1)) then + MSTWlocx=1 + return + endif + if(x.eq.xx(nx)) then + MSTWlocx=nx-1 + return + endif + ju=nx+1 + jl=0 + 1 if((ju-jl).le.1) goto 2 + jm=(ju+jl)/2 + if(x.ge.xx(jm)) then + jl=jm + else + ju=jm + endif + goto 1 + 2 MSTWlocx=jl + return + end + +!---------------------------------------------------------------------- + + double precision function polderiv1(x1,x2,x3,y1,y2,y3) +!-- returns the estimate of the derivative at x1 obtained by a +!-- polynomial interpolation using the three points (x_i,y_i). + implicit none + double precision x1,x2,x3,y1,y2,y3 + polderiv1=(x3*x3*(y1-y2)+2.d0*x1*(x3*(-y1+y2)+x2*(y1-y3)) & + & +x2*x2*(-y1+y3)+x1*x1*(-y2+y3))/((x1-x2)*(x1-x3)*(x2-x3)) + return + end + + double precision function polderiv2(x1,x2,x3,y1,y2,y3) +!-- returns the estimate of the derivative at x2 obtained by a +!-- polynomial interpolation using the three points (x_i,y_i). + implicit none + double precision x1,x2,x3,y1,y2,y3 + polderiv2=(x3*x3*(y1-y2)-2.d0*x2*(x3*(y1-y2)+x1*(y2-y3)) & + & +x2*x2*(y1-y3)+x1*x1*(y2-y3))/((x1-x2)*(x1-x3)*(x2-x3)) + return + end + + double precision function polderiv3(x1,x2,x3,y1,y2,y3) +!-- returns the estimate of the derivative at x3 obtained by a +!-- polynomial interpolation using the three points (x_i,y_i). + implicit none + double precision x1,x2,x3,y1,y2,y3 + polderiv3=(x3*x3*(-y1+y2)+2.d0*x2*x3*(y1-y3)+x1*x1*(y2-y3) & + & +x2*x2*(-y1+y3)+2.d0*x1*x3*(-y2+y3))/ & + & ((x1-x2)*(x1-x3)*(x2-x3)) + return + end + +!---------------------------------------------------------------------- + +!---------------------------------------------------------------------- +!-- Stand-alone code for alpha_s cannibalised (with permission) +!-- from Andreas Vogt's QCD-PEGASUS package (hep-ph/0408244). +!-- The running coupling alpha_s is obtained at N^mLO (m = 0,1,2,3) +!-- by solving the renormalisation group equation in the MSbar scheme +!-- by a fourth-order Runge-Kutta integration. Transitions from +!-- n_f to n_f+1 flavours are made when the factorisation scale +!-- mu_f equals the pole masses m_h (h = c,b,t). At exactly +!-- the thresholds m_{c,b,t}, the number of flavours n_f = {3,4,5}. +!-- The top quark mass should be set to be very large to evolve with +!-- a maximum of five flavours. The factorisation scale mu_f may be +!-- a constant multiple of the renormalisation scale mu_r. The input +!-- factorisation scale mu_(f,0) should be less than or equal to +!-- the charm quark mass. However, if it is greater than the +!-- charm quark mass, the value of alpha_s at mu_(f,0) = 1 GeV will +!-- be found using a root-finding algorithm. +!-- +!-- Example of usage. +!-- First call the initialisation routine (only needed once): +!-- +!-- IORD = 2 ! perturbative order (N^mLO,m=0,1,2,3) +!-- FR2 = 1.D0 ! ratio of mu_f^2 to mu_r^2 +!-- MUR = 1.D0 ! input mu_r in GeV +!-- ASMUR = 0.5D0 ! input value of alpha_s at mu_r +!-- MC = 1.4D0 ! charm quark mass +!-- MB = 4.75D0 ! bottom quark mass +!-- MT = 1.D10 ! top quark mass +!-- CALL MSTWINITALPHAS(IORD, FR2, MUR, ASMUR, MC, MB, MT) +!-- +!-- Then get alpha_s at a renormalisation scale mu_r with: +!-- +!-- MUR = 100.D0 ! renormalisation scale in GeV +!-- ALFAS = MSTWALPHAS(MUR) +!-- +!---------------------------------------------------------------------- +!-- Comments to Graeme Watt +!---------------------------------------------------------------------- + + SUBROUTINE MSTWINITALPHAS(IORD, FR2, MUR, ASMUR, MC, MB, MT) +!-- IORD = 0 (LO), 1 (NLO), 2 (NNLO), 3 (NNNLO). +!-- FR2 = ratio of mu_f^2 to mu_r^2 (must be a fixed value). +!-- MUR = input renormalisation scale (in GeV) for alpha_s. +!-- ASMUR = input value of alpha_s at the renormalisation scale MUR. +!-- MC,MB,MT = heavy-quark masses in GeV. + IMPLICIT NONE + INTEGER IORD,IORDc,MAXF,MODE + DOUBLE PRECISION FR2,MUR,ASMUR,MC,MB,MT,EPS,A,B,MSTWDZEROX, & + & R0c,FR2c,MURc,ASMURc,MCc,MBc,MTc,FINDALPHASR0,R0,ASI + COMMON / MSTWDZEROXcommon / FR2c,MURc,ASMURc,MCc,MBc,MTc,R0c,IORDc + PARAMETER(EPS=1.D-10,MAXF=10000,MODE=1) + EXTERNAL FINDALPHASR0 + + IF (MUR*sqrt(FR2).LE.MC) THEN ! Check that MUF <= MC. + R0 = MUR + ASI = ASMUR + ELSE ! Solve for alpha_s at R0 = 1 GeV. +!-- Copy variables to common block. + R0c = 1.D0/sqrt(FR2) + IORDc = IORD + FR2c = FR2 + MURc = MUR + ASMURc = ASMUR + MCc = MC + MBc = MB + MTc = MT +!-- Now get alpha_s(R0) corresponding to alpha_s(MUR). + A = 0.02D0 ! lower bound for alpha_s(R0) + B = 2.00D0 ! upper bound for alpha_s(R0) + R0 = R0c + ASI = MSTWDZEROX(A,B,EPS,MAXF,FINDALPHASR0,MODE) + END IF + + CALL MSTWINITALPHASR0(IORD, FR2, R0, ASI, MC, MB, MT) + + RETURN + END + +!---------------------------------------------------------------------- + +!-- Find the zero of this function using MSTWDZEROX. + DOUBLE PRECISION FUNCTION FINDALPHASR0(ASI) + IMPLICIT NONE + INTEGER IORD + DOUBLE PRECISION FR2, R0, ASI, MC, MB, MT, MUR, ASMUR, MSTWALPHAS + COMMON / MSTWDZEROXcommon / FR2, MUR, ASMUR, MC, MB, MT, R0, IORD + + CALL MSTWINITALPHASR0(IORD, FR2, R0, ASI, MC, MB, MT) + FINDALPHASR0 = MSTWALPHAS(MUR) - ASMUR ! solve equal to zero + + RETURN + END + +!---------------------------------------------------------------------- + + SUBROUTINE MSTWINITALPHASR0(IORD, FR2, R0, ASI, MC, MB, MT) +!-- IORD = 0 (LO), 1 (NLO), 2 (NNLO), 3 (NNNLO). +!-- FR2 = ratio of mu_f^2 to mu_r^2 (must be a fixed value). +!-- R0 = input renormalisation scale (in GeV) for alphas_s. +!-- ASI = input value of alpha_s at the renormalisation scale R0. +!-- MC,MB,MT = heavy-quark masses in GeV. +!-- Must have R0*sqrt(FR2) <= MC to call this subroutine. + IMPLICIT NONE + INTEGER IORD,NAORD,NASTPS,IVFNS,NFF + DOUBLE PRECISION FR2,R0,ASI,MC,MB,MT,LOGFR,R20, & + & PI,ZETA,CF,CA,TR,AS0,M20,MC2,MB2,MT2 + PARAMETER(PI = 3.14159265358979D0) + + COMMON / RZETA / ZETA(6) + COMMON / COLOUR / CF, CA, TR + COMMON / ASINP / AS0, M20 + COMMON / ASPAR / NAORD, NASTPS + COMMON / VARFLV / IVFNS + COMMON / NFFIX / NFF + COMMON / FRRAT / LOGFR + +! +! ..QCD colour factors +! + CA = 3.D0 + CF = 4./3.D0 + TR = 0.5D0 +! +! ..The lowest integer values of the Zeta function +! + ZETA(1) = 0.57721566490153D0 + ZETA(2) = 1.644934066848226D0 + ZETA(3) = 1.202056903159594D0 + ZETA(4) = 1.082323233711138D0 + ZETA(5) = 1.036927755143370D0 + ZETA(6) = 1.017343061984449D0 + + IVFNS = 1 ! variable flavour-number scheme (VFNS) +! IVFNS = 0 ! fixed flavour-number scheme (FFNS) + NFF = 4 ! number of flavours for FFNS + NAORD = IORD ! perturbative order of alpha_s + NASTPS = 20 ! num. steps in Runge-Kutta integration + R20 = R0**2 ! input renormalisation scale + MC2 = MC**2 ! mu_f^2 for charm threshold + MB2 = MB**2 ! mu_f^2 for bottom threshold + MT2 = MT**2 ! mu_f^2 for top threshold + LOGFR = LOG(FR2) ! log of ratio of mu_f^2 to mu_r^2 + M20 = R20 * FR2 ! input factorisation scale + +! +! ..Stop some nonsense +! + IF ( (IVFNS .EQ. 0) .AND. (NFF .LT. 3) ) THEN + WRITE (6,*) 'Wrong flavour number for FFNS evolution. STOP' + STOP + END IF + IF ( (IVFNS .EQ. 0) .AND. (NFF .GT. 5) ) THEN + WRITE (6,*) 'Wrong flavour number for FFNS evolution. STOP' + STOP + END IF +! + IF ( NAORD .GT. 3 ) THEN + WRITE (6,*) 'Specified order in a_s too high. STOP' + STOP + END IF +! + IF ( (IVFNS .NE. 0) .AND. (FR2 .GT. 4.001D0) ) THEN + WRITE (6,*) 'Too low mu_r for VFNS evolution. STOP' + STOP + END IF +! + IF ( (IVFNS .EQ. 1) .AND. (M20 .GT. MC2) ) THEN + WRITE (6,*) 'Too high mu_0 for VFNS evolution. STOP' + STOP + END IF +! + IF ( (ASI .GT. 2.D0) .OR. (ASI .LT. 2.D-2) ) THEN + WRITE (6,*) 'alpha_s out of range. STOP' + STOP + END IF +! + IF ( (IVFNS .EQ. 1) .AND. (MC2 .GT. MB2) ) THEN + WRITE (6,*) 'Wrong charm-bottom mass hierarchy. STOP' + STOP + END IF + IF ( (IVFNS .EQ. 1) .AND. (MB2 .GT. MT2) ) THEN + WRITE (6,*) 'Wrong bottom-top mass hierarchy. STOP' + STOP + END IF +! + +!-- Store the beta function coefficients in a COMMON block. + CALL BETAFCT + +!-- Store a_s = alpha_s(mu_r^2)/(4 pi) at the input scale R0. + AS0 = ASI / (4.D0* PI) + +!-- Store alpha_s at the heavy flavour thresholds in a COMMON block. + IF (IVFNS .NE. 0) THEN + CALL EVNFTHR (MC2, MB2, MT2) + END IF + + RETURN + END + +!---------------------------------------------------------------------- + + DOUBLE PRECISION FUNCTION MSTWALPHAS(MUR) + IMPLICIT NONE + INTEGER NFF,IVFNS,NF + DOUBLE PRECISION PI,LOGFR,AS0,M20,ASC,M2C,ASB,M2B,AST,M2T,M2,MUR, & + & R2,ASI,ASF,R20,R2T,R2B,R2C,AS + PARAMETER ( PI = 3.14159265358979D0 ) +! +! ..Input common blocks +! + COMMON / NFFIX / NFF + COMMON / VARFLV / IVFNS + COMMON / FRRAT / LOGFR + COMMON / ASINP / AS0, M20 + COMMON / ASFTHR / ASC, M2C, ASB, M2B, AST, M2T + + R2 = MUR**2 + M2 = R2 * EXP(+LOGFR) + IF (IVFNS .EQ. 0) THEN +! +! Fixed number of flavours +! + NF = NFF + R20 = M20 * R2/M2 + ASI = AS0 + ASF = AS (R2, R20, AS0, NF) +! + ELSE +! +! ..Variable number of flavours +! + IF (M2 .GT. M2T) THEN + NF = 6 + R2T = M2T * R2/M2 + ASI = AST + ASF = AS (R2, R2T, AST, NF) +! + ELSE IF (M2 .GT. M2B) THEN + NF = 5 + R2B = M2B * R2/M2 + ASI = ASB + ASF = AS (R2, R2B, ASB, NF) +! + ELSE IF (M2 .GT. M2C) THEN + NF = 4 + R2C = M2C * R2/M2 + ASI = ASC + ASF = AS (R2, R2C, ASC, NF) +! + ELSE + NF = 3 + R20 = M20 * R2/M2 + ASI = AS0 + ASF = AS (R2, R20, AS0, NF) +! + END IF +! + END IF +! +! ..Final value of alpha_s +! + MSTWALPHAS = 4.D0*PI*ASF + + RETURN + END +! +! =================================================================av== + + +! ===================================================================== +! +! ..The threshold matching of the QCD coupling in the MS(bar) scheme, +! a_s = alpha_s(mu_r^2)/(4 pi), for NF -> NF + 1 active flavours +! up to order a_s^4 (NNNLO). +! +! ..The value ASNF of a_s for NF flavours at the matching scale, the +! logarithm LOGRH = ln (mu_r^2/m_H^2) -- where m_H is the pole mass +! of the heavy quark -- and NF are passed as arguments to the +! function ASNF1. The order of the expansion NAORD (defined as +! the 'n' in N^nLO) is provided by the common-block ASPAR. +! +! ..The matching coefficients are inverted from Chetyrkin, Kniehl and +! Steinhauser, Phys. Rev. Lett. 79 (1997) 2184. The QCD colour +! factors have been hard-wired in these results. The lowest integer +! values of the Zeta function are given by the common-block RZETA. +! +! ===================================================================== +! +! + DOUBLE PRECISION FUNCTION ASNF1 (ASNF, LOGRH, NF) +! + IMPLICIT NONE + INTEGER NF, NAORD, NASTPS, PRVCLL, K1, K2 + DOUBLE PRECISION ASNF,LOGRH,ZETA,CMC,CMCI30,CMCF30,CMCF31, & + & CMCI31,ASP,LRHP + + DIMENSION CMC(3,0:3) +! +! --------------------------------------------------------------------- +! +! ..Input common-blocks +! + COMMON / ASPAR / NAORD, NASTPS + COMMON / RZETA / ZETA(6) +! +! ..Variables to be saved for the next call +! + SAVE CMC, CMCI30, CMCF30, CMCF31, CMCI31, PRVCLL +! +! --------------------------------------------------------------------- +! +! ..The coupling-constant matching coefficients (CMC's) up to NNNLO +! (calculated and saved in the first call of this routine) +! + IF (PRVCLL .NE. 1) THEN +! + CMC(1,0) = 0.D0 + CMC(1,1) = 2./3.D0 +! + CMC(2,0) = 14./3.D0 + CMC(2,1) = 38./3.D0 + CMC(2,2) = 4./9.D0 +! + CMCI30 = + 80507./432.D0 * ZETA(3) + 58933./1944.D0 & + & + 128./3.D0 * ZETA(2) * (1.+ DLOG(2.D0)/3.D0) + CMCF30 = - 64./9.D0 * (ZETA(2) + 2479./3456.D0) + CMCI31 = 8941./27.D0 + CMCF31 = - 409./27.D0 + CMC(3,2) = 511./9.D0 + CMC(3,3) = 8./27.D0 +! + PRVCLL = 1 +! + END IF +! +! --------------------------------------------------------------------- +! +! ..The N_f dependent CMC's, and the alpha_s matching at order NAORD +! + CMC(3,0) = CMCI30 + NF * CMCF30 + CMC(3,1) = CMCI31 + NF * CMCF31 +! + ASNF1 = ASNF + IF (NAORD .EQ. 0) GOTO 1 + ASP = ASNF +! + DO 11 K1 = 1, NAORD + ASP = ASP * ASNF + LRHP = 1.D0 +! + DO 12 K2 = 0, K1 + ASNF1 = ASNF1 + ASP * CMC(K1,K2) * LRHP + LRHP = LRHP * LOGRH +! + 12 CONTINUE + 11 CONTINUE +! +! --------------------------------------------------------------------- +! + 1 RETURN + END + +! +! =================================================================av== +! +! ..The subroutine EVNFTHR for the evolution of a_s = alpha_s/(4 pi) +! from a three-flavour initial scale to the four- to six-flavour +! thresholds (identified with the squares of the corresponding quark +! masses). The results are written to the common-block ASFTHR. +! +! ..The input scale M20 = mu_(f,0)^2 and the corresponding value +! AS0 of a_s are provided by ASINP. The fixed scale logarithm +! LOGFR = ln (mu_f^2/mu_r^2) is specified in FRRAT. The alpha_s +! matching is done by the function ASNF1. +! +! ===================================================================== +! +! + SUBROUTINE EVNFTHR (MC2, MB2, MT2) +! + IMPLICIT NONE + DOUBLE PRECISION MC2, MB2, MT2, M20, M2C, M2B, M2T, R20, R2C, & + & R2B, R2T, AS, ASNF1, AS0, ASC, ASB, AST, & + & ASC3, ASB4, AST5, LOGFR, SC, SB, ST +! +! --------------------------------------------------------------------- +! +! ..Input common blocks +! + COMMON / ASINP / AS0, M20 + COMMON / FRRAT / LOGFR +! +! ..Output common blocks +! + COMMON / ASFTHR / ASC, M2C, ASB, M2B, AST, M2T + +! --------------------------------------------------------------------- +! +! ..Coupling constants at and evolution distances to/between thresholds +! + R20 = M20 * EXP(-LOGFR) +! +! ..Charm +! + M2C = MC2 + R2C = M2C * R20/M20 + ASC3 = AS (R2C, R20, AS0, 3) + SC = LOG (AS0 / ASC3) + ASC = ASNF1 (ASC3, -LOGFR, 3) +! +! ..Bottom +! + M2B = MB2 + R2B = M2B * R20/M20 + ASB4 = AS (R2B, R2C, ASC, 4) + SB = LOG (ASC / ASB4) + ASB = ASNF1 (ASB4, -LOGFR, 4) +! +! ..Top +! + M2T = MT2 + R2T = M2T * R20/M20 + AST5 = AS (R2T, R2B, ASB, 5) + ST = LOG (ASB / AST5) + AST = ASNF1 (AST5, -LOGFR, 5) + + RETURN + END + +! +! =================================================================av== +! +! ..The running coupling of QCD, +! +! AS = a_s = alpha_s(mu_r^2)/(4 pi), +! +! obtained by integrating the evolution equation for a fixed number +! of massless flavours NF. Except at leading order (LO), AS is +! obtained using a fourth-order Runge-Kutta integration. +! +! ..The initial and final scales R20 and R2, the value AS0 at +! R20, and NF are passed as function arguments. The coefficients +! of the beta function up to a_s^5 (N^3LO) are provided by the +! common-block BETACOM. The order of the expansion NAORD (defined +! as the 'n' in N^nLO) and the number of steps NASTPS for the +! integration beyond LO are given by the common-block ASPAR. +! +! ===================================================================== +! +! + DOUBLE PRECISION FUNCTION AS (R2, R20, AS0, NF) +! + IMPLICIT NONE + INTEGER NFMIN, NFMAX, NF, NAORD, NASTPS, K1 + DOUBLE PRECISION R2, R20, AS0, SXTH, BETA0, BETA1, BETA2, BETA3, & + & FBETA1,FBETA2,FBETA3,A,LRRAT,DLR,XK0,XK1,XK2,XK3 + PARAMETER (NFMIN = 3, NFMAX = 6) + PARAMETER ( SXTH = 0.166666666666666D0 ) +! +! --------------------------------------------------------------------- +! +! ..Input common-blocks +! + COMMON / ASPAR / NAORD, NASTPS + COMMON / BETACOM / BETA0 (NFMIN:NFMAX), BETA1 (NFMIN:NFMAX), & + & BETA2 (NFMIN:NFMAX), BETA3 (NFMIN:NFMAX) +! +! ..The beta functions FBETAn at N^nLO for n = 1, 2, and 3 +! + FBETA1(A) = - A**2 * ( BETA0(NF) + A * BETA1(NF) ) + FBETA2(A) = - A**2 * ( BETA0(NF) + A * ( BETA1(NF) & + & + A * BETA2(NF) ) ) + FBETA3(A) = - A**2 * ( BETA0(NF) + A * ( BETA1(NF) & + & + A * (BETA2(NF) + A * BETA3(NF)) ) ) +! +! --------------------------------------------------------------------- +! +! ..Initial value, evolution distance and step size +! + AS = AS0 + LRRAT = LOG (R2/R20) + DLR = LRRAT / NASTPS +! +! ..Solution of the evolution equation depending on NAORD +! (fourth-order Runge-Kutta beyond the leading order) +! + IF (NAORD .EQ. 0) THEN +! + AS = AS0 / (1.+ BETA0(NF) * AS0 * LRRAT) +! + ELSE IF (NAORD .EQ. 1) THEN +! + DO 2 K1 = 1, NASTPS + XK0 = DLR * FBETA1 (AS) + XK1 = DLR * FBETA1 (AS + 0.5 * XK0) + XK2 = DLR * FBETA1 (AS + 0.5 * XK1) + XK3 = DLR * FBETA1 (AS + XK2) + AS = AS + SXTH * (XK0 + 2.* XK1 + 2.* XK2 + XK3) + 2 CONTINUE +! + ELSE IF (NAORD .EQ. 2) THEN +! + DO 3 K1 = 1, NASTPS + XK0 = DLR * FBETA2 (AS) + XK1 = DLR * FBETA2 (AS + 0.5 * XK0) + XK2 = DLR * FBETA2 (AS + 0.5 * XK1) + XK3 = DLR * FBETA2 (AS + XK2) + AS = AS + SXTH * (XK0 + 2.* XK1 + 2.* XK2 + XK3) + 3 CONTINUE +! + ELSE IF (NAORD .EQ. 3) THEN +! + DO 4 K1 = 1, NASTPS + XK0 = DLR * FBETA3 (AS) + XK1 = DLR * FBETA3 (AS + 0.5 * XK0) + XK2 = DLR * FBETA3 (AS + 0.5 * XK1) + XK3 = DLR * FBETA3 (AS + XK2) + AS = AS + SXTH * (XK0 + 2.* XK1 + 2.* XK2 + XK3) + 4 CONTINUE + END IF +! +! --------------------------------------------------------------------- +! + RETURN + END + +! +! =================================================================av== +! +! ..The subroutine BETAFCT for the coefficients BETA0...BETA3 of the +! beta function of QCD up to order alpha_s^5 (N^3LO), normalized by +! +! d a_s / d ln mu_r^2 = - BETA0 a_s^2 - BETA1 a_s^3 - ... +! +! with a_s = alpha_s/(4*pi). +! +! ..The MSbar coefficients are written to the common-block BETACOM for +! NF = 3...6 (parameters NFMIN, NFMAX) quark flavours. +! +! ..The factors CF, CA and TF are taken from the common-block COLOUR. +! Beyond NLO the QCD colour factors are hard-wired in this routine, +! and the numerical coefficients are truncated to six digits. +! +! ===================================================================== +! +! + SUBROUTINE BETAFCT +! + IMPLICIT DOUBLE PRECISION (A - Z) + INTEGER NFMIN, NFMAX, NF + PARAMETER (NFMIN = 3, NFMAX = 6) +! +! --------------------------------------------------------------------- +! +! ..Input common-block +! + COMMON / COLOUR / CF, CA, TR +! +! ..Output common-block +! + COMMON / BETACOM / BETA0 (NFMIN:NFMAX), BETA1 (NFMIN:NFMAX), & + & BETA2 (NFMIN:NFMAX), BETA3 (NFMIN:NFMAX) + +! +! --------------------------------------------------------------------- +! +! ..The full LO and NLO coefficients +! + B00 = 11./3.D0 * CA + B01 = -4./3.D0 * TR + B10 = 34./3.D0 * CA**2 + B11 = -20./3.D0 * CA*TR - 4.* CF*TR +! +! ..Flavour-number loop and output to the array +! + DO 1 NF = NFMIN, NFMAX +! + BETA0(NF) = B00 + B01 * NF + BETA1(NF) = B10 + B11 * NF +! + BETA2(NF) = 1428.50 - 279.611 * NF + 6.01852 * NF**2 + BETA3(NF) = 29243.0 - 6946.30 * NF + 405.089 * NF**2 & + & + 1.49931 * NF**3 +! +! --------------------------------------------------------------------- +! + 1 CONTINUE +! + RETURN + END +! +! =================================================================av== + + +!-- G.W. MSTWDZEROX taken from CERNLIB to find the zero of a function. + DOUBLE PRECISION FUNCTION MSTWDZEROX(A0,B0,EPS,MAXF,F,MODE) + IMPLICIT DOUBLE PRECISION (A-H,O-Z) +! Based on +! +! J.C.P. Bus and T.J. Dekker, Two Efficient Algorithms with +! Guaranteed Convergence for Finding a Zero of a Function, +! ACM Trans. Math. Software 1 (1975) 330-345. +! +! (MODE = 1: Algorithm M; MODE = 2: Algorithm R) + CHARACTER*80 ERRTXT + LOGICAL LMT + DIMENSION IM1(2),IM2(2),LMT(2) + PARAMETER (Z1 = 1, HALF = Z1/2) + DATA IM1 /2,3/, IM2 /-1,3/ + MSTWDZEROX = 0.D0 ! G.W. to prevent compiler warning + IF(MODE .NE. 1 .AND. MODE .NE. 2) THEN + C=0 + WRITE(ERRTXT,101) MODE + WRITE(6,*) ERRTXT + GOTO 99 + ENDIF + FA=F(B0) + FB=F(A0) + IF(FA*FB .GT. 0) THEN + C=0 + WRITE(ERRTXT,102) A0,B0 + WRITE(6,*) ERRTXT + GOTO 99 + ENDIF + ATL=ABS(EPS) + B=A0 + A=B0 + LMT(2)=.TRUE. + MF=2 + 1 C=A + FC=FA + 2 IE=0 + 3 IF(ABS(FC) .LT. ABS(FB)) THEN + IF(C .NE. A) THEN + D=A + FD=FA + END IF + A=B + B=C + C=A + FA=FB + FB=FC + FC=FA + END IF + TOL=ATL*(1+ABS(C)) + H=HALF*(C+B) + HB=H-B + IF(ABS(HB) .GT. TOL) THEN + IF(IE .GT. IM1(MODE)) THEN + W=HB + ELSE + TOL=TOL*SIGN(Z1,HB) + P=(B-A)*FB + LMT(1)=IE .LE. 1 + IF(LMT(MODE)) THEN + Q=FA-FB + LMT(2)=.FALSE. + ELSE + FDB=(FD-FB)/(D-B) + FDA=(FD-FA)/(D-A) + P=FDA*P + Q=FDB*FA-FDA*FB + END IF + IF(P .LT. 0) THEN + P=-P + Q=-Q + END IF + IF(IE .EQ. IM2(MODE)) P=P+P + IF(P .EQ. 0 .OR. P .LE. Q*TOL) THEN + W=TOL + ELSEIF(P .LT. HB*Q) THEN + W=P/Q + ELSE + W=HB + END IF + END IF + D=A + A=B + FD=FA + FA=FB + B=B+W + MF=MF+1 + IF(MF .GT. MAXF) THEN + WRITE(6,*) "Error in MSTWDZEROX: TOO MANY FUNCTION CALLS" + GOTO 99 + ENDIF + FB=F(B) + IF(FB .EQ. 0 .OR. SIGN(Z1,FC) .EQ. SIGN(Z1,FB)) GOTO 1 + IF(W .EQ. HB) GOTO 2 + IE=IE+1 + GOTO 3 + END IF + MSTWDZEROX=C + 99 CONTINUE + RETURN + 101 FORMAT('Error in MSTWDZEROX: MODE = ',I3,' ILLEGAL') + 102 FORMAT('Error in MSTWDZEROX: F(A) AND F(B) HAVE THE SAME SIGN, A = ', & + & 1P,D15.8,', B = ',D15.8) + END + +! --------------------------------------------------------------------- diff --git a/LHAPDF/lhapdf-5.9.1/src/wrapmstw.f b/LHAPDF/lhapdf-5.9.1/src/wrapmstw.f new file mode 100644 index 00000000000..76fa816eddf --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/wrapmstw.f @@ -0,0 +1,1446 @@ +! -*- F90 -*- + +!-- LHAPDF version of MSTW interpolation code and alphaS routines. +!-- 22/01/2009 by Graeme Watt + +!-- Modified to allow possibility of different heavy-quark masses. +!-- 25/06/2010 by Graeme Watt + +!-- Fix "NaN" bug for q <= m_c when m_c^2 < 1.25 GeV^2. +!-- 25/01/2011 by Graeme Watt + +subroutine MSTWevolve(x,Q,xpdf,xphoton) + implicit none + ! + include 'parmsetup.inc' + character*16 name(nmxset) + integer iset,mem,nset,nmem(nmxset),ndef(nmxset),mmem,imem + COMMON/NAME/name,nmem,ndef,mmem + double precision xpdf(-6:6),xvalence(6),xphoton, & + & x,Q,alfas,Qalfa,Eorder,Q2fit,MSTWALPHAS + logical warn,fatal + parameter(warn=.false.,fatal=.true.) + ! Set warn=.true. to turn on warnings when extrapolating. + ! Set fatal=.false. to return zero instead of terminating when + ! invalid input values of x and q are used. + integer ih,f,nhess,nx,nq,np,nqc0,nqb0,n,m,ip,io, & + & nExtraFlavours + double precision xmin,xmax,qsqmin,qsqmax,mc2,mb2,eps, & + & qsq,xlog,qsqlog,res,res1,anom,ExtrapolateMSTWPDF, & + & InterpolateMSTWPDF + parameter(nx=64,nq=48,np=12) + parameter(xmin=1d-6,xmax=1d0,qsqmin=1d0,qsqmax=1d9,eps=1d-6) + parameter(nhess=2*23) + character dummyChar,dummyWord*50 + double precision gridx(nmxgridx),gridq(nmxgridq) + integer ngridx,ngridq,jx,jq + double precision ff(np,nx,nq) + double precision qqorig(nq),qq(nq),xx(nx),cc(np,0:nhess,nx,nq,4,4,nmxset) + double precision xxl(nx),qql(nq,nmxset,0:nhess) + ! Store values of distance and tolerance along each eigenvector, + ! heavy-quark masses and alphaS parameters in COMMON block. + ! Allow the possibility of different alphaS parameters and + ! heavy-quark masses for each member of the set. + double precision distance(nmxset,0:nhess),tolerance(nmxset,0:nhess), & + & mCharm(nmxset,0:nhess),mBottom(nmxset,0:nhess), & + & alphaSQ0(nmxset,0:nhess),alphaSMZ(nmxset,0:nhess) + integer alphaSorder(nmxset,0:nhess),alphaSnfmax(nmxset,0:nhess) + common/mstwCommon/distance,tolerance, & + & mCharm,mBottom,alphaSQ0,alphaSMZ,alphaSorder,alphaSnfmax + double precision mCharmSave,mBottomSave,mTopSave + double precision cmass(nmxset),bmass(nmxset),tmass(nmxset) + common/masses_LHA/cmass,bmass,tmass + data xx/1d-6,2d-6,4d-6,6d-6,8d-6, & + & 1d-5,2d-5,4d-5,6d-5,8d-5, & + & 1d-4,2d-4,4d-4,6d-4,8d-4, & + & 1d-3,2d-3,4d-3,6d-3,8d-3, & + & 1d-2,1.4d-2,2d-2,3d-2,4d-2,6d-2,8d-2, & + & .1d0,.125d0,.15d0,.175d0,.2d0,.225d0,.25d0,.275d0, & + & .3d0,.325d0,.35d0,.375d0,.4d0,.425d0,.45d0,.475d0, & + & .5d0,.525d0,.55d0,.575d0,.6d0,.625d0,.65d0,.675d0, & + & .7d0,.725d0,.75d0,.775d0,.8d0,.825d0,.85d0,.875d0, & + & .9d0,.925d0,.95d0,.975d0,1d0/ + data qqorig/1.d0, & + & 1.25d0,1.5d0,0.d0,0.d0,2.5d0,3.2d0,4d0,5d0,6.4d0,8d0, & + & 1d1,1.2d1,0.d0,0.d0,2.6d1,4d1,6.4d1,1d2, & + & 1.6d2,2.4d2,4d2,6.4d2,1d3,1.8d3,3.2d3,5.6d3,1d4, & + & 1.8d4,3.2d4,5.6d4,1d5,1.8d5,3.2d5,5.6d5,1d6, & + & 1.8d6,3.2d6,5.6d6,1d7,1.8d7,3.2d7,5.6d7,1d8, & + & 1.8d8,3.2d8,5.6d8,1d9/ + save + + call getnset(iset) + call getnmem(iset,imem) + ih = imem + + qsq=q*q + mc2=mCharm(iset,ih)**2 + mb2=mBottom(iset,ih)**2 + ! If mc2 < qsq < mc2+eps, then qsq = mc2+eps. + if (qsq.gt.mc2.and.qsq.lt.mc2+eps) then + qsq = mc2+eps + end if + ! If mb2 < qsq < mb2+eps, then qsq = mb2+eps. + if (qsq.gt.mb2.and.qsq.lt.mb2+eps) then + qsq = mb2+eps + end if + + xlog=log10(x) + qsqlog=log10(qsq) + + do f = 0, 13 ! loop over flavours + + res = 0.d0 + + if (f.eq.0) then ! gluon + ip = 1 + else if (f.ge.1.and.f.le.5) then ! quarks + ip = f+1 + else if (f.le.-1.and.f.ge.-5) then ! antiquarks + ip = -f+1 + else if (f.ge.7.and.f.le.11) then ! valence quarks + ip = f + else if (f.eq.13) then ! photon + ip = 12 + else if (abs(f).ne.6.and.f.ne.12) then + if (warn.or.fatal) print *,"Error in MSTWevolve: f = ",f + if (fatal) stop + end if + + if (x.le.0.d0.or.x.gt.xmax.or.q.le.0.d0) then + + if (warn.or.fatal) print *,"Error in MSTWevolve: x,qsq = ", & + & x,qsq + if (fatal) stop + + else if (abs(f).eq.6.or.f.eq.12) then ! set top quarks to zero + + res = 0.d0 + + else if (qsq.lt.qsqmin) then ! extrapolate to low Q^2 + + if (warn) then + print *, "Warning in MSTWevolve, extrapolating: f = ",f, & + & ", x = ",x,", q = ",q + end if + + if (x.lt.xmin) then ! extrapolate to low x + + res = ExtrapolateMSTWPDF(ip,np,ih,nhess,xlog, & + & log10(qsqmin),nx,nq,xxl,qql(1,iset,ih),cc(1,0,1,1,1,1,iset)) + res1 = ExtrapolateMSTWPDF(ip,np,ih,nhess,xlog, & + & log10(1.01D0*qsqmin),nx,nq,xxl,qql(1,iset,ih),cc(1,0,1,1,1,1,iset)) + if (f.le.-1.and.f.ge.-5) then ! antiquark = quark - valence + res = res - ExtrapolateMSTWPDF(ip+5,np,ih,nhess,xlog, & + & log10(qsqmin),nx,nq,xxl,qql(1,iset,ih),cc(1,0,1,1,1,1,iset)) + res1 = res1 - ExtrapolateMSTWPDF(ip+5,np,ih,nhess,xlog, & + & log10(1.01D0*qsqmin),nx,nq,xxl,qql(1,iset,ih),cc(1,0,1,1,1,1,iset)) + end if + + else ! do usual interpolation + + res = InterpolateMSTWPDF(ip,np,ih,nhess,xlog, & + & log10(qsqmin),nx,nq,xxl,qql(1,iset,ih),cc(1,0,1,1,1,1,iset)) + res1 = InterpolateMSTWPDF(ip,np,ih,nhess,xlog, & + & log10(1.01D0*qsqmin),nx,nq,xxl,qql(1,iset,ih),cc(1,0,1,1,1,1,iset)) + if (f.le.-1.and.f.ge.-5) then ! antiquark = quark - valence + res = res - InterpolateMSTWPDF(ip+5,np,ih,nhess,xlog, & + & log10(qsqmin),nx,nq,xxl,qql(1,iset,ih),cc(1,0,1,1,1,1,iset)) + res1 = res1 - InterpolateMSTWPDF(ip+5,np,ih,nhess,xlog, & + & log10(1.01D0*qsqmin),nx,nq,xxl,qql(1,iset,ih),cc(1,0,1,1,1,1,iset)) + end if + + end if + + ! Calculate the anomalous dimension, dlog(xf)/dlog(qsq), + ! evaluated at qsqmin. Then extrapolate the PDFs to low + ! qsq < qsqmin by interpolating the anomalous dimenion between + ! the value at qsqmin and a value of 1 for qsq << qsqmin. + ! If value of PDF at qsqmin is very small, just set + ! anomalous dimension to 1 to prevent rounding errors. + ! Impose minimum anomalous dimension of -2.5. + if (abs(res).ge.1.D-5) then + anom = max( -2.5D0, (res1-res)/res/0.01D0 ) + else + anom = 1.D0 + end if + res = res*(qsq/qsqmin)**(anom*qsq/qsqmin+1.D0-qsq/qsqmin) + + else if (x.lt.xmin.or.qsq.gt.qsqmax) then ! extrapolate + + if (warn) then + print *, "Warning in MSTWevolve, extrapolating: f = ",f, & + & ", x = ",x,", q = ",q + end if + + res = ExtrapolateMSTWPDF(ip,np,ih,nhess,xlog, & + & qsqlog,nx,nq,xxl,qql(1,iset,ih),cc(1,0,1,1,1,1,iset)) + + if (f.le.-1.and.f.ge.-5) then ! antiquark = quark - valence + res = res - ExtrapolateMSTWPDF(ip+5,np,ih,nhess,xlog, & + & qsqlog,nx,nq,xxl,qql(1,iset,ih),cc(1,0,1,1,1,1,iset)) + end if + + else ! do usual interpolation + + res = InterpolateMSTWPDF(ip,np,ih,nhess,xlog, & + & qsqlog,nx,nq,xxl,qql(1,iset,ih),cc(1,0,1,1,1,1,iset)) + + if (f.le.-1.and.f.ge.-5) then ! antiquark = quark - valence + res = res - InterpolateMSTWPDF(ip+5,np,ih,nhess,xlog, & + & qsqlog,nx,nq,xxl,qql(1,iset,ih),cc(1,0,1,1,1,1,iset)) + end if + + end if + + if (f.ge.7.and.f.le.12) then + xvalence(f-6) = res + else if (f.eq.13) then + xphoton = res + else + xpdf(f) = res + end if + + end do + + do f = 1, 6 + xpdf(-f) = xpdf(f) - xvalence(f) ! antiquarks + end do + + return + ! + entry MSTWgetgrid(nset,ngridx,ngridq,gridx,gridq) + do jx=1,nx + gridx(jx)=xx(jx) + enddo + do jq=1,nq + gridq(jq)=qq(jq) + enddo + ngridx=nx + ngridq=nq + return + + entry MSTWread(nset) + + read(1,*) nmem(nset),ndef(nset) + + do ih = 0, nmem(nset) + + ! Read header containing heavy-quark masses and alphaS values. + read(1,*) + read(1,*) + read(1,*) dummyChar,dummyWord,dummyWord,dummyChar, & + & distance(nset,ih),tolerance(nset,ih) + read(1,*) dummyChar,dummyWord,dummyChar,mCharm(nset,ih) + read(1,*) dummyChar,dummyWord,dummyChar,mBottom(nset,ih) + read(1,*) dummyChar,dummyWord,dummyChar,alphaSQ0(nset,ih) + read(1,*) dummyChar,dummyWord,dummyChar,alphaSMZ(nset,ih) + read(1,*) dummyChar,dummyWord,dummyWord,dummyChar, & + & alphaSorder(nset,ih),alphaSnfmax(nset,ih) + read(1,*) dummyChar,dummyWord,dummyChar,nExtraFlavours + read(1,*) + read(1,*) + + ! Heavy-quark masses and alphaS values + ! are stored in a COMMON block. + ! WRITE(6,*) "mCharm = ",mCharm(nset,ih), & + ! & ", mBottom = ",mBottom(nset,ih) + ! WRITE(6,*) "alphaS(Q0) = ",alphaSQ0(nset,ih),", alphaS(MZ) = ", & + ! & alphaSMZ(nset,ih),", alphaSorder = ",alphaSorder(nset,ih), & + ! & ", alphaSnfmax = ",alphaSnfmax(nset,ih) + + mc2=mCharm(nset,ih)**2 + mb2=mBottom(nset,ih)**2 + + ! Check that the heavy-quark masses are sensible. + ! Redistribute grid points if not in usual range. + do m=1,nq + qq(m) = qqorig(m) + end do + if (mc2.le.qq(1).or.mc2+eps.ge.qq(8)) then + print *,"Error in MSTWevolve: invalid mCharm = ",mCharm(nset,ih) + stop + else if (mc2.lt.qq(2)) then + nqc0=2 + qq(4)=qq(2) + qq(5)=qq(3) + else if (mc2.lt.qq(3)) then + nqc0=3 + qq(5)=qq(3) + else if (mc2.lt.qq(6)) then + nqc0=4 + else if (mc2.lt.qq(7)) then + nqc0=5 + qq(4)=qq(6) + else + nqc0=6 + qq(4)=qq(6) + qq(5)=qq(7) + end if + if (mb2.le.qq(12).or.mb2+eps.ge.qq(17)) then + print *,"Error in MSTWevolve: invalid mBottom = ",mBottom(nset,ih) + stop + else if (mb2.lt.qq(13)) then + nqb0=13 + qq(15)=qq(13) + else if (mb2.lt.qq(16)) then + nqb0=14 + else + nqb0=15 + qq(14)=qq(16) + end if + qq(nqc0)=mc2 + qq(nqc0+1)=mc2+eps + qq(nqb0)=mb2 + qq(nqb0+1)=mb2+eps + + ! The nExtraFlavours variable is provided to aid compatibility + ! with future grids where, for example, a photon distribution + ! might be provided (cf. the MRST2004QED PDFs). + if (nExtraFlavours.lt.0.or.nExtraFlavours.gt.1) then + print *,"Error in MSTWevolve: invalid nExtraFlavours = ", & + & nExtraFlavours + stop + end if + + ! Now read in the grids from the grid file. + do n=1,nx-1 + do m=1,nq + if (nExtraFlavours.gt.0) then + if (alphaSorder(nset,ih).eq.2) then ! NNLO + read(1,'(12(1pe12.4))',iostat=io) & + & (ff(ip,n,m),ip=1,12) + else ! LO or NLO + ff(10,n,m) = 0.d0 ! = chm-cbar + ff(11,n,m) = 0.d0 ! = bot-bbar + read(1,'(10(1pe12.4))',iostat=io) & + & (ff(ip,n,m),ip=1,9),ff(12,n,m) + end if + else ! nExtraFlavours = 0 + if (alphaSorder(nset,ih).eq.2) then ! NNLO + ff(12,n,m) = 0.d0 ! = photon + read(1,'(11(1pe12.4))',iostat=io) & + & (ff(ip,n,m),ip=1,11) + else ! LO or NLO + ff(10,n,m) = 0.d0 ! = chm-cbar + ff(11,n,m) = 0.d0 ! = bot-bbar + ff(12,n,m) = 0.d0 ! = photon + read(1,'(9(1pe12.4))',iostat=io) & + & (ff(ip,n,m),ip=1,9) + end if + end if + if (io.ne.0) then + print *,"Error in MSTWevolve reading file" + stop + end if + enddo + enddo + + ! PDFs are identically zero at x = 1. + do m=1,nq + do ip=1,np + ff(ip,nx,m)=0d0 + enddo + enddo + + do n=1,nx + xxl(n)=log10(xx(n)) + enddo + do m=1,nq + qql(m,nset,ih)=log10(qq(m)) + enddo + + ! Initialise all parton flavours. + do ip=1,np + call InitialiseMSTWPDF(ip,np,ih,nhess,nx,nq,nqc0,nqb0, & + & xxl,qql(1,nset,ih),ff,cc(1,0,1,1,1,1,nset)) + enddo + + end do + + return + ! + entry MSTWalfa(alfas,Qalfa) + call getnset(iset) + call getnmem(iset,imem) + + ! Check value of Qalfa is below appropriate thresholds. + ! If not, redefine thresholds and reinitialise alphaS. + IF (alphaSnfmax(iset,imem).EQ.5) THEN ! maximum of five flavours + IF (Qalfa.GT.mTopSave) THEN + mTopSave = 2.D0*Qalfa + CALL MSTWINITALPHAS(alphaSorder(iset,imem), & + & 1.D0,1.D0,alphaSQ0(iset,imem), & + & mCharmSave,mBottomSave,mTopSave) + END IF + ELSE IF (alphaSnfmax(iset,imem).EQ.4) THEN ! maximum of four flavours + IF (Qalfa.GT.mBottomSave) THEN + mBottomSave = 2.D0*Qalfa + mTopSave = mBottomSave/0.9D0 + CALL MSTWINITALPHAS(alphaSorder(iset,imem), & + & 1.D0,1.D0,alphaSQ0(iset,imem), & + & mCharmSave,mBottomSave,mTopSave) + END IF + ELSE IF (alphaSnfmax(iset,imem).EQ.3) THEN ! maximum of three flavours + IF (Qalfa.GT.mCharmSave) THEN + mCharmSave = 2.D0*Qalfa + mBottomSave = mCharmSave*0.9D0/0.8D0 + mTopSave = mBottomSave/0.9D0 + CALL MSTWINITALPHAS(alphaSorder(iset,imem), & + & 1.D0,1.D0,alphaSQ0(iset,imem), & + & mCharmSave,mBottomSave,mTopSave) + END IF + END IF + alfas = MSTWALPHAS(Qalfa) + return + ! + entry MSTWinit(nset,Eorder,Q2fit) + return + ! + entry MSTWpdf(mem) + call getnset(iset) + call setnmem(iset,mem) + + ! Call the initialisation routine with alpha_S(Q_0). + IF (alphaSnfmax(iset,mem).EQ.5) THEN ! maximum of five flavours + mCharmSave = mCharm(iset,mem) + mBottomSave = mBottom(iset,mem) + mTopSave = 1.D10 + ELSE IF (alphaSnfmax(iset,mem).EQ.4) THEN ! maximum of four flavours + mCharmSave = mCharm(iset,mem) + mBottomSave = 0.9D10 + mTopSave = 1.D10 + ELSE IF (alphaSnfmax(iset,mem).EQ.3) THEN ! maximum of three flavours + mCharmSave = 0.8D10 + mBottomSave = 0.9D10 + mTopSave = 1.D10 + END IF + + ! Update masses stored in common/masses_LHA/. + cmass(iset) = mCharm(iset,mem) + bmass(iset) = mBottom(iset,mem) + tmass(iset) = mTopSave + + CALL MSTWINITALPHAS(alphaSorder(iset,mem),1.D0,1.D0,alphaSQ0(iset,mem), & + & mCharmSave,mBottomSave,mTopSave) + + ! ! Check calculated value of alpha_S(M_Z) matches stored value. + ! WRITE(6,'(" alphaS(MZ) = ",F7.5," = ",F7.5)') & + ! & MSTWALPHAS(91.1876D0),alphaSMZ(iset,mem) + + return + ! +END subroutine MSTWevolve + + + +!---------------------------------------------------------------------- + +subroutine InitialiseMSTWPDF(ip,np,ih,nhess,nx,my,myc0,myb0, & + & xx,yy,ff,cc) + implicit none + integer nhess,ih,nx,my,myc0,myb0,j,k,l,m,n,ip,np + double precision xx(nx),yy(my),ff(np,nx,my), & + & ff1(nx,my),ff2(nx,my),ff12(nx,my),ff21(nx,my), & + & yy0(4),yy1(4),yy2(4),yy12(4),z(16), & + & cl(16),cc(np,0:nhess,nx,my,4,4),iwt(16,16), & + & polderiv1,polderiv2,polderiv3,d1,d2,d1d2,xxd + + data iwt/1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, & + & 0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0, & + & -3,0,0,3,0,0,0,0,-2,0,0,-1,0,0,0,0, & + & 2,0,0,-2,0,0,0,0,1,0,0,1,0,0,0,0, & + & 0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0, & + & 0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0, & + & 0,0,0,0,-3,0,0,3,0,0,0,0,-2,0,0,-1, & + & 0,0,0,0,2,0,0,-2,0,0,0,0,1,0,0,1, & + & -3,3,0,0,-2,-1,0,0,0,0,0,0,0,0,0,0, & + & 0,0,0,0,0,0,0,0,-3,3,0,0,-2,-1,0,0, & + & 9,-9,9,-9,6,3,-3,-6,6,-6,-3,3,4,2,1,2, & + & -6,6,-6,6,-4,-2,2,4,-3,3,3,-3,-2,-1,-1,-2, & + & 2,-2,0,0,1,1,0,0,0,0,0,0,0,0,0,0, & + & 0,0,0,0,0,0,0,0,2,-2,0,0,1,1,0,0, & + & -6,6,-6,6,-3,-3,3,3,-4,4,2,-2,-2,-2,-1,-1, & + & 4,-4,4,-4,2,2,-2,-2,2,-2,-2,2,1,1,1,1/ + + do m=1,my + ff1(1,m)=polderiv1(xx(1),xx(2),xx(3), & + & ff(ip,1,m),ff(ip,2,m),ff(ip,3,m)) + ff1(nx,m)=polderiv3(xx(nx-2),xx(nx-1),xx(nx), & + & ff(ip,nx-2,m),ff(ip,nx-1,m),ff(ip,nx,m)) + do n=2,nx-1 + ff1(n,m)=polderiv2(xx(n-1),xx(n),xx(n+1), & + & ff(ip,n-1,m),ff(ip,n,m),ff(ip,n+1,m)) + enddo + enddo + +!-- Calculate the derivatives at qsq=mc2,mc2+eps,mb2,mb2+eps +!-- in a similar way as at the endpoints qsqmin and qsqmax. + do n=1,nx + do m=1,my + if (myc0.eq.2.and.m.eq.1) then + ff2(n,m)=(ff(ip,n,m+1)-ff(ip,n,m))/(yy(m+1)-yy(m)) + else if (myc0.eq.2.and.m.eq.2) then + ff2(n,m)=(ff(ip,n,m)-ff(ip,n,m-1))/(yy(m)-yy(m-1)) + else if (m.eq.1.or.m.eq.myc0+1.or.m.eq.myb0+1) then + ff2(n,m)=polderiv1(yy(m),yy(m+1),yy(m+2), & + & ff(ip,n,m),ff(ip,n,m+1),ff(ip,n,m+2)) + else if (m.eq.my.or.m.eq.myc0.or.m.eq.myb0) then + ff2(n,m)=polderiv3(yy(m-2),yy(m-1),yy(m), & + & ff(ip,n,m-2),ff(ip,n,m-1),ff(ip,n,m)) + else + ff2(n,m)=polderiv2(yy(m-1),yy(m),yy(m+1), & + & ff(ip,n,m-1),ff(ip,n,m),ff(ip,n,m+1)) + end if + end do + end do + +!-- Calculate the cross derivatives (d/dx)(d/dy). + do m=1,my + ff12(1,m)=polderiv1(xx(1),xx(2),xx(3), & + & ff2(1,m),ff2(2,m),ff2(3,m)) + ff12(nx,m)=polderiv3(xx(nx-2),xx(nx-1),xx(nx), & + & ff2(nx-2,m),ff2(nx-1,m),ff2(nx,m)) + do n=2,nx-1 + ff12(n,m)=polderiv2(xx(n-1),xx(n),xx(n+1), & + & ff2(n-1,m),ff2(n,m),ff2(n+1,m)) + enddo + enddo + +!-- Calculate the cross derivatives (d/dy)(d/dx). + do n=1,nx + do m = 1, my + if (myc0.eq.2.and.m.eq.1) then + ff21(n,m)=(ff1(n,m+1)-ff1(n,m))/(yy(m+1)-yy(m)) + else if (myc0.eq.2.and.m.eq.2) then + ff21(n,m)=(ff1(n,m)-ff1(n,m-1))/(yy(m)-yy(m-1)) + else if (m.eq.1.or.m.eq.myc0+1.or.m.eq.myb0+1) then + ff21(n,m)=polderiv1(yy(m),yy(m+1),yy(m+2), & + & ff1(n,m),ff1(n,m+1),ff1(n,m+2)) + else if (m.eq.my.or.m.eq.myc0.or.m.eq.myb0) then + ff21(n,m)=polderiv3(yy(m-2),yy(m-1),yy(m), & + & ff1(n,m-2),ff1(n,m-1),ff1(n,m)) + else + ff21(n,m)=polderiv2(yy(m-1),yy(m),yy(m+1), & + & ff1(n,m-1),ff1(n,m),ff1(n,m+1)) + end if + end do + end do + +!-- Take the average of (d/dx)(d/dy) and (d/dy)(d/dx). + do n=1,nx + do m = 1, my + ff12(n,m)=0.5*(ff12(n,m)+ff21(n,m)) + end do + end do + + do n=1,nx-1 + do m=1,my-1 + d1=xx(n+1)-xx(n) + d2=yy(m+1)-yy(m) + d1d2=d1*d2 + + yy0(1)=ff(ip,n,m) + yy0(2)=ff(ip,n+1,m) + yy0(3)=ff(ip,n+1,m+1) + yy0(4)=ff(ip,n,m+1) + + yy1(1)=ff1(n,m) + yy1(2)=ff1(n+1,m) + yy1(3)=ff1(n+1,m+1) + yy1(4)=ff1(n,m+1) + + yy2(1)=ff2(n,m) + yy2(2)=ff2(n+1,m) + yy2(3)=ff2(n+1,m+1) + yy2(4)=ff2(n,m+1) + + yy12(1)=ff12(n,m) + yy12(2)=ff12(n+1,m) + yy12(3)=ff12(n+1,m+1) + yy12(4)=ff12(n,m+1) + + do k=1,4 + z(k)=yy0(k) + z(k+4)=yy1(k)*d1 + z(k+8)=yy2(k)*d2 + z(k+12)=yy12(k)*d1d2 + enddo + + do l=1,16 + xxd=0.d0 + do k=1,16 + xxd=xxd+iwt(k,l)*z(k) + enddo + cl(l)=xxd + enddo + l=0 + do k=1,4 + do j=1,4 + l=l+1 + cc(ip,ih,n,m,k,j)=cl(l) + enddo + enddo + enddo + enddo + return + end + +!---------------------------------------------------------------------- + + double precision function InterpolateMSTWPDF(ip,np,ih,nhess,x,y, & + & nx,my,xx,yy,cc) + implicit none + integer ih,nx,my,nhess,MSTWlocx,l,m,n,ip,np + double precision xx(nx),yy(my),cc(np,0:nhess,nx,my,4,4), & + & x,y,z,t,u + + n=MSTWlocx(xx,nx,x) + m=MSTWlocx(yy,my,y) + + t=(x-xx(n))/(xx(n+1)-xx(n)) + u=(y-yy(m))/(yy(m+1)-yy(m)) + + z=0.d0 + do l=4,1,-1 + z=t*z+((cc(ip,ih,n,m,l,4)*u+cc(ip,ih,n,m,l,3))*u & + & +cc(ip,ih,n,m,l,2))*u+cc(ip,ih,n,m,l,1) + enddo + + InterpolateMSTWPDF = z + + return + end + +!---------------------------------------------------------------------- + + double precision function ExtrapolateMSTWPDF(ip,np,ih,nhess,x,y, & + & nx,my,xx,yy,cc) + implicit none + integer ih,nx,my,nhess,MSTWlocx,n,m,ip,np + double precision xx(nx),yy(my),cc(np,0:nhess,nx,my,4,4), & + & x,y,z,f0,f1,z0,z1,InterpolateMSTWPDF + + n=MSTWlocx(xx,nx,x) ! 0: below xmin, nx: above xmax + m=MSTWlocx(yy,my,y) ! 0: below qsqmin, my: above qsqmax + +! If extrapolation in small x only: + if (n.eq.0.and.m.gt.0.and.m.lt.my) then + f0 = InterpolateMSTWPDF(ip,np,ih,nhess,xx(1),y,nx,my,xx,yy,cc) + f1 = InterpolateMSTWPDF(ip,np,ih,nhess,xx(2),y,nx,my,xx,yy,cc) + if (f0.gt.1.d-3.and.f1.gt.1.d-3) then + z = exp(log(f0)+(log(f1)-log(f0))/(xx(2)-xx(1))*(x-xx(1))) + else + z = f0+(f1-f0)/(xx(2)-xx(1))*(x-xx(1)) + end if +! If extrapolation into large q only: + else if (n.gt.0.and.m.eq.my) then + f0 = InterpolateMSTWPDF(ip,np,ih,nhess,x,yy(my),nx,my,xx,yy,cc) + f1 = InterpolateMSTWPDF(ip,np,ih,nhess,x,yy(my-1),nx,my,xx,yy,cc) + if (f0.gt.1.d-3.and.f1.gt.1.d-3) then + z = exp(log(f0)+(log(f0)-log(f1))/(yy(my)-yy(my-1))* & + & (y-yy(my))) + else + z = f0+(f0-f1)/(yy(my)-yy(my-1))*(y-yy(my)) + end if +! If extrapolation into large q AND small x: + else if (n.eq.0.and.m.eq.my) then + f0 = InterpolateMSTWPDF(ip,np,ih,nhess,xx(1),yy(my),nx,my,xx,yy,cc) + f1 = InterpolateMSTWPDF(ip,np,ih,nhess,xx(1),yy(my-1),nx,my,xx,yy, & + & cc) + if (f0.gt.1.d-3.and.f1.gt.1.d-3) then + z0 = exp(log(f0)+(log(f0)-log(f1))/(yy(my)-yy(my-1))* & + & (y-yy(my))) + else + z0 = f0+(f0-f1)/(yy(my)-yy(my-1))*(y-yy(my)) + end if + f0 = InterpolateMSTWPDF(ip,np,ih,nhess,xx(2),yy(my),nx,my,xx,yy,cc) + f1 = InterpolateMSTWPDF(ip,np,ih,nhess,xx(2),yy(my-1),nx,my,xx,yy, & + & cc) + if (f0.gt.1.d-3.and.f1.gt.1.d-3) then + z1 = exp(log(f0)+(log(f0)-log(f1))/(yy(my)-yy(my-1))* & + & (y-yy(my))) + else + z1 = f0+(f0-f1)/(yy(my)-yy(my-1))*(y-yy(my)) + end if + if (z0.gt.1.d-3.and.z1.gt.1.d-3) then + z = exp(log(z0)+(log(z1)-log(z0))/(xx(2)-xx(1))*(x-xx(1))) + else + z = z0+(z1-z0)/(xx(2)-xx(1))*(x-xx(1)) + end if + else + print *,"Error in ExtrapolateMSTWPDF" + stop + end if + + ExtrapolateMSTWPDF = z + + return + end + +!---------------------------------------------------------------------- + + integer function MSTWlocx(xx,nx,x) +! returns an integer j such that x lies inbetween xx(j) and xx(j+1). +! nx is the length of the array with xx(nx) the highest element. + implicit none + integer nx,jl,ju,jm + double precision x,xx(nx) + if(x.eq.xx(1)) then + MSTWlocx=1 + return + endif + if(x.eq.xx(nx)) then + MSTWlocx=nx-1 + return + endif + ju=nx+1 + jl=0 + 1 if((ju-jl).le.1) goto 2 + jm=(ju+jl)/2 + if(x.ge.xx(jm)) then + jl=jm + else + ju=jm + endif + goto 1 + 2 MSTWlocx=jl + return + end + +!---------------------------------------------------------------------- + + double precision function polderiv1(x1,x2,x3,y1,y2,y3) +!-- returns the estimate of the derivative at x1 obtained by a +!-- polynomial interpolation using the three points (x_i,y_i). + implicit none + double precision x1,x2,x3,y1,y2,y3 + polderiv1=(x3*x3*(y1-y2)+2.d0*x1*(x3*(-y1+y2)+x2*(y1-y3)) & + & +x2*x2*(-y1+y3)+x1*x1*(-y2+y3))/((x1-x2)*(x1-x3)*(x2-x3)) + return + end + + double precision function polderiv2(x1,x2,x3,y1,y2,y3) +!-- returns the estimate of the derivative at x2 obtained by a +!-- polynomial interpolation using the three points (x_i,y_i). + implicit none + double precision x1,x2,x3,y1,y2,y3 + polderiv2=(x3*x3*(y1-y2)-2.d0*x2*(x3*(y1-y2)+x1*(y2-y3)) & + & +x2*x2*(y1-y3)+x1*x1*(y2-y3))/((x1-x2)*(x1-x3)*(x2-x3)) + return + end + + double precision function polderiv3(x1,x2,x3,y1,y2,y3) +!-- returns the estimate of the derivative at x3 obtained by a +!-- polynomial interpolation using the three points (x_i,y_i). + implicit none + double precision x1,x2,x3,y1,y2,y3 + polderiv3=(x3*x3*(-y1+y2)+2.d0*x2*x3*(y1-y3)+x1*x1*(y2-y3) & + & +x2*x2*(-y1+y3)+2.d0*x1*x3*(-y2+y3))/ & + & ((x1-x2)*(x1-x3)*(x2-x3)) + return + end + +!---------------------------------------------------------------------- + +!---------------------------------------------------------------------- +!-- Stand-alone code for alpha_s cannibalised (with permission) +!-- from Andreas Vogt's QCD-PEGASUS package (hep-ph/0408244). +!-- The running coupling alpha_s is obtained at N^mLO (m = 0,1,2,3) +!-- by solving the renormalisation group equation in the MSbar scheme +!-- by a fourth-order Runge-Kutta integration. Transitions from +!-- n_f to n_f+1 flavours are made when the factorisation scale +!-- mu_f equals the pole masses m_h (h = c,b,t). At exactly +!-- the thresholds m_{c,b,t}, the number of flavours n_f = {3,4,5}. +!-- The top quark mass should be set to be very large to evolve with +!-- a maximum of five flavours. The factorisation scale mu_f may be +!-- a constant multiple of the renormalisation scale mu_r. The input +!-- factorisation scale mu_(f,0) should be less than or equal to +!-- the charm quark mass. However, if it is greater than the +!-- charm quark mass, the value of alpha_s at mu_(f,0) = 1 GeV will +!-- be found using a root-finding algorithm. +!-- +!-- Example of usage. +!-- First call the initialisation routine (only needed once): +!-- +!-- IORD = 2 ! perturbative order (N^mLO,m=0,1,2,3) +!-- FR2 = 1.D0 ! ratio of mu_f^2 to mu_r^2 +!-- MUR = 1.D0 ! input mu_r in GeV +!-- ASMUR = 0.5D0 ! input value of alpha_s at mu_r +!-- MC = 1.4D0 ! charm quark mass +!-- MB = 4.75D0 ! bottom quark mass +!-- MT = 1.D10 ! top quark mass +!-- CALL MSTWINITALPHAS(IORD, FR2, MUR, ASMUR, MC, MB, MT) +!-- +!-- Then get alpha_s at a renormalisation scale mu_r with: +!-- +!-- MUR = 100.D0 ! renormalisation scale in GeV +!-- ALFAS = MSTWALPHAS(MUR) +!-- +!---------------------------------------------------------------------- +!-- Comments to Graeme Watt +!---------------------------------------------------------------------- + + SUBROUTINE MSTWINITALPHAS(IORD, FR2, MUR, ASMUR, MC, MB, MT) +!-- IORD = 0 (LO), 1 (NLO), 2 (NNLO), 3 (NNNLO). +!-- FR2 = ratio of mu_f^2 to mu_r^2 (must be a fixed value). +!-- MUR = input renormalisation scale (in GeV) for alpha_s. +!-- ASMUR = input value of alpha_s at the renormalisation scale MUR. +!-- MC,MB,MT = heavy-quark masses in GeV. + IMPLICIT NONE + INTEGER IORD,IORDc,MAXF,MODE + DOUBLE PRECISION FR2,MUR,ASMUR,MC,MB,MT,EPS,A,B,MSTWDZEROX, & + & R0c,FR2c,MURc,ASMURc,MCc,MBc,MTc,FINDALPHASR0,R0,ASI + COMMON / MSTWDZEROXcommon / FR2c,MURc,ASMURc,MCc,MBc,MTc,R0c,IORDc + PARAMETER(EPS=1.D-10,MAXF=10000,MODE=1) + EXTERNAL FINDALPHASR0 + + IF (MUR*sqrt(FR2).LE.MC) THEN ! Check that MUF <= MC. + R0 = MUR + ASI = ASMUR + ELSE ! Solve for alpha_s at R0 = 1 GeV. +!-- Copy variables to common block. + R0c = 1.D0/sqrt(FR2) + IORDc = IORD + FR2c = FR2 + MURc = MUR + ASMURc = ASMUR + MCc = MC + MBc = MB + MTc = MT +!-- Now get alpha_s(R0) corresponding to alpha_s(MUR). + A = 0.02D0 ! lower bound for alpha_s(R0) + B = 2.00D0 ! upper bound for alpha_s(R0) + R0 = R0c + ASI = MSTWDZEROX(A,B,EPS,MAXF,FINDALPHASR0,MODE) + END IF + + CALL MSTWINITALPHASR0(IORD, FR2, R0, ASI, MC, MB, MT) + + RETURN + END + +!---------------------------------------------------------------------- + +!-- Find the zero of this function using MSTWDZEROX. + DOUBLE PRECISION FUNCTION FINDALPHASR0(ASI) + IMPLICIT NONE + INTEGER IORD + DOUBLE PRECISION FR2, R0, ASI, MC, MB, MT, MUR, ASMUR, MSTWALPHAS + COMMON / MSTWDZEROXcommon / FR2, MUR, ASMUR, MC, MB, MT, R0, IORD + + CALL MSTWINITALPHASR0(IORD, FR2, R0, ASI, MC, MB, MT) + FINDALPHASR0 = MSTWALPHAS(MUR) - ASMUR ! solve equal to zero + + RETURN + END + +!---------------------------------------------------------------------- + + SUBROUTINE MSTWINITALPHASR0(IORD, FR2, R0, ASI, MC, MB, MT) +!-- IORD = 0 (LO), 1 (NLO), 2 (NNLO), 3 (NNNLO). +!-- FR2 = ratio of mu_f^2 to mu_r^2 (must be a fixed value). +!-- R0 = input renormalisation scale (in GeV) for alphas_s. +!-- ASI = input value of alpha_s at the renormalisation scale R0. +!-- MC,MB,MT = heavy-quark masses in GeV. +!-- Must have R0*sqrt(FR2) <= MC to call this subroutine. + IMPLICIT NONE + INTEGER IORD,NAORD,NASTPS,IVFNS,NFF + DOUBLE PRECISION FR2,R0,ASI,MC,MB,MT,LOGFR,R20, & + & PI,ZETA,CF,CA,TR,AS0,M20,MC2,MB2,MT2 + PARAMETER(PI = 3.14159265358979D0) + + COMMON / RZETA / ZETA(6) + COMMON / COLOUR / CF, CA, TR + COMMON / ASINP / AS0, M20 + COMMON / ASPAR / NAORD, NASTPS + COMMON / VARFLV / IVFNS + COMMON / NFFIX / NFF + COMMON / FRRAT / LOGFR + +! +! ..QCD colour factors +! + CA = 3.D0 + CF = 4./3.D0 + TR = 0.5D0 +! +! ..The lowest integer values of the Zeta function +! + ZETA(1) = 0.57721566490153D0 + ZETA(2) = 1.644934066848226D0 + ZETA(3) = 1.202056903159594D0 + ZETA(4) = 1.082323233711138D0 + ZETA(5) = 1.036927755143370D0 + ZETA(6) = 1.017343061984449D0 + + IVFNS = 1 ! variable flavour-number scheme (VFNS) +! IVFNS = 0 ! fixed flavour-number scheme (FFNS) + NFF = 4 ! number of flavours for FFNS + NAORD = IORD ! perturbative order of alpha_s + NASTPS = 20 ! num. steps in Runge-Kutta integration + R20 = R0**2 ! input renormalisation scale + MC2 = MC**2 ! mu_f^2 for charm threshold + MB2 = MB**2 ! mu_f^2 for bottom threshold + MT2 = MT**2 ! mu_f^2 for top threshold + LOGFR = LOG(FR2) ! log of ratio of mu_f^2 to mu_r^2 + M20 = R20 * FR2 ! input factorisation scale + +! +! ..Stop some nonsense +! + IF ( (IVFNS .EQ. 0) .AND. (NFF .LT. 3) ) THEN + WRITE (6,*) 'Wrong flavour number for FFNS evolution. STOP' + STOP + END IF + IF ( (IVFNS .EQ. 0) .AND. (NFF .GT. 5) ) THEN + WRITE (6,*) 'Wrong flavour number for FFNS evolution. STOP' + STOP + END IF +! + IF ( NAORD .GT. 3 ) THEN + WRITE (6,*) 'Specified order in a_s too high. STOP' + STOP + END IF +! + IF ( (IVFNS .NE. 0) .AND. (FR2 .GT. 4.001D0) ) THEN + WRITE (6,*) 'Too low mu_r for VFNS evolution. STOP' + STOP + END IF +! + IF ( (IVFNS .EQ. 1) .AND. (M20 .GT. MC2) ) THEN + WRITE (6,*) 'Too high mu_0 for VFNS evolution. STOP' + STOP + END IF +! + IF ( (ASI .GT. 2.D0) .OR. (ASI .LT. 2.D-2) ) THEN + WRITE (6,*) 'alpha_s out of range. STOP' + STOP + END IF +! + IF ( (IVFNS .EQ. 1) .AND. (MC2 .GT. MB2) ) THEN + WRITE (6,*) 'Wrong charm-bottom mass hierarchy. STOP' + STOP + END IF + IF ( (IVFNS .EQ. 1) .AND. (MB2 .GT. MT2) ) THEN + WRITE (6,*) 'Wrong bottom-top mass hierarchy. STOP' + STOP + END IF +! + +!-- Store the beta function coefficients in a COMMON block. + CALL BETAFCT + +!-- Store a_s = alpha_s(mu_r^2)/(4 pi) at the input scale R0. + AS0 = ASI / (4.D0* PI) + +!-- Store alpha_s at the heavy flavour thresholds in a COMMON block. + IF (IVFNS .NE. 0) THEN + CALL EVNFTHR (MC2, MB2, MT2) + END IF + + RETURN + END + +!---------------------------------------------------------------------- + + DOUBLE PRECISION FUNCTION MSTWALPHAS(MUR) + IMPLICIT NONE + INTEGER NFF,IVFNS,NF + DOUBLE PRECISION PI,LOGFR,AS0,M20,ASC,M2C,ASB,M2B,AST,M2T,M2,MUR, & + & R2,ASI,ASF,R20,R2T,R2B,R2C,AS + PARAMETER ( PI = 3.14159265358979D0 ) +! +! ..Input common blocks +! + COMMON / NFFIX / NFF + COMMON / VARFLV / IVFNS + COMMON / FRRAT / LOGFR + COMMON / ASINP / AS0, M20 + COMMON / ASFTHR / ASC, M2C, ASB, M2B, AST, M2T + + R2 = MUR**2 + M2 = R2 * EXP(+LOGFR) + IF (IVFNS .EQ. 0) THEN +! +! Fixed number of flavours +! + NF = NFF + R20 = M20 * R2/M2 + ASI = AS0 + ASF = AS (R2, R20, AS0, NF) +! + ELSE +! +! ..Variable number of flavours +! + IF (M2 .GT. M2T) THEN + NF = 6 + R2T = M2T * R2/M2 + ASI = AST + ASF = AS (R2, R2T, AST, NF) +! + ELSE IF (M2 .GT. M2B) THEN + NF = 5 + R2B = M2B * R2/M2 + ASI = ASB + ASF = AS (R2, R2B, ASB, NF) +! + ELSE IF (M2 .GT. M2C) THEN + NF = 4 + R2C = M2C * R2/M2 + ASI = ASC + ASF = AS (R2, R2C, ASC, NF) +! + ELSE + NF = 3 + R20 = M20 * R2/M2 + ASI = AS0 + ASF = AS (R2, R20, AS0, NF) +! + END IF +! + END IF +! +! ..Final value of alpha_s +! + MSTWALPHAS = 4.D0*PI*ASF + + RETURN + END +! +! =================================================================av== + + +! ===================================================================== +! +! ..The threshold matching of the QCD coupling in the MS(bar) scheme, +! a_s = alpha_s(mu_r^2)/(4 pi), for NF -> NF + 1 active flavours +! up to order a_s^4 (NNNLO). +! +! ..The value ASNF of a_s for NF flavours at the matching scale, the +! logarithm LOGRH = ln (mu_r^2/m_H^2) -- where m_H is the pole mass +! of the heavy quark -- and NF are passed as arguments to the +! function ASNF1. The order of the expansion NAORD (defined as +! the 'n' in N^nLO) is provided by the common-block ASPAR. +! +! ..The matching coefficients are inverted from Chetyrkin, Kniehl and +! Steinhauser, Phys. Rev. Lett. 79 (1997) 2184. The QCD colour +! factors have been hard-wired in these results. The lowest integer +! values of the Zeta function are given by the common-block RZETA. +! +! ===================================================================== +! +! + DOUBLE PRECISION FUNCTION ASNF1 (ASNF, LOGRH, NF) +! + IMPLICIT NONE + INTEGER NF, NAORD, NASTPS, PRVCLL, K1, K2 + DOUBLE PRECISION ASNF,LOGRH,ZETA,CMC,CMCI30,CMCF30,CMCF31, & + & CMCI31,ASP,LRHP + + DIMENSION CMC(3,0:3) +! +! --------------------------------------------------------------------- +! +! ..Input common-blocks +! + COMMON / ASPAR / NAORD, NASTPS + COMMON / RZETA / ZETA(6) +! +! ..Variables to be saved for the next call +! + SAVE CMC, CMCI30, CMCF30, CMCF31, CMCI31, PRVCLL +! +! --------------------------------------------------------------------- +! +! ..The coupling-constant matching coefficients (CMC's) up to NNNLO +! (calculated and saved in the first call of this routine) +! + IF (PRVCLL .NE. 1) THEN +! + CMC(1,0) = 0.D0 + CMC(1,1) = 2./3.D0 +! + CMC(2,0) = 14./3.D0 + CMC(2,1) = 38./3.D0 + CMC(2,2) = 4./9.D0 +! + CMCI30 = + 80507./432.D0 * ZETA(3) + 58933./1944.D0 & + & + 128./3.D0 * ZETA(2) * (1.+ DLOG(2.D0)/3.D0) + CMCF30 = - 64./9.D0 * (ZETA(2) + 2479./3456.D0) + CMCI31 = 8941./27.D0 + CMCF31 = - 409./27.D0 + CMC(3,2) = 511./9.D0 + CMC(3,3) = 8./27.D0 +! + PRVCLL = 1 +! + END IF +! +! --------------------------------------------------------------------- +! +! ..The N_f dependent CMC's, and the alpha_s matching at order NAORD +! + CMC(3,0) = CMCI30 + NF * CMCF30 + CMC(3,1) = CMCI31 + NF * CMCF31 +! + ASNF1 = ASNF + IF (NAORD .EQ. 0) GOTO 1 + ASP = ASNF +! + DO 11 K1 = 1, NAORD + ASP = ASP * ASNF + LRHP = 1.D0 +! + DO 12 K2 = 0, K1 + ASNF1 = ASNF1 + ASP * CMC(K1,K2) * LRHP + LRHP = LRHP * LOGRH +! + 12 CONTINUE + 11 CONTINUE +! +! --------------------------------------------------------------------- +! + 1 RETURN + END + +! +! =================================================================av== +! +! ..The subroutine EVNFTHR for the evolution of a_s = alpha_s/(4 pi) +! from a three-flavour initial scale to the four- to six-flavour +! thresholds (identified with the squares of the corresponding quark +! masses). The results are written to the common-block ASFTHR. +! +! ..The input scale M20 = mu_(f,0)^2 and the corresponding value +! AS0 of a_s are provided by ASINP. The fixed scale logarithm +! LOGFR = ln (mu_f^2/mu_r^2) is specified in FRRAT. The alpha_s +! matching is done by the function ASNF1. +! +! ===================================================================== +! +! + SUBROUTINE EVNFTHR (MC2, MB2, MT2) +! + IMPLICIT NONE + DOUBLE PRECISION MC2, MB2, MT2, M20, M2C, M2B, M2T, R20, R2C, & + & R2B, R2T, AS, ASNF1, AS0, ASC, ASB, AST, & + & ASC3, ASB4, AST5, LOGFR, SC, SB, ST +! +! --------------------------------------------------------------------- +! +! ..Input common blocks +! + COMMON / ASINP / AS0, M20 + COMMON / FRRAT / LOGFR +! +! ..Output common blocks +! + COMMON / ASFTHR / ASC, M2C, ASB, M2B, AST, M2T + +! --------------------------------------------------------------------- +! +! ..Coupling constants at and evolution distances to/between thresholds +! + R20 = M20 * EXP(-LOGFR) +! +! ..Charm +! + M2C = MC2 + R2C = M2C * R20/M20 + ASC3 = AS (R2C, R20, AS0, 3) + SC = LOG (AS0 / ASC3) + ASC = ASNF1 (ASC3, -LOGFR, 3) +! +! ..Bottom +! + M2B = MB2 + R2B = M2B * R20/M20 + ASB4 = AS (R2B, R2C, ASC, 4) + SB = LOG (ASC / ASB4) + ASB = ASNF1 (ASB4, -LOGFR, 4) +! +! ..Top +! + M2T = MT2 + R2T = M2T * R20/M20 + AST5 = AS (R2T, R2B, ASB, 5) + ST = LOG (ASB / AST5) + AST = ASNF1 (AST5, -LOGFR, 5) + + RETURN + END + +! +! =================================================================av== +! +! ..The running coupling of QCD, +! +! AS = a_s = alpha_s(mu_r^2)/(4 pi), +! +! obtained by integrating the evolution equation for a fixed number +! of massless flavours NF. Except at leading order (LO), AS is +! obtained using a fourth-order Runge-Kutta integration. +! +! ..The initial and final scales R20 and R2, the value AS0 at +! R20, and NF are passed as function arguments. The coefficients +! of the beta function up to a_s^5 (N^3LO) are provided by the +! common-block BETACOM. The order of the expansion NAORD (defined +! as the 'n' in N^nLO) and the number of steps NASTPS for the +! integration beyond LO are given by the common-block ASPAR. +! +! ===================================================================== +! +! + DOUBLE PRECISION FUNCTION AS (R2, R20, AS0, NF) +! + IMPLICIT NONE + INTEGER NFMIN, NFMAX, NF, NAORD, NASTPS, K1 + DOUBLE PRECISION R2, R20, AS0, SXTH, BETA0, BETA1, BETA2, BETA3, & + & FBETA1,FBETA2,FBETA3,A,LRRAT,DLR,XK0,XK1,XK2,XK3 + PARAMETER (NFMIN = 3, NFMAX = 6) + PARAMETER ( SXTH = 0.166666666666666D0 ) +! +! --------------------------------------------------------------------- +! +! ..Input common-blocks +! + COMMON / ASPAR / NAORD, NASTPS + COMMON / BETACOM / BETA0 (NFMIN:NFMAX), BETA1 (NFMIN:NFMAX), & + & BETA2 (NFMIN:NFMAX), BETA3 (NFMIN:NFMAX) +! +! ..The beta functions FBETAn at N^nLO for n = 1, 2, and 3 +! + FBETA1(A) = - A**2 * ( BETA0(NF) + A * BETA1(NF) ) + FBETA2(A) = - A**2 * ( BETA0(NF) + A * ( BETA1(NF) & + & + A * BETA2(NF) ) ) + FBETA3(A) = - A**2 * ( BETA0(NF) + A * ( BETA1(NF) & + & + A * (BETA2(NF) + A * BETA3(NF)) ) ) +! +! --------------------------------------------------------------------- +! +! ..Initial value, evolution distance and step size +! + AS = AS0 + LRRAT = LOG (R2/R20) + DLR = LRRAT / NASTPS +! +! ..Solution of the evolution equation depending on NAORD +! (fourth-order Runge-Kutta beyond the leading order) +! + IF (NAORD .EQ. 0) THEN +! + AS = AS0 / (1.+ BETA0(NF) * AS0 * LRRAT) +! + ELSE IF (NAORD .EQ. 1) THEN +! + DO 2 K1 = 1, NASTPS + XK0 = DLR * FBETA1 (AS) + XK1 = DLR * FBETA1 (AS + 0.5 * XK0) + XK2 = DLR * FBETA1 (AS + 0.5 * XK1) + XK3 = DLR * FBETA1 (AS + XK2) + AS = AS + SXTH * (XK0 + 2.* XK1 + 2.* XK2 + XK3) + 2 CONTINUE +! + ELSE IF (NAORD .EQ. 2) THEN +! + DO 3 K1 = 1, NASTPS + XK0 = DLR * FBETA2 (AS) + XK1 = DLR * FBETA2 (AS + 0.5 * XK0) + XK2 = DLR * FBETA2 (AS + 0.5 * XK1) + XK3 = DLR * FBETA2 (AS + XK2) + AS = AS + SXTH * (XK0 + 2.* XK1 + 2.* XK2 + XK3) + 3 CONTINUE +! + ELSE IF (NAORD .EQ. 3) THEN +! + DO 4 K1 = 1, NASTPS + XK0 = DLR * FBETA3 (AS) + XK1 = DLR * FBETA3 (AS + 0.5 * XK0) + XK2 = DLR * FBETA3 (AS + 0.5 * XK1) + XK3 = DLR * FBETA3 (AS + XK2) + AS = AS + SXTH * (XK0 + 2.* XK1 + 2.* XK2 + XK3) + 4 CONTINUE + END IF +! +! --------------------------------------------------------------------- +! + RETURN + END + +! +! =================================================================av== +! +! ..The subroutine BETAFCT for the coefficients BETA0...BETA3 of the +! beta function of QCD up to order alpha_s^5 (N^3LO), normalized by +! +! d a_s / d ln mu_r^2 = - BETA0 a_s^2 - BETA1 a_s^3 - ... +! +! with a_s = alpha_s/(4*pi). +! +! ..The MSbar coefficients are written to the common-block BETACOM for +! NF = 3...6 (parameters NFMIN, NFMAX) quark flavours. +! +! ..The factors CF, CA and TF are taken from the common-block COLOUR. +! Beyond NLO the QCD colour factors are hard-wired in this routine, +! and the numerical coefficients are truncated to six digits. +! +! ===================================================================== +! +! + SUBROUTINE BETAFCT +! + IMPLICIT DOUBLE PRECISION (A - Z) + INTEGER NFMIN, NFMAX, NF + PARAMETER (NFMIN = 3, NFMAX = 6) +! +! --------------------------------------------------------------------- +! +! ..Input common-block +! + COMMON / COLOUR / CF, CA, TR +! +! ..Output common-block +! + COMMON / BETACOM / BETA0 (NFMIN:NFMAX), BETA1 (NFMIN:NFMAX), & + & BETA2 (NFMIN:NFMAX), BETA3 (NFMIN:NFMAX) + +! +! --------------------------------------------------------------------- +! +! ..The full LO and NLO coefficients +! + B00 = 11./3.D0 * CA + B01 = -4./3.D0 * TR + B10 = 34./3.D0 * CA**2 + B11 = -20./3.D0 * CA*TR - 4.* CF*TR +! +! ..Flavour-number loop and output to the array +! + DO 1 NF = NFMIN, NFMAX +! + BETA0(NF) = B00 + B01 * NF + BETA1(NF) = B10 + B11 * NF +! + BETA2(NF) = 1428.50 - 279.611 * NF + 6.01852 * NF**2 + BETA3(NF) = 29243.0 - 6946.30 * NF + 405.089 * NF**2 & + & + 1.49931 * NF**3 +! +! --------------------------------------------------------------------- +! + 1 CONTINUE +! + RETURN + END +! +! =================================================================av== + + +!-- G.W. MSTWDZEROX taken from CERNLIB to find the zero of a function. + DOUBLE PRECISION FUNCTION MSTWDZEROX(A0,B0,EPS,MAXF,F,MODE) + IMPLICIT DOUBLE PRECISION (A-H,O-Z) +! Based on +! +! J.C.P. Bus and T.J. Dekker, Two Efficient Algorithms with +! Guaranteed Convergence for Finding a Zero of a Function, +! ACM Trans. Math. Software 1 (1975) 330-345. +! +! (MODE = 1: Algorithm M; MODE = 2: Algorithm R) + CHARACTER*80 ERRTXT + LOGICAL LMT + DIMENSION IM1(2),IM2(2),LMT(2) + PARAMETER (Z1 = 1, HALF = Z1/2) + DATA IM1 /2,3/, IM2 /-1,3/ + MSTWDZEROX = 0.D0 ! G.W. to prevent compiler warning + IF(MODE .NE. 1 .AND. MODE .NE. 2) THEN + C=0 + WRITE(ERRTXT,101) MODE + WRITE(6,*) ERRTXT + GOTO 99 + ENDIF + FA=F(B0) + FB=F(A0) + IF(FA*FB .GT. 0) THEN + C=0 + WRITE(ERRTXT,102) A0,B0 + WRITE(6,*) ERRTXT + GOTO 99 + ENDIF + ATL=ABS(EPS) + B=A0 + A=B0 + LMT(2)=.TRUE. + MF=2 + 1 C=A + FC=FA + 2 IE=0 + 3 IF(ABS(FC) .LT. ABS(FB)) THEN + IF(C .NE. A) THEN + D=A + FD=FA + END IF + A=B + B=C + C=A + FA=FB + FB=FC + FC=FA + END IF + TOL=ATL*(1+ABS(C)) + H=HALF*(C+B) + HB=H-B + IF(ABS(HB) .GT. TOL) THEN + IF(IE .GT. IM1(MODE)) THEN + W=HB + ELSE + TOL=TOL*SIGN(Z1,HB) + P=(B-A)*FB + LMT(1)=IE .LE. 1 + IF(LMT(MODE)) THEN + Q=FA-FB + LMT(2)=.FALSE. + ELSE + FDB=(FD-FB)/(D-B) + FDA=(FD-FA)/(D-A) + P=FDA*P + Q=FDB*FA-FDA*FB + END IF + IF(P .LT. 0) THEN + P=-P + Q=-Q + END IF + IF(IE .EQ. IM2(MODE)) P=P+P + IF(P .EQ. 0 .OR. P .LE. Q*TOL) THEN + W=TOL + ELSEIF(P .LT. HB*Q) THEN + W=P/Q + ELSE + W=HB + END IF + END IF + D=A + A=B + FD=FA + FA=FB + B=B+W + MF=MF+1 + IF(MF .GT. MAXF) THEN + WRITE(6,*) "Error in MSTWDZEROX: TOO MANY FUNCTION CALLS" + GOTO 99 + ENDIF + FB=F(B) + IF(FB .EQ. 0 .OR. SIGN(Z1,FC) .EQ. SIGN(Z1,FB)) GOTO 1 + IF(W .EQ. HB) GOTO 2 + IE=IE+1 + GOTO 3 + END IF + MSTWDZEROX=C + 99 CONTINUE + RETURN + 101 FORMAT('Error in MSTWDZEROX: MODE = ',I3,' ILLEGAL') + 102 FORMAT('Error in MSTWDZEROX: F(A) AND F(B) HAVE THE SAME SIGN, A = ', & + & 1P,D15.8,', B = ',D15.8) + END + +! --------------------------------------------------------------------- diff --git a/LHAPDF/lhapdf-5.9.1/src/wrapowpi.f b/LHAPDF/lhapdf-5.9.1/src/wrapowpi.f new file mode 100644 index 00000000000..ed22a022707 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/wrapowpi.f @@ -0,0 +1,219 @@ +! -*- F90 -*- + + + subroutine OWPevolve(xin,qin,pdf) + include 'parmsetup.inc' + real*8 xin,qin,pdf(-6:6),xval(45),qcdl4,qcdl5 + real*8 upv,dnv,usea,dsea,str,chm,bot,top,glu + character*16 name(nmxset) + integer nmem(nmxset),ndef(nmxset) + common/NAME/name,nmem,ndef,mmem + integer mem,mmem + integer nset +! integer iset,iimem +! common/SET/iset,iimem + + save + + q2in = qin*qin +! iset = imem + + if(imem.eq.0) then + call strowp1(xin,Qin,upv,dnv,usea,str,chm,glu) + elseif(imem.eq.1) then + call strowp1(xin,Qin,upv,dnv,usea,str,chm,glu) + elseif(imem.eq.2) then + call strowp2(xin,Qin,upv,dnv,usea,str,chm,glu) + else + endif + + pdf(-6)= 0.0d0 + pdf(6)= 0.0d0 + pdf(-5)= 0.0d0 + pdf(5 )= 0.0d0 + pdf(-4)= chm + pdf(4 )= chm + pdf(-3)= str + pdf(3 )= str + pdf(-2)= usea + pdf(2 )= upv+usea + pdf(-1)= usea + pdf(1 )= dnv+usea + pdf(0 )= glu + + return +! +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + entry OWPread(nset) + read(1,*)nmem(nset),ndef(nset) +! iset = nset + return +! +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + entry OWPalfa(alfas,qalfa) + call getnset(iset) + call GetOrderAsM(iset,iord) +! print*,'from getorderasm',iord + call Getlam4M(iset,imem,qcdl4) +! print*,'from getorderasm',iord + call Getlam5M(iset,imem,qcdl5) +! print*,'from getorderasm',iord + call aspdflib(alfas,Qalfa,iord,qcdl5) + return +! +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + entry OWPinit(Eorder,Q2fit) + return +! +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + entry OWPpdf(mem) + imem = mem + return +! + 1000 format(5e13.5) + END +! +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +!********************************************************************* + + SUBROUTINE STROWP1(X,SCALE,UPV,DNV,SEA,STR,CHM,GL) +! :::::::::::::: OWENS SET 1 PION STRUCTURE FUNCTION ::::::::::::::: + implicit real*8 (a-h,o-z) + DOUBLE PRECISION DGAMMA_LHA + double precision & + & COW(3,5,4),TS(6),XQ(9) + +!...Expansion coefficients for up and down valence quark distributions. + DATA ((COW(IP,IS,1),IS=1,5),IP=1,3)/ & + & 4.0000D-01, 7.0000D-01, 0.0000D+00, 0.0000D+00, 0.0000D+00, & + & -6.2120D-02, 6.4780D-01, 0.0000D+00, 0.0000D+00, 0.0000D+00, & + & -7.1090D-03, 1.3350D-02, 0.0000D+00, 0.0000D+00, 0.0000D+00/ +!...Expansion coefficients for gluon distribution. + DATA ((COW(IP,IS,2),IS=1,5),IP=1,3)/ & + & 8.8800D-01, 0.0000D+00, 3.1100D+00, 6.0000D+00, 0.0000D+00, & + & -1.8020D+00, -1.5760D+00, -1.3170D-01, 2.8010D+00, -1.7280D+01, & + & 1.8120D+00, 1.2000D+00, 5.0680D-01, -1.2160D+01, 2.0490D+01/ +!...Expansion coefficients for (up+down+strange) quark sea distribution. + DATA ((COW(IP,IS,3),IS=1,5),IP=1,3)/ & + & 9.0000D-01, 0.0000D+00, 5.0000D+00, 0.0000D+00, 0.0000D+00, & + & -2.4280D-01, -2.1200D-01, 8.6730D-01, 1.2660D+00, 2.3820D+00, & + & 1.3860D-01, 3.6710D-03, 4.7470D-02, -2.2150D+00, 3.4820D-01/ +!...Expansion coefficients for charm quark sea distribution. + DATA ((COW(IP,IS,4),IS=1,5),IP=1,3)/ & + & 0.0000D+00, -2.2120D-02, 2.8940D+00, 0.0000D+00, 0.0000D+00, & + & 7.9280D-02, -3.7850D-01, 9.4330D+00, 5.2480D+00, 8.3880D+00, & + & -6.1340D-02, -1.0880D-01, -1.0852D+01, -7.1870D+00, -1.1610D+01/ + + DATA ZEROD/0.D0/, ONED/1.D0/, SIXD/6.D0/ + DATA ALAM/0.2D0/, Q02/4.D0/, QMAX2/2.D3/ +!...Pion structure functions from Owens. +!...Allowed variable range: 4 GeV^2 < Q^2 < approx 2000 GeV^2. + +!...Determine set, Lambda and s expansion variable. + Q2 = SCALE*SCALE +! Q2IN = MIN( QMAX2,MAX( Q02,Q2)) + Q2IN = Q2 + SD = LOG( LOG( Q2IN/ALAM**2)/ LOG( Q02/ALAM**2)) + +!...Calculate structure functions. + DO 240 KFL=1,4 + DO 230 IS=1,5 + 230 TS(IS)=COW(1,IS,KFL)+COW(2,IS,KFL)*SD+ & + & COW(3,IS,KFL)*SD*SD + IF(KFL.EQ.1) THEN +!if defined(CERNLIB_SINGLE) +! DENOM = GAMMA(TS(1))*GAMMA(TS(2)+ONED)/GAMMA(TS(1)+TS(2)+ONED +!endif +!if defined(CERNLIB_DOUBLE) + DENOM = DGAMMA_LHA(TS(1))*DGAMMA_LHA(TS(2)+ONED)/ & + & DGAMMA_LHA(TS(1)+TS(2)+ONED) +!endif + XQ(KFL)=X**TS(1)*(1.-X)**TS(2)/DENOM + ELSE + XQ(KFL)=TS(1)*X**TS(2)*(1.-X)**TS(3)*(1.+TS(4)*X+TS(5)*X**2) + ENDIF + 240 CONTINUE + +!...Put into output arrays. + UPV = XQ(1) + DNV = XQ(1) + SEA = XQ(3)/SIXD + STR = XQ(3)/SIXD + CHM = XQ(4) + BOT = ZEROD + TOP = ZEROD + GL = XQ(2) +! + RETURN + END + +!********************************************************************* + + SUBROUTINE STROWP2(X,SCALE,UPV,DNV,SEA,STR,CHM,GL) +! :::::::::::::: OWENS SET 2 PION STRUCTURE FUNCTION ::::::::::::::: + implicit real*8 (a-h,o-z) + DOUBLE PRECISION DGAMMA_LHA + double precision & + & COW(3,5,4),TS(6),XQ(9) + +!...Expansion coefficients for up and down valence quark distributions. + DATA ((COW(IP,IS,1),IS=1,5),IP=1,3)/ & + & 4.0000D-01, 6.2800D-01, 0.0000D+00, 0.0000D+00, 0.0000D+00, & + & -5.9090D-02, 6.4360D-01, 0.0000D+00, 0.0000D+00, 0.0000D+00, & + & -6.5240D-03, 1.4510D-02, 0.0000D+00, 0.0000D+00, 0.0000D+00/ +!...Expansion coefficients for gluon distribution. + DATA ((COW(IP,IS,2),IS=1,5),IP=1,3)/ & + & 7.9400D-01, 0.0000D+00, 2.8900D+00, 6.0000D+00, 0.0000D+00, & + & -9.1440D-01, -1.2370D+00, 5.9660D-01, -3.6710D+00, -8.1910D+00, & + & 5.9660D-01, 6.5820D-01, -2.5500D-01, -2.3040D+00, 7.7580D+00/ +!...Expansion coefficients for (up+down+strange) quark sea distribution. + DATA ((COW(IP,IS,3),IS=1,5),IP=1,3)/ & + & 9.0000D-01, 0.0000D+00, 5.0000D+00, 0.0000D+00, 0.0000D+00, & + & -1.4170D-01, -1.6970D-01, -2.4740D+00, -2.5340D+00, 5.6210D-01, & + & -1.7400D-01, -9.6230D-02, 1.5750D+00, 1.3780D+00, -2.7010D-01/ +!...Expansion coefficients for charm quark sea distribution. + DATA ((COW(IP,IS,4),IS=1,5),IP=1,3)/ & + & 0.0000D+00, -8.8200D-02, 1.9240D+00, 0.0000D+00, 0.0000D+00, & + & 6.2290D-02, -2.8920D-01, 2.4240D-01, -4.4630D+00, -8.3670D-01, & + & -4.0990D-02, -1.0820D-01, 2.0360D+00, 5.2090D+00, -4.8400D-02/ + + DATA ZEROD/0.D0/, ONED/1.D0/, SIXD/6.D0/ + DATA ALAM/0.4D0/, Q02/4.D0/, QMAX2/2.D3/ +!...Pion structure functions from Owens. +!...Allowed variable range: 4 GeV^2 < Q^2 < approx 2000 GeV^2. + +!...Determine set, Lambda and s expansion variable. + Q2 = SCALE*SCALE +! Q2IN = MIN( QMAX2,MAX( Q02,Q2)) + Q2IN = Q2 + SD = LOG( LOG( Q2IN/ALAM**2)/ LOG( Q02/ALAM**2)) + +!...Calculate structure functions. + DO 10 KFL=1,4 + DO 20 IS=1,5 + 20 TS(IS)=COW(1,IS,KFL)+COW(2,IS,KFL)*SD+ & + & COW(3,IS,KFL)*SD*SD + IF(KFL.EQ.1) THEN +!if defined(CERNLIB_SINGLE) +! DENOM = GAMMA(TS(1))*GAMMA(TS(2)+ONED)/GAMMA(TS(1)+TS(2)+ONED) +!endif +!if defined(CERNLIB_DOUBLE) + DENOM = DGAMMA_LHA(TS(1))*DGAMMA_LHA(TS(2)+ONED)/ & + & DGAMMA_LHA(TS(1)+TS(2)+ONED) +!endif + XQ(KFL)=X**TS(1)*(1.-X)**TS(2)/DENOM + ELSE + XQ(KFL)=TS(1)*X**TS(2)*(1.-X)**TS(3)*(1.+TS(4)*X+TS(5)*X**2) + ENDIF + 10 CONTINUE + +!...output + UPV = XQ(1) + DNV = XQ(1) + SEA = XQ(3)/SIXD + STR = XQ(3)/SIXD + CHM = XQ(4) + GL = XQ(2) +! + RETURN + END diff --git a/LHAPDF/lhapdf-5.9.1/src/wrapsasg.f b/LHAPDF/lhapdf-5.9.1/src/wrapsasg.f new file mode 100644 index 00000000000..97af190e918 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/wrapsasg.f @@ -0,0 +1,1373 @@ +! -*- F90 -*- + + + subroutine SASGevolvep(xin,qin,p2in,ip2in,pdf) + real*8 xin,qin,q2in,p2in,pdf(-6:6),xval(45),qcdl4,qcdl5 + include 'parmsetup.inc' + character*16 name(nmxset) + integer nmem(nmxset),ndef(nmxset),mmem + common/NAME/name,nmem,ndef,mmem + integer nset + real*8 upv,dnv,usea,dsea,str,chm,bot,top,glu + + save + call getnset(iset) + call getnmem(iset,imem) + + iimem = imem + if(iimem.eq.0) iimem=6 + q2in = qin*qin + call SFSASxx(iimem,xin,Q2in,p2in,ip2, & + & upv,dnv,usea,dsea,str,chm,bot,top,glu) + + pdf(-6)= top + pdf(6)= top + pdf(-5)= bot + pdf(5 )= bot + pdf(-4)= chm + pdf(4 )= chm + pdf(-3)= str + pdf(3 )= str + pdf(-2)= usea + pdf(2 )= upv + pdf(-1)= dsea + pdf(1 )= dnv + pdf(0 )= glu + + return +! +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + entry SASGread(nset) +! print *,'calling SASGread' + read(1,*)nmem(nset),ndef(nset) + return +! +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + entry SASGalfa(alfas,qalfa) + call getnset(iset) + call getnmem(iset,imem) + call GetOrderAsM(iset,iord) + call Getlam4M(iset,imem,qcdl4) + call Getlam5M(iset,imem,qcdl5) + call aspdflib(alfas,Qalfa,iord,qcdl5) + + return +! +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + entry SASGinit(Eorder,Q2fit) + return +! +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + entry SASGpdf(mem) +! print *,'calling SASGpdf',mem +! imem = mem + call getnset(iset) + call setnmem(iset,mem) + return +! + 1000 format(5e13.5) + END +! +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +!----------------------------------------------------------------------- + SUBROUTINE SFSASxx(iset,DX,DQ2,DP2,ip2, & + & DUPV,DDNV,DSEA,DSEAD,DSTR,DCHM,DBOT,DTOP,DGL) +! +! ******************************************************************** +! * * +! * Interface to SASset of structure functions * +! * * +! * Author: H. Plothow-Besch (CERN-PPE) * +! * * +! ******************************************************************** +! +! :::::::::::: Structure functions from the SAS group version 2 +! :::::::::::: Lambda = 0.200 GeV, Q**2 = 0.36 GeV**2 (DIS) +! + double precision & + & DX,DQ2,DP2, & + & DUPV,DDNV,DSEA,DSEAD,DSTR,DCHM,DBOT,DTOP,DGL + DIMENSION XPDFGM(-6:6) + REAL X, Q, Q2, P2, F2GAM, XPDFGM +! PARAMETER (ISET=1) +! + X = DX + Q = SQRT(DQ2) + Q2 = DQ2 + P2 = DP2 +! +! generate the individual structure fcn calls +! + if(iset.le.4) then + iiset=iset + CALL LHASASGAM1(iISET,X,Q2,P2,F2GAM,XPDFGM) + else + iiset = iset-4 + CALL LHASASGAM2(iISET,X,Q2,P2,ip2,F2GAM,XPDFGM) + endif + + UPV = XPDFGM(2) + DUPV = UPV + DNV = XPDFGM(1) + DDNV = DNV + SEAU = XPDFGM(-2) + DSEA = SEAU + SEAD = XPDFGM(-1) + DSEAD = SEAD + STR = XPDFGM(-3) + DSTR = STR + CHM = XPDFGM(-4) + DCHM = CHM + BOT = XPDFGM(-5) + DBOT = BOT + TOP = 0. +! IF (DSCAL.GT.TMAS) TOP = XPDFGM(6) + DTOP = TOP + GL = XPDFGM(0) + DGL = GL +! + RETURN + END +!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +! ------------- SASGAM1 ------------------------ +!...SaSgam - parton distributions of the photon +!...by Gerhard A. Schuler and Torbjorn Sjostrand +!...For further information see preprint CERN-TH/95-62 and LU TP 95-6: +!...Low- and high-mass components of the photon distribution functions +!...Program last changed on 21 March 1995. + +!...The user should only need to call the SASGAM routine, +!...which in turn calls the auxiliary routines SASVM1, SASAN1, +!...SASBEH and SASDIR. The package is self-contained. + +!...One particular aspect of these parametrizations is that F2 for +!...the photon is not obtained just as the charge-squared-weighted +!...sum of quark distributions, but differ in the treatment of +!...heavy flavours (in F2 the DIS relation W2 = Q2*(1-x)/x restricts +!...the kinematics range of heavy-flavour production, but the same +!...kinematics is not relevant e.g. for jet production) and, for the +!...'MSbar' fits, in the addition of a Cgamma term related to the +!...separation of direct processes. Schematically: +!...PDF = VMD (rho, omega, phi) + anomalous (d, u, s, c, b). +!...F2 = VMD (rho, omega, phi) + anomalous (d, u, s) + +!... Bethe-Heitler (c, b) (+ Cgamma (d, u, s)). +!...The J/psi and Upsilon states have not been included in the VMD sum, +!...but low c and b masses in the other components should compensate +!...for this in a duality sense. + +!...The calling sequence is the following: +! CALL SASGAM1(ISET,X,Q2,P2,F2GM,XPDFGM) +!...with the following declaration statement: +! DIMENSION XPDFGM(-6:6) +!...and, optionally, further information in: +! COMMON/SASCOM/XPVMD(-6:6),XPANL(-6:6),XPANH(-6:6),XPBEH(-6:6), +! &XPDIR(-6:6) +!...Input: ISET = 1 : SaS set 1D ('DIS', Q0 = 0.6 GeV) +! = 2 : SaS set 1M ('MSbar', Q0 = 0.6 GeV) +! = 3 : SaS set 2D ('DIS', Q0 = 2 GeV) +! = 4 : SaS set 2M ('MSbar', Q0 = 2 GeV) +! X : x value. +! Q2 : Q2 value. +! P2 : P2 value; should be = 0. for an on-shell photon. +!...Output: F2GM : F2 value of the photon (including factors of alpha_em +! XPFDGM : x times parton distribution functions of the photo +! with elements 0 = g, 1 = d, 2 = u, 3 = s, 4 = c, 5 = b, +! 6 = t (always empty!), - for antiquarks (result is same) +!...The breakdown by component is stored in the commonblock SASCOM, +! with elements as above. +! XPVMD : rho, omega, phi VMD part only of output. +! XPANL : d, u, s anomalous part only of output. +! XPANH : c, b anomalous part only of output. +! XPBEH : c, b Bethe-Heitler part only of output. +! XPDIR : Cgamma (direct contribution) part only of output. + + SUBROUTINE LHASASGAM1(ISET,X,Q2,P2,F2GM,XPDFGM) +!...Purpose: to construct the F2 and parton distributions of the photon +!...by summing homogeneous (VMD) and inhomogeneous (anomalous) terms. +!...For F2, c and b are included by the Bethe-Heitler formula; +!...in the 'MSbar' scheme additionally a Cgamma term is added. + DIMENSION XPDFGM(-6:6) + COMMON/LHASASCOM/XPVMD(-6:6),XPANL(-6:6),XPANH(-6:6),XPBEH(-6:6), & + &XPDIR(-6:6) + SAVE /LHASASCOM/ + +!...Temporary array. + DIMENSION XPGA(-6:6) +!...Charm and bottom masses (low to compensate for J/psi etc.). + DATA PMC/1.3/, PMB/4.6/ +!...alpha_em and alpha_em/(2*pi). + DATA AEM/0.007297/, AEM2PI/0.0011614/ +!...Lambda value for 4 flavours. + DATA ALAM/0.20/ +!...Mixture u/(u+d), = 0.5 for incoherent and = 0.8 for coherent sum. + DATA FRACU/0.8/ +!...VMD couplings f_V**2/(4*pi). + DATA FRHO/2.20/, FOMEGA/23.6/, FPHI/18.4/ +!...Masses for rho (=omega) and phi. + DATA PMRHO/0.770/, PMPHI/1.020/ + +!...Reset output. + F2GM=0. + DO 100 KFL=-6,6 + XPDFGM(KFL)=0. + XPVMD(KFL)=0. + XPANL(KFL)=0. + XPANH(KFL)=0. + XPBEH(KFL)=0. + XPDIR(KFL)=0. + 100 END DO + +!...Check that input sensible. + IF(ISET.LE.0.OR.ISET.GE.5) THEN + WRITE(*,*) ' FATAL ERROR: SaSgam called for unknown set' + WRITE(*,*) ' ISET = ',ISET + STOP + ENDIF + IF(X.LE.0..OR.X.GT.1.) THEN + WRITE(*,*) ' FATAL ERROR: SaSgam called for unphysical x' + WRITE(*,*) ' X = ',X + STOP + ENDIF + +!...Set Q0 cut-off parameter as function of set used. + IF(ISET.LE.2) THEN + Q0=0.6 + ELSE + Q0=2. + ENDIF + Q02 = Q0**2 + +!...Call VMD parametrization for d quark and use to give rho, omega, phi +!...Note scale choice and dipole dampening for off-shell photon. + P2MX=MAX(P2,Q02) + CALL LHASASVM1(ISET,1,X,Q2,P2MX,ALAM,XPGA) + XFVAL=XPGA(1)-XPGA(2) + XPGA(1)=XPGA(2) + XPGA(-1)=XPGA(-2) + FACUD=AEM*(1./FRHO+1./FOMEGA)*(PMRHO**2/(PMRHO**2+P2))**2 + FACS=AEM*(1./FPHI)*(PMPHI**2/(PMPHI**2+P2))**2 + DO 110 KFL=-5,5 + XPVMD(KFL)=(FACUD+FACS)*XPGA(KFL) + 110 END DO + XPVMD(1)=XPVMD(1)+(1.-FRACU)*FACUD*XFVAL + XPVMD(2)=XPVMD(2)+FRACU*FACUD*XFVAL + XPVMD(3)=XPVMD(3)+FACS*XFVAL + XPVMD(-1)=XPVMD(-1)+(1.-FRACU)*FACUD*XFVAL + XPVMD(-2)=XPVMD(-2)+FRACU*FACUD*XFVAL + XPVMD(-3)=XPVMD(-3)+FACS*XFVAL + +!...Call anomalous parametrization for d + u + s. + CALL LHASASAN1(-3,X,Q2,P2MX,ALAM,XPGA) + DO 120 KFL=-5,5 + XPANL(KFL)=XPGA(KFL) + 120 END DO + +!...Call anomalous parametrization for c and b. + CALL LHASASAN1(4,X,Q2,P2MX,ALAM,XPGA) + DO 130 KFL=-5,5 + XPANH(KFL)=XPGA(KFL) + 130 END DO + CALL LHASASAN1(5,X,Q2,P2MX,ALAM,XPGA) + DO 140 KFL=-5,5 + XPANH(KFL)=XPANH(KFL)+XPGA(KFL) + 140 END DO + +!...Call Bethe-Heitler term expression for charm and bottom. + CALL LHASASBEH(4,X,Q2,P2,PMC**2,XPBH) + XPBEH(4)=XPBH + XPBEH(-4)=XPBH + CALL LHASASBEH(5,X,Q2,P2,PMB**2,XPBH) + XPBEH(5)=XPBH + XPBEH(-5)=XPBH + +!...For MSbar subtraction call C^gamma term expression for d, u, s. + IF(ISET.EQ.2.OR.ISET.EQ.4) THEN + CALL LHASASDIR(X,Q2,P2,Q02,XPGA) + DO 150 KFL=-5,5 + XPDIR(KFL)=XPGA(KFL) + 150 CONTINUE + ENDIF + +!...Store result in output array. + DO 160 KFL=-5,5 + CHSQ=1./9. + IF(IABS(KFL).EQ.2.OR.IABS(KFL).EQ.4) CHSQ=4./9. + XPF2=XPVMD(KFL)+XPANL(KFL)+XPBEH(KFL)+XPDIR(KFL) + IF(KFL.NE.0) F2GM=F2GM+CHSQ*XPF2 + XPDFGM(KFL)=XPVMD(KFL)+XPANL(KFL)+XPANH(KFL) + 160 END DO + + RETURN + END +!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +! ------------------ SASGAM2 --------------------------- +!...SaSgam version 2 - parton distributions of the photon +!...by Gerhard A. Schuler and Torbjorn Sjostrand +!...For further information see Z. Phys. C68 (1995) 607 +!...and CERN-TH/96-04 and LU TP 96-2. +!...Program last changed on 18 January 1996. + +!!!!Note that one further call parameter - IP2 - has been added +!!!!to the SASGAM argument list compared with version 1. + +!...The user should only need to call the SASGAM routine, +!...which in turn calls the auxiliary routines SASVMD, SASANO, +!...SASBEH and SASDIR. The package is self-contained. + +!...One particular aspect of these parametrizations is that F2 for +!...the photon is not obtained just as the charge-squared-weighted +!...sum of quark distributions, but differ in the treatment of +!...heavy flavours (in F2 the DIS relation W2 = Q2*(1-x)/x restricts +!...the kinematics range of heavy-flavour production, but the same +!...kinematics is not relevant e.g. for jet production) and, for the +!...'MSbar' fits, in the addition of a Cgamma term related to the +!...separation of direct processes. Schematically: +!...PDF = VMD (rho, omega, phi) + anomalous (d, u, s, c, b). +!...F2 = VMD (rho, omega, phi) + anomalous (d, u, s) + +!... Bethe-Heitler (c, b) (+ Cgamma (d, u, s)). +!...The J/psi and Upsilon states have not been included in the VMD sum, +!...but low c and b masses in the other components should compensate +!...for this in a duality sense. + +!...The calling sequence is the following: +! CALL SASGAM2(ISET,X,Q2,P2,IP2,F2GM,XPDFGM) +!...with the following declaration statement: +! DIMENSION XPDFGM(-6:6) +!...and, optionally, further information in: +! COMMON/SASCOM/XPVMD(-6:6),XPANL(-6:6),XPANH(-6:6),XPBEH(-6:6), +! &XPDIR(-6:6) +! COMMON/SASVAL/VXPVMD(-6:6),VXPANL(-6:6),VXPANH(-6:6),VXPDGM(-6:6) +!...Input: ISET = 1 : SaS set 1D ('DIS', Q0 = 0.6 GeV) +! = 2 : SaS set 1M ('MSbar', Q0 = 0.6 GeV) +! = 3 : SaS set 2D ('DIS', Q0 = 2 GeV) +! = 4 : SaS set 2M ('MSbar', Q0 = 2 GeV) +! X : x value. +! Q2 : Q2 value. +! P2 : P2 value; should be = 0. for an on-shell photon. +! IP2 : scheme used to evaluate off-shell anomalous component. +! = 0 : recommended default, see = 7. +! = 1 : dipole dampening by integration; very time-consumi +! = 2 : P_0^2 = max( Q_0^2, P^2 ) +! = 3 : P'_0^2 = Q_0^2 + P^2. +! = 4 : P_{eff} that preserves momentum sum. +! = 5 : P_{int} that preserves momentum and average +! evolution range. +! = 6 : P_{eff}, matched to P_0 in P2 -> Q2 limit. +! = 7 : P_{eff}, matched to P_0 in P2 -> Q2 limit. +!...Output: F2GM : F2 value of the photon (including factors of alpha_em +! XPFDGM : x times parton distribution functions of the photo +! with elements 0 = g, 1 = d, 2 = u, 3 = s, 4 = c, 5 = b, +! 6 = t (always empty!), - for antiquarks (result is same) +!...The breakdown by component is stored in the commonblock SASCOM, +! with elements as above. +! XPVMD : rho, omega, phi VMD part only of output. +! XPANL : d, u, s anomalous part only of output. +! XPANH : c, b anomalous part only of output. +! XPBEH : c, b Bethe-Heitler part only of output. +! XPDIR : Cgamma (direct contribution) part only of output. +!...The above arrays do not distinguish valence and sea contributions, +!...although this information is available internally. The additional +!...commonblock SASVAL provides the valence part only of the above +!...distributions. Array names VXPVMD, VXPANL and VXPANH correspond +!...to XPVMD, XPANL and XPANH, while XPBEH and XPDIR are valence only +!...and therefore not given doubly. VXPDGM gives the sum of valence +!...parts, and so matches XPDFGM. The difference, i.e. XPVMD-VXPVMD +!...and so on, gives the sea part only. + + SUBROUTINE LHASASGAM2(ISET,X,Q2,P2,IP2,F2GM,XPDFGM) +!...Purpose: to construct the F2 and parton distributions of the photon +!...by summing homogeneous (VMD) and inhomogeneous (anomalous) terms. +!...For F2, c and b are included by the Bethe-Heitler formula; +!...in the 'MSbar' scheme additionally a Cgamma term is added. + DIMENSION XPDFGM(-6:6) + COMMON/LHASASCOM/XPVMD(-6:6),XPANL(-6:6),XPANH(-6:6),XPBEH(-6:6), & + &XPDIR(-6:6) + COMMON/LHASASVAL/VXPVMD(-6:6),VXPANL(-6:6),VXPANH(-6:6), & + &VXPDGM(-6:6) + SAVE /LHASASCOM/,/LHASASVAL/ + +!...Temporary array. + DIMENSION XPGA(-6:6), VXPGA(-6:6) +!...Charm and bottom masses (low to compensate for J/psi etc.). + DATA PMC/1.3/, PMB/4.6/ +!...alpha_em and alpha_em/(2*pi). + DATA AEM/0.007297/, AEM2PI/0.0011614/ +!...Lambda value for 4 flavours. + DATA ALAM/0.20/ +!...Mixture u/(u+d), = 0.5 for incoherent and = 0.8 for coherent sum. + DATA FRACU/0.8/ +!...VMD couplings f_V**2/(4*pi). + DATA FRHO/2.20/, FOMEGA/23.6/, FPHI/18.4/ +!...Masses for rho (=omega) and phi. + DATA PMRHO/0.770/, PMPHI/1.020/ +!...Number of points in integration for IP2=1. + DATA NSTEP/100/ + +!...Reset output. + F2GM=0. + DO 100 KFL=-6,6 + XPDFGM(KFL)=0. + XPVMD(KFL)=0. + XPANL(KFL)=0. + XPANH(KFL)=0. + XPBEH(KFL)=0. + XPDIR(KFL)=0. + VXPVMD(KFL)=0. + VXPANL(KFL)=0. + VXPANH(KFL)=0. + VXPDGM(KFL)=0. + 100 END DO + +!...Check that input sensible. + IF(ISET.LE.0.OR.ISET.GE.5) THEN + WRITE(*,*) ' FATAL ERROR: SaSgam called for unknown set' + WRITE(*,*) ' ISET = ',ISET + STOP + ENDIF + IF(X.LE.0..OR.X.GT.1.) THEN + WRITE(*,*) ' FATAL ERROR: SaSgam called for unphysical x' + WRITE(*,*) ' X = ',X + STOP + ENDIF + +!...Set Q0 cut-off parameter as function of set used. + IF(ISET.LE.2) THEN + Q0=0.6 + ELSE + Q0=2. + ENDIF + Q02=Q0**2 + +!...Scale choice for off-shell photon; common factors. + Q2A=Q2 + FACNOR=1. + IF(IP2.EQ.1) THEN + P2MX=P2+Q02 + Q2A=Q2+P2*Q02/MAX(Q02,Q2) + FACNOR=LOG(Q2/Q02)/NSTEP + ELSEIF(IP2.EQ.2) THEN + P2MX=MAX(P2,Q02) + ELSEIF(IP2.EQ.3) THEN + P2MX=P2+Q02 + Q2A=Q2+P2*Q02/MAX(Q02,Q2) + ELSEIF(IP2.EQ.4) THEN + P2MX=Q2*(Q02+P2)/(Q2+P2)*EXP(P2*(Q2-Q02)/ & + & ((Q2+P2)*(Q02+P2))) + ELSEIF(IP2.EQ.5) THEN + P2MXA=Q2*(Q02+P2)/(Q2+P2)*EXP(P2*(Q2-Q02)/ & + & ((Q2+P2)*(Q02+P2))) + P2MX=Q0*SQRT(P2MXA) + FACNOR=LOG(Q2/P2MXA)/LOG(Q2/P2MX) + ELSEIF(IP2.EQ.6) THEN + P2MX=Q2*(Q02+P2)/(Q2+P2)*EXP(P2*(Q2-Q02)/ & + & ((Q2+P2)*(Q02+P2))) + P2MX=MAX(0.,1.-P2/Q2)*P2MX+MIN(1.,P2/Q2)*MAX(P2,Q02) + ELSE + P2MXA=Q2*(Q02+P2)/(Q2+P2)*EXP(P2*(Q2-Q02)/ & + & ((Q2+P2)*(Q02+P2))) + P2MX=Q0*SQRT(P2MXA) + P2MXB=P2MX + P2MX=MAX(0.,1.-P2/Q2)*P2MX+MIN(1.,P2/Q2)*MAX(P2,Q02) + P2MXB=MAX(0.,1.-P2/Q2)*P2MXB+MIN(1.,P2/Q2)*P2MXA + FACNOR=LOG(Q2/P2MXA)/LOG(Q2/P2MXB) + ENDIF + +!...Call VMD parametrization for d quark and use to give rho, omega, +!...phi. Note dipole dampening for off-shell photon. + CALL LHASASVMD(ISET,1,X,Q2A,P2MX,ALAM,XPGA,VXPGA) + XFVAL=VXPGA(1) + XPGA(1)=XPGA(2) + XPGA(-1)=XPGA(-2) + FACUD=AEM*(1./FRHO+1./FOMEGA)*(PMRHO**2/(PMRHO**2+P2))**2 + FACS=AEM*(1./FPHI)*(PMPHI**2/(PMPHI**2+P2))**2 + DO 110 KFL=-5,5 + XPVMD(KFL)=(FACUD+FACS)*XPGA(KFL) + 110 END DO + XPVMD(1)=XPVMD(1)+(1.-FRACU)*FACUD*XFVAL + XPVMD(2)=XPVMD(2)+FRACU*FACUD*XFVAL + XPVMD(3)=XPVMD(3)+FACS*XFVAL + XPVMD(-1)=XPVMD(-1)+(1.-FRACU)*FACUD*XFVAL + XPVMD(-2)=XPVMD(-2)+FRACU*FACUD*XFVAL + XPVMD(-3)=XPVMD(-3)+FACS*XFVAL + VXPVMD(1)=(1.-FRACU)*FACUD*XFVAL + VXPVMD(2)=FRACU*FACUD*XFVAL + VXPVMD(3)=FACS*XFVAL + VXPVMD(-1)=(1.-FRACU)*FACUD*XFVAL + VXPVMD(-2)=FRACU*FACUD*XFVAL + VXPVMD(-3)=FACS*XFVAL + + IF(IP2.NE.1) THEN +!...Anomalous parametrizations for different strategies +!...for off-shell photons; except full integration. + +!...Call anomalous parametrization for d + u + s. + CALL LHASASANO(-3,X,Q2A,P2MX,ALAM,XPGA,VXPGA) + DO 120 KFL=-5,5 + XPANL(KFL)=FACNOR*XPGA(KFL) + VXPANL(KFL)=FACNOR*VXPGA(KFL) + 120 CONTINUE + +!...Call anomalous parametrization for c and b. + CALL LHASASANO(4,X,Q2A,P2MX,ALAM,XPGA,VXPGA) + DO 130 KFL=-5,5 + XPANH(KFL)=FACNOR*XPGA(KFL) + VXPANH(KFL)=FACNOR*VXPGA(KFL) + 130 CONTINUE + CALL LHASASANO(5,X,Q2A,P2MX,ALAM,XPGA,VXPGA) + DO 140 KFL=-5,5 + XPANH(KFL)=XPANH(KFL)+FACNOR*XPGA(KFL) + VXPANH(KFL)=VXPANH(KFL)+FACNOR*VXPGA(KFL) + 140 CONTINUE + + ELSE +!...Special option: loop over flavours and integrate over k2. + DO 170 KF=1,5 + DO 160 ISTEP=1,NSTEP + Q2STEP=Q02*(Q2/Q02)**((ISTEP-0.5)/NSTEP) + IF((KF.EQ.4.AND.Q2STEP.LT.PMC**2).OR. & + & (KF.EQ.5.AND.Q2STEP.LT.PMB**2)) GOTO 160 + CALL LHASASVMD(0,KF,X,Q2,Q2STEP,ALAM,XPGA,VXPGA) + FACQ=AEM2PI*(Q2STEP/(Q2STEP+P2))**2*FACNOR + IF(MOD(KF,2).EQ.0) FACQ=FACQ*(8./9.) + IF(MOD(KF,2).EQ.1) FACQ=FACQ*(2./9.) + DO 150 KFL=-5,5 + IF(KF.LE.3) XPANL(KFL)=XPANL(KFL)+FACQ*XPGA(KFL) + IF(KF.GE.4) XPANH(KFL)=XPANH(KFL)+FACQ*XPGA(KFL) + IF(KF.LE.3) VXPANL(KFL)=VXPANL(KFL)+FACQ*VXPGA(KFL) + IF(KF.GE.4) VXPANH(KFL)=VXPANH(KFL)+FACQ*VXPGA(KFL) + 150 CONTINUE + 160 CONTINUE + 170 CONTINUE + ENDIF + +!...Call Bethe-Heitler term expression for charm and bottom. + CALL LHASASBEH(4,X,Q2,P2,PMC**2,XPBH) + XPBEH(4)=XPBH + XPBEH(-4)=XPBH + CALL LHASASBEH(5,X,Q2,P2,PMB**2,XPBH) + XPBEH(5)=XPBH + XPBEH(-5)=XPBH + +!...For MSbar subtraction call C^gamma term expression for d, u, s. + IF(ISET.EQ.2.OR.ISET.EQ.4) THEN + CALL LHASASDIR(X,Q2,P2,Q02,XPGA) + DO 180 KFL=-5,5 + XPDIR(KFL)=XPGA(KFL) + 180 CONTINUE + ENDIF + +!...Store result in output array. + DO 190 KFL=-5,5 + CHSQ=1./9. + IF(IABS(KFL).EQ.2.OR.IABS(KFL).EQ.4) CHSQ=4./9. + XPF2=XPVMD(KFL)+XPANL(KFL)+XPBEH(KFL)+XPDIR(KFL) + IF(KFL.NE.0) F2GM=F2GM+CHSQ*XPF2 + XPDFGM(KFL)=XPVMD(KFL)+XPANL(KFL)+XPANH(KFL) + VXPDGM(KFL)=VXPVMD(KFL)+VXPANL(KFL)+VXPANH(KFL) + 190 END DO + + RETURN + END + + +!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + SUBROUTINE LHASASVMD(ISET,KF,X,Q2,P2,ALAM,XPGA,VXPGA) +!...Purpose: to evaluate the VMD parton distributions of a photon, +!...evolved homogeneously from an initial scale P2 to Q2. +!...Does not include dipole suppression factor. +!...ISET is parton distribution set, see above; +!...additionally ISET=0 is used for the evolution of an anomalous photon +!...which branched at a scale P2 and then evolved homogeneously to Q2. +!...ALAM is the 4-flavour Lambda, which is automatically converted +!...to 3- and 5-flavour equivalents as needed. + DIMENSION XPGA(-6:6), VXPGA(-6:6) + DATA PMC/1.3/, PMB/4.6/, AEM/0.007297/, AEM2PI/0.0011614/ + +!...Reset output. + DO 100 KFL=-6,6 + XPGA(KFL)=0. + VXPGA(KFL)=0. + 100 END DO + KFA=IABS(KF) + +!...Calculate Lambda; protect against unphysical Q2 and P2 input. + ALAM3=ALAM*(PMC/ALAM)**(2./27.) + ALAM5=ALAM*(ALAM/PMB)**(2./23.) + P2EFF=MAX(P2,1.2*ALAM3**2) + IF(KFA.EQ.4) P2EFF=MAX(P2EFF,PMC**2) + IF(KFA.EQ.5) P2EFF=MAX(P2EFF,PMB**2) + Q2EFF=MAX(Q2,P2EFF) + +!...Find number of flavours at lower and upper scale. + NFP=4 + IF(P2EFF.LT.PMC**2) NFP=3 + IF(P2EFF.GT.PMB**2) NFP=5 + NFQ=4 + IF(Q2EFF.LT.PMC**2) NFQ=3 + IF(Q2EFF.GT.PMB**2) NFQ=5 + +!...Find s as sum of 3-, 4- and 5-flavour parts. + S=0. + IF(NFP.EQ.3) THEN + Q2DIV=PMC**2 + IF(NFQ.EQ.3) Q2DIV=Q2EFF + S=S+(6./27.)*LOG(LOG(Q2DIV/ALAM3**2)/LOG(P2EFF/ALAM3**2)) + ENDIF + IF(NFP.LE.4.AND.NFQ.GE.4) THEN + P2DIV=P2EFF + IF(NFP.EQ.3) P2DIV=PMC**2 + Q2DIV=Q2EFF + IF(NFQ.EQ.5) Q2DIV=PMB**2 + S=S+(6./25.)*LOG(LOG(Q2DIV/ALAM**2)/LOG(P2DIV/ALAM**2)) + ENDIF + IF(NFQ.EQ.5) THEN + P2DIV=PMB**2 + IF(NFP.EQ.5) P2DIV=P2EFF + S=S+(6./23.)*LOG(LOG(Q2EFF/ALAM5**2)/LOG(P2DIV/ALAM5**2)) + ENDIF + +!...Calculate frequent combinations of x and s. + X1=1.-X + XL=-LOG(X) + S2=S**2 + S3=S**3 + S4=S**4 + +!...Evaluate homogeneous anomalous parton distributions below or +!...above threshold. + IF(ISET.EQ.0) THEN + IF(Q2.LE.P2.OR.(KFA.EQ.4.AND.Q2.LT.PMC**2).OR. & + &(KFA.EQ.5.AND.Q2.LT.PMB**2)) THEN + XVAL = X * 1.5 * (X**2+X1**2) + XGLU = 0. + XSEA = 0. + ELSE + XVAL = (1.5/(1.-0.197*S+4.33*S2)*X**2 + (1.5+2.10*S)/ & + & (1.+3.29*S)*X1**2 + 5.23*S/(1.+1.17*S+19.9*S3)*X*X1) * & + & X**(1./(1.+1.5*S)) * (1.-X**2)**(2.667*S) + XGLU = 4.*S/(1.+4.76*S+15.2*S2+29.3*S4) * & + & X**(-2.03*S/(1.+2.44*S)) * (X1*XL)**(1.333*S) * & + & ((4.*X**2+7.*X+4.)*X1/3. - 2.*X*(1.+X)*XL) + XSEA = S2/(1.+4.54*S+8.19*S2+8.05*S3) * & + & X**(-1.54*S/(1.+1.29*S)) * X1**(2.667*S) * & + & ((8.-73.*X+62.*X**2)*X1/9. + (3.-8.*X**2/3.)*X*XL + & + & (2.*X-1.)*X*XL**2) + ENDIF + +!...Evaluate set 1D parton distributions below or above threshold. + ELSEIF(ISET.EQ.1) THEN + IF(Q2.LE.P2.OR.(KFA.EQ.4.AND.Q2.LT.PMC**2).OR. & + &(KFA.EQ.5.AND.Q2.LT.PMB**2)) THEN + XVAL = 1.294 * X**0.80 * X1**0.76 + XGLU = 1.273 * X**0.40 * X1**1.76 + XSEA = 0.100 * X1**3.76 + ELSE + XVAL = 1.294/(1.+0.252*S+3.079*S2) * X**(0.80-0.13*S) * & + & X1**(0.76+0.667*S) * XL**(2.*S) + XGLU = 7.90*S/(1.+5.50*S) * EXP(-5.16*S) * & + & X**(-1.90*S/(1.+3.60*S)) * X1**1.30 * XL**(0.50+3.*S) + & + & 1.273 * EXP(-10.*S) * X**0.40 * X1**(1.76+3.*S) + XSEA = (0.1-0.397*S2+1.121*S3)/(1.+5.61*S2+5.26*S3) * & + & X**(-7.32*S2/(1.+10.3*S2)) * & + & X1**((3.76+15.*S+12.*S2)/(1.+4.*S)) + XSEA0 = 0.100 * X1**3.76 + ENDIF + +!...Evaluate set 1M parton distributions below or above threshold. + ELSEIF(ISET.EQ.2) THEN + IF(Q2.LE.P2.OR.(KFA.EQ.4.AND.Q2.LT.PMC**2).OR. & + &(KFA.EQ.5.AND.Q2.LT.PMB**2)) THEN + XVAL = 0.8477 * X**0.51 * X1**1.37 + XGLU = 3.42 * X**0.255 * X1**2.37 + XSEA = 0. + ELSE + XVAL = 0.8477/(1.+1.37*S+2.18*S2+3.73*S3) * X**(0.51+0.21*S) & + & * X1**1.37 * XL**(2.667*S) + XGLU = 24.*S/(1.+9.6*S+0.92*S2+14.34*S3) * EXP(-5.94*S) * & + & X**((-0.013-1.80*S)/(1.+3.14*S)) * X1**(2.37+0.4*S) * & + & XL**(0.32+3.6*S) + 3.42 * EXP(-12.*S) * X**0.255 * & + & X1**(2.37+3.*S) + XSEA = 0.842*S/(1.+21.3*S-33.2*S2+229.*S3) * & + & X**((0.13-2.90*S)/(1.+5.44*S)) * X1**(3.45+0.5*S) * & + & XL**(2.8*S) + XSEA0 = 0. + ENDIF + +!...Evaluate set 2D parton distributions below or above threshold. + ELSEIF(ISET.EQ.3) THEN + IF(Q2.LE.P2.OR.(KFA.EQ.4.AND.Q2.LT.PMC**2).OR. & + &(KFA.EQ.5.AND.Q2.LT.PMB**2)) THEN + XVAL = X**0.46 * X1**0.64 + 0.76 * X + XGLU = 1.925 * X1**2 + XSEA = 0.242 * X1**4 + ELSE + XVAL = (1.+0.186*S)/(1.-0.209*S+1.495*S2) * X**(0.46+0.25*S) & + & * X1**((0.64+0.14*S+5.*S2)/(1.+S)) * XL**(1.9*S) + & + & (0.76+0.4*S) * X * X1**(2.667*S) + XGLU = (1.925+5.55*S+147.*S2)/(1.-3.59*S+3.32*S2) * & + & EXP(-18.67*S) * X**((-5.81*S-5.34*S2)/(1.+29.*S-4.26*S2)) & + & * X1**((2.-5.9*S)/(1.+1.7*S)) * XL**(9.3*S/(1.+1.7*S)) + XSEA = (0.242-0.252*S+1.19*S2)/(1.-0.607*S+21.95*S2) * & + & X**(-12.1*S2/(1.+2.62*S+16.7*S2)) * X1**4 * XL**S + XSEA0 = 0.242 * X1**4 + ENDIF + +!...Evaluate set 2M parton distributions below or above threshold. + ELSEIF(ISET.EQ.4) THEN + IF(Q2.LE.P2.OR.(KFA.EQ.4.AND.Q2.LT.PMC**2).OR. & + &(KFA.EQ.5.AND.Q2.LT.PMB**2)) THEN + XVAL = 1.168 * X**0.50 * X1**2.60 + 0.965 * X + XGLU = 1.808 * X1**2 + XSEA = 0.209 * X1**4 + ELSE + XVAL = (1.168+1.771*S+29.35*S2) * EXP(-5.776*S) * & + & X**((0.5+0.208*S)/(1.-0.794*S+1.516*S2)) * & + & X1**((2.6+7.6*S)/(1.+5.*S)) * XL**(5.15*S/(1.+2.*S)) + & + & (0.965+22.35*S)/(1.+18.4*S) * X * X1**(2.667*S) + XGLU = (1.808+29.9*S)/(1.+26.4*S) * EXP(-5.28*S) * & + & X**((-5.35*S-10.11*S2)/(1.+31.71*S)) * & + & X1**((2.-7.3*S+4.*S2)/(1.+2.5*S)) * & + & XL**(10.9*S/(1.+2.5*S)) + XSEA = (0.209+0.644*S2)/(1.+0.319*S+17.6*S2) * & + & X**((-0.373*S-7.71*S2)/(1.+0.815*S+11.0*S2)) * & + & X1**(4.+S) * XL**(0.45*S) + XSEA0 = 0.209 * X1**4 + ENDIF + ENDIF + +!...Threshold factors for c and b sea. + SLL=LOG(LOG(Q2EFF/ALAM**2)/LOG(P2EFF/ALAM**2)) + XCHM=0. + IF(Q2.GT.PMC**2.AND.Q2.GT.1.001*P2EFF) THEN + SCH=MAX(0.,LOG(LOG(PMC**2/ALAM**2)/LOG(P2EFF/ALAM**2))) + IF(ISET.EQ.0) THEN + XCHM=XSEA*(1.-(SCH/SLL)**2) + ELSE + XCHM=MAX(0.,XSEA-XSEA0*X1**(2.667*S))*(1.-SCH/SLL) + ENDIF + ENDIF + XBOT=0. + IF(Q2.GT.PMB**2.AND.Q2.GT.1.001*P2EFF) THEN + SBT=MAX(0.,LOG(LOG(PMB**2/ALAM**2)/LOG(P2EFF/ALAM**2))) + IF(ISET.EQ.0) THEN + XBOT=XSEA*(1.-(SBT/SLL)**2) + ELSE + XBOT=MAX(0.,XSEA-XSEA0*X1**(2.667*S))*(1.-SBT/SLL) + ENDIF + ENDIF + +!...Fill parton distributions. + XPGA(0)=XGLU + XPGA(1)=XSEA + XPGA(2)=XSEA + XPGA(3)=XSEA + XPGA(4)=XCHM + XPGA(5)=XBOT + XPGA(KFA)=XPGA(KFA)+XVAL + DO 110 KFL=1,5 + XPGA(-KFL)=XPGA(KFL) + 110 END DO + VXPGA(KFA)=XVAL + VXPGA(-KFA)=XVAL + + RETURN + END + +!********************************************************************* + + SUBROUTINE LHASASANO(KF,X,Q2,P2,ALAM,XPGA,VXPGA) +!...Purpose: to evaluate the parton distributions of the anomalous +!...photon, inhomogeneously evolved from a scale P2 (where it vanishes) +!...to Q2. +!...KF=0 gives the sum over (up to) 5 flavours, +!...KF<0 limits to flavours up to abs(KF), +!...KF>0 is for flavour KF only. +!...ALAM is the 4-flavour Lambda, which is automatically converted +!...to 3- and 5-flavour equivalents as needed. + DIMENSION XPGA(-6:6), VXPGA(-6:6), ALAMSQ(3:5) + DATA PMC/1.3/, PMB/4.6/, AEM/0.007297/, AEM2PI/0.0011614/ + +!...Reset output. + DO 100 KFL=-6,6 + XPGA(KFL)=0. + VXPGA(KFL)=0. + 100 END DO + IF(Q2.LE.P2) RETURN + KFA=IABS(KF) + +!...Calculate Lambda; protect against unphysical Q2 and P2 input. + ALAMSQ(3)=(ALAM*(PMC/ALAM)**(2./27.))**2 + ALAMSQ(4)=ALAM**2 + ALAMSQ(5)=(ALAM*(ALAM/PMB)**(2./23.))**2 + P2EFF=MAX(P2,1.2*ALAMSQ(3)) + IF(KF.EQ.4) P2EFF=MAX(P2EFF,PMC**2) + IF(KF.EQ.5) P2EFF=MAX(P2EFF,PMB**2) + Q2EFF=MAX(Q2,P2EFF) + XL=-LOG(X) + +!...Find number of flavours at lower and upper scale. + NFP=4 + IF(P2EFF.LT.PMC**2) NFP=3 + IF(P2EFF.GT.PMB**2) NFP=5 + NFQ=4 + IF(Q2EFF.LT.PMC**2) NFQ=3 + IF(Q2EFF.GT.PMB**2) NFQ=5 + +!...Define range of flavour loop. + IF(KF.EQ.0) THEN + KFLMN=1 + KFLMX=5 + ELSEIF(KF.LT.0) THEN + KFLMN=1 + KFLMX=KFA + ELSE + KFLMN=KFA + KFLMX=KFA + ENDIF + +!...Loop over flavours the photon can branch into. + DO 110 KFL=KFLMN,KFLMX + +!...Light flavours: calculate t range and (approximate) s range. + IF(KFL.LE.3.AND.(KFL.EQ.1.OR.KFL.EQ.KF)) THEN + TDIFF=LOG(Q2EFF/P2EFF) + S=(6./(33.-2.*NFQ))*LOG(LOG(Q2EFF/ALAMSQ(NFQ))/ & + & LOG(P2EFF/ALAMSQ(NFQ))) + IF(NFQ.GT.NFP) THEN + Q2DIV=PMB**2 + IF(NFQ.EQ.4) Q2DIV=PMC**2 + SNFQ=(6./(33.-2.*NFQ))*LOG(LOG(Q2DIV/ALAMSQ(NFQ))/ & + & LOG(P2EFF/ALAMSQ(NFQ))) + SNFP=(6./(33.-2.*(NFQ-1)))*LOG(LOG(Q2DIV/ALAMSQ(NFQ-1))/ & + & LOG(P2EFF/ALAMSQ(NFQ-1))) + S=S+(LOG(Q2DIV/P2EFF)/LOG(Q2EFF/P2EFF))*(SNFP-SNFQ) + ENDIF + IF(NFQ.EQ.5.AND.NFP.EQ.3) THEN + Q2DIV=PMC**2 + SNF4=(6./(33.-2.*4))*LOG(LOG(Q2DIV/ALAMSQ(4))/ & + & LOG(P2EFF/ALAMSQ(4))) + SNF3=(6./(33.-2.*3))*LOG(LOG(Q2DIV/ALAMSQ(3))/ & + & LOG(P2EFF/ALAMSQ(3))) + S=S+(LOG(Q2DIV/P2EFF)/LOG(Q2EFF/P2EFF))*(SNF3-SNF4) + ENDIF + +!...u and s quark do not need a separate treatment when d has been done. + ELSEIF(KFL.EQ.2.OR.KFL.EQ.3) THEN + +!...Charm: as above, but only include range above c threshold. + ELSEIF(KFL.EQ.4) THEN + IF(Q2.LE.PMC**2) EXIT + P2EFF=MAX(P2EFF,PMC**2) + Q2EFF=MAX(Q2EFF,P2EFF) + TDIFF=LOG(Q2EFF/P2EFF) + S=(6./(33.-2.*NFQ))*LOG(LOG(Q2EFF/ALAMSQ(NFQ))/ & + & LOG(P2EFF/ALAMSQ(NFQ))) + IF(NFQ.EQ.5.AND.NFP.EQ.4) THEN + Q2DIV=PMB**2 + SNFQ=(6./(33.-2.*NFQ))*LOG(LOG(Q2DIV/ALAMSQ(NFQ))/ & + & LOG(P2EFF/ALAMSQ(NFQ))) + SNFP=(6./(33.-2.*(NFQ-1)))*LOG(LOG(Q2DIV/ALAMSQ(NFQ-1))/ & + & LOG(P2EFF/ALAMSQ(NFQ-1))) + S=S+(LOG(Q2DIV/P2EFF)/LOG(Q2EFF/P2EFF))*(SNFP-SNFQ) + ENDIF + +!...Bottom: as above, but only include range above b threshold. + ELSEIF(KFL.EQ.5) THEN + IF(Q2.LE.PMB**2) EXIT + P2EFF=MAX(P2EFF,PMB**2) + Q2EFF=MAX(Q2,P2EFF) + TDIFF=LOG(Q2EFF/P2EFF) + S=(6./(33.-2.*NFQ))*LOG(LOG(Q2EFF/ALAMSQ(NFQ))/ & + & LOG(P2EFF/ALAMSQ(NFQ))) + ENDIF + +!...Evaluate flavour-dependent prefactor (charge^2 etc.). + CHSQ=1./9. + IF(KFL.EQ.2.OR.KFL.EQ.4) CHSQ=4./9. + FAC=AEM2PI*2.*CHSQ*TDIFF + +!...Evaluate parton distributions (normalized to unit momentum sum). + IF(KFL.EQ.1.OR.KFL.EQ.4.OR.KFL.EQ.5.OR.KFL.EQ.KF) THEN + XVAL= ((1.5+2.49*S+26.9*S**2)/(1.+32.3*S**2)*X**2 + & + & (1.5-0.49*S+7.83*S**2)/(1.+7.68*S**2)*(1.-X)**2 + & + & 1.5*S/(1.-3.2*S+7.*S**2)*X*(1.-X)) * & + & X**(1./(1.+0.58*S)) * (1.-X**2)**(2.5*S/(1.+10.*S)) + XGLU= 2.*S/(1.+4.*S+7.*S**2) * & + & X**(-1.67*S/(1.+2.*S)) * (1.-X**2)**(1.2*S) * & + & ((4.*X**2+7.*X+4.)*(1.-X)/3. - 2.*X*(1.+X)*XL) + XSEA= 0.333*S**2/(1.+4.90*S+4.69*S**2+21.4*S**3) * & + & X**(-1.18*S/(1.+1.22*S)) * (1.-X)**(1.2*S) * & + & ((8.-73.*X+62.*X**2)*(1.-X)/9. + (3.-8.*X**2/3.)*X*XL + & + & (2.*X-1.)*X*XL**2) + +!...Threshold factors for c and b sea. + SLL=LOG(LOG(Q2EFF/ALAM**2)/LOG(P2EFF/ALAM**2)) + XCHM=0. + IF(Q2.GT.PMC**2.AND.Q2.GT.1.001*P2EFF) THEN + SCH=MAX(0.,LOG(LOG(PMC**2/ALAM**2)/LOG(P2EFF/ALAM**2))) + XCHM=XSEA*(1.-(SCH/SLL)**3) + ENDIF + XBOT=0. + IF(Q2.GT.PMB**2.AND.Q2.GT.1.001*P2EFF) THEN + SBT=MAX(0.,LOG(LOG(PMB**2/ALAM**2)/LOG(P2EFF/ALAM**2))) + XBOT=XSEA*(1.-(SBT/SLL)**3) + ENDIF + ENDIF + +!...Add contribution of each valence flavour. + XPGA(0)=XPGA(0)+FAC*XGLU + XPGA(1)=XPGA(1)+FAC*XSEA + XPGA(2)=XPGA(2)+FAC*XSEA + XPGA(3)=XPGA(3)+FAC*XSEA + XPGA(4)=XPGA(4)+FAC*XCHM + XPGA(5)=XPGA(5)+FAC*XBOT + XPGA(KFL)=XPGA(KFL)+FAC*XVAL + VXPGA(KFL)=VXPGA(KFL)+FAC*XVAL + 110 END DO + DO 120 KFL=1,5 + XPGA(-KFL)=XPGA(KFL) + VXPGA(-KFL)=VXPGA(KFL) + 120 END DO + + RETURN + END + +!********************************************************************* + + SUBROUTINE LHASASBEH(KF,X,Q2,P2,PM2,XPBH) +!...Purpose: to evaluate the Bethe-Heitler cross section for +!...heavy flavour production. + DATA AEM2PI/0.0011614/ + +!...Reset output. + XPBH=0. + SIGBH=0. + +!...Check kinematics limits. + IF(X.GE.Q2/(4.*PM2+Q2+P2)) RETURN + W2=Q2*(1.-X)/X-P2 + BETA2=1.-4.*PM2/W2 + IF(BETA2.LT.1E-10) RETURN + BETA=SQRT(BETA2) + RMQ=4.*PM2/Q2 + +!...Simple case: P2 = 0. + IF(P2.LT.1E-4) THEN + IF(BETA.LT.0.99) THEN + XBL=LOG((1.+BETA)/(1.-BETA)) + ELSE + XBL=LOG((1.+BETA)**2*W2/(4.*PM2)) + ENDIF + SIGBH=BETA*(8.*X*(1.-X)-1.-RMQ*X*(1.-X))+ & + & XBL*(X**2+(1.-X)**2+RMQ*X*(1.-3.*X)-0.5*RMQ**2*X**2) + +!...Complicated case: P2 > 0, based on approximation of +!...C.T. Hill and G.G. Ross, Nucl. Phys. B148 (1979) 373 + ELSE + RPQ=1.-4.*X**2*P2/Q2 + IF(RPQ.GT.1E-10) THEN + RPBE=SQRT(RPQ*BETA2) + IF(RPBE.LT.0.99) THEN + XBL=LOG((1.+RPBE)/(1.-RPBE)) + XBI=2.*RPBE/(1.-RPBE**2) + ELSE + RPBESN=4.*PM2/W2+(4.*X**2*P2/Q2)*BETA2 + XBL=LOG((1.+RPBE)**2/RPBESN) + XBI=2.*RPBE/RPBESN + ENDIF + SIGBH=BETA*(6.*X*(1.-X)-1.)+ & + & XBL*(X**2+(1.-X)**2+RMQ*X*(1.-3.*X)-0.5*RMQ**2*X**2)+ & + & XBI*(2.*X/Q2)*(PM2*X*(2.-RMQ)-P2*X) + ENDIF + ENDIF + +!...Multiply by charge-squared etc. to get parton distribution. + CHSQ=1./9. + IF(IABS(KF).EQ.2.OR.IABS(KF).EQ.4) CHSQ=4./9. + XPBH=3.*CHSQ*AEM2PI*X*SIGBH + + RETURN + END + +!********************************************************************* + + SUBROUTINE LHASASDIR(X,Q2,P2,Q02,XPGA) +!...Purpose: to evaluate the direct contribution, i.e. the C^gamma term, +!...as needed in MSbar parametrizations. + DIMENSION XPGA(-6:6) + DATA PMC/1.3/, PMB/4.6/, AEM2PI/0.0011614/ + +!...Reset output. + DO 100 KFL=-6,6 + XPGA(KFL)=0. + 100 END DO + +!...Evaluate common x-dependent expression. + XTMP = (X**2+(1.-X)**2) * (-LOG(X)) - 1. + CGAM = 3.*AEM2PI*X * (XTMP*(1.+P2/(P2+Q02)) + 6.*X*(1.-X)) + +!...d, u, s part by simple charge factor. + XPGA(1)=(1./9.)*CGAM + XPGA(2)=(4./9.)*CGAM + XPGA(3)=(1./9.)*CGAM + +!...Also fill for antiquarks. + DO 110 KF=1,5 + XPGA(-KF)=XPGA(KF) + 110 END DO + + RETURN + END +!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + SUBROUTINE LHASASVM1(ISET,KF,X,Q2,P2,ALAM,XPGA) +!...Purpose: to evaluate the VMD parton distributions of a photon, +!...evolved homogeneously from an initial scale P2 to Q2. +!...Does not include dipole suppression factor. +!...ISET is parton distribution set, see above; +!...additionally ISET=0 is used for the evolution of an anomalous photon +!...which branched at a scale P2 and then evolved homogeneously to Q2. +!...ALAM is the 4-flavour Lambda, which is automatically converted +!...to 3- and 5-flavour equivalents as needed. + DIMENSION XPGA(-6:6) + DATA PMC/1.3/, PMB/4.6/, AEM/0.007297/, AEM2PI/0.0011614/ + +!...Reset output. + DO 100 KFL=-6,6 + XPGA(KFL)=0. + 100 END DO + KFA=IABS(KF) + +!...Calculate Lambda; protect against unphysical Q2 and P2 input. + ALAM3=ALAM*(PMC/ALAM)**(2./27.) + ALAM5=ALAM*(ALAM/PMB)**(2./23.) + P2EFF=MAX(P2,1.2*ALAM3**2) + IF(KFA.EQ.4) P2EFF=MAX(P2EFF,PMC**2) + IF(KFA.EQ.5) P2EFF=MAX(P2EFF,PMB**2) + Q2EFF=MAX(Q2,P2EFF) + +!...Find number of flavours at lower and upper scale. + NFP=4 + IF(P2EFF.LT.PMC**2) NFP=3 + IF(P2EFF.GT.PMB**2) NFP=5 + NFQ=4 + IF(Q2EFF.LT.PMC**2) NFQ=3 + IF(Q2EFF.GT.PMB**2) NFQ=5 + +!...Find s as sum of 3-, 4- and 5-flavour parts. + S=0. + IF(NFP.EQ.3) THEN + Q2DIV=PMC**2 + IF(NFQ.EQ.3) Q2DIV=Q2EFF + S=S+(6./27.)*LOG(LOG(Q2DIV/ALAM3**2)/LOG(P2EFF/ALAM3**2)) + ENDIF + IF(NFP.LE.4.AND.NFQ.GE.4) THEN + P2DIV=P2EFF + IF(NFP.EQ.3) P2DIV=PMC**2 + Q2DIV=Q2EFF + IF(NFQ.EQ.5) Q2DIV=PMB**2 + S=S+(6./25.)*LOG(LOG(Q2DIV/ALAM**2)/LOG(P2DIV/ALAM**2)) + ENDIF + IF(NFQ.EQ.5) THEN + P2DIV=PMB**2 + IF(NFP.EQ.5) P2DIV=P2EFF + S=S+(6./23.)*LOG(LOG(Q2EFF/ALAM5**2)/LOG(P2DIV/ALAM5**2)) + ENDIF + +!...Calculate frequent combinations of x and s. + X1=1.-X + XL=-LOG(X) + S2=S**2 + S3=S**3 + S4=S**4 + +!...Evaluate homogeneous anomalous parton distributions below or +!...above threshold. + IF(ISET.EQ.0) THEN + IF(Q2.LE.P2.OR.(KFA.EQ.4.AND.Q2.LT.PMC**2).OR. & + &(KFA.EQ.5.AND.Q2.LT.PMB**2)) THEN + XVAL = X * 1.5 * (X**2+X1**2) + XGLU = 0. + XSEA = 0. + ELSE + XVAL = (1.5/(1.-0.197*S+4.33*S2)*X**2 + (1.5+2.10*S)/ & + & (1.+3.29*S)*X1**2 + 5.23*S/(1.+1.17*S+19.9*S3)*X*X1) * & + & X**(1./(1.+1.5*S)) * (1.-X**2)**(2.667*S) + XGLU = 4.*S/(1.+4.76*S+15.2*S2+29.3*S4) * & + & X**(-2.03*S/(1.+2.44*S)) * (X1*XL)**(1.333*S) * & + & ((4.*X**2+7.*X+4.)*X1/3. - 2.*X*(1.+X)*XL) + XSEA = S2/(1.+4.54*S+8.19*S2+8.05*S3) * & + & X**(-1.54*S/(1.+1.29*S)) * X1**(2.667*S) * & + & ((8.-73.*X+62.*X**2)*X1/9. + (3.-8.*X**2/3.)*X*XL + & + & (2.*X-1.)*X*XL**2) + ENDIF + +!...Evaluate set 1D parton distributions below or above threshold. + ELSEIF(ISET.EQ.1) THEN + IF(Q2.LE.P2.OR.(KFA.EQ.4.AND.Q2.LT.PMC**2).OR. & + &(KFA.EQ.5.AND.Q2.LT.PMB**2)) THEN + XVAL = 1.294 * X**0.80 * X1**0.76 + XGLU = 1.273 * X**0.40 * X1**1.76 + XSEA = 0.100 * X1**3.76 + ELSE + XVAL = 1.294/(1.+0.252*S+3.079*S2) * X**(0.80-0.13*S) * & + & X1**(0.76+0.667*S) * XL**(2.*S) + XGLU = 7.90*S/(1.+5.50*S) * EXP(-5.16*S) * & + & X**(-1.90*S/(1.+3.60*S)) * X1**1.30 * XL**(0.50+3.*S) + & + & 1.273 * EXP(-10.*S) * X**0.40 * X1**(1.76+3.*S) + XSEA = (0.1-0.397*S2+1.121*S3)/(1.+5.61*S2+5.26*S3) * & + & X**(-7.32*S2/(1.+10.3*S2)) * & + & X1**((3.76+15.*S+12.*S2)/(1.+4.*S)) + XSEA0 = 0.100 * X1**3.76 + ENDIF + +!...Evaluate set 1M parton distributions below or above threshold. + ELSEIF(ISET.EQ.2) THEN + IF(Q2.LE.P2.OR.(KFA.EQ.4.AND.Q2.LT.PMC**2).OR. & + &(KFA.EQ.5.AND.Q2.LT.PMB**2)) THEN + XVAL = 0.8477 * X**0.51 * X1**1.37 + XGLU = 3.42 * X**0.255 * X1**2.37 + XSEA = 0. + ELSE + XVAL = 0.8477/(1.+1.37*S+2.18*S2+3.73*S3) * X**(0.51+0.21*S) & + & * X1**1.37 * XL**(2.667*S) + XGLU = 24.*S/(1.+9.6*S+0.92*S2+14.34*S3) * EXP(-5.94*S) * & + & X**((-0.013-1.80*S)/(1.+3.14*S)) * X1**(2.37+0.4*S) * & + & XL**(0.32+3.6*S) + 3.42 * EXP(-12.*S) * X**0.255 * & + & X1**(2.37+3.*S) + XSEA = 0.842*S/(1.+21.3*S-33.2*S2+229.*S3) * & + & X**((0.13-2.90*S)/(1.+5.44*S)) * X1**(3.45+0.5*S) * & + & XL**(2.8*S) + XSEA0 = 0. + ENDIF + +!...Evaluate set 2D parton distributions below or above threshold. + ELSEIF(ISET.EQ.3) THEN + IF(Q2.LE.P2.OR.(KFA.EQ.4.AND.Q2.LT.PMC**2).OR. & + &(KFA.EQ.5.AND.Q2.LT.PMB**2)) THEN + XVAL = X**0.46 * X1**0.64 + 0.76 * X + XGLU = 1.925 * X1**2 + XSEA = 0.242 * X1**4 + ELSE + XVAL = (1.+0.186*S)/(1.-0.209*S+1.495*S2) * X**(0.46+0.25*S) & + & * X1**((0.64+0.14*S+5.*S2)/(1.+S)) * XL**(1.9*S) + & + & (0.76+0.4*S) * X * X1**(2.667*S) + XGLU = (1.925+5.55*S+147.*S2)/(1.-3.59*S+3.32*S2) * & + & EXP(-18.67*S) * X**((-5.81*S-5.34*S2)/(1.+29.*S-4.26*S2)) & + & * X1**((2.-5.9*S)/(1.+1.7*S)) * XL**(9.3*S/(1.+1.7*S)) + XSEA = (0.242-0.252*S+1.19*S2)/(1.-0.607*S+21.95*S2) * & + & X**(-12.1*S2/(1.+2.62*S+16.7*S2)) * X1**4 * XL**S + XSEA0 = 0.242 * X1**4 + ENDIF + +!...Evaluate set 2M parton distributions below or above threshold. + ELSEIF(ISET.EQ.4) THEN + IF(Q2.LE.P2.OR.(KFA.EQ.4.AND.Q2.LT.PMC**2).OR. & + &(KFA.EQ.5.AND.Q2.LT.PMB**2)) THEN + XVAL = 1.168 * X**0.50 * X1**2.60 + 0.965 * X + XGLU = 1.808 * X1**2 + XSEA = 0.209 * X1**4 + ELSE + XVAL = (1.168+1.771*S+29.35*S2) * EXP(-5.776*S) * & + & X**((0.5+0.208*S)/(1.-0.794*S+1.516*S2)) * & + & X1**((2.6+7.6*S)/(1.+5.*S)) * XL**(5.15*S/(1.+2.*S)) + & + & (0.965+22.35*S)/(1.+18.4*S) * X * X1**(2.667*S) + XGLU = (1.808+29.9*S)/(1.+26.4*S) * EXP(-5.28*S) * & + & X**((-5.35*S-10.11*S2)/(1.+31.71*S)) * & + & X1**((2.-7.3*S+4.*S2)/(1.+2.5*S)) * & + & XL**(10.9*S/(1.+2.5*S)) + XSEA = (0.209+0.644*S2)/(1.+0.319*S+17.6*S2) * & + & X**((-0.373*S-7.71*S2)/(1.+0.815*S+11.0*S2)) * & + & X1**(4.+S) * XL**(0.45*S) + XSEA0 = 0.209 * X1**4 + ENDIF + ENDIF + +!...Threshold factors for c and b sea. + SLL=LOG(LOG(Q2EFF/ALAM**2)/LOG(P2EFF/ALAM**2)) + XCHM=0. + IF(Q2.GT.PMC**2.AND.Q2.GT.1.001*P2EFF) THEN + SCH=MAX(0.,LOG(LOG(PMC**2/ALAM**2)/LOG(P2EFF/ALAM**2))) + IF(ISET.EQ.0) THEN + XCHM=XSEA*(1.-(SCH/SLL)**2) + ELSE + XCHM=MAX(0.,XSEA-XSEA0*X1**(2.667*S))*(1.-SCH/SLL) + ENDIF + ENDIF + XBOT=0. + IF(Q2.GT.PMB**2.AND.Q2.GT.1.001*P2EFF) THEN + SBT=MAX(0.,LOG(LOG(PMB**2/ALAM**2)/LOG(P2EFF/ALAM**2))) + IF(ISET.EQ.0) THEN + XBOT=XSEA*(1.-(SBT/SLL)**2) + ELSE + XBOT=MAX(0.,XSEA-XSEA0*X1**(2.667*S))*(1.-SBT/SLL) + ENDIF + ENDIF + +!...Fill parton distributions. + XPGA(0)=XGLU + XPGA(1)=XSEA + XPGA(2)=XSEA + XPGA(3)=XSEA + XPGA(4)=XCHM + XPGA(5)=XBOT + XPGA(KFA)=XPGA(KFA)+XVAL + DO 110 KFL=1,5 + XPGA(-KFL)=XPGA(KFL) + 110 END DO + + RETURN + END +!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + SUBROUTINE LHASASAN1(KF,X,Q2,P2,ALAM,XPGA) +!...Purpose: to evaluate the parton distributions of the anomalous +!...photon, inhomogeneously evolved from a scale P2 (where it vanishes) +!...to Q2. +!...KF=0 gives the sum over (up to) 5 flavours, +!...KF<0 limits to flavours up to abs(KF), +!...KF>0 is for flavour KF only. +!...ALAM is the 4-flavour Lambda, which is automatically converted +!...to 3- and 5-flavour equivalents as needed. + DIMENSION XPGA(-6:6),ALAMSQ(3:5) + DATA PMC/1.3/, PMB/4.6/, AEM/0.007297/, AEM2PI/0.0011614/ + +!...Reset output. + DO 100 KFL=-6,6 + XPGA(KFL)=0. + 100 END DO + IF(Q2.LE.P2) RETURN + KFA=IABS(KF) + +!...Calculate Lambda; protect against unphysical Q2 and P2 input. + ALAMSQ(3)=(ALAM*(PMC/ALAM)**(2./27.))**2 + ALAMSQ(4)=ALAM**2 + ALAMSQ(5)=(ALAM*(ALAM/PMB)**(2./23.))**2 + P2EFF=MAX(P2,1.2*ALAMSQ(3)) + IF(KF.EQ.4) P2EFF=MAX(P2EFF,PMC**2) + IF(KF.EQ.5) P2EFF=MAX(P2EFF,PMB**2) + Q2EFF=MAX(Q2,P2EFF) + XL=-LOG(X) + +!...Find number of flavours at lower and upper scale. + NFP=4 + IF(P2EFF.LT.PMC**2) NFP=3 + IF(P2EFF.GT.PMB**2) NFP=5 + NFQ=4 + IF(Q2EFF.LT.PMC**2) NFQ=3 + IF(Q2EFF.GT.PMB**2) NFQ=5 + +!...Define range of flavour loop. + IF(KF.EQ.0) THEN + KFLMN=1 + KFLMX=5 + ELSEIF(KF.LT.0) THEN + KFLMN=1 + KFLMX=KFA + ELSE + KFLMN=KFA + KFLMX=KFA + ENDIF + +!...Loop over flavours the photon can branch into. + DO 110 KFL=KFLMN,KFLMX + +!...Light flavours: calculate t range and (approximate) s range. + IF(KFL.LE.3.AND.(KFL.EQ.1.OR.KFL.EQ.KF)) THEN + TDIFF=LOG(Q2EFF/P2EFF) + S=(6./(33.-2.*NFQ))*LOG(LOG(Q2EFF/ALAMSQ(NFQ))/ & + & LOG(P2EFF/ALAMSQ(NFQ))) + IF(NFQ.GT.NFP) THEN + Q2DIV=PMB**2 + IF(NFQ.EQ.4) Q2DIV=PMC**2 + SNFQ=(6./(33.-2.*NFQ))*LOG(LOG(Q2DIV/ALAMSQ(NFQ))/ & + & LOG(P2EFF/ALAMSQ(NFQ))) + SNFP=(6./(33.-2.*(NFQ-1)))*LOG(LOG(Q2DIV/ALAMSQ(NFQ-1))/ & + & LOG(P2EFF/ALAMSQ(NFQ-1))) + S=S+(LOG(Q2DIV/P2EFF)/LOG(Q2EFF/P2EFF))*(SNFP-SNFQ) + ENDIF + IF(NFQ.EQ.5.AND.NFP.EQ.3) THEN + Q2DIV=PMC**2 + SNF4=(6./(33.-2.*4))*LOG(LOG(Q2DIV/ALAMSQ(4))/ & + & LOG(P2EFF/ALAMSQ(4))) + SNF3=(6./(33.-2.*3))*LOG(LOG(Q2DIV/ALAMSQ(3))/ & + & LOG(P2EFF/ALAMSQ(3))) + S=S+(LOG(Q2DIV/P2EFF)/LOG(Q2EFF/P2EFF))*(SNF3-SNF4) + ENDIF + +!...u and s quark do not need a separate treatment when d has been done. + ELSEIF(KFL.EQ.2.OR.KFL.EQ.3) THEN + +!...Charm: as above, but only include range above c threshold. + ELSEIF(KFL.EQ.4) THEN + IF(Q2.LE.PMC**2) EXIT + P2EFF=MAX(P2EFF,PMC**2) + Q2EFF=MAX(Q2EFF,P2EFF) + TDIFF=LOG(Q2EFF/P2EFF) + S=(6./(33.-2.*NFQ))*LOG(LOG(Q2EFF/ALAMSQ(NFQ))/ & + & LOG(P2EFF/ALAMSQ(NFQ))) + IF(NFQ.EQ.5.AND.NFP.EQ.4) THEN + Q2DIV=PMB**2 + SNFQ=(6./(33.-2.*NFQ))*LOG(LOG(Q2DIV/ALAMSQ(NFQ))/ & + & LOG(P2EFF/ALAMSQ(NFQ))) + SNFP=(6./(33.-2.*(NFQ-1)))*LOG(LOG(Q2DIV/ALAMSQ(NFQ-1))/ & + & LOG(P2EFF/ALAMSQ(NFQ-1))) + S=S+(LOG(Q2DIV/P2EFF)/LOG(Q2EFF/P2EFF))*(SNFP-SNFQ) + ENDIF + +!...Bottom: as above, but only include range above b threshold. + ELSEIF(KFL.EQ.5) THEN + IF(Q2.LE.PMB**2) EXIT + P2EFF=MAX(P2EFF,PMB**2) + Q2EFF=MAX(Q2,P2EFF) + TDIFF=LOG(Q2EFF/P2EFF) + S=(6./(33.-2.*NFQ))*LOG(LOG(Q2EFF/ALAMSQ(NFQ))/ & + & LOG(P2EFF/ALAMSQ(NFQ))) + ENDIF + +!...Evaluate flavour-dependent prefactor (charge^2 etc.). + CHSQ=1./9. + IF(KFL.EQ.2.OR.KFL.EQ.4) CHSQ=4./9. + FAC=AEM2PI*2.*CHSQ*TDIFF + +!...Evaluate parton distributions (normalized to unit momentum sum). + IF(KFL.EQ.1.OR.KFL.EQ.4.OR.KFL.EQ.5.OR.KFL.EQ.KF) THEN + XVAL= ((1.5+2.49*S+26.9*S**2)/(1.+32.3*S**2)*X**2 + & + & (1.5-0.49*S+7.83*S**2)/(1.+7.68*S**2)*(1.-X)**2 + & + & 1.5*S/(1.-3.2*S+7.*S**2)*X*(1.-X)) * & + & X**(1./(1.+0.58*S)) * (1.-X**2)**(2.5*S/(1.+10.*S)) + XGLU= 2.*S/(1.+4.*S+7.*S**2) * & + & X**(-1.67*S/(1.+2.*S)) * (1.-X**2)**(1.2*S) * & + & ((4.*X**2+7.*X+4.)*(1.-X)/3. - 2.*X*(1.+X)*XL) + XSEA= 0.333*S**2/(1.+4.90*S+4.69*S**2+21.4*S**3) * & + & X**(-1.18*S/(1.+1.22*S)) * (1.-X)**(1.2*S) * & + & ((8.-73.*X+62.*X**2)*(1.-X)/9. + (3.-8.*X**2/3.)*X*XL + & + & (2.*X-1.)*X*XL**2) + +!...Threshold factors for c and b sea. + SLL=LOG(LOG(Q2EFF/ALAM**2)/LOG(P2EFF/ALAM**2)) + XCHM=0. + IF(Q2.GT.PMC**2.AND.Q2.GT.1.001*P2EFF) THEN + SCH=MAX(0.,LOG(LOG(PMC**2/ALAM**2)/LOG(P2EFF/ALAM**2))) + XCHM=XSEA*(1.-(SCH/SLL)**3) + ENDIF + XBOT=0. + IF(Q2.GT.PMB**2.AND.Q2.GT.1.001*P2EFF) THEN + SBT=MAX(0.,LOG(LOG(PMB**2/ALAM**2)/LOG(P2EFF/ALAM**2))) + XBOT=XSEA*(1.-(SBT/SLL)**3) + ENDIF + ENDIF + +!...Add contribution of each valence flavour. + XPGA(0)=XPGA(0)+FAC*XGLU + XPGA(1)=XPGA(1)+FAC*XSEA + XPGA(2)=XPGA(2)+FAC*XSEA + XPGA(3)=XPGA(3)+FAC*XSEA + XPGA(4)=XPGA(4)+FAC*XCHM + XPGA(5)=XPGA(5)+FAC*XBOT + XPGA(KFL)=XPGA(KFL)+FAC*XVAL + 110 END DO + DO 120 KFL=1,5 + XPGA(-KFL)=XPGA(KFL) + 120 END DO + + RETURN + END diff --git a/LHAPDF/lhapdf-5.9.1/src/wrapsmrspi.f b/LHAPDF/lhapdf-5.9.1/src/wrapsmrspi.f new file mode 100644 index 00000000000..cf29cc8fbf4 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/wrapsmrspi.f @@ -0,0 +1,172 @@ +! -*- F90 -*- + + + subroutine SMRSPevolve(xin,qin,pdf) + include 'parmsetup.inc' + PARAMETER(NX=50) + PARAMETER(NQ=19) + real*8 xin,qin,pdf(-6:6),xval(45),qcdl4,qcdl5 + real*8 upv,dnv,usea,dsea,str,chm,bot,top,glu + real*8 SIG,QNS,GL + real*8 holdit + real*8 f + common /SMRSP/ F(7,NX,NQ,3) + character*16 name(nmxset) + character*1 dummy + integer nmem(nmxset),ndef(nmxset),mmem + common/NAME/name,nmem,ndef,mmem + integer nset + integer initread/0/ + save + + call getnset(iset) + call getnmem(iset,imem) + + iimem = imem + if(iimem.eq.0) iimem = 2 + if(iimem.le.3) then + call SMRSPxx(iimem,xin,qin,upv,dnv,usea,str,chm,bot,glu) + endif + + + pdf(-6)= 0.0d0 + pdf(6)= 0.0d0 + pdf(-5)= bot + pdf(5 )= bot + pdf(-4)= chm + pdf(4 )= chm + pdf(-3)= str + pdf(3 )= str + pdf(-2)= usea + pdf(2 )= upv+usea + pdf(-1)= usea + pdf(1 )= dnv+usea + pdf(0 )= glu + + return +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + entry SMRSPread(nset) + read(1,*)nmem(nset),ndef(nset) + do j=1,3 + do k=1,NX + do l=1,NQ + if(initread.eq.0) then + read(1,*)(F(m,k,l,j),m=1,5),F(7,k,l,j),F(6,k,l,j) + else + read(1,'(a1)')dummy + endif + enddo + enddo + enddo + initread=1 + return +! +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + entry SMRSPalfa(alfas,qalfa) + call getnset(iset) + call getnmem(iset,imem) + call GetOrderAsM(iset,iord) + call Getlam4M(iset,imem,qcdl4) + call Getlam5M(iset,imem,qcdl5) + call aspdflib(alfas,Qalfa,iord,qcdl5) + return +! +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + entry SMRSPinit(Eorder,Q2fit) + return +! +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + entry SMRSPpdf(mem) +! imem = mem + call getnset(iset) + call setnmem(iset,mem) + return +! + 1000 format(5e13.5) + END +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +! + SUBROUTINE SMRSPxx(iset,X,SCALE,UPV,DNV,SEA,STR,CHM,BOT,GLU) +! +! :::::::::::: PION STRUCTURE FUNCTION :: 10% SEA ::::::::::::::::: +! + implicit real*8 (a-h,o-z) + PARAMETER(NX=50) + PARAMETER(NQ=19) + PARAMETER(NTENTH=21) + common /SMRSP/ F(7,NX,NQ,3) + DIMENSION G(7),XX(NX),N0(7),XX0(NX) +! DIMENSION F(7,NX,NQ),G(7),XX(NX),N0(7) + DATA XX/1.D-5,2.D-5,4.D-5,6.D-5,8.D-5, & + & 1.D-4,2.D-4,4.D-4,6.D-4,8.D-4, & + & 1.D-3,2.D-3,4.D-3,6.D-3,8.D-3, & + & 1.D-2,2.D-2,4.D-2,6.D-2,8.D-2, & + & .1D0,.125D0,.15D0,.175D0,.2D0,.225D0,.25D0,.275D0, & + & .3D0,.325D0,.35D0,.375D0,.4D0,.425D0,.45D0,.475D0, & + & .5D0,.525D0,.55D0,.575D0,.6D0,.65D0,.7D0,.75D0, & + & .8D0,.85D0,.9D0,.95D0,.975D0,1.D0/ + DATA XMIN,XMAX,QSQMIN,QSQMAX/1.D-5,1.D0,5.D0,1310720.D0/ + DATA N0/0,0,3,5,0,5,0/ + DATA ZEROD/0.D0/,PONED/0.1D0/,ONED/1.D0/,ONEDO/1.1D0/,TWOD/2.D0/ + DATA INIT/0/ + save + XSAVE=X + IF(INIT.NE.0) GOTO 10 + INIT=1 + do n=1,nx + xx0(n)=xx(n) + enddo + do jset=1,3 + DO 20 N=1,NX-1 + DO 20 M=1,NQ + DO 25 I=1,7 + 25 F(I,N,M,jset)=F(I,N,M,jset)/(ONED-XX0(N))**N0(I) + 20 CONTINUE + DO 30 J=1,NTENTH-1 + if(jset.eq.1) XX(J)= LOG10(XX(J))+ONEDO + DO 30 I=2,6 + DO 30 K=1,NQ + 30 F(I,J,K,jset)= LOG(F(I,J,K,jset)) & + & *F(I,NTENTH,K,jset)/ LOG(F(I,NTENTH,K,jset)) + 50 FORMAT(7F10.5) + DO 40 I=1,7 + DO 40 M=1,NQ + 40 F(I,NX,M,jset)=ZEROD + enddo + 10 CONTINUE +! IF(X.LT.XMIN) X=XMIN +! IF(X.GT.XMAX) X=XMAX + QSQ=SCALE**2 +! IF(QSQ.LT.QSQMIN) QSQ=QSQMIN +! IF(QSQ.GT.QSQMAX) QSQ=QSQMAX + XXX=X + IF(X.LT.PONED) XXX= LOG10(X)+ONEDO + N=0 + 70 N=N+1 + IF(XXX.GT.XX(N+1)) GOTO 70 + A=(XXX-XX(N))/(XX(N+1)-XX(N)) + RM= LOG(QSQ/QSQMIN)/ LOG(TWOD) + B=RM-AINT(RM) + M=1+ INT(RM) + DO 60 I=1,7 + G(I)= (ONED-A)*(ONED-B)*F(I,N,M,iset)+(ONED-A)*B*F(I,N,M+1,iset) & + & + A*(ONED-B)*F(I,N+1,M,iset) + A*B*F(I,N+1,M+1,iset) + IF(N.GE.NTENTH) GOTO 65 + IF(I.EQ.7.OR.I.EQ.1) GOTO 65 + FAC=(ONED-B)*F(I,NTENTH,M,iset)+B*F(I,NTENTH,M+1,iset) + G(I)=FAC**(G(I)/FAC) + 65 CONTINUE + G(I)=G(I)*(ONED-X)**N0(I) + 60 END DO +! UPBAR DISTRIBUTION = D DISTRIBUTION + UPV=G(2) + DNV=G(2) +! THIS SEA IS (UBAR+DBAR)/2 + SEA=G(4) + STR=G(6) + CHM=G(5) + GLU=G(3) + BOT=G(7) + X=XSAVE + RETURN + END diff --git a/LHAPDF/lhapdf-5.9.1/src/wrapusergrid.f b/LHAPDF/lhapdf-5.9.1/src/wrapusergrid.f new file mode 100644 index 00000000000..2df0b2d99fc --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/wrapusergrid.f @@ -0,0 +1,495 @@ + subroutine USERGRIDevolve(xin,qin,pdf) + implicit real*8 (a-h,o-z) + include 'parmsetup.inc' + double precision parm(nopmax) + character*16 name(nmxset) + integer nmem(nmxset),ndef(nmxset),mmem + common/NAME/name,nmem,ndef,mmem + CHARACTER*80 LINE + dimension pdf(-6:6) + integer init,set,i,j,k,l,nset,iset + parameter(nhess=0) + double precision fgrid(0:nhess,201,201,-6:6),grid(402) + double precision agrid(201),alfas,Qalfa + integer nacross,iparton(13) + logical NPARTON(-6:6) + common/ugrid/NUMX,NUMQ2,fgrid + double precision up,upv,dn,dnv,usea,dsea,str,chm,bot,glu + double precision qq(5),yntmp(5) + save + x=xin + q2=qin*qin + call getnset(iset) + upv = 0.0d0 + dnv = 0.0d0 + usea = 0.0d0 + dsea = 0.0d0 + str = 0.0d0 + sbar = 0.0d0 + chm = 0.0d0 + cbar = 0.0d0 + bot = 0.0d0 + bbar = 0.0d0 + top = 0.0d0 + tbar = 0.0d0 + glu = 0.0d0 + if(name(iset)(1:len_trim(name(iset))).eq.'USERGRIDQ4') then + ! HERE FOR QUARTIC POLYNOMIAL INTERPOLATION + do np = 1,npartons + if(iparton(np).eq.-6) tbar = USERGRIDQ4(x,Q2,grid,-6) + if(iparton(np).eq.-5) bbar = USERGRIDQ4(x,Q2,grid,-5) + if(iparton(np).eq.-4) cbar = USERGRIDQ4(x,Q2,grid,-4) + if(iparton(np).eq.-3) sbar = USERGRIDQ4(x,Q2,grid,-3) + if(iparton(np).eq.-2) usea = USERGRIDQ4(x,Q2,grid,-2) + if(iparton(np).eq.-1) dsea = USERGRIDQ4(x,Q2,grid,-1) + if(iparton(np).eq.0) glu = USERGRIDQ4(x,Q2,grid,0) + if(iparton(np).eq.1) dnv = USERGRIDQ4(x,Q2,grid,1) + if(iparton(np).eq.2) upv = USERGRIDQ4(x,Q2,grid,2) + if(iparton(np).eq.3) str = USERGRIDQ4(x,Q2,grid,3) + if(iparton(np).eq.4) chm = USERGRIDQ4(x,Q2,grid,4) + if(iparton(np).eq.5) bot = USERGRIDQ4(x,Q2,grid,5) + if(iparton(np).eq.6) top = USERGRIDQ4(x,Q2,grid,6) + enddo + else if(name(iset)(1:len_trim(name(iset))).eq.'USERGRIDQ3') then + ! HERE FOR CUBIC POLYNOMIAL INTERPOLATION + do np = 1,npartons + if(iparton(np).eq.-6) tbar = USERGRIDQ3(x,Q2,grid,-6) + if(iparton(np).eq.-5) bbar = USERGRIDQ3(x,Q2,grid,-5) + if(iparton(np).eq.-4) cbar = USERGRIDQ3(x,Q2,grid,-4) + if(iparton(np).eq.-3) sbar = USERGRIDQ3(x,Q2,grid,-3) + if(iparton(np).eq.-2) usea = USERGRIDQ3(x,Q2,grid,-2) + if(iparton(np).eq.-1) dsea = USERGRIDQ3(x,Q2,grid,-1) + if(iparton(np).eq.0) glu = USERGRIDQ3(x,Q2,grid,0) + if(iparton(np).eq.1) dnv = USERGRIDQ3(x,Q2,grid,1) + if(iparton(np).eq.2) upv = USERGRIDQ3(x,Q2,grid,2) + if(iparton(np).eq.3) str = USERGRIDQ3(x,Q2,grid,3) + if(iparton(np).eq.4) chm = USERGRIDQ3(x,Q2,grid,4) + if(iparton(np).eq.5) bot = USERGRIDQ3(x,Q2,grid,5) + if(iparton(np).eq.6) top = USERGRIDQ3(x,Q2,grid,6) + enddo + else if(name(iset)(1:len_trim(name(iset))).eq.'USERGRIDQ2') then + ! HERE FOR QUADRATIC POLYNOMIAL INTERPOLATION + do np = 1,npartons + if(iparton(np).eq.-6) tbar = USERGRIDQ2(x,Q2,grid,-6) + if(iparton(np).eq.-5) bbar = USERGRIDQ2(x,Q2,grid,-5) + if(iparton(np).eq.-4) cbar = USERGRIDQ2(x,Q2,grid,-4) + if(iparton(np).eq.-3) sbar = USERGRIDQ2(x,Q2,grid,-3) + if(iparton(np).eq.-2) usea = USERGRIDQ2(x,Q2,grid,-2) + if(iparton(np).eq.-1) dsea = USERGRIDQ2(x,Q2,grid,-1) + if(iparton(np).eq.0) glu = USERGRIDQ2(x,Q2,grid,0) + if(iparton(np).eq.1) dnv = USERGRIDQ2(x,Q2,grid,1) + if(iparton(np).eq.2) upv = USERGRIDQ2(x,Q2,grid,2) + if(iparton(np).eq.3) str = USERGRIDQ2(x,Q2,grid,3) + if(iparton(np).eq.4) chm = USERGRIDQ2(x,Q2,grid,4) + if(iparton(np).eq.5) bot = USERGRIDQ2(x,Q2,grid,5) + if(iparton(np).eq.6) top = USERGRIDQ2(x,Q2,grid,6) + enddo + else + print *,'Unknown interpolation method ', & + & name(iset)(1:len_trim(name(iset))),' called for!' + stop + endif + up = upv + usea + dn = dnv + dsea + + if(NPARTON(-6)) then + pdf(-6) = tbar + else + pdf(-6) = top + endif + pdf(6) = top + + if(NPARTON(-5)) then + pdf(-5) = bbar + else + pdf(-5) = bot + endif + pdf(5) = bot + + if(NPARTON(-4)) then + pdf(-4) = cbar + else + pdf(-4) = chm + endif + pdf(4) = chm + + if(NPARTON(-3)) then + pdf(-3) = sbar + else + pdf(-3) = str + endif + pdf(3) = str + pdf(-2) = usea + pdf(2) = up + pdf(-1) = dsea + pdf(1) = dn + pdf(0) = glu + return +! +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + entry USERGRIDread(nset) +! + call getnmem(nset,imem) + + read(1,*)nmem(nset),ndef(nset),NUMX,NUMQ2,nacross,npartons,(iparton(k),k=1,npartons) + + do np = -6,6 + NPARTON(np) = .FALSE. + enddo + + nnx = numx/nacross + nnq2 = numq2/nacross + + do iq=1,nnq2 + read(1,*) (grid(NUMX+(iq-1)*nacross+ii),ii=1,nacross) + enddo + + do jx=1,nnx + read(1,*) (grid((jx-1)*nacross+ii),ii=1,nacross) + enddo + + !read in to alphas grid + do iq=1,nnq2 + read(1,*) (agrid((iq-1)*nacross+ii),ii=1,nacross) + enddo + + do ns=0,nmem(nset) + do k = 1,npartons + NPARTON(iparton(k)) = .TRUE. + do IQ=1,NUMQ2 + do JX=1,nnx + read(1,*)(fgrid(ns,(jx-1)*nacross+ii,iq,iparton(k)),ii=1,nacross) + enddo + enddo + enddo + enddo + return +! +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + entry USERGRIDalfa(alfas,Qalfa) + q2 = Qalfa*Qalfa + nqlow = -1 + nqhi = NUMQ2+1 + do while (nqhi-nqlow.gt.1) + nqmid = (nqlow+nqhi)/2 + if(q2.ge.grid(NUMX+nqmid)) then + nqlow = nqmid + else + nqhi = nqmid + endif + enddo + ! do a linear interpolation on the alphas grid + npt = 2 + call userpolint(grid(NUMX+nqlow),agrid(nqlow),npt,q2,alfas,dy) + call getnset(iset) + call getnmem(iset,imem) + call listPDF(iset,imem,parm) + alfas=alfas*parm(1)/0.1176d0 + return +! +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + entry USERGRIDinit(Eorder,Q2fit) + return +! +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + entry USERGRIDpdf(mem) + imem = mem + call getnset(iset) + call setnmem(iset,imem) + return +! + 1000 format(5e13.5) + end +! +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +! attempt at polynomial (order 4) interpolation based on polint + double precision function USERGRIDQ4(x,Q2,grid,n) + implicit real*8(a-h,o-z) + integer iset,imem,nhess + parameter(nhess=0) + double precision grid(402),x,Q2 + double precision fgrid(0:nhess,201,201,-6:6) + double precision ya(5,5),yntmp(5),ymtmp(5) + common/ugrid/NUMX,NUMQ2,fgrid + + npt = 5 + call getnset(iset) + call getnmem(iset,imem) + +! find the x bins around x + nxlow = -1 + nxhi = NUMX+1 + do while (nxhi-nxlow.gt.1) + nxmid = (nxlow+nxhi)/2 + if(x.ge.grid(nxmid)) then + nxlow = nxmid + else + nxhi = nxmid + endif + enddo + +! find the q2 bins around q2 + nqlow = -1 + nqhi = NUMQ2+1 + do while (nqhi-nqlow.gt.1) + nqmid = (nqlow+nqhi)/2 + if(q2.ge.grid(NUMX+nqmid)) then + nqlow = nqmid + else + nqhi = nqmid + endif + enddo + +! fill the temp 4x4 funtion array (allowing for endpoints and extrapolation) + if(nxlow.le.0) nxlow=1 + if(nxlow.ge.NUMX) nxlow=NUMX-1 + if(nxlow.eq.1) then + nxbot = 1 + elseif(nxlow.eq.2) then + nxbot = 2 + else + if(nxlow.eq.NUMX-1) then + nxbot = 4 + else + nxbot = 3 + endif + endif + if(nqlow.le.0) nqlow=1 + if(nqlow.ge.NUMQ2) nqlow=NUMQ2-1 + if(nqlow.eq.1) then + nqbot = 1 + elseif(nqlow.eq.2) then + nqbot = 2 + else + if(nqlow.eq.NUMQ2-1) then + nqbot = 4 + else + nqbot = 3 + endif + endif + + do nx=1,5 + do nq=1,5 + ya(nx,nq) = fgrid(imem,nxlow+nx-nxbot,nqlow+nq-nqbot,n) + enddo + enddo + + do j=1,5 + do k=1,5 + yntmp(k)=ya(j,k) + enddo + call userpolint(grid(NUMX+nqlow-nqbot+1),yntmp,npt,q2,ymtmp(j),dy) + enddo + call userpolint(grid(nxlow-nxbot+1),ymtmp,npt,x,y,dy) + + usergridq4=y + + return + end +!========================================================= +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +! attempt at polynomial (order 3) interpolation based on polint + double precision function USERGRIDQ3(x,Q2,grid,n) + implicit real*8(a-h,o-z) + integer iset,imem,nhess + parameter(nhess=0) + double precision grid(402),x,Q2 + double precision fgrid(0:nhess,201,201,-6:6) + double precision ya(4,4),yntmp(4),ymtmp(4) + common/ugrid/NUMX,NUMQ2,fgrid + + npt = 4 + call getnset(iset) + call getnmem(iset,imem) + +! find the x bins around x + nxlow = -1 + nxhi = NUMX+1 + do while (nxhi-nxlow.gt.1) + nxmid = (nxlow+nxhi)/2 + if(x.ge.grid(nxmid)) then + nxlow = nxmid + else + nxhi = nxmid + endif + enddo + +! find the q2 bins around q2 + nqlow = -1 + nqhi = NUMQ2+1 + do while (nqhi-nqlow.gt.1) + nqmid = (nqlow+nqhi)/2 + if(q2.ge.grid(NUMX+nqmid)) then + nqlow = nqmid + else + nqhi = nqmid + endif + enddo + +! fill the temp 4x4 funtion array (allowing for endpoints and extrapolation) + if(nxlow.le.0) nxlow=1 + if(nxlow.ge.NUMX) nxlow=NUMX-1 + if(nxlow.eq.1) then + nxbot = 1 + else + if(nxlow.eq.NUMX-1) then + nxbot = 3 + else + nxbot = 2 + endif + endif + if(nqlow.le.0) nqlow=1 + if(nqlow.ge.NUMQ2) nqlow=NUMQ2-1 + if(nqlow.eq.1) then + nqbot = 1 + else + if(nqlow.eq.NUMQ2-1) then + nqbot = 3 + else + nqbot = 2 + endif + endif + + do nx=1,4 + do nq=1,4 + ya(nx,nq) = fgrid(imem,nxlow+nx-nxbot,nqlow+nq-nqbot,n) + enddo + enddo + + do j=1,4 + do k=1,4 + yntmp(k)=ya(j,k) + enddo + call userpolint(grid(NUMX+nqlow-nqbot+1),yntmp,npt,q2,ymtmp(j),dy) + enddo + call userpolint(grid(nxlow-nxbot+1),ymtmp,npt,x,y,dy) + + usergridq3=y + + return + end +!========================================================= +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +! attempt at polynomial (order 2) interpolation based on polint + double precision function USERGRIDQ2(x,Q2,grid,n) + implicit real*8(a-h,o-z) + integer iset,imem,nhess + parameter(nhess=0) + double precision grid(402),x,Q2 + double precision fgrid(0:nhess,201,201,-6:6) + double precision ya(3,3),yntmp(3),ymtmp(3) + common/ugrid/NUMX,NUMQ2,fgrid + + npt = 3 + call getnset(iset) + call getnmem(iset,imem) + +! find the x bins around x + nxlow = -1 + nxhi = NUMX+1 + do while (nxhi-nxlow.gt.1) + nxmid = (nxlow+nxhi)/2 + if(x.ge.grid(nxmid)) then + nxlow = nxmid + else + nxhi = nxmid + endif + enddo + +! find the q2 bins around q2 + nqlow = -1 + nqhi = NUMQ2+1 + do while (nqhi-nqlow.gt.1) + nqmid = (nqlow+nqhi)/2 + if(q2.ge.grid(NUMX+nqmid)) then + nqlow = nqmid + else + nqhi = nqmid + endif + enddo + +! fill the temp 4x4 funtion array (allowing for endpoints and extrapolation) + if(nxlow.le.0) nxlow=1 + if(nxlow.ge.NUMX) nxlow=NUMX-1 + if(nxlow.eq.1) then + nxbot = 1 + else + if(nxlow.eq.NUMX-1) then + nxbot = 2 + else + nxbot = 1 + endif + endif + if(nqlow.le.0) nqlow=1 + if(nqlow.ge.NUMQ2) nqlow=NUMQ2-1 + if(nqlow.eq.1) then + nqbot = 1 + else + if(nqlow.eq.NUMQ2-1) then + nqbot = 2 + else + nqbot = 1 + endif + endif + + do nx=1,3 + do nq=1,3 + ya(nx,nq) = fgrid(imem,nxlow+nx-nxbot,nqlow+nq-nqbot,n) + enddo + enddo + + do j=1,3 + do k=1,3 + yntmp(k)=ya(j,k) + enddo + call userpolint(grid(NUMX+nqlow-nqbot+1),yntmp,npt,q2,ymtmp(j),dy) + enddo + call userpolint(grid(nxlow-nxbot+1),ymtmp,npt,x,y,dy) + + usergridq2=y + + return + end +!========================================================= + + SUBROUTINE USERPOLINT (XA,YA,N,X,Y,DY) + + IMPLICIT DOUBLE PRECISION (A-H, O-Z) +! Adapted from "Numerical Recipes" + PARAMETER (NMAX=10) + DIMENSION XA(N),YA(N),C(NMAX),D(NMAX) + NS=1 + DIF=ABS(X-XA(1)) + DO 11 I=1,N + DIFT=ABS(X-XA(I)) + IF (DIFT.LT.DIF) THEN + NS=I + DIF=DIFT + ENDIF + C(I)=YA(I) + D(I)=YA(I) +11 CONTINUE + Y=YA(NS) + NS=NS-1 + DO 13 M=1,N-1 + DO 12 I=1,N-M + HO=XA(I)-X + HP=XA(I+M)-X + W=C(I+1)-D(I) + DEN=HO-HP + IF(DEN.EQ.0.) RETURN + DEN=W/DEN + D(I)=HP*DEN + C(I)=HO*DEN +12 CONTINUE + IF (2*NS.LT.N-M)THEN + DY=C(NS+1) + ELSE + DY=D(NS) + NS=NS-1 + ENDIF + Y=Y+DY +13 CONTINUE + RETURN + END +!========================================================= diff --git a/LHAPDF/lhapdf-5.9.1/src/wrapwhitg.f b/LHAPDF/lhapdf-5.9.1/src/wrapwhitg.f new file mode 100644 index 00000000000..7c9ce6a7c22 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/wrapwhitg.f @@ -0,0 +1,2126 @@ +! -*- F90 -*- + + + subroutine WHITGevolvep(xin,qin,p2in,ip2in,pdf) + include 'parmsetup.inc' + real*8 xin,qin,q2in,p2in,pdf(-6:6),xval(45),qcdl4,qcdl5 + real*8 upv,dnv,usea,dsea,str,chm,bot,top,glu + character*16 name(nmxset) + integer nmem(nmxset),ndef(nmxset),mmem + common/NAME/name,nmem,ndef,mmem + integer nset + + save + call getnset(iset) + call getnmem(iset,imem) + + if(imem.eq.1.or.imem.eq.0) then + call SFWHI1(xin,qin,upv,dnv,usea,dsea,str,chm,glu) + + elseif(imem.eq.2) then + call SFWHI2(xin,qin,upv,dnv,usea,dsea,str,chm,glu) + + elseif(imem.eq.3) then + call SFWHI3(xin,qin,upv,dnv,usea,dsea,str,chm,glu) + + elseif(imem.eq.4) then + call SFWHI4(xin,qin,upv,dnv,usea,dsea,str,chm,glu) + + elseif(imem.eq.5) then + call SFWHI5(xin,qin,upv,dnv,usea,dsea,str,chm,glu) + + elseif(imem.eq.6) then + call SFWHI6(xin,qin,upv,dnv,usea,dsea,str,chm,glu) + + else + CONTINUE + endif + + pdf(-6)= 0.0d0 + pdf(6)= 0.0d0 + pdf(-5)= 0.0d0 + pdf(5 )= 0.0d0 + pdf(-4)= chm + pdf(4 )= chm + pdf(-3)= str + pdf(3 )= str + pdf(-2)= usea + pdf(2 )= upv + pdf(-1)= dsea + pdf(1 )= dnv + pdf(0 )= glu + + return +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + entry WHITGread(nset) + read(1,*)nmem(nset),ndef(nset) + return +! +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + entry WHITGalfa(alfas,qalfa) + call getnset(iset) + call getnmem(iset,imem) + call GetOrderAsM(iset,iord) + call Getlam4M(iset,imem,qcdl4) + call Getlam5M(iset,imem,qcdl5) + call aspdflib(alfas,Qalfa,iord,qcdl5) + + return +! +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + entry WHITGinit(Eorder,Q2fit) + return +! +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + entry WHITGpdf(mem) + call getnset(iset) + call setnmem(iset,mem) +! imem = mem + return +! + 1000 format(5e13.5) + END +!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +!------------------------------------------------------- + subroutine SFWHI1(ZX,ZQ,ZUV,ZDV,ZUB,ZDB,ZSB,ZCB,ZGL) +!------------------------------------------------------- +! WHIT1 parton distribution in the photon +! +! INPUT: integer ic : if ic=0 then qc=0 +! else qc is calculated +! DOUBLE PRECISION Q2 : energy scale Q^2 (GeV^2) +! DOUBLE PRECISION x : energy fraction +! +! OUTPUT: DOUBLE PRECISION qu : up-quark dist. +! DOUBLE PRECISION qd : down- or strange-quark dist. +! DOUBLE PRECISION qc : charm-quark dist. +! DOUBLE PRECISION g : gluon dist. +!------------------------------------------------------- +! Modified by M.Tanaka on July 22, 1994. +! The bug pointed out by M.Drees is fixed. +!------------------------------------------------------- +! Modified by I.Watanabe on July 22, 1994. +!------------------------------------------------------- + implicit none + external WHIT1G + double precision & + & ZX,ZQ,ZUV,ZDV,ZUB,ZDB,ZSB,ZCB,ZGL +! arg + integer ic + DOUBLE PRECISION Q2,x + DOUBLE PRECISION qu,qd,qc,g +! const + DOUBLE PRECISION q42it,q52it,lam42,lam52 + DOUBLE PRECISION alinv,mc,PI +! local + DOUBLE PRECISION qv,qsea,cv,cs,dcv,dcs + DOUBLE PRECISION A0val,A1val,A2val,Bval,Cval, & + & A0sea,B0sea,BB0sea,C0sea + DOUBLE PRECISION A0dcv,A1dcv,A2dcv,A3dcv,Bdcv,Cdcv + DOUBLE PRECISION Adcs, B0dcs, B1dcs, Cdcs + DOUBLE PRECISION x1,x2,mc2q2 + DOUBLE PRECISION s,s2,s3,s4,prsccf,alstpi + DOUBLE PRECISION WHIT1G +! parameters + parameter(lam42=0.16d0, lam52=0.091411319d0) + parameter(Q42IT=4.0d0, Q52IT=100.0d0) + parameter(alinv=137.036d0, mc=1.5d0) + parameter(pi=3.14159265358979323846d0) + common /scale/ s,s2,s3,s4,prsccf +! +! begin + x=ZX + Q2=ZQ*ZQ + ic=1 +! + x1=1.0d0-x + x2=x**2 + mc2q2=mc**2/Q2 +! + if(Q2.lt.100.0d0) then +! under 100 GeV^2 +! +! set scale s + if(Q2.lt.4.0d0) then +!ccc for under 4GeV^2 prescription + s= 0.0d0 + prsccf = log(Q2/LAM42)/ log(Q42IT/LAM42) + alstpi = 6.0d0/25.0d0/ log(Q42IT/LAM42) + else + s= log( log(Q2/LAM42)/ log(Q42IT/LAM42)) + prsccf = 1.0d0 + alstpi = 6.0d0/25.0d0/ log(Q2/LAM42) + endif + s2=s**2 + s3=s2*s + s4=s2**2 +! +!ccccc WHIT1 quark (U100) +! + A0val= 1.882000d+00+s*( 1.213000d+00)+s2*( 6.970000d-01) + A1val= s*(-2.361000d+00)+s2*(-1.136000d+00) + A2val= s*( 5.280000d-01)+s2*( 2.406000d+00) + Bval = 5.000000d-01+s*( 2.107000d-02)+s2*( 4.130000d-03) + Cval = 2.500000d-01+s*(-2.376000d-01)+s2*( 2.018000d-01) & + & +s3*(-5.040000d-02) + A0sea= 6.510000d-01+s*( 1.291000d+00)+s2*(-4.470000d+00) & + & +s3*( 5.140000d+00)+s4*(-2.091000d+00) + B0sea=-3.820000d-02+s*( 9.010000d-02)+s2*(-1.356000d+00) & + & +s3*( 1.582000d+00)+s4*(-6.440000d-01) + BB0sea=2.084000d+00+s*( 7.740000d+00)+s2*(-2.970000d+01) & + & +s3*( 3.860000d+01)+s4*(-1.705000d+01) + C0sea= 7.000000d+00+s*(-1.608000d+01)+s2*( 4.670000d+01) & + & +s3*(-5.710000d+01)+s4*( 2.386000d+01) +! + qv = prsccf/alinv/x* & + & (A0val+A1val*x+A2val*x2) * x**Bval * x1**Cval + qsea= prsccf/alinv/x* & + & A0sea * x**(B0sea+BB0sea*x) * x1**C0sea +! + qu = qv/3.0d0 + qsea/6.0d0 + qu = qu*x + ZUV=qu + ZUB=qu + qd = qv/12.0d0 + qsea/6.0d0 + qd = qd*x + ZDV=qd + ZDB=qd + ZSB=qd +! + if((ic.ne.0) .and. (x*(1.0d0+4.0d0*mc2q2).lt.1.0d0)) then + call WHIT1Q(x,mc2q2,cv,cs) + qc = cv/alinv/2.0d0/PI + cs*alstpi + qc = qc*x + ZCB=qc + else + qc = 0.0d0 + ZCB=qc + endif +! + g = WHIT1G(x,Q2) + g = g*x + ZGL=g +! + else +! over 100 GeV^2 +! +! set scale s + s= log( log(Q2/LAM52)/ log(Q52IT/LAM52)) + prsccf = 1.0d0 + alstpi = 6.0d0/23.0d0/ log(Q2/LAM52) + s2=s**2 + s3=s2*s + s4=s2**2 +! +!ccccc WHIT1 quark (O100) +! + A0val= 3.058000d+00+s*( 2.474000d+00)+s2*( 1.002000d+00) + A1val=-2.182000d+00+s*(-4.480000d+00)+s2*(-2.251000d-01) + A2val= 1.522000d+00+s*( 4.310000d+00)+s2*( 1.314000d+00) + Bval = 5.170000d-01+s*( 4.040000d-02)+s2*(-2.100000d-02) + Cval = 1.655000d-01+s*(-2.062000d-02)+s2*( 5.360000d-02) + A0sea= 6.250000d-01+s*(-5.890000d-01)+s2*( 4.180000d+00) & + & +s3*(-1.206000d+01)+s4*( 1.257000d+01) + B0sea=-2.492000d-01+s*(-4.110000d-01)+s2*( 9.660000d-01) & + & +s3*(-2.584000d+00)+s4*( 2.670000d+00) + BB0sea=2.100000d+00+s*(-5.750000d+00)+s2*( 4.780000d+01) & + & +s3*(-1.407000d+02)+s4*( 1.476000d+02) + C0sea= 4.780000d+00+s*( 4.860000d+00)+s2*(-4.890000d+01) & + & +s3*( 1.477000d+02)+s4*(-1.602000d+02) +! + qv = 1.0d0/alinv/x* & + & (A0val+A1val*x+A2val*x2) * x**Bval * x1**Cval + qsea= 1.0d0/alinv/x* & + & A0sea * x**(B0sea+BB0sea*x) * x1**C0sea +! + qu = qv/3.0d0 + qsea/6.0d0 + qu = qu*x + ZUV=qu + ZUB=qu + qd = qv/12.0d0 + qsea/6.0d0 + qd = qd*x + ZDV=qd + ZDB=qd + ZSB=qd + g = WHIT1G(x,Q2) + g = g*x + ZGL=g +! + if((ic.ne.0) .and. (x*(1.0d0+4.0d0*mc2q2).lt.1.0d0)) then + A0dcv= s*( 1.219000d-01)+s2*( 6.200000d+00) & + & +s3*(-2.504000d+01)+s4*( 3.098000d+01) + A1dcv= s*( 1.913000d+00)+s2*(-7.690000d+01) & + & +s3*( 3.180000d+02)+s4*(-3.920000d+02) + A2dcv= s*(-7.160000d+00)+s2*( 2.503000d+02) & + & +s3*(-1.062000d+03)+s4*( 1.308000d+03) + A3dcv= s*( 3.190000d+00)+s2*(-2.301000d+02) & + & +s3*( 1.012000d+03)+s4*(-1.250000d+03) + Bdcv = 4.990000d-01+s*( 3.470000d+00)+s2*(-1.526000d+01) & + & +s3*( 1.967000d+01) + Cdcv = 3.290000d-01+s*( 8.240000d+00)+s2*(-3.800000d+01) & + & +s3*( 4.630000d+01) + Adcs = s*(-1.815000d-02)+s2*( 2.043000d-03) & + & +s3*(-4.130000d-03) + B0dcs=-3.086000d-01+s*(-2.565000d-01)+s2*( 9.840000d-02) + B1dcs= 1.376000d+00+s*(-4.630000d-01)+s2*( 1.232000d+00) + Cdcs = 3.650000d+00+s*( 7.290000d-01)+s2*(-7.570000d+00) & + & +s3*( 7.790000d+00) +! + dcv = 1.0d0/alinv/x* & + & (A0dcv+x*A1dcv+x2*A2dcv+x2*x*A3dcv) * x**Bdcv * x1**Cdcv + dcs = 1.0d0/alinv/x* & + & Adcs * x**(B0dcs+B1dcs*x) * x1**Cdcs +! + call WHIT1Q(x,mc*mc/Q2,cv,cs) + qc = cv/alinv/2.0d0/PI + cs*alstpi + dcs + dcv + qc = qc*x + ZCB=qc + else + qc = 0.0d0 + ZCB=qc + endif + endif +! + return + END +!------------------------------------------------------- + subroutine SFWHI2(ZX,ZQ,ZUV,ZDV,ZUB,ZDB,ZSB,ZCB,ZGL) +!------------------------------------------------------- +! WHIT2 parton distribution in the photon +! +! INPUT: integer ic : if ic=0 then qc=0 +! else qc is calculated +! DOUBLE PRECISION Q2 : energy scale Q^2 (GeV^2) +! DOUBLE PRECISION x : energy fraction +! +! OUTPUT: DOUBLE PRECISION qu : up-quark dist. +! DOUBLE PRECISION qd : down- or strange-quark dist. +! DOUBLE PRECISION qc : charm-quark dist. +! DOUBLE PRECISION g : gluon dist. +!------------------------------------------------------- +! Modified by M.Tanaka on July 22, 1994. +! The bug pointed out by M.Drees is fixed. +!------------------------------------------------------- +! Modified by I.Watanabe on July 22, 1994. +!------------------------------------------------------- + implicit none + external WHIT2G + double precision & + & ZX,ZQ,ZUV,ZDV,ZUB,ZDB,ZSB,ZCB,ZGL +! arg + integer ic + DOUBLE PRECISION Q2,x + DOUBLE PRECISION qu,qd,qc,g +! const + DOUBLE PRECISION q42it,q52it,lam42,lam52 + DOUBLE PRECISION alinv,mc,PI +! local + DOUBLE PRECISION qv,qsea,cv,cs,dcv,dcs + DOUBLE PRECISION A0val,A1val,A2val,Bval,Cval, & + & A0sea,B0sea,BB0sea,C0sea + DOUBLE PRECISION A0dcv,A1dcv,A2dcv,A3dcv,Bdcv,Cdcv + DOUBLE PRECISION Adcs, B0dcs, B1dcs, Cdcs + DOUBLE PRECISION x1,x2,mc2q2 + DOUBLE PRECISION s,s2,s3,s4,prsccf,alstpi + DOUBLE PRECISION WHIT2G +! parameters + parameter(lam42=0.16d0, lam52=0.091411319d0) + parameter(Q42IT=4.0d0, Q52IT=100.0d0) + parameter(alinv=137.036d0, mc=1.5d0) + parameter(pi=3.14159265358979323846d0) + common /scale/ s,s2,s3,s4,prsccf +! +! begin + x=ZX + Q2=ZQ*ZQ + ic=1 +! + x1=1.0d0-x + x2=x**2 + mc2q2=mc**2/Q2 +! + if(Q2.lt.100.0d0) then +! under 100 GeV^2 +! +! set scale s + if(Q2.lt.4.0d0) then +!ccc for under 4GeV^2 prescription + s= 0.0d0 + prsccf = log(Q2/LAM42)/ log(Q42IT/LAM42) + alstpi = 6.0d0/25.0d0/ log(Q42IT/LAM42) + else + s= log( log(Q2/LAM42)/ log(Q42IT/LAM42)) + prsccf = 1.0d0 + alstpi = 6.0d0/25.0d0/ log(Q2/LAM42) + endif + s2=s**2 + s3=s2*s + s4=s2**2 +! +!ccccc WHIT2 quark (U100) +! + A0val= 1.882000d+00+s*( 1.213000d+00)+s2*( 6.970000d-01) + A1val= s*(-2.361000d+00)+s2*(-1.136000d+00) + A2val= s*( 5.280000d-01)+s2*( 2.406000d+00) + Bval= 5.000000d-01+s*( 2.107000d-02)+s2*( 4.130000d-03) + Cval= 2.500000d-01+s*(-2.376000d-01)+s2*( 2.018000d-01) & + & +s3*(-5.040000d-02) + A0sea= 1.237000d+00+s*( 3.390000d+00)+s2*(-1.075000d+01) & + & +s3*( 1.246000d+01)+s4*(-5.580000d+00) + B0sea=-7.270000d-02+s*( 1.748000d-01)+s2*(-1.392000d+00) & + & +s3*( 1.711000d+00)+s4*(-7.960000d-01) + BB0sea=4.290000d+00+s*( 1.787000d+01)+s2*(-5.810000d+01) & + & +s3*( 8.190000d+01)+s4*(-4.140000d+01) + C0sea= 1.434000d+01+s*(-4.490000d+01)+s2*( 1.197000d+02) & + & +s3*(-1.585000d+02)+s4*( 7.530000d+01) +! + qv = prsccf/alinv/x* & + & (A0val+A1val*x+A2val*x2) * x**Bval * x1**Cval + qsea= prsccf/alinv/x* & + & A0sea * x**(B0sea+BB0sea*x) * x1**C0sea +! + qu = qv/3.0d0 + qsea/6.0d0 + qu = qu*x + ZUV=qu + ZUB=qu + qd = qv/12.0d0 + qsea/6.0d0 + qd = qd*x + ZDV=qd + ZDB=qd + ZSB=qd +! + if((ic.ne.0) .and. (x*(1.0d0+4.0d0*mc2q2).lt.1.0d0)) then + call WHIT2Q(x,mc2q2,cv,cs) + qc = cv/alinv/2.0d0/PI + cs*alstpi + qc = qc*x + ZCB=qc + else + qc = 0.0d0 + ZCB=qc + endif +! + g = WHIT2G(x,Q2) + g = g*x + ZGL=g +! + else +! over 100 GeV^2 +! +! set scale s + s= log( log(Q2/LAM52)/ log(Q52IT/LAM52)) + prsccf = 1.0d0 + alstpi = 6.0d0/23.0d0/ log(Q2/LAM52) + s2=s**2 + s3=s2*s + s4=s2**2 +! +!ccccc WHIT2 quark (O100) +! + A0val= 3.058000d+00+s*( 2.474000d+00)+s2*( 1.002000d+00) + A1val=-2.182000d+00+s*(-4.480000d+00)+s2*(-2.259000d-01) + A2val= 1.522000d+00+s*( 4.300000d+00)+s2*( 1.315000d+00) + Bval = 5.170000d-01+s*( 4.030000d-02)+s2*(-2.098000d-02) + Cval = 1.655000d-01+s*(-2.063000d-02)+s2*( 5.370000d-02) + A0sea= 1.287000d+00+s*(-2.069000d+00)+s2*( 1.157000d+01) & + & +s3*(-3.570000d+01)+s4*( 3.740000d+01) + B0sea=-2.340000d-01+s*(-4.430000d-01)+s2*( 1.235000d+00) & + & +s3*(-3.720000d+00)+s4*( 3.840000d+00) + BB0sea=6.460000d+00+s*(-1.048000d+01)+s2*( 8.980000d+01) & + & +s3*(-2.847000d+02)+s4*( 2.998000d+02) + C0sea= 5.350000d+00+s*( 1.011000d+01)+s2*(-1.337000d+02) & + & +s3*( 4.270000d+02)+s4*(-4.570000d+02) +! + qv = 1.0d0/alinv/x* & + & (A0val+A1val*x+A2val*x2) * x**Bval * x1**Cval + qsea= 1.0d0/alinv/x* & + & A0sea * x**(B0sea+BB0sea*x) * x1**C0sea +! + qu = qv/3.0d0 + qsea/6.0d0 + qu = qu*x + ZUV=qu + ZUB=qu + qd = qv/12.0d0 + qsea/6.0d0 + qd = qd*x + ZDV=qd + ZDB=qd + ZSB=qd + g = WHIT2G(x,Q2) + g = g*x + ZGL=g +! + if((ic.ne.0) .and. (x*(1.0d0+4.0d0*mc2q2).lt.1.0d0)) then + A0dcv= s*( 1.219000d-01)+s2*( 6.200000d+00) & + & +s3*(-2.504000d+01)+s4*( 3.098000d+01) + A1dcv= s*( 1.913000d+00)+s2*(-7.690000d+01) & + & +s3*( 3.180000d+02)+s4*(-3.920000d+02) + A2dcv= s*(-7.160000d+00)+s2*( 2.503000d+02) & + & +s3*(-1.062000d+03)+s4*( 1.308000d+03) + A3dcv= s*( 3.190000d+00)+s2*(-2.301000d+02) & + & +s3*( 1.012000d+03)+s4*(-1.250000d+03) + Bdcv = 4.990000d-01+s*( 3.470000d+00)+s2*(-1.526000d+01) & + & +s3*( 1.967000d+01) + Cdcv = 3.290000d-01+s*( 8.240000d+00)+s2*(-3.800000d+01) & + & +s3*( 4.630000d+01) + Adcs = s*(-2.786000d-02)+s2*( 3.490000d-02) & + & +s3*(-2.223000d-02) + B0dcs=-3.141000d-01+s*(-4.250000d-01)+s2*( 1.564000d-01) + B1dcs= 4.720000d+00+s*(-5.480000d+00)+s2*( 2.686000d+00) + Cdcs = 2.961000d+00+s*( 7.760000d-01)+s2*(-8.280000d+00) & + & +s3*( 9.780000d+00) +! + dcv = 1.0d0/alinv/x* & + & (A0dcv+x*A1dcv+x2*A2dcv+x2*x*A3dcv) * x**Bdcv * x1**Cdcv + dcs = 1.0d0/alinv/x* & + & Adcs * x**(B0dcs+B1dcs*x) * x1**Cdcs +! + call WHIT2Q(x,mc*mc/Q2,cv,cs) + qc = cv/alinv/2.0d0/PI + cs*alstpi + dcs + dcv + qc = qc*x + ZCB=qc + else + qc = 0.0d0 + ZCB=qc + endif + endif +! + return + END +!------------------------------------------------------- + subroutine SFWHI3(ZX,ZQ,ZUV,ZDV,ZUB,ZDB,ZSB,ZCB,ZGL) +!------------------------------------------------------- +! WHIT3 parton distribution in the photon +! +! INPUT: integer ic : if ic=0 then qc=0 +! else qc is calculated +! DOUBLE PRECISION Q2 : energy scale Q^2 (GeV^2) +! DOUBLE PRECISION x : energy fraction +! +! OUTPUT: DOUBLE PRECISION qu : up-quark dist. +! DOUBLE PRECISION qd : down- or strange-quark dist. +! DOUBLE PRECISION qc : charm-quark dist. +! DOUBLE PRECISION g : gluon dist. +!------------------------------------------------------- +! Modified by M.Tanaka on July 22, 1994. +! The bug pointed out by M.Drees is fixed. +!------------------------------------------------------- +! Modified by I.Watanabe on July 22, 1994. +!------------------------------------------------------- + implicit none + external whit3g + double precision & + & ZX,ZQ,ZUV,ZDV,ZUB,ZDB,ZSB,ZCB,ZGL +! arg + integer ic + DOUBLE PRECISION Q2,x + DOUBLE PRECISION qu,qd,qc,g +! const + DOUBLE PRECISION q42it,q52it,lam42,lam52 + DOUBLE PRECISION alinv,mc,PI +! local + DOUBLE PRECISION qv,qsea,cv,cs,dcv,dcs + DOUBLE PRECISION A0val,A1val,A2val,Bval,Cval, & + & A0sea,B0sea,BB0sea,C0sea + DOUBLE PRECISION A0dcv,A1dcv,A2dcv,A3dcv,Bdcv,Cdcv + DOUBLE PRECISION Adcs, B0dcs, B1dcs, Cdcs + DOUBLE PRECISION x1,x2,mc2q2 + DOUBLE PRECISION s,s2,s3,s4,prsccf,alstpi + DOUBLE PRECISION WHIT3g +! parameters + parameter(lam42=0.16d0, lam52=0.091411319d0) + parameter(Q42IT=4.0d0, Q52IT=100.0d0) + parameter(alinv=137.036d0, mc=1.5d0) + parameter(pi=3.14159265358979323846d0) + common /scale/ s,s2,s3,s4,prsccf +! +! begin + x=ZX + Q2=ZQ*ZQ + ic=1 +! + x1=1.0d0-x + x2=x**2 + mc2q2=mc**2/Q2 +! + if(Q2.lt.100.0d0) then +! under 100 GeV^2 +! +! set scale s + if(Q2.lt.4.0d0) then +!ccc for under 4GeV^2 prescription + s= 0.0d0 + prsccf = log(Q2/LAM42)/ log(Q42IT/LAM42) + alstpi = 6.0d0/25.0d0/ log(Q42IT/LAM42) + else + s= log( log(Q2/LAM42)/ log(Q42IT/LAM42)) + prsccf = 1.0d0 + alstpi = 6.0d0/25.0d0/ log(Q2/LAM42) + endif + s2=s**2 + s3=s2*s + s4=s2**2 +! +!ccccc WHIT3 quark (U100) +! + A0val= 1.882000d+00+s*( 1.213000d+00)+s2*( 6.970000d-01) + A1val= s*(-2.361000d+00)+s2*(-1.136000d+00) + A2val= s*( 5.280000d-01)+s2*( 2.406000d+00) + Bval = 5.000000d-01+s*( 2.107000d-02)+s2*( 4.130000d-03) + Cval = 2.500000d-01+s*(-2.376000d-01)+s2*( 2.018000d-01) & + & +s3*(-5.040000d-02) + A0sea= 1.587000d+00+s*( 5.050000d+00)+s2*(-1.126000d+01) & + & +s3*( 7.560000d+00)+s4*(-1.471000d+00) + B0sea=-1.006000d-01+s*( 2.259000d-01)+s2*(-1.195000d+00) & + & +s3*( 1.175000d+00)+s4*(-4.460000d-01) + BB0sea=5.730000d+00+s*( 2.564000d+01)+s2*(-5.870000d+01) & + & +s3*( 6.320000d+01)+s4*(-2.577000d+01) + C0sea= 2.136000d+01+s*(-7.290000d+01)+s2*( 1.532000d+02) & + & +s3*(-1.679000d+02)+s4*( 6.740000d+01) +! + qv = prsccf/alinv/x* & + & (A0val+A1val*x+A2val*x2) * x**Bval * x1**Cval + qsea= prsccf/alinv/x* & + & A0sea * x**(B0sea+BB0sea*x) * x1**C0sea +! + qu = qv/3.0d0 + qsea/6.0d0 + qu = qu*x + ZUV=qu + ZUB=qu + qd = qv/12.0d0 + qsea/6.0d0 + qd = qd*x + ZDV=qd + ZDB=qd + ZSB=qd +! + if((ic.ne.0) .and. (x*(1.0d0+4.0d0*mc2q2).lt.1.0d0)) then + call WHIT3Q(x,mc2q2,cv,cs) + qc = cv/alinv/2.0d0/PI + cs*alstpi + qc = qc*x + ZCB=qc + else + qc = 0.0d0 + ZCB=qc + endif +! + g = WHIT3G(x,Q2) + g = g*x + ZGL=g +! + else +! over 100 GeV^2 +! +! set scale s + s= log( log(Q2/LAM52)/ log(Q52IT/LAM52)) + prsccf = 1.0d0 + alstpi = 6.0d0/23.0d0/ log(Q2/LAM52) + s2=s**2 + s3=s2*s + s4=s2**2 +! +!ccccc WHIT3 quark (O100) +! + A0val= 3.058000d+00+s*( 2.474000d+00)+s2*( 1.002000d+00) + A1val=-2.182000d+00+s*(-4.480000d+00)+s2*(-2.264000d-01) + A2val= 1.522000d+00+s*( 4.300000d+00)+s2*( 1.315000d+00) + Bval = 5.170000d-01+s*( 4.030000d-02)+s2*(-2.097000d-02) + Cval = 1.655000d-01+s*(-2.064000d-02)+s2*( 5.370000d-02) + A0sea= 1.850000d+00+s*(-3.670000d+00)+s2*( 2.714000d+01) & + & +s3*(-1.066000d+02)+s4*( 1.309000d+02) + B0sea=-2.299000d-01+s*(-4.970000d-01)+s2*( 2.464000d+00) & + & +s3*(-9.950000d+00)+s4*( 1.232000d+01) + BB0sea=1.042000d+01+s*(-1.074000d+01)+s2*( 1.327000d+02) & + & +s3*(-5.390000d+02)+s4*( 6.560000d+02) + C0sea= 4.070000d+00+s*( 4.110000d+00)+s2*(-1.719000d+02) & + & +s3*( 7.070000d+02)+s4*(-8.590000d+02) +! + qv = 1.0d0/alinv/x* & + & (A0val+A1val*x+A2val*x2) * x**Bval * x1**Cval + qsea= 1.0d0/alinv/x* & + & A0sea * x**(B0sea+BB0sea*x) * x1**C0sea +! + qu = qv/3.0d0 + qsea/6.0d0 + qu = qu*x + ZUV=qu + ZUB=qu + qd = qv/12.0d0 + qsea/6.0d0 + qd = qd*x + ZDV=qd + ZDB=qd + ZSB=qd + g = WHIT3G(x,Q2) + g = g*x + ZGL=g +! + if((ic.ne.0) .and. (x*(1.0d0+4.0d0*mc2q2).lt.1.0d0)) then + A0dcv= s*( 1.219000d-01)+s2*( 6.200000d+00) & + & +s3*(-2.504000d+01)+s4*( 3.098000d+01) + A1dcv= s*( 1.913000d+00)+s2*(-7.690000d+01) & + & +s3*( 3.180000d+02)+s4*(-3.920000d+02) + A2dcv= s*(-7.160000d+00)+s2*( 2.503000d+02) & + & +s3*(-1.062000d+03)+s4*( 1.308000d+03) + A3dcv= s*( 3.190000d+00)+s2*(-2.301000d+02) & + & +s3*( 1.012000d+03)+s4*(-1.250000d+03) + Bdcv = 4.990000d-01+s*( 3.470000d+00)+s2*(-1.526000d+01) & + & +s3*( 1.967000d+01) + Cdcv = 3.290000d-01+s*( 8.240000d+00)+s2*(-3.800000d+01) & + & +s3*( 4.630000d+01) + Adcs = s*(-1.948000d-02)+s2*( 2.861000d-02) & + & +s3*(-2.036000d-02) + B0dcs=-4.130000d-01+s*(-4.390000d-01)+s2*( 1.810000d-01) + B1dcs= 5.190000d+00+s*(-7.400000d+00)+s2*( 3.400000d+00) + Cdcs = 2.359000d+00+s*( 9.770000d-01)+s2*(-7.730000d+00) & + & +s3*( 9.480000d+00) +! + dcv = 1.0d0/alinv/x* & + & (A0dcv+x*A1dcv+x2*A2dcv+x2*x*A3dcv) * x**Bdcv * x1**Cdcv + dcs = 1.0d0/alinv/x* & + & Adcs * x**(B0dcs+B1dcs*x) * x1**Cdcs +! + call WHIT3Q(x,mc*mc/Q2,cv,cs) + qc = cv/alinv/2.0d0/PI + cs*alstpi + dcs + dcv + qc = qc*x + ZCB=qc + else + qc = 0.0d0 + ZCB=qc + endif + endif +! + return + END +!------------------------------------------------------- + subroutine SFWHI4(ZX,ZQ,ZUV,ZDV,ZUB,ZDB,ZSB,ZCB,ZGL) +!------------------------------------------------------- +! WHIT4 parton distribution in the photon +! +! INPUT: integer ic : if ic=0 then qc=0 +! else qc is calculated +! DOUBLE PRECISION Q2 : energy scale Q^2 (GeV^2) +! DOUBLE PRECISION x : energy fraction +! +! OUTPUT: DOUBLE PRECISION qu : up-quark dist. +! DOUBLE PRECISION qd : down- or strange-quark dist. +! DOUBLE PRECISION qc : charm-quark dist. +! DOUBLE PRECISION g : gluon dist. +!------------------------------------------------------- +! Modified by M.Tanaka on July 22, 1994. +! The bug pointed out by M.Drees is fixed. +!------------------------------------------------------- +! Modified by I.Watanabe on July 22, 1994. +!------------------------------------------------------- + implicit none + external WHIT4G + double precision & + & ZX,ZQ,ZUV,ZDV,ZUB,ZDB,ZSB,ZCB,ZGL +! arg + integer ic + DOUBLE PRECISION Q2,x + DOUBLE PRECISION qu,qd,qc,g +! const + DOUBLE PRECISION q42it,q52it,lam42,lam52 + DOUBLE PRECISION alinv,mc,PI +! local + DOUBLE PRECISION qv,qsea,cv,cs,dcv,dcs + DOUBLE PRECISION A0val,A1val,A2val,Bval,Cval, & + & A0sea,B0sea,BB0sea,C0sea + DOUBLE PRECISION A0dcv,A1dcv,A2dcv,A3dcv,Bdcv,Cdcv + DOUBLE PRECISION Adcs, B0dcs, B1dcs, Cdcs + DOUBLE PRECISION x1,x2,mc2q2 + DOUBLE PRECISION s,s2,s3,s4,prsccf,alstpi + DOUBLE PRECISION WHIT4G +! parameters + parameter(lam42=0.16d0, lam52=0.091411319d0) + parameter(Q42IT=4.0d0, Q52IT=100.0d0) + parameter(alinv=137.036d0, mc=1.5d0) + parameter(pi=3.14159265358979323846d0) + common /scale/ s,s2,s3,s4,prsccf +! +! begin + x=ZX + Q2=ZQ*ZQ + ic=1 +! + x1=1.0d0-x + x2=x**2 + mc2q2=mc**2/Q2 +! + if(Q2.lt.100.0d0) then +! under 100 GeV^2 +! +! set scale s + if(Q2.lt.4.0d0) then +!ccc for under 4GeV^2 prescription + s= 0.0d0 + prsccf = log(Q2/LAM42)/ log(Q42IT/LAM42) + alstpi = 6.0d0/25.0d0/ log(Q42IT/LAM42) + else + s= log( log(Q2/LAM42)/ log(Q42IT/LAM42)) + prsccf = 1.0d0 + alstpi = 6.0d0/25.0d0/ log(Q2/LAM42) + endif + s2=s**2 + s3=s2*s + s4=s2**2 +! +!ccccc WHIT4 quark (U100) +! + A0val= 2.540000d+00+s*( 2.000000d+00)+s2*( 7.180000d-01) + A1val= 6.230000d-02+s*(-7.010000d+00)+s2*( 1.251000d-01) + A2val=-1.642000d-01+s*(-4.360000d-01)+s2*( 1.048000d+01) & + & +s3*(-5.200000d+00) + Bval = 6.990000d-01+s*(-2.796000d-02)+s2*(-3.650000d-03) + Cval = 4.420000d-01+s*(-1.255000d+00)+s2*( 1.941000d+00) & + & +s3*(-9.950000d-01) + A0sea= 1.308000d+00+s*( 2.315000d+00)+s2*(-7.880000d+00) & + & +s3*( 8.260000d+00)+s4*(-3.004000d+00) + B0sea=-3.730000d-02+s*( 5.630000d-02)+s2*(-1.133000d+00) & + & +s3*( 1.185000d+00)+s4*(-4.180000d-01) + BB0sea=2.103000d+00+s*( 4.850000d+00)+s2*(-1.781000d+01) & + & +s3*( 2.062000d+01)+s4*(-7.940000d+00) + C0sea= 7.000000d+00+s*(-1.017000d+01)+s2*( 2.600000d+01) & + & +s3*(-2.960000d+01)+s4*( 1.227000d+01) +! + qv = prsccf/alinv/x* & + & (A0val+A1val*x+A2val*x2) * x**Bval * x1**Cval + qsea= prsccf/alinv/x* & + & A0sea * x**(B0sea+BB0sea*x) * x1**C0sea +! + qu = qv/3.0d0 + qsea/6.0d0 + qu = qu*x + ZUV=qu + ZUB=qu + qd = qv/12.0d0 + qsea/6.0d0 + qd = qd*x + ZDV=qd + ZDB=qd + ZSB=qd +! + if((ic.ne.0) .and. (x*(1.0d0+4.0d0*mc2q2).lt.1.0d0)) then + call WHIT4Q(x,mc2q2,cv,cs) + qc = cv/alinv/2.0d0/PI + cs*alstpi + qc = qc*x + ZCB=qc + else + qc = 0.0d0 + ZCB=qc + endif +! + g = WHIT4G(x,Q2) + g = g*x + ZGL=g +! + else +! over 100 GeV^2 +! +! set scale s + s= log( log(Q2/LAM52)/ log(Q52IT/LAM52)) + prsccf = 1.0d0 + alstpi = 6.0d0/23.0d0/ log(Q2/LAM52) + s2=s**2 + s3=s2*s + s4=s2**2 +! +!ccccc WHIT4 quark (O100) +! + A0val= 4.270000d+00+s*( 3.096000d+00)+s2*( 1.619000d+00) + A1val=-4.740000d+00+s*(-6.900000d+00)+s2*(-2.430000d+00) + A2val= 2.837000d+00+s*( 6.470000d+00)+s2*( 4.090000d+00) + Bval = 6.780000d-01+s*(-3.940000d-02)+s2*( 1.756000d-02) + Cval = 1.728000d-01+s*(-2.479000d-02)+s2*( 1.446000d-01) + A0sea= 1.188000d+00+s*(-1.396000d+00)+s2*( 8.710000d+00) & + & +s3*(-2.542000d+01)+s4*( 2.492000d+01) + B0sea=-2.448000d-01+s*(-4.190000d-01)+s2*( 1.007000d+00) & + & +s3*(-2.689000d+00)+s4*( 2.517000d+00) + BB0sea=1.942000d+00+s*(-6.040000d+00)+s2*( 5.030000d+01) & + & +s3*(-1.478000d+02)+s4*( 1.481000d+02) + C0sea= 5.420000d+00+s*( 6.110000d+00)+s2*(-5.380000d+01) & + & +s3*( 1.632000d+02)+s4*(-1.716000d+02) +! + qv = 1.0d0/alinv/x* & + & (A0val+A1val*x+A2val*x2) * x**Bval * x1**Cval + qsea= 1.0d0/alinv/x* & + & A0sea * x**(B0sea+BB0sea*x) * x1**C0sea +! + qu = qv/3.0d0 + qsea/6.0d0 + qu = qu*x + ZUV=qu + ZUB=qu + qd = qv/12.0d0 + qsea/6.0d0 + qd = qd*x + ZDV=qd + ZDB=qd + ZSB=qd + g = WHIT4G(x,Q2) + g = g*x + ZGL=g +! + if((ic.ne.0) .and. (x*(1.0d0+4.0d0*mc2q2).lt.1.0d0)) then + A0dcv= s*( 1.219000d-01)+s2*( 6.200000d+00) & + & +s3*(-2.504000d+01)+s4*( 3.098000d+01) + A1dcv= s*( 1.913000d+00)+s2*(-7.690000d+01) & + & +s3*( 3.180000d+02)+s4*(-3.920000d+02) + A2dcv= s*(-7.160000d+00)+s2*( 2.503000d+02) & + & +s3*(-1.062000d+03)+s4*( 1.308000d+03) + A3dcv= s*( 3.190000d+00)+s2*(-2.301000d+02) & + & +s3*( 1.012000d+03)+s4*(-1.250000d+03) + Bdcv = 4.990000d-01+s*( 3.470000d+00)+s2*(-1.526000d+01) & + & +s3*( 1.967000d+01) + Cdcv = 3.290000d-01+s*( 8.240000d+00)+s2*(-3.800000d+01) & + & +s3*( 4.630000d+01) + Adcs = s*(-2.821000d-02)+s2*(-2.649000d-04) & + & +s3*( 7.040000d-03) + B0dcs=-3.270000d-01+s*(-2.298000d-01)+s2*( 3.500000d-02) + B1dcs= 1.254000d+00+s*( 8.780000d-01)+s2*( 2.086000d-01) + Cdcs = 4.170000d+00+s*( 6.400000d-01)+s2*(-7.630000d+00) & + & +s3*( 7.170000d+00) +! + dcv = 1.0d0/alinv/x* & + & (A0dcv+x*A1dcv+x2*A2dcv+x2*x*A3dcv) * x**Bdcv * x1**Cdcv + dcs = 1.0d0/alinv/x* & + & Adcs * x**(B0dcs+B1dcs*x) * x1**Cdcs +! + call WHIT4Q(x,mc*mc/Q2,cv,cs) + qc = cv/alinv/2.0d0/PI + cs*alstpi + dcs + dcv + qc = qc*x + ZCB=qc + else + qc = 0.0d0 + ZCB=qc + endif + endif +! + return + END +!------------------------------------------------------- + subroutine SFWHI5(ZX,ZQ,ZUV,ZDV,ZUB,ZDB,ZSB,ZCB,ZGL) +!------------------------------------------------------- +! WHIT5 parton distribution in the photon +! +! INPUT: integer ic : if ic=0 then qc=0 +! else qc is calculated +! DOUBLE PRECISION Q2 : energy scale Q^2 (GeV^2) +! DOUBLE PRECISION x : energy fraction +! +! OUTPUT: DOUBLE PRECISION qu : up-quark dist. +! DOUBLE PRECISION qd : down- or strange-quark dist. +! DOUBLE PRECISION qc : charm-quark dist. +! DOUBLE PRECISION g : gluon dist. +!------------------------------------------------------- +! Modified by M.Tanaka on July 22, 1994. +! The bug pointed out by M.Drees is fixed. +!------------------------------------------------------- +! Modified by I.Watanabe on July 22, 1994. +!------------------------------------------------------- + implicit none + external WHIT5G + double precision & + & ZX,ZQ,ZUV,ZDV,ZUB,ZDB,ZSB,ZCB,ZGL +! arg + integer ic + DOUBLE PRECISION Q2,x + DOUBLE PRECISION qu,qd,qc,g +! const + DOUBLE PRECISION q42it,q52it,lam42,lam52 + DOUBLE PRECISION alinv,mc,PI +! local + DOUBLE PRECISION qv,qsea,cv,cs,dcv,dcs + DOUBLE PRECISION A0val,A1val,A2val,Bval,Cval, & + & A0sea,B0sea,BB0sea,C0sea + DOUBLE PRECISION A0dcv,A1dcv,A2dcv,A3dcv,Bdcv,Cdcv + DOUBLE PRECISION Adcs, B0dcs, B1dcs, Cdcs + DOUBLE PRECISION x1,x2,mc2q2 + DOUBLE PRECISION s,s2,s3,s4,prsccf,alstpi + DOUBLE PRECISION WHIT5G +! parameters + parameter(lam42=0.16d0, lam52=0.091411319d0) + parameter(Q42IT=4.0d0, Q52IT=100.0d0) + parameter(alinv=137.036d0, mc=1.5d0) + parameter(pi=3.14159265358979323846d0) + common /scale/ s,s2,s3,s4,prsccf +! +! begin + x=ZX + Q2=ZQ*ZQ + ic=1 +! + x1=1.0d0-x + x2=x**2 + mc2q2=mc**2/Q2 +! + if(Q2.lt.100.0d0) then +! under 100 GeV^2 +! +! set scale s + if(Q2.lt.4.0d0) then +!ccc for under 4GeV^2 prescription + s= 0.0d0 + prsccf = log(Q2/LAM42)/ log(Q42IT/LAM42) + alstpi = 6.0d0/25.0d0/ log(Q42IT/LAM42) + else + s= log( log(Q2/LAM42)/ log(Q42IT/LAM42)) + prsccf = 1.0d0 + alstpi = 6.0d0/25.0d0/ log(Q2/LAM42) + endif + s2=s**2 + s3=s2*s + s4=s2**2 +! +!ccccc WHIT5 quark (U100) +! + A0val= 2.540000d+00+s*( 2.000000d+00)+s2*( 7.180000d-01) + A1val= 6.230000d-02+s*(-7.010000d+00)+s2*( 1.251000d-01) + A2val=-1.642000d-01+s*(-4.360000d-01)+s2*( 1.048000d+01) & + & +s3*(-5.200000d+00) + Bval = 6.990000d-01+s*(-2.796000d-02)+s2*(-3.650000d-03) + Cval = 4.420000d-01+s*(-1.255000d+00)+s2*( 1.941000d+00) & + & +s3*(-9.950000d-01) + A0sea= 2.227000d+00+s*( 5.720000d+00)+s2*(-1.295000d+01) & + & +s3*( 7.220000d+00)+s4*(-2.514000d-01) + B0sea=-8.810000d-02+s*( 1.465000d-01)+s2*(-9.750000d-01) & + & +s3*( 7.820000d-01)+s4*(-2.074000d-01) + BB0sea=3.370000d+00+s*( 1.416000d+01)+s2*(-3.150000d+01) & + & +s3*( 2.789000d+01)+s4*(-8.710000d+00) + C0sea= 1.581000d+01+s*(-3.630000d+01)+s2*( 7.710000d+01) & + & +s3*(-7.810000d+01)+s4*( 2.948000d+01) +! + qv = prsccf/alinv/x* & + & (A0val+A1val*x+A2val*x2) * x**Bval * x1**Cval + qsea= prsccf/alinv/x* & + & A0sea * x**(B0sea+BB0sea*x) * x1**C0sea +! + qu = qv/3.0d0 + qsea/6.0d0 + qu = qu*x + ZUV=qu + ZUB=qu + qd = qv/12.0d0 + qsea/6.0d0 + qd = qd*x + ZDV=qd + ZDB=qd + ZSB=qd +! + if((ic.ne.0) .and. (x*(1.0d0+4.0d0*mc2q2).lt.1.0d0)) then + call WHIT5Q(x,mc2q2,cv,cs) + qc = cv/alinv/2.0d0/PI + cs*alstpi + qc = qc*x + ZCB=qc + else + qc = 0.0d0 + ZCB=qc + endif +! + g = WHIT5G(x,Q2) + g = g*x + ZGL=g +! + else +! over 100 GeV^2 +! +! set scale s + s= log( log(Q2/LAM52)/ log(Q52IT/LAM52)) + prsccf = 1.0d0 + alstpi = 6.0d0/23.0d0/ log(Q2/LAM52) + s2=s**2 + s3=s2*s + s4=s2**2 +! +!ccccc WHIT5 quark (O100) +! + A0val= 4.270000d+00+s*( 3.096000d+00)+s2*( 1.617000d+00) + A1val=-4.740000d+00+s*(-6.900000d+00)+s2*(-2.417000d+00) + A2val= 2.837000d+00+s*( 6.470000d+00)+s2*( 4.070000d+00) + Bval = 6.780000d-01+s*(-3.940000d-02)+s2*( 1.750000d-02) + Cval = 1.728000d-01+s*(-2.457000d-02)+s2*( 1.440000d-01) + A0sea= 2.318000d+00+s*(-3.760000d+00)+s2*( 2.026000d+01) & + & +s3*(-5.950000d+01)+s4*( 5.900000d+01) + B0sea=-2.425000d-01+s*(-4.360000d-01)+s2*( 1.241000d+00) & + & +s3*(-3.510000d+00)+s4*( 3.360000d+00) + BB0sea=5.330000d+00+s*(-8.680000d+00)+s2*( 7.420000d+01) & + & +s3*(-2.070000d+02)+s4*( 1.967000d+02) + C0sea= 8.480000d+00+s*( 9.310000d+00)+s2*(-1.041000d+02) & + & +s3*( 2.801000d+02)+s4*(-2.663000d+02) +! + qv = 1.0d0/alinv/x* & + & (A0val+A1val*x+A2val*x2) * x**Bval * x1**Cval + qsea= 1.0d0/alinv/x* & + & A0sea * x**(B0sea+BB0sea*x) * x1**C0sea +! + qu = qv/3.0d0 + qsea/6.0d0 + qu = qu*x + ZUV=qu + ZUB=qu + qd = qv/12.0d0 + qsea/6.0d0 + qd = qd*x + ZDV=qd + ZDB=qd + ZSB=qd + g = WHIT5G(x,Q2) + g = g*x + ZGL=g +! + if((ic.ne.0) .and. (x*(1.0d0+4.0d0*mc2q2).lt.1.0d0)) then + A0dcv= s*( 1.219000d-01)+s2*( 6.200000d+00) & + & +s3*(-2.504000d+01)+s4*( 3.098000d+01) + A1dcv= s*( 1.913000d+00)+s2*(-7.690000d+01) & + & +s3*( 3.180000d+02)+s4*(-3.920000d+02) + A2dcv= s*(-7.160000d+00)+s2*( 2.503000d+02) & + & +s3*(-1.062000d+03)+s4*( 1.308000d+03) + A3dcv= s*( 3.190000d+00)+s2*(-2.301000d+02) & + & +s3*( 1.012000d+03)+s4*(-1.250000d+03) + Bdcv = 4.990000d-01+s*( 3.470000d+00)+s2*(-1.526000d+01) & + & +s3*( 1.967000d+01) + Cdcv = 3.290000d-01+s*( 8.240000d+00)+s2*(-3.800000d+01) & + & +s3*( 4.630000d+01) + Adcs = s*(-6.580000d-02)+s2*( 1.059000d-01) & + & +s3*(-6.630000d-02) + B0dcs=-2.750000d-01+s*(-4.760000d-01)+s2*( 1.191000d-01) + B1dcs= 6.370000d+00+s*(-5.320000d+00)+s2*( 1.986000d+00) + Cdcs = 3.400000d+00+s*( 3.750000d-01)+s2*(-8.790000d+00) & + & +s3*( 1.001000d+01) +! + dcv = 1.0d0/alinv/x* & + & (A0dcv+x*A1dcv+x2*A2dcv+x2*x*A3dcv) * x**Bdcv * x1**Cdcv + dcs = 1.0d0/alinv/x* & + & Adcs * x**(B0dcs+B1dcs*x) * x1**Cdcs +! + call WHIT5Q(x,mc*mc/Q2,cv,cs) + qc = cv/alinv/2.0d0/PI + cs*alstpi + dcs + dcv + qc = qc*x + ZCB=qc + else + qc = 0.0d0 + ZCB=qc + endif + endif +! + return + END +!------------------------------------------------------- + subroutine SFWHI6(ZX,ZQ,ZUV,ZDV,ZUB,ZDB,ZSB,ZCB,ZGL) +!------------------------------------------------------- +! WHIT6 parton distribution in the photon +! +! INPUT: integer ic : if ic=0 then qc=0 +! else qc is calculated +! DOUBLE PRECISION Q2 : energy scale Q^2 (GeV^2) +! DOUBLE PRECISION x : energy fraction +! +! OUTPUT: DOUBLE PRECISION qu : up-quark dist. +! DOUBLE PRECISION qd : down- or strange-quark dist. +! DOUBLE PRECISION qc : charm-quark dist. +! DOUBLE PRECISION g : gluon dist. +!------------------------------------------------------- +! Modified by M.Tanaka on July 22, 1994. +! The bug pointed out by M.Drees is fixed. +!------------------------------------------------------- +! Modified by I.Watanabe on July 22, 1994. +!------------------------------------------------------- + implicit none + external WHIT6G + double precision & + & ZX,ZQ,ZUV,ZDV,ZUB,ZDB,ZSB,ZCB,ZGL +! arg + integer ic + DOUBLE PRECISION Q2,x + DOUBLE PRECISION qu,qd,qc,g +! const + DOUBLE PRECISION q42it,q52it,lam42,lam52 + DOUBLE PRECISION alinv,mc,PI +! local + DOUBLE PRECISION qv,qsea,cv,cs,dcv,dcs + DOUBLE PRECISION A0val,A1val,A2val,Bval,Cval, & + & A0sea,B0sea,BB0sea,C0sea + DOUBLE PRECISION A0dcv,A1dcv,A2dcv,A3dcv,Bdcv,Cdcv + DOUBLE PRECISION Adcs, B0dcs, B1dcs, Cdcs + DOUBLE PRECISION x1,x2,mc2q2 + DOUBLE PRECISION s,s2,s3,s4,prsccf,alstpi + DOUBLE PRECISION WHIT6G +! parameters + parameter(lam42=0.16d0, lam52=0.091411319d0) + parameter(Q42IT=4.0d0, Q52IT=100.0d0) + parameter(alinv=137.036d0, mc=1.5d0) + parameter(pi=3.14159265358979323846d0) + common /scale/ s,s2,s3,s4,prsccf +! +! begin + x=ZX + Q2=ZQ*ZQ + ic=1 +! + x1=1.0d0-x + x2=x**2 + mc2q2=mc**2/Q2 +! + if(Q2.lt.100.0d0) then +! under 100 GeV^2 +! +! set scale s + if(Q2.lt.4.0d0) then +!ccc for under 4GeV^2 prescription + s= 0.0d0 + prsccf = log(Q2/LAM42)/ log(Q42IT/LAM42) + alstpi = 6.0d0/25.0d0/ log(Q42IT/LAM42) + else + s= log( log(Q2/LAM42)/ log(Q42IT/LAM42)) + prsccf = 1.0d0 + alstpi = 6.0d0/25.0d0/ log(Q2/LAM42) + endif + s2=s**2 + s3=s2*s + s4=s2**2 +! +!ccccc WHIT6 quark (U100) +! + A0val= 2.540000d+00+s*( 2.000000d+00)+s2*( 7.180000d-01) + A1val= 6.230000d-02+s*(-7.010000d+00)+s2*( 1.251000d-01) + A2val=-1.642000d-01+s*(-4.360000d-01)+s2*( 1.048000d+01) & + & +s3*(-5.200000d+00) + Bval = 6.990000d-01+s*(-2.796000d-02)+s2*(-3.650000d-03) + Cval = 4.420000d-01+s*(-1.255000d+00)+s2*( 1.941000d+00) & + & +s3*(-9.950000d-01) + A0sea= 3.180000d+00+s*( 8.690000d+00)+s2*(-2.287000d+01) & + & +s3*( 1.896000d+01)+s4*(-5.140000d+00) + B0sea=-1.003000d-01+s*( 1.603000d-01)+s2*(-1.037000d+00) & + & +s3*( 9.440000d-01)+s4*(-2.915000d-01) + BB0sea=5.690000d+00+s*( 1.867000d+01)+s2*(-4.670000d+01) & + & +s3*( 5.050000d+01)+s4*(-1.835000d+01) + C0sea= 2.149000d+01+s*(-5.650000d+01)+s2*( 1.293000d+02) & + & +s3*(-1.459000d+02)+s4*( 5.750000d+01) +! + qv = prsccf/alinv/x* & + & (A0val+A1val*x+A2val*x2) * x**Bval * x1**Cval + qsea= prsccf/alinv/x* & + & A0sea * x**(B0sea+BB0sea*x) * x1**C0sea +! + qu = qv/3.0d0 + qsea/6.0d0 + qu = qu*x + ZUV=qu + ZUB=qu + qd = qv/12.0d0 + qsea/6.0d0 + qd = qd*x + ZDV=qd + ZDB=qd + ZSB=qd +! + if((ic.ne.0) .and. (x*(1.0d0+4.0d0*mc2q2).lt.1.0d0)) then + call WHIT6Q(x,mc2q2,cv,cs) + qc = cv/alinv/2.0d0/PI + cs*alstpi + qc = qc*x + ZCB=qc + else + qc = 0.0d0 + ZCB=qc + endif +! + g = WHIT6G(x,Q2) + g = g*x + ZGL=g +! + else +! over 100 GeV^2 +! +! set scale s + s= log( log(Q2/LAM52)/ log(Q52IT/LAM52)) + prsccf = 1.0d0 + alstpi = 6.0d0/23.0d0/ log(Q2/LAM52) + s2=s**2 + s3=s2*s + s4=s2**2 +! +!ccccc WHIT6 quark (O100) +! + A0val= 4.270000d+00+s*( 3.096000d+00)+s2*( 1.621000d+00) + A1val=-4.740000d+00+s*(-6.900000d+00)+s2*(-2.439000d+00) + A2val= 2.837000d+00+s*( 6.460000d+00)+s2*( 4.100000d+00) + Bval = 6.780000d-01+s*(-3.940000d-02)+s2*( 1.758000d-02) + Cval = 1.728000d-01+s*(-2.493000d-02)+s2*( 1.451000d-01) + A0sea= 3.340000d+00+s*(-5.610000d+00)+s2*( 5.000000d+01) & + & +s3*(-2.207000d+02)+s4*( 3.028000d+02) + B0sea=-2.402000d-01+s*(-4.090000d-01)+s2*( 2.263000d+00) & + & +s3*(-1.050000d+01)+s4*( 1.487000d+01) + BB0sea=8.790000d+00+s*(-8.860000d+00)+s2*( 1.640000d+02) & + & +s3*(-7.120000d+02)+s4*( 9.730000d+02) + C0sea= 9.160000d+00+s*( 9.290000d+00)+s2*(-2.784000d+02) & + & +s3*( 1.175000d+03)+s4*(-1.592000d+03) +! + qv = 1.0d0/alinv/x* & + & (A0val+A1val*x+A2val*x2) * x**Bval * x1**Cval + qsea= 1.0d0/alinv/x* & + & A0sea * x**(B0sea+BB0sea*x) * x1**C0sea +! + qu = qv/3.0d0 + qsea/6.0d0 + qu = qu*x + ZUV=qu + ZUB=qu + qd = qv/12.0d0 + qsea/6.0d0 + qd = qd*x + ZDV=qd + ZDB=qd + ZSB=qd + g = WHIT6G(x,Q2) + g = g*x + ZGL=g +! + if((ic.ne.0) .and. (x*(1.0d0+4.0d0*mc2q2).lt.1.0d0)) then + A0dcv= s*( 1.219000d-01)+s2*( 6.200000d+00) & + & +s3*(-2.504000d+01)+s4*( 3.098000d+01) + A1dcv= s*( 1.913000d+00)+s2*(-7.690000d+01) & + & +s3*( 3.180000d+02)+s4*(-3.920000d+02) + A2dcv= s*(-7.160000d+00)+s2*( 2.503000d+02) & + & +s3*(-1.062000d+03)+s4*( 1.308000d+03) + A3dcv= s*( 3.190000d+00)+s2*(-2.301000d+02) & + & +s3*( 1.012000d+03)+s4*(-1.250000d+03) + Bdcv = 4.990000d-01+s*( 3.470000d+00)+s2*(-1.526000d+01) & + & +s3*( 1.967000d+01) + Cdcv = 3.290000d-01+s*( 8.240000d+00)+s2*(-3.800000d+01) & + & +s3*( 4.630000d+01) + Adcs = s*(-4.990000d-02)+s2*( 1.026000d-01) & + & +s3*(-7.870000d-02) + B0dcs=-3.610000d-01+s*(-5.760000d-01)+s2*( 2.257000d-01) + B1dcs= 7.680000d+00+s*(-8.830000d+00)+s2*( 3.880000d+00) + Cdcs = 2.548000d+00+s*( 6.910000d-01)+s2*(-8.700000d+00) & + & +s3*( 1.065000d+01) +! + dcv = 1.0d0/alinv/x* & + & (A0dcv+x*A1dcv+x2*A2dcv+x2*x*A3dcv) * x**Bdcv * x1**Cdcv + dcs = 1.0d0/alinv/x* & + & Adcs * x**(B0dcs+B1dcs*x) * x1**Cdcs +! + call WHIT6Q(x,mc*mc/Q2,cv,cs) + qc = cv/alinv/2.0d0/PI + cs*alstpi + dcs + dcv + qc = qc*x + ZCB=qc + else + qc = 0.0d0 + ZCB=qc + endif + endif +! + return + END +! +!cccccccccccccccccccccccccccccccccccccccccccccccccccccc + DOUBLE PRECISION function WHIT1G(x,Q2) +! input: x,Q2 +! output: clg +! (gluon dist.) +!cccccccccccccccccccccccccccccccccccccccccccccccccccccc + implicit none +! arg + DOUBLE PRECISION Q2,x +! const + DOUBLE PRECISION q42it,q52it,lam42,lam52 + DOUBLE PRECISION alinv +! local + DOUBLE PRECISION A0g,B0g,C0g,A1g,AA1g,B1g,C1g + DOUBLE PRECISION s,s2,s3,s4,prsccf + DOUBLE PRECISION x1 +! parameters + parameter(lam42=0.16d0, lam52=0.091411319d0) + parameter(Q42IT=4.0d0, Q52IT=100.0d0) + parameter(alinv=137.036d0) + common /scale/ s,s2,s3,s4,prsccf +! +! begin + x1=1.0d0-x +! + if(Q2.lt.100.0d0) then +! under 100 GeV^2 +! +!ccccc WHIT1 gluon (U100) +! + A0g = 2.000000d+00+s*(-3.280000d+00)+s2*( 2.894000d+00) & + & +s3*(-1.561000d+00)+s4*( 8.180000d-01) + B0g = s*(-7.610000d-01)+s2*(-4.900000d-02) & + & +s3*( 4.460000d-01) + C0g = 3.000000d+00+s*( 1.586000d+00)+s2*(-9.490000d-01) & + & +s3*( 2.425000d+00) + A1g = s*( 4.610000d-01)+s2*( 1.041000d-01) & + & +s3*(-1.753000d-02)+s4*(-2.717000d-01) + AA1g= s*( 9.680000d-03)+s2*(-4.170000d-01) & + & +s3*(-3.950000d-01)+s4*( 8.430000d-01) + B1g =-4.140000d-01+s*(-6.060000d-02)+s2*( 2.847000d-01) & + & +s3*(-5.070000d-01) + C1g = 1.244000d+00+s*( 5.880000d-01)+s2*(-1.228000d+00) & + & +s3*( 8.090000d-01) + else +! over 100 GeV^2 +! +!ccccc WHIT1 gluon (O100) +! + A0g = 7.840000d-01+s*(-2.238000d+00)+s2*( 1.617000d+01) & + & +s3*(-6.250000d+01)+s4*( 8.390000d+01) + B0g =-4.030000d-01+s*(-1.307000d+00)+s2*( 8.780000d+00) & + & +s3*(-3.580000d+01)+s4*( 5.350000d+01) + C0g = 4.450000d+00+s*( 1.027000d+00)+s2*( 4.460000d+01) & + & +s3*(-1.600000d+02)+s4*( 1.816000d+02) + A1g = 3.010000d-01+s*( 1.275000d+00)+s2*(-1.563000d+00) & + & +s3*( 4.100000d+00)+s4*(-1.337000d+01) + AA1g=-1.305000d-01+s*(-1.245000d+00)+s2*( 2.438000d+00) & + & +s3*(-2.539000d+00)+s4*( 1.273000d+01) + B1g =-4.890000d-01+s*( 9.550000d-01)+s2*(-4.400000d+00) & + & +s3*( 1.022000d+01)+s4*(-1.713000d+01) + C1g = 1.331000d+00+s*(-2.481000d-01)+s2*( 1.950000d+00) & + & +s3*(-2.072000d+00) + endif +! + WHIT1G = prsccf/alinv/x* & + & ( A0g * x**B0g * x1**C0g & + & +(A1g+AA1g*x) * x**B1g * x1**C1g ) +! + return + END +! +!ccccccccccccccccccccccccccccc +! QPM calculation + subroutine WHIT1Q(x,r,cv,cs) +!cc INPUTS : x,r=mc^2/Q^2 +!cc OUTPUTS: cv,cs (valence- and sea- charm quark dist) +!cc cv <-- cv / ( alpha / 2PI) +!cc cs <-- cs / ( alpha_s/2PI) +! + implicit none +! arg + DOUBLE PRECISION x,r + DOUBLE PRECISION cv,cs +! CONST + DOUBLE PRECISION ec,mc + parameter(ec=2.0d0/3.0d0,mc=1.5d0) +! N=15 Gauss int. weights and points + integer GN,i + parameter(GN=15) + DOUBLE PRECISION XG(GN), XW(GN) + DATA (XG(i),i=1,GN)/6.003741d-03, & + & 3.136330d-02, 7.589671d-02, 1.377911d-01, 2.145139d-01, & + & 3.029243d-01, 3.994030d-01, 5.000000d-01, 6.005970d-01, & + & 6.970757d-01, 7.854861d-01, 8.622089d-01, 9.241033d-01, & + & 9.686367d-01, 9.939963d-01/ + DATA (XW(i),i=1,GN)/1.537662d-02, & + & 3.518302d-02, 5.357961d-02, 6.978534d-02, 8.313460d-02, & + & 9.308050d-02, 9.921574d-02, 1.012891d-01, 9.921574d-02, & + & 9.308050d-02, 8.313460d-02, 6.978534d-02, 5.357961d-02, & + & 3.518302d-02, 1.537662d-02/ +! local + DOUBLE PRECISION sum, y,z,beta,w,WHIT1G,L + parameter(L=4.0d0) + DOUBLE PRECISION x1,rx,z1,rz +! +! begin + x1=1.0d0-x + rx=4.0d0*r*x +! +! direct + beta=dsqrt(1.0d0-rx/x1) + w=x*( beta*(-1.0d0+8.0d0*x*x1-rx*x1) & + & +(x**2+x1**2+rx*(1.0d0-3.0d0*x)-0.5d0*rx**2) & + & * log( (1.0d0+beta)/(1.0d0-beta) )) + cv = 3.0d0*ec**2 * w / x +! +! resolved + sum=0.0d0 + do 10 i=1,GN + y= x+rx + (x1-rx)*XG(i)**L + z=x/y + z1=1.0d0-z + rz=4.0d0*r*z + beta=dsqrt(1.0d0-rz/z1) + w=z*( beta*(-1.0d0+8.0d0*z*z1-rz*z1) & + & +(z**2+z1**2+rz*(1.0d0-3.0d0*z)-0.5d0*rz**2) & + & * log( (1.0d0+beta)/(1.0d0-beta) )) +! + sum= sum + w * WHIT1G(y,mc**2/r)* L*XG(i)**(L-1.0d0)*XW(i) +! + 10 continue +! + cs = 0.5d0/x * (x1-rx) * sum +! + return + END +! +!cccccccccccccccccccccccccccccccccccccccccccccccccccccc + DOUBLE PRECISION function WHIT2G(x,Q2) +! input: x,Q2 +! output: clg +! (gluon dist.) +!cccccccccccccccccccccccccccccccccccccccccccccccccccccc + implicit none +! arg + DOUBLE PRECISION Q2,x +! const + DOUBLE PRECISION q42it,q52it,lam42,lam52 + DOUBLE PRECISION alinv +! local + DOUBLE PRECISION A0g,B0g,C0g,A1g,AA1g,B1g,C1g + DOUBLE PRECISION s,s2,s3,s4,prsccf + DOUBLE PRECISION x1 +! parameters + parameter(lam42=0.16d0, lam52=0.091411319d0) + parameter(Q42IT=4.0d0, Q52IT=100.0d0) + parameter(alinv=137.036d0) + common /scale/ s,s2,s3,s4,prsccf +! +! begin + x1=1.0d0-x +! + if(Q2.lt.100.0d0) then +! under 100 GeV^2 +! +!ccccc WHIT2 gluon (U100) +! + A0g = 5.000000d+00+s*(-1.499000d+01)+s2*( 2.617000d+01) & + & +s3*(-2.530000d+01)+s4*( 1.012000d+01) + B0g = s*(-9.370000d-01)+s2*( 4.100000d-01) & + & +s3*( 3.390000d-02) + C0g = 9.000000d+00+s*( 7.090000d-01)+s2*( 3.118000d+00) & + & +s3*(-5.820000d-04) + A1g = s*( 4.610000d-01)+s2*( 1.041000d-01) & + & +s3*(-1.753000d-02)+s4*(-2.717000d-01) + AA1g= s*( 9.680000d-03)+s2*(-4.170000d-01) & + & +s3*(-3.950000d-01)+s4*( 8.430000d-01) + B1g =-4.140000d-01+s*(-6.060000d-02)+s2*( 2.847000d-01) & + & +s3*(-5.070000d-01) + C1g = 1.244000d+00+s*( 5.880000d-01)+s2*(-1.228000d+00) & + & +s3*( 8.090000d-01) + else +! over 100 GeV^2 +! +!ccccc WHIT2 gluon (O100) +! + A0g = 1.095000d+00+s*(-2.388000d+00)+s2*( 9.190000d+00) & + & +s3*(-3.032000d+01)+s4*( 3.480000d+01) + B0g =-4.410000d-01+s*(-9.070000d-01)+s2*( 4.680000d+00) & + & +s3*(-1.866000d+01)+s4*( 2.717000d+01) + C0g = 1.099000d+01+s*( 4.710000d+00)+s2*( 2.801000d+01) & + & +s3*(-1.279000d+02)+s4*( 1.640000d+02) + A1g = 3.010000d-01+s*( 1.275000d+00)+s2*(-1.563000d+00) & + & +s3*( 4.100000d+00)+s4*(-1.337000d+01) + AA1g=-1.305000d-01+s*(-1.245000d+00)+s2*( 2.438000d+00) & + & +s3*(-2.539000d+00)+s4*( 1.273000d+01) + B1g =-4.890000d-01+s*( 9.550000d-01)+s2*(-4.400000d+00) & + & +s3*( 1.022000d+01)+s4*(-1.713000d+01) + C1g = 1.331000d+00+s*(-2.481000d-01)+s2*( 1.950000d+00) & + & +s3*(-2.072000d+00) + endif +! + WHIT2G = prsccf/alinv/x* & + & ( A0g * x**B0g * x1**C0g & + & +(A1g+AA1g*x) * x**B1g * x1**C1g ) +! + return + END +! +!ccccccccccccccccccccccccccccc +! QPM calculation + subroutine WHIT2Q(x,r,cv,cs) +!cc INPUTS : x,r=mc^2/Q^2 +!cc OUTPUTS: cv,cs (valence- and sea- charm quark dist) +!cc cv <-- cv / ( alpha / 2PI) +!cc cs <-- cs / ( alpha_s/2PI) +! + implicit none +! arg + DOUBLE PRECISION x,r + DOUBLE PRECISION cv,cs +! CONST + DOUBLE PRECISION ec,mc + parameter(ec=2.0d0/3.0d0,mc=1.5d0) +! N=15 Gauss int. weights and points + integer GN,i + parameter(GN=15) + DOUBLE PRECISION XG(GN), XW(GN) + DATA (XG(i),i=1,GN)/6.003741d-03, & + & 3.136330d-02, 7.589671d-02, 1.377911d-01, 2.145139d-01, & + & 3.029243d-01, 3.994030d-01, 5.000000d-01, 6.005970d-01, & + & 6.970757d-01, 7.854861d-01, 8.622089d-01, 9.241033d-01, & + & 9.686367d-01, 9.939963d-01/ + DATA (XW(i),i=1,GN)/1.537662d-02, & + & 3.518302d-02, 5.357961d-02, 6.978534d-02, 8.313460d-02, & + & 9.308050d-02, 9.921574d-02, 1.012891d-01, 9.921574d-02, & + & 9.308050d-02, 8.313460d-02, 6.978534d-02, 5.357961d-02, & + & 3.518302d-02, 1.537662d-02/ +! local + DOUBLE PRECISION sum, y,z,beta,w,WHIT2G,L + parameter(L=4.0d0) + DOUBLE PRECISION x1,rx,z1,rz +! +! begin + x1=1.0d0-x + rx=4.0d0*r*x +! +! direct + beta=dsqrt(1.0d0-rx/x1) + w=x*( beta*(-1.0d0+8.0d0*x*x1-rx*x1) & + & +(x**2+x1**2+rx*(1.0d0-3.0d0*x)-0.5d0*rx**2) & + & * log( (1.0d0+beta)/(1.0d0-beta) )) + cv = 3.0d0*ec**2 * w / x +! +! resolved + sum=0.0d0 + do 10 i=1,GN + y= x+rx + (x1-rx)*XG(i)**L + z=x/y + z1=1.0d0-z + rz=4.0d0*r*z + beta=dsqrt(1.0d0-rz/z1) + w=z*( beta*(-1.0d0+8.0d0*z*z1-rz*z1) & + & +(z**2+z1**2+rz*(1.0d0-3.0d0*z)-0.5d0*rz**2) & + & * log( (1.0d0+beta)/(1.0d0-beta) )) +! + sum= sum + w * WHIT2G(y,mc**2/r)* L*XG(i)**(L-1.0d0)*XW(i) +! + 10 continue +! + cs = 0.5d0/x * (x1-rx) * sum +! + return + END +! +!cccccccccccccccccccccccccccccccccccccccccccccccccccccc + DOUBLE PRECISION function WHIT3G(x,Q2) +! input: x,Q2 +! output: clg +! (gluon dist.) +!cccccccccccccccccccccccccccccccccccccccccccccccccccccc + implicit none +! arg + DOUBLE PRECISION Q2,x +! const + DOUBLE PRECISION q42it,q52it,lam42,lam52 + DOUBLE PRECISION alinv +! local + DOUBLE PRECISION A0g,B0g,C0g,A1g,AA1g,B1g,C1g + DOUBLE PRECISION s,s2,s3,s4,prsccf + DOUBLE PRECISION x1 +! parameters + parameter(lam42=0.16d0, lam52=0.091411319d0) + parameter(Q42IT=4.0d0, Q52IT=100.0d0) + parameter(alinv=137.036d0) + common /scale/ s,s2,s3,s4,prsccf +! +! begin + x1=1.0d0-x +! + if(Q2.lt.100.0d0) then +! under 100 GeV^2 +! +!ccccc WHIT3 gluon (U100) +! + A0g = 8.000000d+00+s*(-2.864000d+01)+s2*( 5.590000d+01) & + & +s3*(-5.760000d+01)+s4*( 2.366000d+01) + B0g = s*(-9.870000d-01)+s2*( 5.100000d-01) & + & +s3*(-6.670000d-02) + C0g = 1.500000d+01+s*( 3.310000d-01)+s2*( 3.500000d+00) & + & +s3*( 8.920000d-01) + A1g = s*( 4.610000d-01)+s2*( 1.041000d-01) & + & +s3*(-1.753000d-02)+s4*(-2.717000d-01) + AA1g= s*( 9.680000d-03)+s2*(-4.170000d-01) & + & +s3*(-3.950000d-01)+s4*( 8.430000d-01) + B1g =-4.140000d-01+s*(-6.060000d-02)+s2*( 2.847000d-01) & + & +s3*(-5.070000d-01) + C1g = 1.244000d+00+s*( 5.880000d-01)+s2*(-1.228000d+00) & + & +s3*( 8.090000d-01) + else +! over 100 GeV^2 +! +!ccccc WHIT3 gluon (O100) +! + A0g = 1.270000d+00+s*(-2.817000d+00)+s2*( 5.740000d+00) & + & +s3*(-1.327000d+01)+s4*( 1.268000d+01) + B0g =-4.610000d-01+s*(-8.170000d-01)+s2*( 3.320000d+00) & + & +s3*(-1.296000d+01)+s4*( 1.893000d+01) + C0g = 1.721000d+01+s*( 1.257000d+00)+s2*( 5.050000d+01) & + & +s3*(-2.761000d+02)+s4*( 4.900000d+02) + A1g = 3.010000d-01+s*( 1.275000d+00)+s2*(-1.563000d+00) & + & +s3*( 4.100000d+00)+s4*(-1.337000d+01) + AA1g=-1.305000d-01+s*(-1.245000d+00)+s2*( 2.438000d+00) & + & +s3*(-2.539000d+00)+s4*( 1.273000d+01) + B1g =-4.890000d-01+s*( 9.550000d-01)+s2*(-4.400000d+00) & + & +s3*( 1.022000d+01)+s4*(-1.713000d+01) + C1g = 1.331000d+00+s*(-2.481000d-01)+s2*( 1.950000d+00) & + & +s3*(-2.072000d+00) + endif +! + WHIT3G = prsccf/alinv/x* & + & ( A0g * x**B0g * x1**C0g & + & +(A1g+AA1g*x) * x**B1g * x1**C1g ) +! + return + END +! +!ccccccccccccccccccccccccccccc +! QPM calculation + subroutine WHIT3Q(x,r,cv,cs) +!cc INPUTS : x,r=mc^2/Q^2 +!cc OUTPUTS: cv,cs (valence- and sea- charm quark dist) +!cc cv <-- cv / ( alpha / 2PI) +!cc cs <-- cs / ( alpha_s/2PI) +! + implicit none +! arg + DOUBLE PRECISION x,r + DOUBLE PRECISION cv,cs +! CONST + DOUBLE PRECISION ec,mc + parameter(ec=2.0d0/3.0d0,mc=1.5d0) +! N=15 Gauss int. weights and points + integer GN,i + parameter(GN=15) + DOUBLE PRECISION XG(GN), XW(GN) + DATA (XG(i),i=1,GN)/6.003741d-03, & + & 3.136330d-02, 7.589671d-02, 1.377911d-01, 2.145139d-01, & + & 3.029243d-01, 3.994030d-01, 5.000000d-01, 6.005970d-01, & + & 6.970757d-01, 7.854861d-01, 8.622089d-01, 9.241033d-01, & + & 9.686367d-01, 9.939963d-01/ + DATA (XW(i),i=1,GN)/1.537662d-02, & + & 3.518302d-02, 5.357961d-02, 6.978534d-02, 8.313460d-02, & + & 9.308050d-02, 9.921574d-02, 1.012891d-01, 9.921574d-02, & + & 9.308050d-02, 8.313460d-02, 6.978534d-02, 5.357961d-02, & + & 3.518302d-02, 1.537662d-02/ +! local + DOUBLE PRECISION sum, y,z,beta,w,WHIT3G,L + parameter(L=4.0d0) + DOUBLE PRECISION x1,rx,z1,rz +! +! begin + x1=1.0d0-x + rx=4.0d0*r*x +! +! direct + beta=dsqrt(1.0d0-rx/x1) + w=x*( beta*(-1.0d0+8.0d0*x*x1-rx*x1) & + & +(x**2+x1**2+rx*(1.0d0-3.0d0*x)-0.5d0*rx**2) & + & * log( (1.0d0+beta)/(1.0d0-beta) )) + cv = 3.0d0*ec**2 * w / x +! +! resolved + sum=0.0d0 + do 10 i=1,GN + y= x+rx + (x1-rx)*XG(i)**L + z=x/y + z1=1.0d0-z + rz=4.0d0*r*z + beta=dsqrt(1.0d0-rz/z1) + w=z*( beta*(-1.0d0+8.0d0*z*z1-rz*z1) & + & +(z**2+z1**2+rz*(1.0d0-3.0d0*z)-0.5d0*rz**2) & + & * log( (1.0d0+beta)/(1.0d0-beta) )) +! + sum= sum + w * WHIT3G(y,mc**2/r)* L*XG(i)**(L-1.0d0)*XW(i) +! + 10 continue +! + cs = 0.5d0/x * (x1-rx) * sum +! + return + END +! +!cccccccccccccccccccccccccccccccccccccccccccccccccccccc + DOUBLE PRECISION function WHIT4G(x,Q2) +! input: x,Q2 +! output: clg +! (gluon dist.) +!cccccccccccccccccccccccccccccccccccccccccccccccccccccc + implicit none +! arg + DOUBLE PRECISION Q2,x +! const + DOUBLE PRECISION q42it,q52it,lam42,lam52 + DOUBLE PRECISION alinv +! local + DOUBLE PRECISION A0g,B0g,C0g,A1g,AA1g,B1g,C1g + DOUBLE PRECISION s,s2,s3,s4,prsccf + DOUBLE PRECISION x1 +! parameters + parameter(lam42=0.16d0, lam52=0.091411319d0) + parameter(Q42IT=4.0d0, Q52IT=100.0d0) + parameter(alinv=137.036d0) + common /scale/ s,s2,s3,s4,prsccf +! +! begin + x1=1.0d0-x +! + if(Q2.lt.100.0d0) then +! under 100 GeV^2 +! +!ccccc WHIT4 gluon (U100) +! + A0g = 4.000000d+00+s*(-9.400000d+00)+s2*( 1.555000d+01) & + & +s3*(-1.450000d+01)+s4*( 5.470000d+00) + B0g = s*(-1.142000d+00)+s2*( 1.034000d+00) & + & +s3*(-4.410000d-01) + C0g = 3.000000d+00+s*( 8.720000d-01)+s2*( 1.006000d+00) & + & +s3*( 3.560000d-01) + A1g = s*( 6.020000d-01)+s2*( 5.090000d-01) & + & +s3*(-2.054000d+00)+s4*( 1.392000d+00) + AA1g= s*(-9.220000d-02)+s2*(-1.899000d+00) & + & +s3*( 4.180000d+00)+s4*(-2.494000d+00) + B1g =-2.895000d-01+s*( 3.760000d-01)+s2*(-1.719000d+00) & + & +s3*( 1.116000d+00) + C1g = 1.439000d+00+s*(-5.570000d-01)+s2*( 3.660000d-01) & + & +s3*( 7.330000d-01)+s4*(-7.620000d-01) + else +! over 100 GeV^2 +! +!ccccc WHIT4 gluon (O100) +! + A0g = 1.384000d+00+s*(-2.455000d+00)+s2*( 8.940000d+00) & + & +s3*(-2.906000d+01)+s4*( 3.710000d+01) + B0g =-4.420000d-01+s*(-7.190000d-01)+s2*( 2.961000d+00) & + & +s3*(-1.209000d+01)+s4*( 1.916000d+01) + C0g = 4.210000d+00+s*( 2.524000d+00)+s2*( 1.003000d+01) & + & +s3*(-1.827000d+01)+s4*( 2.162000d+00) + A1g = 2.992000d-01+s*( 1.179000d+00)+s2*(-1.915000d+00) & + & +s3*( 7.260000d+00)+s4*(-1.839000d+01) + AA1g=-1.600000d-01+s*(-1.114000d+00)+s2*( 2.939000d+00) & + & +s3*(-6.660000d+00)+s4*( 1.923000d+01) + B1g =-4.830000d-01+s*( 7.550000d-01)+s2*(-3.800000d+00) & + & +s3*( 1.075000d+01)+s4*(-1.993000d+01) + C1g = 1.297000d+00+s*(-1.669000d-01)+s2*( 1.906000d+00) & + & +s3*(-2.057000d+00) + endif +! + WHIT4G = prsccf/alinv/x* & + & ( A0g * x**B0g * x1**C0g & + & +(A1g+AA1g*x) * x**B1g * x1**C1g ) +! + return + END +! +!ccccccccccccccccccccccccccccc +! QPM calculation + subroutine WHIT4Q(x,r,cv,cs) +!cc INPUTS : x,r=mc^2/Q^2 +!cc OUTPUTS: cv,cs (valence- and sea- charm quark dist) +!cc cv <-- cv / ( alpha / 2PI) +!cc cs <-- cs / ( alpha_s/2PI) +! + implicit none +! arg + DOUBLE PRECISION x,r + DOUBLE PRECISION cv,cs +! CONST + DOUBLE PRECISION ec,mc + parameter(ec=2.0d0/3.0d0,mc=1.5d0) +! N=15 Gauss int. weights and points + integer GN,i + parameter(GN=15) + DOUBLE PRECISION XG(GN), XW(GN) + DATA (XG(i),i=1,GN)/6.003741d-03, & + & 3.136330d-02, 7.589671d-02, 1.377911d-01, 2.145139d-01, & + & 3.029243d-01, 3.994030d-01, 5.000000d-01, 6.005970d-01, & + & 6.970757d-01, 7.854861d-01, 8.622089d-01, 9.241033d-01, & + & 9.686367d-01, 9.939963d-01/ + DATA (XW(i),i=1,GN)/1.537662d-02, & + & 3.518302d-02, 5.357961d-02, 6.978534d-02, 8.313460d-02, & + & 9.308050d-02, 9.921574d-02, 1.012891d-01, 9.921574d-02, & + & 9.308050d-02, 8.313460d-02, 6.978534d-02, 5.357961d-02, & + & 3.518302d-02, 1.537662d-02/ +! local + DOUBLE PRECISION sum, y,z,beta,w,WHIT4G,L + parameter(L=4.0d0) + DOUBLE PRECISION x1,rx,z1,rz +! +! begin + x1=1.0d0-x + rx=4.0d0*r*x +! +! direct + beta=dsqrt(1.0d0-rx/x1) + w=x*( beta*(-1.0d0+8.0d0*x*x1-rx*x1) & + & +(x**2+x1**2+rx*(1.0d0-3.0d0*x)-0.5d0*rx**2) & + & * log( (1.0d0+beta)/(1.0d0-beta) )) + cv = 3.0d0*ec**2 * w / x +! +! resolved + sum=0.0d0 + do 10 i=1,GN + y= x+rx + (x1-rx)*XG(i)**L + z=x/y + z1=1.0d0-z + rz=4.0d0*r*z + beta=dsqrt(1.0d0-rz/z1) + w=z*( beta*(-1.0d0+8.0d0*z*z1-rz*z1) & + & +(z**2+z1**2+rz*(1.0d0-3.0d0*z)-0.5d0*rz**2) & + & * log( (1.0d0+beta)/(1.0d0-beta) )) +! + sum= sum + w * WHIT4G(y,mc**2/r)* L*XG(i)**(L-1.0d0)*XW(i) +! + 10 continue +! + cs = 0.5d0/x * (x1-rx) * sum +! + return + END +! +!cccccccccccccccccccccccccccccccccccccccccccccccccccccc + DOUBLE PRECISION function WHIT5G(x,Q2) +! input: x,Q2 +! output: clg +! (gluon dist.) +!cccccccccccccccccccccccccccccccccccccccccccccccccccccc + implicit none +! arg + DOUBLE PRECISION Q2,x +! const + DOUBLE PRECISION q42it,q52it,lam42,lam52 + DOUBLE PRECISION alinv +! local + DOUBLE PRECISION A0g,B0g,C0g,A1g,AA1g,B1g,C1g + DOUBLE PRECISION s,s2,s3,s4,prsccf + DOUBLE PRECISION x1 +! parameters + parameter(lam42=0.16d0, lam52=0.091411319d0) + parameter(Q42IT=4.0d0, Q52IT=100.0d0) + parameter(alinv=137.036d0) + common /scale/ s,s2,s3,s4,prsccf +! +! begin + x1=1.0d0-x +! + if(Q2.lt.100.0d0) then +! under 100 GeV^2 +! +!ccccc WHIT5 gluon (U100) +! + A0g = 1.000000d+01+s*(-3.400000d+01)+s2*( 6.900000d+01) & + & +s3*(-7.530000d+01)+s4*( 3.230000d+01) + B0g = s*(-1.126000d+00)+s2*( 9.260000d-01) & + & +s3*(-3.930000d-01) + C0g = 9.000000d+00+s*( 4.810000d-01)+s2*( 3.200000d+00) & + & +s3*(-3.470000d-01) + A1g = s*( 6.020000d-01)+s2*( 5.090000d-01) & + & +s3*(-2.054000d+00)+s4*( 1.392000d+00) + AA1g= s*(-9.220000d-02)+s2*(-1.899000d+00) & + & +s3*( 4.180000d+00)+s4*(-2.494000d+00) + B1g =-2.895000d-01+s*( 3.760000d-01)+s2*(-1.719000d+00) & + & +s3*( 1.116000d+00) + C1g = 1.439000d+00+s*(-5.570000d-01)+s2*( 3.660000d-01) & + & +s3*( 7.330000d-01)+s4*(-7.620000d-01) + else +! over 100 GeV^2 +! +!ccccc WHIT5 gluon (O100) +! + A0g = 1.995000d+00+s*(-3.260000d+00)+s2*( 1.818000d+00) & + & +s3*( 1.711000d+00)+s4*(-4.990000d+00) + B0g =-4.660000d-01+s*(-6.100000d-01)+s2*( 1.691000d+00) & + & +s3*(-6.680000d+00)+s4*( 1.019000d+01) + C0g = 1.075000d+01+s*( 5.420000d+00)+s2*( 6.550000d+00) & + & +s3*(-2.297000d+01)+s4*( 1.867000d+01) + A1g = 2.992000d-01+s*( 1.179000d+00)+s2*(-1.915000d+00) & + & +s3*( 7.260000d+00)+s4*(-1.839000d+01) + AA1g=-1.600000d-01+s*(-1.114000d+00)+s2*( 2.939000d+00) & + & +s3*(-6.660000d+00)+s4*( 1.923000d+01) + B1g =-4.830000d-01+s*( 7.550000d-01)+s2*(-3.800000d+00) & + & +s3*( 1.075000d+01)+s4*(-1.993000d+01) + C1g = 1.297000d+00+s*(-1.669000d-01)+s2*( 1.906000d+00) & + & +s3*(-2.057000d+00) + endif +! + WHIT5G = prsccf/alinv/x* & + & ( A0g * x**B0g * x1**C0g & + & +(A1g+AA1g*x) * x**B1g * x1**C1g ) +! + return + END +! +!ccccccccccccccccccccccccccccc +! QPM calculation + subroutine WHIT5Q(x,r,cv,cs) +!cc INPUTS : x,r=mc^2/Q^2 +!cc OUTPUTS: cv,cs (valence- and sea- charm quark dist) +!cc cv <-- cv / ( alpha / 2PI) +!cc cs <-- cs / ( alpha_s/2PI) +! + implicit none +! arg + DOUBLE PRECISION x,r + DOUBLE PRECISION cv,cs +! CONST + DOUBLE PRECISION ec,mc + parameter(ec=2.0d0/3.0d0,mc=1.5d0) +! N=15 Gauss int. weights and points + integer GN,i + parameter(GN=15) + DOUBLE PRECISION XG(GN), XW(GN) + DATA (XG(i),i=1,GN)/6.003741d-03, & + & 3.136330d-02, 7.589671d-02, 1.377911d-01, 2.145139d-01, & + & 3.029243d-01, 3.994030d-01, 5.000000d-01, 6.005970d-01, & + & 6.970757d-01, 7.854861d-01, 8.622089d-01, 9.241033d-01, & + & 9.686367d-01, 9.939963d-01/ + DATA (XW(i),i=1,GN)/1.537662d-02, & + & 3.518302d-02, 5.357961d-02, 6.978534d-02, 8.313460d-02, & + & 9.308050d-02, 9.921574d-02, 1.012891d-01, 9.921574d-02, & + & 9.308050d-02, 8.313460d-02, 6.978534d-02, 5.357961d-02, & + & 3.518302d-02, 1.537662d-02/ +! local + DOUBLE PRECISION sum, y,z,beta,w,WHIT5G,L + parameter(L=4.0d0) + DOUBLE PRECISION x1,rx,z1,rz +! +! begin + x1=1.0d0-x + rx=4.0d0*r*x +! +! direct + beta=dsqrt(1.0d0-rx/x1) + w=x*( beta*(-1.0d0+8.0d0*x*x1-rx*x1) & + & +(x**2+x1**2+rx*(1.0d0-3.0d0*x)-0.5d0*rx**2) & + & * log( (1.0d0+beta)/(1.0d0-beta) )) + cv = 3.0d0*ec**2 * w / x +! +! resolved + sum=0.0d0 + do 10 i=1,GN + y= x+rx + (x1-rx)*XG(i)**L + z=x/y + z1=1.0d0-z + rz=4.0d0*r*z + beta=dsqrt(1.0d0-rz/z1) + w=z*( beta*(-1.0d0+8.0d0*z*z1-rz*z1) & + & +(z**2+z1**2+rz*(1.0d0-3.0d0*z)-0.5d0*rz**2) & + & * log( (1.0d0+beta)/(1.0d0-beta) )) +! + sum= sum + w * WHIT5G(y,mc**2/r)* L*XG(i)**(L-1.0d0)*XW(i) +! + 10 continue +! + cs = 0.5d0/x * (x1-rx) * sum +! + return + END +! +!cccccccccccccccccccccccccccccccccccccccccccccccccccccc + DOUBLE PRECISION function WHIT6G(x,Q2) +! input: x,Q2 +! output: clg +! (gluon dist.) +!cccccccccccccccccccccccccccccccccccccccccccccccccccccc + implicit none +! arg + DOUBLE PRECISION Q2,x +! const + DOUBLE PRECISION q42it,q52it,lam42,lam52 + DOUBLE PRECISION alinv +! local + DOUBLE PRECISION A0g,B0g,C0g,A1g,AA1g,B1g,C1g + DOUBLE PRECISION s,s2,s3,s4,prsccf + DOUBLE PRECISION x1 +! parameters + parameter(lam42=0.16d0, lam52=0.091411319d0) + parameter(Q42IT=4.0d0, Q52IT=100.0d0) + parameter(alinv=137.036d0) + common /scale/ s,s2,s3,s4,prsccf +! +! begin + x1=1.0d0-x +! + if(Q2.lt.100.0d0) then +! under 100 GeV^2 +! +!ccccc WHIT6 gluon (U100) +! + A0g = 1.600000d+01+s*(-6.100000d+01)+s2*( 1.278000d+02) & + & +s3*(-1.399000d+02)+s4*( 5.990000d+01) + B0g = s*(-1.109000d+00)+s2*( 8.450000d-01) & + & +s3*(-3.510000d-01) + C0g = 1.500000d+01+s*( 1.596000d-01)+s2*( 4.180000d+00) & + & +s3*(-1.765000d-01) + A1g = s*( 6.020000d-01)+s2*( 5.090000d-01) & + & +s3*(-2.054000d+00)+s4*( 1.392000d+00) + AA1g= s*(-9.220000d-02)+s2*(-1.899000d+00) & + & +s3*( 4.180000d+00)+s4*(-2.494000d+00) + B1g =-2.895000d-01+s*( 3.760000d-01)+s2*(-1.719000d+00) & + & +s3*( 1.116000d+00) + C1g = 1.439000d+00+s*(-5.570000d-01)+s2*( 3.660000d-01) & + & +s3*( 7.330000d-01)+s4*(-7.620000d-01) + else +! over 100 GeV^2 +! +!ccccc WHIT6 gluon (O100) +! + A0g = 2.378000d+00+s*(-4.380000d+00)+s2*( 5.850000d-01) & + & +s3*( 8.340000d+00)+s4*(-9.920000d+00) + B0g =-4.790000d-01+s*(-6.070000d-01)+s2*( 1.458000d+00) & + & +s3*(-6.030000d+00)+s4*( 9.330000d+00) + C0g = 1.706000d+01+s*( 4.960000d+00)+s2*( 2.497000d+01) & + & +s3*(-1.582000d+02)+s4*( 2.954000d+02) + A1g = 2.992000d-01+s*( 1.179000d+00)+s2*(-1.915000d+00) & + & +s3*( 7.260000d+00)+s4*(-1.839000d+01) + AA1g=-1.600000d-01+s*(-1.114000d+00)+s2*( 2.939000d+00) & + & +s3*(-6.660000d+00)+s4*( 1.923000d+01) + B1g =-4.830000d-01+s*( 7.550000d-01)+s2*(-3.800000d+00) & + & +s3*( 1.075000d+01)+s4*(-1.993000d+01) + C1g = 1.297000d+00+s*(-1.669000d-01)+s2*( 1.906000d+00) & + & +s3*(-2.057000d+00) + endif +! + WHIT6G = prsccf/alinv/x* & + & ( A0g * x**B0g * x1**C0g & + & +(A1g+AA1g*x) * x**B1g * x1**C1g ) +! + return + END +! +!ccccccccccccccccccccccccccccc +! QPM calculation + subroutine WHIT6Q(x,r,cv,cs) +!cc INPUTS : x,r=mc^2/Q^2 +!cc OUTPUTS: cv,cs (valence- and sea- charm quark dist) +!cc cv <-- cv / ( alpha / 2PI) +!cc cs <-- cs / ( alpha_s/2PI) +! + implicit none +! arg + DOUBLE PRECISION x,r + DOUBLE PRECISION cv,cs +! CONST + DOUBLE PRECISION ec,mc + parameter(ec=2.0d0/3.0d0,mc=1.5d0) +! N=15 Gauss int. weights and points + integer GN,i + parameter(GN=15) + DOUBLE PRECISION XG(GN), XW(GN) + DATA (XG(i),i=1,GN)/6.003741d-03, & + & 3.136330d-02, 7.589671d-02, 1.377911d-01, 2.145139d-01, & + & 3.029243d-01, 3.994030d-01, 5.000000d-01, 6.005970d-01, & + & 6.970757d-01, 7.854861d-01, 8.622089d-01, 9.241033d-01, & + & 9.686367d-01, 9.939963d-01/ + DATA (XW(i),i=1,GN)/1.537662d-02, & + & 3.518302d-02, 5.357961d-02, 6.978534d-02, 8.313460d-02, & + & 9.308050d-02, 9.921574d-02, 1.012891d-01, 9.921574d-02, & + & 9.308050d-02, 8.313460d-02, 6.978534d-02, 5.357961d-02, & + & 3.518302d-02, 1.537662d-02/ +! local + DOUBLE PRECISION sum, y,z,beta,w,WHIT6G,L + parameter(L=4.0d0) + DOUBLE PRECISION x1,rx,z1,rz +! +! begin + x1=1.0d0-x + rx=4.0d0*r*x +! +! direct + beta=dsqrt(1.0d0-rx/x1) + w=x*( beta*(-1.0d0+8.0d0*x*x1-rx*x1) & + & +(x**2+x1**2+rx*(1.0d0-3.0d0*x)-0.5d0*rx**2) & + & * log( (1.0d0+beta)/(1.0d0-beta) )) + cv = 3.0d0*ec**2 * w / x +! +! resolved + sum=0.0d0 + do 10 i=1,GN + y= x+rx + (x1-rx)*XG(i)**L + z=x/y + z1=1.0d0-z + rz=4.0d0*r*z + beta=dsqrt(1.0d0-rz/z1) + w=z*( beta*(-1.0d0+8.0d0*z*z1-rz*z1) & + & +(z**2+z1**2+rz*(1.0d0-3.0d0*z)-0.5d0*rz**2) & + & * log( (1.0d0+beta)/(1.0d0-beta) )) +! + sum= sum + w * WHIT6G(y,mc**2/r)* L*XG(i)**(L-1.0d0)*XW(i) +! + 10 continue +! + cs = 0.5d0/x * (x1-rx) * sum +! + return + END diff --git a/LHAPDF/lhapdf-5.9.1/src/wrapzeus.f b/LHAPDF/lhapdf-5.9.1/src/wrapzeus.f new file mode 100644 index 00000000000..8b263d8bc00 --- /dev/null +++ b/LHAPDF/lhapdf-5.9.1/src/wrapzeus.f @@ -0,0 +1,579 @@ +! -*- F90 -*- + + + subroutine ZEUSevolve(x,Q,pdf) + implicit double precision (a-h,o-z) + include 'parmsetup.inc' + character*64 gridname + character*16 name(nmxset) + integer nmem(nmxset),ndef(nmxset),mem + common/NAME/name,nmem,ndef,mem + integer nset,iset,isetlast + data isetlast/-1/ + integer Eorder + real*8 mc,mc2,mb,mb2,mt,mt2 + real*8 f(-6:6),pdf(-6:6) + integer qnerr + parameter(nstartp=7) + DIMENSION QSP(NSTARTP) + DATA QSP/10.,20.,30.,40.,50.,80.,100./ + real*8 xval(45) + logical HEAVY,VFN + real*8 pwgt(20) + save +! + call getnset(iset) +! print *,'iset=',iset,' now calling get_pdfqcd' + if(iset.ne.isetlast) then + call get_pdfqcd(iset) + isetlast = iset + endif +! + Q2=Q*Q + UCENT=QPDFXQ('UPVAL',X,Q2,IFAIL) + DCENT=QPDFXQ('DNVAL',X,Q2,IFAIL) + GCENT=QPDFXQ('GLUON',X,Q2,IFAIL) + UBCEN=QPDFXQ('UB',X,Q2,IFAIL) + DBCEN=QPDFXQ('DB',X,Q2,IFAIL) + STCEN=QPDFXQ('SB',X,Q2,IFAIL) + IF(Q2.GE.Q2C)THEN + CHCEN=QPDFXQ('CB',X,Q2,IFAIL) + ELSE + CHCEN=0.0 + ENDIF + IF(Q2.GE.Q2B)THEN + BTCEN=QPDFXQ('BB',X,Q2,IFAIL) + ELSE + BTCEN=0.0 + ENDIF + pdf(1)=dcent+dbcen + pdf(2)=ucent+ubcen + pdf(3)=stcen + pdf(4)=chcen + pdf(5)=btcen + pdf(6)=0d0 + pdf(0)=gcent + pdf(-1)=dbcen + pdf(-2)=ubcen + pdf(-3)=stcen + pdf(-4)=chcen + pdf(-5)=btcen + pdf(-6)=0d0 +! + return +! +!======================================================================= + entry ZEUSalfa(alfas,Q) + Q2=Q*Q + nf=6 + if (Q2.lt.mt2) nf=5 + if (Q2.lt.mb2) nf=4 + if (Q2.lt.mc2) nf=3 + alfas=QALFAS(Q2,Qlam,nf,iflag) +! print *,q2,alfas,qlam,nf,iflag + return +! +!======================================================================= + entry ZEUSread(nset) + read(1,*) gridname,nx,xmin,xmax,nq,qmin,qmax + return +! +!======================================================================= + entry ZEUSinit(nset,Eorder,Q2fit) +! print *,name(nset) + if(name(nset).eq.'QCDNUM_ZEUS_TR') then + HEAVY = .FALSE. + VFN = .TRUE. + else if(name(nset).eq.'QCDNUM_ZEUS_FF') then + HEAVY = .TRUE. + VFN = .FALSE. + else if(name(nset).eq.'QCDNUM_ZEUS_ZM') then + HEAVY = .FALSE. + VFN = .FALSE. + else + print *,'name/scheme not recognized' + stop 1 + endif +!--try 3 way logic ffn/zm-vfn/rt-vfn + IF(HEAVY)THEN + IVFN=1 + ELSE + IVFN=0 + ENDIF + IF(VFN)THEN + IVFN=IVFN+2 + ELSE + IVFN=IVFN + ENDIF +! IVFN=0 IS ZM-VFN, 1 IS FFN,2 IS RT-VFN, 3 IS NOT ALLOWED + + IF(IVFN.EQ.3)THEN + WRITE(*,*)'IVFN=3 SO STOP',IVFN + STOP + ENDIF + + + +!--qcdnum initialisation + CALL QNINIT +!--se thresholds + Q0=Q2fit + ZM=91.187D0 + ZM2=ZM*ZM + ALPHAS=QNALFA(ZM2) + + call getQmassM(nset,4,mc) + mc2=mc*mc + call getQmassM(nset,5,mb) + mb2=mb*mb + call getQmassM(nset,6,mt) + mt2=mt*mt + +! Q2C=1.8225 + Q2C=mc2 +! Q2B=18.49 + Q2B=mb2 +! print *,q2c,q2b + + IF (Q0.LT.Q2C) THEN + NACT=3 + ELSE + NACT=4 + ENDIF +!--this merely defines nact where we startevolution +!--namely at q0 + IF (HEAVY) NACT=3 + + CALL QNRSET('MCSTF',SQRT(Q2C)) + CALL QNRSET('MBSTF',SQRT(Q2B)) + CALL QNRSET('MCALF',SQRT(Q2C)) + CALL QNRSET('MBALF',SQRT(Q2B)) + + IF (HEAVY) THEN + CALL QTHRES(1D10,2D10) +! CALL QTHRES(1D6,2D6) + ELSE + CALL QTHRES(Q2C,Q2B) + ENDIF + + DO I=1,NSTARTP + CALL GRQINP(QSP(I),1) + ENDDO + CALL GRQINP(Q0,1) + CALL GRQINP(Q2C,1) + CALL GRQINP(Q2B,1) +! qcdnum grid not my grid + +! CALL GRXLIM(120,97D-8) + CALL GRXLIM(nx,xmin) + +! CALL GRQLIM(61,29D-2,200D3) + CALL GRQLIM(nq,qmin,qmax) + +!-- Get final grid definitions and grid indices of Q0, Q2C and Q2B + + CALL GRGIVE(NXGRI,XMI,XMA,NQGRI,QMI,QMA) +! WRITE(*,*)'NX,XL,XH,NQ,QL,QH',NXGRI,XMI,XMA,NQGRI,QMI,QMA + IQ0 = IQFROMQ(Q0) + IQC = IQFROMQ(Q2C) + IQB = IQFROMQ(Q2B) +!-- Allow for heavy weights + + IF (HEAVY) THEN + CALL QNLSET('WTF2C',.TRUE.) + CALL QNLSET('WTF2B',.TRUE.) + CALL QNLSET('CLOWQ',.FALSE.) + CALL QNLSET('WTFLC',.TRUE.) + CALL QNLSET('WTFLB',.TRUE.) + ENDIF + +!-- Compute weights and dump, or read in +! +! IF (READIN) THEN +! OPEN(UNIT=24,FILE='weights.dat',FORM='UNFORMATTED', +! . STATUS='UNKNOWN') +! CALL QNREAD(24,ISTOP,IERR) +! ELSE +! CALL QNFILW(0,0) +! IF (HEAVY) THEN +! OPEN(UNIT=24,FILE='weights.dat',FORM='UNFORMATTED', +! . STATUS='UNKNOWN') +! CALL QNDUMP(24) +! ENDIF +! ENDIF + + + if (index(gridname,'none').eq.1) then + call qnfilw(0,0) + else + qnerr=-1 + open(unit=2,status='old',file=gridname, & + & form='unformatted',err=1) + call QNREAD(2,1,qnerr) + 1 close(2) + if (qnerr.ne.0) then + write(*,*) 'Grid file problem: ',gridname + if (qnerr.lt.0) then + write(*,*) 'Grid file does not exist' + write(*,*) 'Calculating and creating grid file' + call qnfilw(0,0) + open(unit=2,status='unknown',file=gridname, & + & form='unformatted') + call QNDUMP(2) + close(2) + else + write(*,*) 'Existing grid file is inconsistent' + if (qnerr.eq.1) & + & write(*,*) 'Defined grid different' + if (qnerr.eq.2) & + & write(*,*) 'Heavy quark weight table different' + if (qnerr.eq.3) & + & write(*,*) 'Charm mass different' + if (qnerr.eq.4) & + & write(*,*) 'Bottom mass different' + stop + endif + endif + endif + +!-- Apply cuts to grid +!--taking away the s cut at 600d0 + CALL GRCUTS(-1D0,-1D0,-1D0,-1D0) + + + + +!-- Choose renormalisation and factorisation scales + + ! renormalisation + CALL QNRSET('AAAR2',1D0) + CALL QNRSET('BBBR2',0D0) + ! factorisation (light) + CALL QNRSET('AAM2L',1D0) + CALL QNRSET('BBM2L',0D0) + ! factorisation (heavy) + CALL QNRSET('AAM2H',1D0) + CALL QNRSET('BBM2H',0D0) + +! ZM=91.187D0 + imem=0 +! print *,imem +! -- only need call to listPDF here to get alphas + call listPDF(nset,imem,xval) +! print *,xval + AS=XVAL(1) +! AS=0.118d0 + CALL QNRSET('ALFQ0',ZM*ZM) + CALL QNRSET('ALFAS',AS) + +! ZM2=ZM*ZM + ALPHAS=QNALFA(ZM2) +! WRITE(*,*)'ALPHAS AT Mz2',ALPHAS + +!-- Book non-singlet distributions + + CALL QNBOOK(2,'UPLUS') + CALL QNBOOK(3,'DPLUS') + CALL QNBOOK(4,'SPLUS') + CALL QNBOOK(5,'CPLUS') + CALL QNBOOK(6,'BPLUS') + CALL QNBOOK(7,'UPVAL') + CALL QNBOOK(8,'DNVAL') + +!-- Book linear combinations for proton for f = 3,4,5 flavours + +!--define some quark pdfs + CALL dVZERO(PWGT,20) + PWGT(2) = 0.5 + + PWGT(7) = -0.5 + + PWGT(1) = 0.5/3. + CALL QNLINC(17,'UB',3,PWGT) + PWGT(1) = 0.5/4. + CALL QNLINC(17,'UB',4,PWGT) + PWGT(1) = 0.5/5. + CALL QNLINC(17,'UB',5,PWGT) + CALL dVZERO(PWGT,20) + + PWGT(4) = 0.5 + PWGT(1) = 0.5/3. + CALL QNLINC(18,'SB',3,PWGT) + PWGT(1) = 0.5/4. + CALL QNLINC(18,'SB',4,PWGT) + PWGT(1) = 0.5/5. + CALL QNLINC(18,'SB',5,PWGT) + CALL dVZERO(PWGT,20) + CALL QNLINC(19,'CB',3,PWGT) + PWGT(5) = 0.5 + PWGT(1) = 0.5/4. + + CALL QNLINC(19,'CB',4,PWGT) + PWGT(1) = 0.5/5. + CALL QNLINC(19,'CB',5,PWGT) + CALL dVZERO(PWGT,20) + PWGT(3) = 0.5 + + PWGT(8) = -0.5 + + PWGT(1) = 0.5/3. + CALL QNLINC(20,'DB',3,PWGT) + PWGT(1) = 0.5/4. + CALL QNLINC(20,'DB',4,PWGT) + PWGT(1) = 0.5/5. + CALL QNLINC(20,'DB',5,PWGT) + CALL dVZERO(PWGT,20) + CALL QNLINC(21,'BB',3,PWGT) + CALL QNLINC(21,'BB',4,PWGT) + PWGT(6) = 0.5 + + PWGT(1) = 0.5/5. + CALL QNLINC(21,'BB',5,PWGT) +!--- + + return +! +!======================================================================= + entry ZEUSpdf(nset) +! ZM = 91.187d0 +! zm2 = zm*zm + +! ALPHAS=QNALFA(ZM2) + + +! imem=mem + call getnmem(nset,imem) + call listPDF(nset,imem,xval) +! print *,nset,imem +! print *,xval +! print *,imem,xval + + UA=XVAL(3) + UB=XVAL(4) + UE=0.0d0 + UC=XVAL(5) + + DA=XVAL(7) + DB=XVAL(8) + DE=0.0d0 + DC=XVAL(9) + + GA=XVAL(11) + GB=XVAL(12) + GE=0.0d0 + GC=XVAL(13) + + SN=XVAL(14) + SA=XVAL(15) + SB=XVAL(16) + SE=0.0d0 + SC=XVAL(17) + + DLN=XVAL(18) + DLA=XVAL(19) +! DLB=XVAL(20) + DLB=XVAL(16)+2.0d0 + DLE=0.0d0 + DLC=XVAL(21) + AS=XVAL(1) + CALL QNRSET('ALFAS',AS) +!-- Input quark distributions at Q2 = Q02 GeV2 +!-- WRITE IN ACTUAL VALUES TO SAVE USING dgamma +! UN=2./AREA(UA-1,UB,UE,UC) +! DN=1./AREA(DA-1,DB,DE,DC) + UN = XVAL(2) + DN=XVAL(6) +! UBDBN=DLN/AREA(DLA-1,DLB,DLE,DLC) +! call grgive(nxgri,xxmin,xxmax,nqgri,qqmin,qqmax) + nxgri=nx + DO IX = 1,NXGRI + xX = XFROMIX(IX) + UPVAL=UN*FF_LHA(Xx,UA,UB,UE,UC) + + + DNVAL=DN*FF_LHA(Xx,DA,DB,DE,DC) + + + SEA=SN*FF_LHA(Xx,SA,SB,SE,SC) + +! GN=(1-UN*AREA(UA,UB,UE,UC)- +! . DN*AREA(DA,DB,DE,DC)- +! . SN*AREA(SA,SB,SE,SC))/AREA(GA,GB,GE,GC) + GN=XVAL(10) + GLUON=GN*FF_LHA(Xx,GA,GB,GE,GC) + + + +! UMD=UBDBN*FF_LHA(X,DLA,DLB,DLE,DLC) + UMD=DLN*FF_LHA(Xx,DLA,DLB,DLE,DLC) + SINGL=UPVAL+DNVAL+SEA + +! print *,un,dn,sn,gn,dln + + CSEA=0.0 + SSEA=0.2*SEA + USEA=(SEA-SSEA-CSEA)/2.-UMD + DSEA=(SEA-SSEA-CSEA)/2.+UMD + UPLUS=UPVAL+USEA-1./NACT*SINGL + DPLUS=DNVAL+DSEA-1./NACT*SINGL + SPLUS=SSEA-1./NACT*SINGL + + + CALL QNPSET('GLUON',IX,IQ0,GLUON) + CALL QNPSET('SINGL',IX,IQ0,SINGL) + CALL QNPSET('UPLUS',IX,IQ0,UPLUS) + CALL QNPSET('DPLUS',IX,IQ0,DPLUS) + CALL QNPSET('SPLUS',IX,IQ0,SPLUS) + CALL QNPSET('UPVAL',IX,IQ0,UPVAL) + CALL QNPSET('DNVAL',IX,IQ0,DNVAL) + ENDDO +!--THINGS ARE FINE FOR HEAVY SO DO IT + IF (HEAVY) THEN + +!-- Evolve over whole grid + + CALL EVOLSG(IQ0,1,NQGRI) + CALL EVPLUS('UPLUS',IQ0,1,NQGRI) + CALL EVPLUS('DPLUS',IQ0,1,NQGRI) + CALL EVPLUS('SPLUS',IQ0,1,NQGRI) + CALL EVOLNM('UPVAL',IQ0,1,NQGRI) + CALL EVOLNM('DNVAL',IQ0,1,NQGRI) + + ELSE + +!-- Evolve gluon, singlet and valence over whole grid + + CALL EVOLSG(IQ0,1,NQGRI) + CALL EVOLNM('UPVAL',IQ0,1,NQGRI) + CALL EVOLNM('DNVAL',IQ0,1,NQGRI) + +!-- Be more careful with plus distributions + + IF (NACT.EQ.3) THEN +!--THINGS ARE ALSO FINE IF 1Q0 IS BELOW 1QC THEN CLEARLY CSEA=0. IS OK +!--SITUATION CD BE 1