!------------------------------------------------------------------------------
!
!  COMPTABL_Z  -- COMPUTE SIGMA*V INTEGRAL TABLE
!
!  DMC SEPT 1988
!
SUBROUTINE COMPTABL_Z(VTR,MTX,DOM1,DOM2,N1,N2,IER)
!
!============
! idecl:  explicitize implicit INTEGER declarations:
  use iso_c_binding, only: fp => c_double
  use sigtabl_mod   
  use physconst_mod, only : zero,one,mp_g
  IMPLICIT NONE
  INTEGER ier,iterbt,ix,jfun,iy,iadr,ierr
!============
! idecl:  explicitize implicit REAL declarations:
  real(fp) dummy,svth_z,epsbt,zv2kev,zcuns,svthe_z,tfun_z,&
       sigma_z,zy,zx,zfac,ztiev,zans1,zans2
!============
  INTEGER N1,N2
  real(fp) VTR(N1),MTX(N1,N2),DOM1(N1),DOM2(N2)
!
!  COMPUTE INTEGRAL TABLES AT USER GRID POINTS WHICH HAVE ALREADY BEEN
!  SET UP (CF X,Y, NXPTS, NYPTS)
!
!  THEN COMPUTE INTEGRALS AT MIDPOINTS OF GAPS IN USER GRID, AND COMPARE
!  RESULTS TO TABLE LOOKUP AND INTERPOLATION.  THIS "GAP GRID" USED FOR
!  ESTIMATING INTERPOLATION ERRORS IN USE OF THE TABLE, HAS ALSO BEEN
!  SET UP (XERR,YERR, NXM1=NXPTS-1, NYM1=NYPTS-1)
!
!  WHEN INTEGRALS ARE DONE USER MAY PLOT RESULTS, EITHER THE INTEGRALS
!  THEMSELVES OR THE INTERPOLATION ERRORS IN PER-CENT.
!
!  METHOD OF INTEGRATION VARIES WITH TYPE OF REACTION, TYPE OF INTEGRAL.
!
!  TYPE OF REACTION IS IDENTIFIED BY COMMON VARS. KREACT, KK
!    E.G. KREACT=-1 DENOTES ATOMIC CHARGE-EXCHANGE
!         KREACT=4  DENOTES D-->T (KK=0) OR T-->D (KK=1)
!    IF KREACT.GT.0 WE ARE DEALING WITH A FUSION REACTION AND KREACT, KK
!    ARE ARGUMENTS TO HARRY TOWNER'S SIGMA ROUTINE
!
!  TYPE OF INTEGRATION IS IDENTIFIED BY COMMON VARIABLE KEY, E.G.
!         KEY=1 FOR THERMONUCLEAR <SIGMA*V>
!         KEY=2 FOR BEAM TARGET <SIGMA*V>, ... ETC.
!
!------------------------------------------------------------------------------
!
!  REVISIONS
!  =========
!    DMC 2 OCT 1988 -- ADDED CALLS TO ATOMIC PHYSICS INTEGRATOR (DOINT,
!  PIRATED FROM OLD TESZIG PROGRAM)
!
!    DMC 7 OCT 1988 -- ADDED CALLS TO ROUTINES FROM BOB MCCANN'S OLD
!  BBCX PROGRAM, TO SUPPORT TRANSP BEAM-BEAM FUSION REACTION RATE GYRO
!  INTEGRALS.  NOTE UNITS ARE FUNNY HERE.
!    ** ALSO ** THE PRIMITIVE CROSS SECTIONS ARE HARD CODED IN THE
!  INTEGRAND ROUTINE.  THESE WERE CAREFULLY CHECKED AGAINST THE CURRENT
!  FUSION CROSS SECTIONS IN HHT'S SIGMA ROUTINE, IN SEPT 1988.
!    ** BUT ** IF FUSION CROSS SECTION FITS CHANGE, BOB'S ROUTINE
!  SIGVBB SHOULD BE UPDATED AND TESTED IN TANDEM
!
!    PCR 13 JUN 2000 -- REMOVED ERROR COMPUTATIONS
!
!------------------------------------------------------------------------------
!  FOR ATOMIC PHYSICS ROUTINES (DOINT ET AL)
!
  EXTERNAL TFUN_Z
!
  LOGICAL ICHEX
!
!------------------------------------------------------------------------------
!  FOR BEAM BEAM FUSION GYRO INTEGRAL
!
!CXX	EXTERNAL SIGVBB_Z  ! CALLED AS SUBROUTINE FROM INTEG_Z NOW !
!
!------------------------------------------------------------------------------
!
  IER=0
!
!  INITIALIZE INTEGRATIONS
!    SEE ALSO SUBROUTINE SIGPREP_Z (CALLS TO RMASS_Z DONE THERE)
!
  IF(KEY.EQ.1) THEN
     DUMMY = SVTH_Z(10._fp,1.e-4_fp,64,KREACT,0,6)
  ENDIF
!
  IF(KEY.EQ.2) THEN
     EPSBT=1.e-4_fp
     ITERBT=256
  ENDIF
!
  ICHEX=.FALSE.
  IF(KREACT.LT.0) THEN
! ATOMIC PHYSICS ROUTINES  -- CHARGE EXCHANGE ??
     IF((KREACT.EQ.-1).OR.(KREACT.EQ.-3).OR.(KREACT.EQ.-6).or.&
          (KREACT.EQ.-20).OR.(KREACT.EQ.-21).OR.(KREACT.EQ.-22))&
          ICHEX=.TRUE.
     IF((KREACT.EQ.-8).OR.(KREACT.EQ.-10).OR.(KREACT.EQ.-14))Then
        ICHEX=.TRUE.           ! tbt 12/20/94 for Lithium
     EndIf
     VCFAC=1.e-6_fp
     IFUN=0
     ZV2KEV=0.5e-3_fp*mp_g/1.6029e-12_fp
     IF(.NOT.ICHEX) THEN
        IF(KEY.EQ.2) IFUN=3
        IF(KEY.EQ.2) ZCUNS=1.e-6_fp
     ELSE
        IF(KEY.EQ.2) IFUN=2
        IF(KEY.EQ.2) ZCUNS=1.e-6_fp
        IF(KEY.EQ.3) IFUN=4
        IF(KEY.EQ.3) ZCUNS=1.0_fp
        IF(KEY.EQ.4) IFUN=6
        IF(KEY.EQ.4) ZCUNS=1.0_fp
     ENDIF
!
     IF(IFUN.EQ.0) THEN
        IER=1
        RETURN
     ENDIF
  ENDIF
!
!  INTEGRATION LOOPS
!
!==============================================================================
!  PRIMARY COMPUTATION OF NUMERICAL RESULT
!==============================================================================
!
!  1D TABLE
!
  IF(N2.EQ.0) THEN
!
!
     IF(KEY.EQ.1) THEN
        do ix=1,n1
           VTR(ix)=SVTHE_Z(DOM1(ix))
        enddo
     ENDIF
!
  ELSE
!
!  2D TABLE
!
!------------------------------------------------------------------------------
!  INSERT CALLS HERE TO EXTERNAL INTEGRATION LOOP ROUTINES
!------------------------------------------------------------------------------
!
     IF(KREACT.LT.0) THEN
!  ATOMIC PHYSICS -- LOOPS INSIDE DOINT_Z ROUTINE
        CALL DOINT_Z(TFUN_Z,MTX,N1,N2,DOM1,DOM2)
        IF((KEY.EQ.3).OR.(KEY.EQ.4)) THEN
!  NORMALIZING INTEGRAL FOR <EAV> OR < VB DOT VTARG / VB * VTH >
           JFUN=IFUN
           IFUN=2
           CALL DOINT_Z(TFUN_Z,ARRAY3,N1,N2,DOM1,DOM2)
           IFUN=JFUN
        ENDIF
     ENDIF
!
!  TRANSP BEAM BEAM GYRO INTEGRALS (DMC OCT 1988)
!
     IF(KEY.EQ.5) THEN
        DUMMY=SIGMA_Z(KREACT,0,6,100.0_fp)    ! set parameters for SIGE_Z
        ARRAY3(1:n2)=DOM2(1:n2)
        CALL INTEG_Z(DOM1,N1,ARRAY3,N2,MTX,KREACT)
     ENDIF
!
!------------------------------------------------------------------------------
!  LOOP OVER ALL INDEPENDENT COORDINATES.  CALL INTEGRATOR ROUTINE
!  *OR* NORMALIZE RESULTS FROM EXTERNAL INTEGRATION LOOP ROUTINE
!------------------------------------------------------------------------------
!
     DO  IY=1,N2
        ZY=DOM2(IY)
        DO IX=1,N1
           ZX=DOM1(IX)
           IADR=(IY-1)*N1+IX
!
           IF(KREACT.LT.0) THEN
!  ATOMIC PHYSICS-- NORMALIZE "DOINT_Z" RESULTS
              IF(KEY.GT.2) THEN
                 IF(KEY.EQ.3) THEN
                    ZFAC=ZV2KEV
                 ELSE
                    ZTIEV=ZY*1.e+3_fp
                    ZFAC=one/(SQRT(1.6029e-12_fp*ZTIEV/mp_g))
                 ENDIF
                 IF(ARRAY3(IADR).GT.zero) THEN
                    MTX(IX,IY)=ZFAC*MTX(IX,IY)/ARRAY3(IADR)
                 ELSE
                    MTX(IX,IY)=zero
                 ENDIF
              ENDIF
              MTX(IX,IY)=ZCUNS*MTX(IX,IY)
           ELSE
!  NUCLEAR PHYSICS-- DO INTEGRALS
              IF(KEY.EQ.2) THEN
!  <SIGMA*V> BEAM-TARGET FUSION
                 CALL DELTA_BEAM_Z(ZX,AMASS2,ZY,AMASS1,EPSBT,ITERBT,&
                      KREACT,KK,IERR,ZANS1,ZANS2)
!      	  IF(IERR.GT.1) WRITE(ILUNT,2901) IERR,ZX,ZY
! 2901 FORMAT(' DELTA_BEAM_Z:  IERR=',I6,', EB=',1PE12.5,' TI=',
!     >		    1PE12.5,' KEV')
                 MTX(IX,IY)=ZANS1
              ENDIF
           ENDIF
        enddo
     enddo
  ENDIF
!
END SUBROUTINE COMPTABL_Z
!
!------------------------------------------------------------------------------
! 30Jun2000 fgtok -s r8_precision.sub "r8con.csh conversion"
