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

	REAL (kind=dp) FUNCTION dege_elec(xchim,t,ro)

c estimation de la dégénérescnce électronique

c subroutine PUBLIC du module mod_etat

c entrées:
c	xchim1 : comp. chim. en mole
c	t : température K
c	ro : densité cgs

c sortie: degen_elec: dégénérescence électronique

c Auteur: P. Morel, Département Lagrange, O.C.A. CESAM2k

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

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

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

	INTEGER, PARAMETER :: m=4, pf12=501
	REAL (kind=dp), SAVE, DIMENSION(1,pf12) :: dgce
	REAL (kind=dp), SAVE, DIMENSION(pf12+m) :: f12t
	REAL (kind=dp), SAVE, DIMENSION(pf12) :: f12
	REAL (kind=dp), DIMENSION(5) :: fd
	REAL (kind=dp), DIMENSION(1) :: dfxdx, fx


	REAL (kind=dp), SAVE :: cte2
	REAL (kind=dp) :: nel, t7

	INTEGER, SAVE :: dep, fin, kno, l=m

	LOGICAL, SAVE :: init=.TRUE.

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

2000	FORMAT(8es10.3)

	IF(init)THEN	!initialisations
	 init=.FALSE.

c tabulation des fonctions F12 de Fermi-Dirac de dep à fin
c signe opposé de celui de Clayton
	 dep=-30.d0 ; fin=30.d0 ; t7=(fin-dep)/REAL(pf12-1,dp)	!vT
	 DO i=1,pf12
	  dgce(1,i)=dep+t7*REAL(i-1,dp) ; CALL fermi_dirac(dgce(1,i),fd)
	  f12(i)=fd(2)
	 ENDDO
	 CALL bsp1dn(1,dgce,f12,f12t,pf12,m,kno,.FALSE.,f12(2),l,fx,dfxdx)
	 IF(no_croiss)PRINT*,'Pb. at 2 in dege_elec'

c constante
	 cte2=SQRT(hpl/2.d0/me/kbol*hpl)**3/4.d0/pi

	ENDIF

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

c calcul direct de la dégénérescence, cas totalement ionisé
c t7 vT, SQRT(hpl/2.d0/me/kbol*hpl)**3/4.d0/pi*nel/SQRT(t)**3
	nel=DOT_PRODUCT(zi,xchim)*ro/amu
	t7=inside(f12(1),f12(pf12),cte2*nel/SQRT(t)**3)
	CALL bsp1dn(1,dgce,f12,f12t,pf12,m,kno,.TRUE.,t7,l,fx,dfxdx)
	IF(no_croiss)PRINT*,'Pb. at 3 in dege_elec'
	dege_elec=fx(1)

	RETURN

	END FUNCTION dege_elec