!-----------------------------------------------------------------------------
!
real(fp) FUNCTION SIGMA_Z(N,KK,IPUNIT,E)
  use iso_c_binding, only: fp => c_double
  use csigma_mod
  IMPLICIT NONE
!============
! idecl:  explicitize implicit INTEGER declarations:
  INTEGER n,kk,ipunit
!============
! idecl:  explicitize implicit REAL declarations:
  real(fp) :: e
  real(fp) :: fbosch,am1,am2,am3,am4,ze2,ze1,zs1,zs2,sige_z
!  10/09/94 TBT
!           Add Lithium reactions 7-11
 
!...3/08/77
!...This  function was written by Harry H. Towner of the
!...Princeton Plasma Physics Lab. This function will initialize
!...parameters in common block csigma and then call function
!...SIGE to calculate the desired fusion cross-section (m**2).
!...if the only parameter which varies is e then SIGE should
!...be used after an initializing call to sigma is made.
!
!-----------------------
! UPGRADE - DMC - 11 SEP 1991
!  CODE IS ADDED TO USE THE NEW BOSCH FITTING PROCEDURE FOR THE
!  REACTIONS 1--4, SUPERSEDING THE OLDER DUANE/JARMIE FITS USED
!  HERETOFORE.  HOWEVER, THE OLD DUANE FITTING CODE IS RETAINED
!  AND MAY BE REVIVED BY CHANGING THE WAY THE LOGICAL VARIABLE
!  LBOSCH IS SET.
!
! THE BOSCH FITS AND FORMULAE ARE GIVEN IN THE PAPER
!
!  "Review of Data and Formulas for Fusion Cross-Sections"
!  by Hans-Stephan Bosch   IPP I/252, Garching, September 1990
!
! The Gamov factor "BG", sqrt(KeV), formula is on p. 2.
! A conversion to center-of-mass frame is required, cf. p. 2.
! The fit coefficients are on p. 29.
!
! Note that for D-T and D-He3 the fitting is split into two
! energy ranges; for simplicity the code supports two energy
! ranges for all reactions
!
! the call to SIGMA sets up COMMON block CSIGMA2 for subsequent
! calls to SIGE to actually evaluate the cross-sections, as before.
!
! NEW DATA:
!
  real(fp) :: BGDATA(4)   ! GAMOV FACTORS
  real(fp) :: ERDATA(3,4) ! ENERGY FIT RANGES
  real(fp) :: ALDATA(5,4),AHDATA(5,4),BLDATA(4,4),BHDATA(4,4) !COEFFS
  real(fp),dimension(6)::A_DPC ! A<nn> coefficient DPC fit 0/2018
  real(fp),dimension(5)::B_DPC ! B<nn> coefficient DPC fit 0/2018
  real(fp),parameter:: BG_DPC=38.4224306526e+00_fp ! GAMOV FACTORS, DPC fit 0/2018
  data A_DPC/1.83514616e+05_fp,-3.17779782e+02_fp,3.76709752e+00_fp,&
       -2.60896847e-03_fp,1.21563195e-06_fp,6.78016367e-11_fp/
  data B_DPC/3.36105299e-05_fp,1.86611385e-05_fp,-2.88648569e-08_fp,&
       1.45561737e-11_fp,-5.27692243e-16_fp/
! ENDF
  real(fp),dimension(4)::A_ENDF ! A<nn> coefficient ENDF fit 0/2018
  real(fp),dimension(4)::B_ENDF ! B<nn> coefficient ENDF fit 0/2018
  real(fp),parameter:: BG_ENDF=38.4224306526_fp
  data A_ENDF/2.86867049e-11_fp, -1.26581396e-02_fp, &
       6.31775307e-03_fp, -3.93623787e-03_fp/
  data B_ENDF/-6.68347948e-01_fp, 1.44900887e-01_fp,&
       1.74153264e-02_fp, 1404460.50227_fp/
!
!  DATA STATEMENTS BELOW...
!
!-----------------------
!
  integer, parameter :: NREACTS=11
!...PARAMETERS:
!...N - Tells what reaction you want
!	  =1 you get the cross section for the reaction  T(D,N)HE4
!	  =2 you get the cross section for the reaction  HE3(D,P)HE4
!	  =3 you get the cross section for the reaction  D(D,P)T
!	  =4 you get the cross section for the reaction  D(D,N)HE3
!	  =5 you get the cross section for the reaction  T(T,2N)HE4
!	  =12 you get the cross section for the reaction  T(T,2N)HE4 DPC fit 06/2018
!	  =6 you get the cross section for the reaction  T(HE3,X)Y
!         =7 Li
!         =8 Li    fudge tbt
!         =9 Li
!         =10Li
!         =11Li
!...KK - If KK=1 then you get the reverse reaction ie if N=1 and
!	 KK=1 you get the cross section for the reaction D(T,N)HE4
!...IPUNIT - the logical unit used for printing.
!...E - The energy of the incident particle.  (KEV)
!
  real(fp),dimension(nreacts) :: AA1,AA2,AA3,AA4,AA5,FFE
 
!       Lithium Fudge tbt (last 5 repeated.
  DATA AA1/1453.0_fp,2823.0_fp,1457.70_fp,1514.0_fp,1214.0_fp,&
       3893.0_fp,&
       2823.0_fp,1457.70_fp,1514.0_fp,1214.0_fp,&
       3893.0_fp/      ! tbt
 
  DATA AA2/502.e+5_fp,259.e+5_fp,372.e+3_fp,482.e+3_fp,448.e+3_fp,1125.e+4_fp,&
       259.e+5_fp,372.e+3_fp,482.e+3_fp,448.e+3_fp,1125.e+4_fp/
  DATA AA3/1368.e-8_fp,398.e-8_fp,436.e-9_fp,308.e-9_fp,102.e-8_fp,0.0_fp,&
       398.e-8_fp,436.e-9_fp,308.e-9_fp,102.e-8_fp,0.0_fp/
  DATA AA4/1.0760_fp,1.2970_fp,1.2200_fp,1.1770_fp,2.090_fp,0.0_fp,&
       1.2970_fp,1.2200_fp,1.1770_fp,2.090_fp,0.0_fp/
 
  DATA AA5/409.e+3,647.e+3_fp,0.0_fp,0.0_fp,0.0_fp,0.0_fp,&
       647.e+3_fp,0.0_fp,0.0_fp,0.0_fp,0.0_fp/
 
  DATA FFE/1.4974660_fp,1.4974560_fp,1.0_fp,1.0_fp,1.0_fp,1.0000070_fp,&
       1.4974560_fp,1.0_fp,1.0_fp,1.0_fp,1.0000070_fp/
 
!-----------------------------
!  DATA STATEMENTS FOR FIT COEFFS FOR NEW BOSCH FITS
!  DMC 11 SEP 1991 -- SEE COMMENTS, ABOVE...
!
  DATA BGDATA/34.3827_fp,68.7508_fp,31.3970_fp,31.3970_fp/
  DATA ERDATA/&
       0.5_fp, 550.0_fp, 4700.0_fp,&
       0.3_fp, 900.0_fp, 4800.0_fp,&
       0.5_fp, 5000.0_fp, 5000.0_fp,&
       0.5_fp, 4900.0_fp, 4900.0_fp/
  DATA ALDATA/&
       6.9270e+04_fp, 7.4540e+08_fp, 2.0500e+06_fp, 5.2002e+04_fp, 0.0_fp,&
       5.7501e+06_fp, 2.5226e+03_fp, 4.5566e+01_fp, 0.0_fp, 0.0_fp,&
       5.5576e+04_fp, 2.1054e+02_fp,-3.2638e-02_fp, 1.4987e-06_fp, 1.8181e-10_fp,&
       5.3701e+04_fp, 3.3027e+02_fp,-1.2706e-01_fp, 2.9327e-05_fp,-2.5151e-09_fp/
  DATA BLDATA/&
       6.3800e+01_fp,-9.9500e-01_fp, 6.9810e-05_fp, 1.728e-04_fp,&
       -3.1995e-03_fp,-8.5530e-06_fp, 5.9014e-08_fp, 0.0_fp,&
       0.0_fp, 0.0_fp, 0.0_fp, 0.0_fp,&
       0.0_fp, 0.0_fp, 0.0_fp, 0.0_fp/
  DATA AHDATA/&
       -1.4714e+06_fp, 0.0_fp, 0.0_fp, 0.0_fp, 0.0_fp,&
       -8.3993e+05_fp, 0.0_fp, 0.0_fp, 0.0_fp, 0.0_fp,&
       0.0_fp, 0.0_fp, 0.0_fp, 0.0_fp, 0.0_fp,&
       0.0_fp, 0.0_fp, 0.0_fp, 0.0_fp, 0.0_fp/
  DATA BHDATA/&
       -8.4127e-03_fp, 4.7983e-06_fp,-1.0748e-09_fp,8.5184e-14_fp,&
       -2.6830e-03_fp, 1.1633e-06_fp,-2.1332e-10_fp,1.4250e-14_fp,&
       0.0_fp, 0.0_fp, 0.0_fp, 0.0_fp,&
       0.0_fp, 0.0_fp, 0.0_fp, 0.0_fp/
!******************************************************************************
!
!
  LBOSCH=.FALSE.
  LFUN=.FALSE.
  LDPC=.FALSE.
  IF (N .GE. 1 .AND. N .LE. NREACTS+1) THEN
!
!  DMC 11 SEP 1991 -- DECIDE BTW OLD DUANE FITS AND NEW BOSCH FITS
!
     IF(N.LE.4) THEN
!  SET UP NEW BOSCH FITS
        LBOSCH=.TRUE.
        BG=BGDATA(N)
        CALL RMASS_Z(N,KK,AM1,AM2,AM3,AM4)
        EFAC=AM1/(AM1+AM2)
        ELOW=ERDATA(1,N)
        EMID=ERDATA(2,N)
        EHI=ERDATA(3,N)
        ALOW(1:5)=ALDATA(1:5,N)
        AHI(1:5)=AHDATA(1:5,N)
        BLOW(1:4)=BLDATA(1:4,N)
        BHI(1:4)=BHDATA(1:4,N)
!
!  COMPUTE SLOPE FOR HIGH ENERGY EXTRAPOLATION
!  I HAVE TESTED THESE TO 25 MeV USING TREXE:NUKTEST.EXE
!  DMC 12 SEP 1991
!
        ZE2=EHI
        ZE1=0.99_fp*EHI
        IF(EHI.GT.EMID) THEN
           ZS1=FBOSCH(ZE1,AHI(1),AHI(2),AHI(3),AHI(4),AHI(5),&
                BHI(1),BHI(2),BHI(3),BHI(4))
           ZS2=FBOSCH(ZE2,AHI(1),AHI(2),AHI(3),AHI(4),AHI(5),&
                BHI(1),BHI(2),BHI(3),BHI(4))
        ELSE
           ZS1=FBOSCH(ZE1,ALOW(1),ALOW(2),ALOW(3),ALOW(4),ALOW(5),&
                BLOW(1),BLOW(2),BLOW(3),BLOW(4))
           ZS2=FBOSCH(ZE2,ALOW(1),ALOW(2),ALOW(3),ALOW(4),ALOW(5),&
                BLOW(1),BLOW(2),BLOW(3),BLOW(4))
        ENDIF

        SLOPE=(ZS2-ZS1)/(ZE2-ZE1)
!  MODIFICATION SEEMS BEST FOR D-T (DMC 12 SEP)
        IF(N.EQ.1) SLOPE=0.15_fp*SLOPE
!
     endif
     IF(N.EQ.12) THEN         !DPC fit 06/2018  
        LDPC=.TRUE. 
        CALL RMASS_Z(N,KK,AM1,AM2,AM3,AM4)
        FE=AM1/(AM1+AM2)
        BG=BG_DPC
        ahi(1:6)=a_dpc(1:6)
        bhi(1:5)=b_dpc(1:5)
     endif
     IF(N.lt.12.and.N.gt.4) THEN 
        LFUN=.TRUE.
        FE=1.0_fp
        IF(KK.EQ.1) FE=1.0_fp/FFE(N)
        A1=AA1(N)
        A2=AA2(N)
        A3=AA3(N)
        A4=AA4(N)
        A5=AA5(N)
     ENDIF
!
     SIGMA_Z=SIGE_Z(E)
     RETURN
!
  ELSE
!  ERROR CHECK
     WRITE(IPUNIT,10) N
10   FORMAT(1X,'This value of n is not allowed ',I3,&
          ' returned from function sigma_z')
     call bad_exit
  ENDIF
!
END FUNCTION SIGMA_Z
!
!------------------------------------------------------------------------------
! 30Jun2000 fgtok -s r8_precision.sub "r8con.csh conversion"
