c****************************************************************

	SUBROUTINE gaunt_degene(ro,t,xchimm,gnt,dgntr,dgntt)!,dgntx)

c calcul de la dégénérescence (milieu complètement ionisé) pui
c fonction de Gaunt avec dégénérescence Cox & Guili eq. 16.84b

c entrées:
c	ro: densité
c	t: température
c	xchim : composition chimique / gramme

c sorties:
c	gnt: facteur de gaunt
c	dgntr, dgntt, dgntx: dérivées / ro, T, X

c Auteur: P. Morel, Département Cassiopée, O.C.A.

c----------------------------------------------------------------------

	USE mod_donnees, ONLY : amu, clight, hpl, kbol, me, nchim,
	1 nucleo, pi, zi
	USE mod_kind
	USE mod_numerique, ONLY : bsp1dn, fermi_dirac, no_croiss

	IMPLICIT NONE

	REAL (kind=dp), INTENT(in), DIMENSION(nchim) :: xchimm
	REAL (kind=dp), INTENT(in) :: ro, t

	REAL (kind=dp), INTENT(out) :: gnt, dgntr, dgntt

	INTEGER, PARAMETER :: pf12=101,	!nb. de points de tabulation de F12
	1 mdg=4	!ordre des splines
	REAL (kind=dp), SAVE, DIMENSION(1,pf12) :: dgce
	REAL (kind=dp), SAVE, DIMENSION(pf12+mdg) :: f12t
	REAL (kind=dp), SAVE, DIMENSION(pf12) :: f12
	REAL (kind=dp), DIMENSION(nchim) :: xchim

	REAL (kind=dp), DIMENSION(5) :: degen
	REAL (kind=dp), SAVE, DIMENSION(1) :: bid, dbid

	REAL (kind=dp),SAVE :: a00, a10, a20, a01, a11, a02, a21, a12, cte1

	REAL (kind=dp) :: a, dde, ddt, dep, detaf12, detar, detat, df12r, df12t,
	1 eta, fin, f12l, ksmec2, lngnt, mue

	INTEGER, SAVE :: i, knot, l=mdg

	LOGICAL, SAVE :: init=.TRUE.

c----------------------------------------------------------------------

2000	FORMAT(8es10.3)

	IF(init)THEN
	 init=.FALSE.

c constantes
	 ksmec2=kbol/me/clight**2
	 cte1=hpl**3/amu/4.d0/pi/SQRT(2.d0*me*kbol)**3	!pour calcul F1/2
	 a00=-0.3037d0	!coefficients équation 16.84b
	 a10=-6.89757d0*ksmec2
	 a20=8.89771d0*ksmec2**2
	 a01=-0.158737d0
	 a11=0.392553d0*ksmec2
	 a02=-0.0146867d0
	 a21=-0.451961d0*ksmec2**2
	 a12=-0.0523759d0*ksmec2

c tabulation des fonctions F12 de Fermi-Dirac de dep à fin
c signe opposé de celui de Clayton, dans le sens F1/2 --> degene
	 dep=-30.d0 ; fin=30.d0 ; a=(fin-dep)/DBLE(pf12-1)
	 DO i=1,pf12
	  dgce(1,i)=dep+a*(i-1) ; CALL fermi_dirac(dgce(1,i),degen)
	  f12(i)=degen(2)
	 ENDDO
	 CALL bsp1dn(1,dgce,f12,f12t,pf12,mdg,knot,.FALSE.,f12(2),l, bid,dbid)
	ENDIF

c--------------------initialisations fin-----------------------------

c xchim/mole, mue (totalement ionisé)
	xchim=xchimm/nucleo
	mue=1.d0/DOT_PRODUCT(xchim,zi)

c dégénérescence
	 f12l=cte1*ro/SQRT(t)**3/mue
	 IF(f12l < f12(1))THEN
	  eta=dgce(1,1) ; detaf12=0.d0 ; df12r= 0.d0 ; df12t=0.d0
	 ELSEIF(f12l > f12(pf12))THEN
	  eta=dgce(1,pf12) ; detaf12=0.d0 ; df12r= 0.d0 ; df12t=0.d0
	 ELSE
	  df12r=f12l/ro ; df12t=-3.d0/2.d0*f12l/t
	  CALL bsp1dn(1,dgce,f12,f12t,pf12,mdg,knot,.TRUE.,f12l,l,bid,dbid)
	  IF(no_croiss)PRINT*,'Pb. at 1 in saha'
	  eta=bid(1) ; detaf12=dbid(1)
	 ENDIF
	 detat=detaf12*df12t ; detar=detaf12*df12r
c	 PRINT*,'degene' ;  WRITE(*,2000)eta

c Gaunt factor
	lngnt=a00+(a10+(a11+a21*eta)*eta+(a20+a21*eta)*t)*t+(a01+a02*eta)*eta
	gnt=EXP(lngnt)

c dérivées
	ddt=a10+2.d0*(a20+a21*eta)*t+(a11+a12*eta)*eta
	dde=a01+(a11+a21*t)*t+2.d0*(a02+a12*t)*eta
	dgntt=gnt*(ddt+dde*detat)
	dgntr=gnt*dde*detar

	RETURN

	END SUBROUTINE gaunt_degene