!******************* START FILE GAUS6_Z.FOR ; GROUP GAUS6 *********************
!
SUBROUTINE GAUS6_Z(A,B,FUN,TEST2,EPS,MAX,J,IPUNIT)
!
!============
! idecl:  explicitize implicit INTEGER declarations:
  use iso_c_binding, only: fp => c_double
  IMPLICIT NONE
  INTEGER j,ipunit,k,i,max
!============
! idecl:  explicitize implicit REAL declarations:
 real(fp) b,test2,eps,a,e00,xlow,test1,sum,xhigh,c1,c0,z,fun,re
 real(fp),DIMENSION(3) :: X,W
!============
 EXTERNAL FUN
!
!	5/10/76
!	THIS PROGRAM WAS WRITTEN BY HARRY H. TOWNER OF THE NUCLEAR
!	ENGINEERING DEPT. UNIVERSITY OF ILLINOIS.  THIS PROGRAM WILL
!	INTEGRATE THE FUNCTION -FUN- BETWEEN THE LIMITS A AND B BY
!	USING 6-POINT GAUSS-LEGENDRE QUADRATURE.
!	PARAMETERS.
!	A=LOWER LIMIT OF INTEGRATION.
!	B=UPPER LIMIT OF INTEGRATION.
!	FUN=FUNCTION TO BE INTEGRATED.
!	TEST2=VALUE OF INTEGRAL.
!	EPS=RELATIVE ERROR OF INTEGRAL.
!	MAX=MAXIMUM NUMBER OF ITERATIONS.
!	J=NUMBER OF ITERATIONS TAKEN.
!	IPUNIT=LOGICAL UNIT USED FOR PRINTING.
!	NOTE THAT FUN IS PASSED BY MEANS OF AN EXTERNAL STATEMENT IN THE
!	CALLING PROGRAM
!	ARRAY X CONTAINS THE ROOTS OF THE LEGENDRE POLYNOMIAL.
!	ARRAY W CONTAINS THE WEIGHT FACTORS.
 DATA X/.238619186083197_fp,.661209386466265_fp,&
      .932469514203152_fp/
 DATA W/.467913934572691_fp,.360761573048139_fp,&
      .171324492379170_fp/
!
!  DMC Jan 2009: limit the warnings...
 integer, save :: iwarn = 0
!
 integer, parameter :: iwarn_max = 10
!------------------------------------------------------------------------------
!
 J=1
!	J TELLS HOW MENY TIMES TO APPLY QUADRATURE TO INTERVAL.
 TEST2=0._fp
200 XLOW=A
 TEST1=TEST2
 SUM=0.0_fp
 DO K=1,J
    XHIGH=XLOW+(B-A)/J
    C1=(XHIGH-XLOW)*.5_fp
    C0=C1+XLOW
    DO I=1,3
       Z=C1*X(I)
       SUM=SUM+C1*W(I)*(FUN(Z+C0)+FUN(-Z+C0))
    enddo
    XLOW=XHIGH
 enddo
 TEST2=SUM
 IF(TEST2.EQ.0._fp) RETURN
 RE=ABS((TEST2-TEST1)/TEST2)
 IF(RE.LE.EPS) return
 J=J*2
 IF(J.LE.MAX) GO TO 200
 J=J/2
 
 if((iwarn.lt.iwarn_max).or.(RE.gt.0.1_fp)) then
    WRITE(IPUNIT,20) J,RE
20  FORMAT(1X,'AFTER',I4,' ITERATIONS INTEGRAL HAS NOT CONVERGED',&
         ' RE=',1PE12.5,' GAUS6_Z')
    iwarn = iwarn + 1
    if(iwarn.eq.iwarn_max) then
       write(ipunit,*) &
            ' [gaus6_z: suppressed further warnings w/ RE < 0.1]'
       write(ipunit,*) ' [gaus6_z: as can generally be ignored.]'
    endif
 endif

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