!******************* START FILE DOINT_Z.FOR ; GROUP TESZIG ********************
!==============================================================================
!
SUBROUTINE DOINT_Z(FUN,ARRAY,N2,N1,ZL2,ZL1)
!
!  CALL INTEGRATOR (FUNCTION FUN
!  EXTERNAL-DECLARED IN CALLER) AND FILL ARRAY
!
!  FUN(W0,TI)  W0--NEUT ENERGY (KEV)  TI -- ION TEMP (KEV)
!
!============
! idecl:  explicitize implicit INTEGER declarations:
  use iso_c_binding, only: fp => c_double
  use sigtabl_mod, only : VCFAC,ifun
  use physconst_mod, only : zero,one,two,mp_g
  IMPLICIT NONE
  INTEGER n2,n1,i2,iwf,i1,ixf,ixf2
!============
! idecl:  explicitize implicit REAL declarations:
  real(fp) w0,ti,fun,zf1,zs1,zer,zs,sigall_z,&
       zvr,zsv,zvi2,zx1,zxf,zff,zffp,zsf,zshft,za3,za2,zzx,zans,&
       zansx
!============
  EXTERNAL FUN
  real(fp) :: ARRAY(N2,N1),ZL1(N1),ZL2(N2)
!
!------------------------------------------------------------------------------
!
  DO I2=1,N2  ! neutral ptcl energy
     W0=ZL2(I2)
     IWF=0
     DO I1=N1,1,-1
        TI=ZL1(I1)
        IF((W0.GT.1.e+3_fp*TI).AND.&
             ((I1.GT.2).OR.(IWF.GT.0))) GO TO 7
!-------------------
! ... DO THE INTEGRAL
        ARRAY(I2,I1)=FUN(W0,TI)
        cycle
!-------------------
! ... TRANSFORM FROM INTEGRAL TO APPROXIMATION CONTINUOUSLY
7       CONTINUE
        IF(IWF.GT.0) GO TO 8
        IWF=1
!  USE APPROXIMATIONS WHEN W0 >> TI
        IF(IFUN.EQ.6) THEN
           ZF1=zero
           ZS1=zero
        ELSE
           ZER=1.e+3_fp*W0+1.5e+3_fp*ZL1(1)
           ZS=1.e+4_fp*SIGALL_Z(ZER*1.e-3_fp,ZVR)
           ZVR=ZVR*100.0_fp
!
           ZSV=ZS*ZVR
           ZVI2=1.5e+3_fp*ZL1(1)*two*1.6029e-12_fp/mp_g
           IF(IFUN.LE.3) ZF1=ZSV
           IF((IFUN.EQ.4).OR.(IFUN.EQ.5)) ZF1=ZSV*ZVI2
           ZS1=zero
           IF(IFUN.GE.4) ZS1=ZL1(1)/ZF1*3.e+3_fp*ZSV*1.6029e-12_fp/mp_g
           ZF1=log10(ZF1)
        ENDIF
        ZX1=log10(ZL1(1))
!
        IXF=I1+1
        IXF2=I1+2
!
        ZXF=ZL1(IXF)
        ZXF=log10(ZXF)
!
        IF(IFUN.NE.6) THEN
           ZFF=ARRAY(I2,IXF)
           ZFF=log10(ZFF)
           ZFFP=log10(ARRAY(I2,IXF2))
        ELSE
           ZFF=ARRAY(I2,IXF)/SQRT(ZL1(IXF))
           ZFFP=ARRAY(I2,IXF2)/SQRT(ZL1(IXF2))
        ENDIF
        ZSF=(ZFFP-ZFF)/(log10(ZL1(IXF2))-ZXF)
!
        ZSHFT=ZX1
        ZX1=zero
        ZXF=ZXF-ZSHFT
!
        ZA3=one/(ZXF*ZXF)*((ZSF-ZS1)+two*(ZS1*ZXF+ZF1-ZFF)/ZXF)
        ZA2=one/ZXF*(3.0_fp*(ZFF-ZF1-ZS1*ZXF)/ZXF+(ZS1-ZSF))
!
8       CONTINUE
        ZZX=log10(ZL1(I1))-ZSHFT
        ZANS=((ZA3*ZZX+ZA2)*ZZX+ZS1)*ZZX+ZF1
        IF(IFUN.NE.6) THEN
           ZANSX=10.0_fp**ZANS
        ELSE
           ZANSX=ZANS*SQRT(ZL1(I1))
        ENDIF
        ARRAY(I2,I1)=ZANSX
!
!--------------------------/LOOP END:
!
     enddo
  enddo

!
  RETURN
END SUBROUTINE DOINT_Z
!
!******************* END FILE DOINT_Z.FOR ; GROUP TESZIG **********************
! 30Jun2000 fgtok -s r8_precision.sub "r8con.csh conversion"
