module general_mod
  use param_mod
! 19 oct 2017 : filament

  implicit none
  contains

    subroutine grilles()
      integer i,j,k
      double precision som,aire

! lecture de Ne et NH venant de PROM7
      open(unit=3,file='Ne_prom7prd',status='old')
      do i =1,NZ
         read(3,*) Ne(i)
      enddo
      close(unit=3)

      open(unit=4,file='NH_prom7prd',status='old')
      do i =1,NZ
         read(4,*) NH(i)
      enddo
      close(unit=4)

! Température
      T(:) = T_in

! Vitesse de Microturbulence
      VT(:) = VT_in

! grille générale
      grille = (/ 1.d-9 &
           , 1.d-8, 1.6d-8, 2.5d-8, 4.0d-8, 6.3d-8 &
           , 1.d-7, 1.6d-7, 2.5d-7, 4.0d-7, 6.3d-7 &
           , 1.d-6, 1.6d-6, 2.5d-6, 4.0d-6, 6.3d-6 &
           , 1.d-5, 1.6d-5, 2.5d-5, 4.0d-5, 6.3d-5 &
           , 1.d-4, 1.6d-4, 2.5d-4, 4.0d-4, 6.3d-4 &
           , 1.d-3, 1.6d-3, 2.5d-3, 4.0d-3, 6.3d-3 &
           , 1.d-2, 1.6d-2, 2.5d-2, 4.0d-2, 6.3d-2 &
           , 0.1d0, 0.2d0, 0.3d0, 0.4d0, 0.5d0, 0.6d0, 0.7d0, 0.8d0, 0.9d0, 1.d0 /)  
      
! NZ = n_grille*2-1

! grille de position en cm
      do i = 1,n_grille
         position(i) = grille(i)*0.5d5*EPST_in
      enddo
      do i = n_grille+1,NZ
         position(i) = position(i-1) + position(NZ-i+2) - position(NZ-i+1)
      enddo
      

! coefficients d'Einstein 
      A21 = AEMS(1,2) ! ok
      B21 = (A21*cl*cl)/(2.d0*h*(nu_0)**3.d0)
      B12 = (gg2/gg1)*B21 

! coefficients d'excitation par collision pour H
      C12(:) = Ne(:)*CECH(1,2,T_in)*exp(-(h*nu_0)/(BOLT*T(:)))
      C21(:) = C12(:)*(gg1/gg2)*exp((h*nu_0)/(BOLT*T(:)))

      
! coefficient d'extinction
      call calcul_coefficient_extinction(C21,T_in,coeff_extinction)

! largeur doppler

      delta_nu_D(:) = (nu_0/cl)*sqrt(VT(:)*VT(:)+(2.d0*T(:)*BOLT)/m_H)

! coefficient total d'absorption (intégré sur la fréquence)
      do i = 1,NZ
         kappa_bar(i) = ((h*nu_0)/(4.d0*pi))*NH(i)*B12
      enddo

 
! grille de profondeur optique tau. ici xmod
     
      xmod(1) = kappa_bar(1)*position(1)
      do i = 2,NZ
         xmod(i) = xmod(i-1)+kappa_bar(i)*(position(i)-position(i-1))
      enddo


! découpage en fréquence réduite

      xfr = (/ 0.d0, 0.5d0, 1.d0, 1.5d0, 2.d0, 2.5d0, 3.d0, 3.5d0, 4.d0, 5.d0, 6.d0 &
    , 8.d0, 10.d0, 14.d0, 20.d0, 28.d0, 38.d0, 50.d0, 70.d0, 100.d0 /)

! fréquence de découpage de la raie Lyman alpha : nu_0*XFR*delta_nuD. Pas besoin ici
      
! profil VOIGT(a_voigt,frequence reduite)

! élargissement naturel
      DFRNA = A21/(4.d0*pi)
 
! calcul de a_voigt
      call ELCOH1(NZ, T, Ne, DFRCO,NH)
      do i = 1,NZ
         a_voigt(i) = (DFRCO(i)+DFRNA)/delta_nu_D(1)
      enddo

! phi_nu non normalisé par rapport aux freq reduites
      do i =1,nfr
         do j = 1,NZ
            phi_nu(i,j) =  VOIGT(a_voigt(j),xfr(i))
         enddo
      enddo

      
! calcul de int(phi_nu~dnu) 
! le 28/11/2017
      do k = 1,NZ
         call integration_trapezes(-100.d0,100.d0,50000,aire,k)
      enddo

! Phi_nu normalisé par rapport à la freq relative
      phi_nu_normalise(:,:) = phi_nu(:,:)/(aire*delta_nu_D(1))


! tau_nu      

      tau_nu(:,:) = 0.d0

      do j = 1,nfr
         tau_nu(1,j) = xmod(1)*phi_nu(j,1)
         do i = 2,NZ
            tau_nu(i,j) = tau_nu(i-1,j)+0.5d0*(phi_nu_normalise(j,i-1)+phi_nu_normalise(j,i))*(xmod(i)-xmod(i-1))
         enddo
      enddo

! mu 
! mu=0 pose problème. Prendre mu /=0

      mu = (/ 0.2d0,0.4d0,0.6d0,0.8d0 /)
     
! poids en frequences relatives !!!
! le 28/11/2017
      call trapez(nfr,xfr*delta_nu_D(1),M) ! poids en frequences
     
      do i = 1,nfr
         do j = 1,NZ
            W(i) = M(i)*phi_nu_normalise(i,j) ! poids approximatif
         enddo
      enddo
      
      som = sum(W)
      W(:) = W(:)/som ! poids normalisé et proportionnel au profil phi_nu_normalise

! calcul du facteur de dilution
      call INTALT ( altitude_in,FADIR)

! CL inférieure
      call SOLINH (NFINT, FRFI, FINT,I_inf )

      return
    end subroutine grilles


    subroutine trapez(kmax,V,H)
! calcule les poids d'integration, pas l'integrale
      integer kmax,k
      double precision, dimension(kmax) :: V,H

      do k = 2, kmax-1
         H(k) = 0.5d0*(V(k+1)-V(k-1))
      enddo
      H(1) = 0.5d0*(V(2)-V(1))
      H(kmax) = 0.5d0*(V(kmax)-V(kmax-1))

      return
    end subroutine trapez
    
    subroutine coeff_mat_tridiagonale(a,b,c,nxmod,imu,ifreq)
      double precision, dimension(nxmod) :: a,b,c
      integer itau,nxmod,ifreq,imu
  
      a(:) = 0.d0
      b(:) = 0.d0
      c(:) = 0.d0

      b(1) = 1.d0+mu(imu)/(tau_nu(2,ifreq)-tau_nu(1,ifreq))
      c(1) = mu(imu)/(tau_nu(2,ifreq)-tau_nu(1,ifreq))
      a(nxmod) = mu(imu)/(tau_nu(nxmod,ifreq)-tau_nu(nxmod-1,ifreq))
      b(nxmod) = 1.d0+mu(imu)/(tau_nu(nxmod,ifreq)-tau_nu(nxmod-1,ifreq))

      do itau = 2,nxmod-1
         a(itau) = (2.d0*mu(imu)*mu(imu))/((tau_nu(itau,ifreq)-tau_nu(itau-1,ifreq))*(tau_nu(itau+1,ifreq)-tau_nu(itau-1,ifreq)))
         b(itau) = 1.d0+(2.d0*mu(imu)*mu(imu))/((tau_nu(itau+1,ifreq)-tau_nu(itau,ifreq))*(tau_nu(itau,ifreq)-tau_nu(itau-1,ifreq)))
         c(itau) = (2.d0*mu(imu)*mu(imu))/((tau_nu(itau+1,ifreq)-tau_nu(itau,ifreq))*(tau_nu(itau+1,ifreq)-tau_nu(itau-1,ifreq)))
      enddo

      return
    end subroutine coeff_mat_tridiagonale

    subroutine elimination_gauss(a,b,c,d,u,iter,imu,ifreq,S,I_inf)
      double precision, dimension(nxmod,nfr,nmu) :: u
      double precision, dimension(nxmod) :: a,b,c,d,z
      integer i,j,iter,imu,ifreq,l
      double precision, dimension(nxmod) :: EE !2nd membre de l'ETR discretisee
      double precision, dimension(nxmod,niter) :: S
      double precision, dimension(nfr) :: I_inf
  
      
      EE(:) = 0.d0
      d(:) = 0.d0
      z(:) = 0.d0
  
      do i = 2,nxmod-1
         EE(i) = S(i,iter-1)
      enddo
      EE(1) = I_sup
      EE(nxmod) = I_inf(ifreq)   
      
      d(1) = c(1)/b(1)
      z(1) = EE(1)/b(1) 
      
      do i = 2,nxmod-1
         d(i) = c(i)/(b(i)-a(i)*d(i-1))
      enddo
      do j = 2,nxmod-1
         z(j) = (EE(j)+a(j)*z(j-1))/(b(j)-a(j)*d(j-1))
      enddo

     u(nxmod,ifreq,imu) = (EE(nxmod)+a(nxmod)*z(nxmod-1))/(b(nxmod)-a(nxmod)*d(nxmod-1))
      do j = nxmod-1,1,-1
         u(j,ifreq,imu) = d(j)*u(j+1,ifreq,imu)+z(j)
      enddo



      return
    end subroutine elimination_gauss

    subroutine calcul_J_nu(u,nxmod,J_nu)
      integer iter,nxmod,i,j,k
   
      double precision, dimension(nxmod,nfr,nmu) :: u
      double precision, dimension(nfr,nxmod) :: J_nu

      J_nu(:,:) = 0.d0

      do i = 1,nfr
         do j = 1,nxmod
            do k = 1,nmu
               J_nu(i,j) = J_nu(i,j) + (1.d0/nmu)*u(j,i,k)
            enddo
         enddo
      enddo
     
      return
    end subroutine calcul_J_nu

    subroutine calcul_J_bar(J_bar,J_nu,W)
      double precision, dimension(nxmod) ::  J_bar  
      double precision, dimension(nfr,nxmod) :: J_nu
      integer i,iter,j
      double precision, dimension(nfr) :: W
     
      J_bar(:) = 0.d0
    
      do i = 1,nxmod
         do j = 1,nfr
            J_bar(i) = J_bar(i)+W(j)*J_nu(j,i)
         enddo
      enddo
  

      return
    end subroutine calcul_J_bar


    FUNCTION VOIGT ( A, V ) result (voigt_res)

!    Voigt function
!        Humlicek (1982) JQSRT 27, 437
      
      double precision A,V,voigt_res
      double complex Z, Z1


      Z = CMPLX ( V, A )
      Z1 = W4(Z)
      voigt_res = real(Z1)

      RETURN
    END FUNCTION VOIGT

    FUNCTION W4(Z) result (w4_res)

! COMPUTES THE COMPLEX PROBABILITY FUNCTION W(Z)=EXP(-Z**2)*ERFC(-I*Z)
! IN THE UPPER HALF-PLANE Z=X+I*Y (I.E. FOR Y>=0)
! MAXIMUM RELATIVE ERROR OF BOTH REAL AND IMAGINARY PARTS IS <1*10**(-4)
      double COMPLEX Z,T,U,w4_res
      double precision X,Y,S

      X=REAL(Z)
      Y=AIMAG(Z)
      T=CMPLX(Y,-X)
      S=ABS(X)+Y
      IF (S < 15.d0) GOTO 1
      ! *** REGION I
      w4_res=T*.5641896d0/(.5d0+T*T)
      RETURN
1     IF (S < 5.5d0) GOTO 2
      ! *** REGION II
      U=T*T
      w4_res=T*(1.410474d0+U*.5641896d0)/(.75d0+U*(3.d0+U))
      RETURN
2     IF (Y < .195d0*ABS(X)-.176d0) GOTO 3
      ! *** REGION III
      w4_res=(16.4955d0+T*(20.20933d0+T*(11.96482d0+T*(3.778987d0+T*.5642236d0))))/ &
           (16.4955d0+T*(38.82363d0+T*(39.27121d0+T*(21.69274d0+T*(6.699398d0+T)))))
      RETURN
      ! *** REGION IV
3     U=T*T
      w4_res= EXP(U)-T*(36183.31d0-U*(3321.9905d0-U*(1540.787d0-U*(219.0313d0-U* &
           (35.76683d0-U*(1.320522d0-U*.56419d0))))))/(32066.6d0-U*(24322.84d0-U* &
           (9022.228d0-U*(2186.181d0-U*(364.2191d0-U*(61.57037d0-U*(1.841439d0-U)))))))
      RETURN
    END FUNCTION W4

    FUNCTION AEMS ( I, J ) result (AJI)
!
!          Einstein coefficient for spontaneous emission in
!     the hydrogen atom (L. C. Johnson, 1972)
!          I    : lower level
!          J    : upper level
!

      integer I,J
      double precision AJI,XI,XJ,POMI,POMJ,COEF,X,XM1,G0,G1,G2,FIJ,GF,AMBDA,EIJ
 
      XI = FLOAT ( I )
      XJ = FLOAT ( J )
      POMI = 2.d0 * XI * XI
      POMJ = 2.d0 * XJ * XJ
      COEF = 32.d0 / ( 3.d0 * SQRT(3.d0) * PI )
      X = 1.d0 - ( XI / XJ )**2.d0
      XM1 = 1.d0 / X
      IF ( I == 1 ) GO TO 120
      IF ( I == 2 ) GO TO 140
      GO TO 160
120   CONTINUE
      G0 = 1.1330d0
      G1 = -0.4059d0
      G2 = 0.07014d0
      GO TO 200
140   CONTINUE
      G0 = 1.0785d0
      G1 = -0.2319d0
      G2 = 0.02947d0
      GO TO 200
160   CONTINUE
      G0 = 0.9935d0 + ( 0.2328d0 - 0.1296d0 / XI ) / XI
      G1 = - ( 0.6282d0 - ( 0.5598d0 - 0.5299d0 / XI ) / XI ) / XI
      G2 = ( 0.3887d0 - ( 1.181d0 - 1.470d0 / XI ) / XI ) / XI / XI
200   CONTINUE
      FIJ = COEF * XI * ( G0 + ( G1 + G2 * XM1 ) * XM1 ) / ( X * XJ )**3.d0
      GF = POMI * FIJ
      EIJ = RYD * ( 1.d0 / XI**2.d0 - 1.d0 / XJ**2.d0 )
      AMBDA = h * 3.d14 / EIJ
      AJI = 0.6670d8 * GF / ( POMJ * AMBDA * AMBDA )
      
      RETURN
    END FUNCTION AEMS
    
    SUBROUTINE ELCOH1 (NZ, T, Ne, DFRCO,NH)

!     Collisional broadening in hydrogen lines.

      double precision, dimension(6) :: PSR
      double precision, dimension(NZ) :: Ne,T,DFRCO,NH
      integer NI,NS,NZ,IZ
      double precision CVDW,PSIW,VHH,PSI,PSIR,COEF,AA1
      
      DATA PSR / 0.0, 4.94E-8, 7.93E-9, 2.75E-9, 1.29E-9, 7.14E-10 /
      

!     Resonance and Van der Waals broadening
!  (Lortet & Roueff, 1969, A&A 3, 462)

      NI = 1
      NS = 2
      
      CVDW = (1.61d-33) * ( NS**4.d0-NI**4.d0 )
      
      PSIR = 0.d0
      DO IZ = 1, NZ
         VHH = 20596.d0 * SQRT ( T(IZ) )
         PSIW = 17.d0 * CVDW**0.4d0 * VHH**0.6d0
         PSI = ( PSIR**EXPHN + PSIW**EXPHN ) ** (1.d0/EXPHN)
         DFRCO(IZ) = NH(IZ) * PSI / ( 4.d0 * PI )
      enddo
!   Stark broadening (Sutton, 1978, JQSRT 20, 333 )

      AA1 = 1.d0
      IF ( NS-NI == 1 ) AA1 = 0.642d0
      COEF = 0.255d0 * AA1 * FLOAT(NS*NS-NI*NI)
      DO IZ = 1, NZ
         DFRCO(IZ) = DFRCO(IZ) + COEF * Ne(IZ)**EXPS
      enddo
      RETURN
    END SUBROUTINE ELCOH1

    FUNCTION CECH ( I, J, TE ) result (CIJ)

!          Excitation coefficient by electron collisions for
!     the hydrogen atom (Johnson, 1972)
!          I    : lower level
!          J    : upper level
!          TE   : temperature
!     Use :
!              Cij = Ne * CECH(i,j,T) * exp(-Eij/kT)

      double precision CIJ,TE
      integer I,J
      double precision XI,XJ,COEF,X,XM1,G0,G1,G2,FIJ,AAA,PBN,RN,YN,BBB
      double precision Y,R,ZZZ,T1,T2,EIJ

      

      XI = FLOAT ( I )
      XJ = FLOAT ( J )
      COEF = 32.d0 / ( 3.d0 * SQRT(3.d0) * PI )
      X = 1.d0 - ( XI / XJ )**2.d0
      XM1 = 1.d0 / X
      IF ( I == 1 ) GO TO 120
      IF ( I == 2 ) GO TO 140
      GO TO 160
120   CONTINUE
      G0 = 1.1330d0
      G1 = -0.4059d0
      G2 = 0.07014d0
      GO TO 200
140   CONTINUE
      G0 = 1.0785d0
      G1 = -0.2319d0
      G2 = 0.02947d0
      GO TO 200
160   CONTINUE
      G0 = 0.9935d0 + ( 0.2328d0 - 0.1296d0 / XI ) / XI
      G1 = - ( 0.6282d0 - ( 0.5598d0 - 0.5299d0 / XI ) / XI ) / XI
      G2 = ( 0.3887d0 - ( 1.181d0 - 1.470d0 / XI ) / XI ) / XI / XI
200   CONTINUE
      FIJ = COEF * XI * ( G0 + ( G1 + G2 * XM1 ) * XM1 ) / ( X * XJ )**3.d0
      AAA = 2.d0 * XI * XI * XM1 * FIJ
      IF ( I == 1 ) THEN
         PBN = -0.603d0
         RN = 0.45d0
      ELSE
         YN = 1.d0 / XI
         PBN = YN * ( 4.d0 + YN * ( -18.63d0 + YN * ( 36.24d0 - YN * 28.09d0 ) ) )
         RN = 1.94d0 * YN**1.57d0
      END IF
      BBB = 4.d0 * XI * ( XI / XJ )**3.d0 * XM1 * XM1 * ( 1.d0 + XM1 * ( 4.d0/3.d0 &
           + XM1 * PBN ) )
      EIJ = RYD * ( 1.d0 / XI**2.d0 - 1.d0 / XJ**2.d0 )
      Y = EIJ / ( BOLT * TE )
      R = RN * X
      ZZZ = R + Y
      T1 = AAA * ( ( 1.d0/Y + 0.5d0 ) * EXPINT ( 1, Y ) - ( 1.d0/ZZZ + 0.5d0 ) &
           * EXPINT ( 1, ZZZ ) )
      T2 = ( BBB - AAA *  LOG ( 2.d0 * XI * XI * XM1 ) ) * ( EXPINT ( 2, Y ) &
           / Y - EXPINT ( 2, ZZZ ) / ZZZ )
      CIJ = SQRT ( CSE * TE ) * 2.d0 * XI * XI * XM1 * PIA02 * Y * Y * &
           ( T1 + T2 )
      
      RETURN
    END FUNCTION CECH

    FUNCTION EXPINT ( M, T ) result (res)
      double precision res,T,AAA,A1,BBB,E1
      double precision DEN,HUM
      integer M,N,I
      
      double precision, parameter ::  AA0=0.2677737343, AA1=8.6347608925 &
    , AA2=18.0590169730, AA3=8.5733287401, BB0=3.9584969228 &
    , BB1=21.0996530827, BB2=25.6329561486, BB3=9.5733223454 

      IF ( T < 0.d0 ) GO TO 900
      IF ( T == 0.d0 ) GO TO 20
      IF ( M == 0 ) GO TO 200
      IF ( T > 1.d0 ) GO TO 2
      E1 = -.57721566490153d0 -  LOG ( T )
      N = 1
      AAA = 1.d0
10    CONTINUE
      AAA = - AAA * T / FLOAT ( N )
      BBB = AAA / FLOAT ( N )
      E1 = E1 - BBB
      IF ( N <= 2 ) GO TO 11
      IF ( ABS(BBB) < (1.d-14*E1) ) GO TO 50
11    CONTINUE
      N= N+1
      GO TO 10
2     CONTINUE
      IF ( T <= 670.d0 ) GO TO 3
      res = 0.d0
      RETURN
 3    CONTINUE
      HUM = AA0 + T * ( AA1 + T * ( AA2 + T * ( AA3 + T ) ) )
      DEN = BB0 + T * ( BB1 + T * ( BB2 + T * ( BB3 + T ) ) )
      E1 = ( HUM / DEN ) * EXP ( - T ) / T
50    CONTINUE
      res = E1
      IF ( M == 1 ) RETURN
      DO  I = 2, M
         res = ( EXP ( - T ) - T * res ) / FLOAT ( I - 1 )
      enddo
      RETURN
20    CONTINUE
      IF ( M <= 1 ) GO TO 900
      res = 1.d0 / FLOAT ( M - 1 )
      RETURN
200   CONTINUE
      res = EXP ( - T ) / T
      RETURN

900   CONTINUE
      PRINT 999
999   FORMAT ( // ' NEGALIVE OR ZERO ARGUMENT IN EXPINT ' // )
      STOP
    END FUNCTION EXPINT

    
    SUBROUTINE INTALT ( ALTI,FADIR)
      
!	Computation of dilution factors, taking into account the
!	limb darkening and the altitude of the prominence.
!	(no limb darkening for Lyman lines).

      double precision ALTI
      integer I
      double precision K,K2,GG1,GG2,GG3,GG4
      double precision FADIR

      K = RS / ( RS + ALTI*1.d5 )
      K2 = K * K
      GG1 = 1.d0 - K2
      GG2 = SQRT(GG1)
      GG3 = LOG( (1.d0+K)/GG2 )
      GG4 = 1.d0 - GG1 * GG3 / K
      FADIR = 0.5d0 * ( 1.d0 - GG2 )
        
      RETURN
    END SUBROUTINE INTALT

    function BENU(F,T0) result (benu_res)
! fonction de Planck : varie en fonction de la temperature
! F : freq nu_0
      double precision F,T0,benu_res
      
      benu_res = 2.d0*h*F*(F/CL)*(F/CL) / ( EXP(h*F/BOLT/T0) - 1.d0 )
      return
    end function BENU

    SUBROUTINE SOLINH (NFINT, FRFI, FINT,I_inf )

!        Definition of intensities emitted by the solar disk in
!   hydrogen lines, in order to provide boundary conditions for
!   solving radiative transfer equations.
      
      integer NFINT,I
      double precision, dimension(NFINT) :: FRFI, FINT
      double precision, dimension(NFINT) :: AUX1,AUX2
      double precision CCLF,FR0
      double precision, dimension(nfr) :: I_inf
    
!     The file "intinc.dat" contains incident intensities for "NLI"
!   hydrogen lines.
!     The number of permitted transitions is given by "NTAR". The incident
!   intensities are registered only if their index is .LE. NTAR.
!     Concerning transitions whose index is .LE. NTAR which are not included
!   in "intinc.dat", the brightness temperature table (subroutine TEMBRI) is
!   used.

      I_inf(:) = 0.d0
    
      OPEN ( UNIT=4, FILE='intensite_incidente_L_alpha', STATUS='OLD' )
      DO I = 1, NFINT
         READ ( 4, * ) AUX1(I), AUX2(I)
      END DO
      
      FR0 = nu_0
      CCLF = 1.d-8 * FR0 * FR0 / CL

      FINT(:) = AUX2(:)*coef_Lalpha ! en erg/.../Hz
      FRFI(:) = AUX1(:)*CCLF ! en Hz
      
      do i =1,NFR
         call INTERL(NFINT,FRFI,FINT,xfr(i)*delta_nu_D(1),I_inf(i))
      enddo
     
! on multiplie les intensités incidentes par le facteur de dilution
      I_inf(:) = I_inf(:)*FADIR*2.d0


      
      RETURN
    END SUBROUTINE SOLINH

    SUBROUTINE INTERL ( N, XT, YT, X, Y )
!
!             INTERPOLATION LINEAIRE
      integer N
      double precision X,Y ! output
      double precision, DIMENSION(N) :: XT, YT
      INTEGER, SAVE :: I
      integer J

      DATA I / 1 /

      IF ( I <= 0 ) I = 1
      IF ( I >= N ) I = N - 1
100   CONTINUE
      IF ( X < XT(I) ) GO TO 200
      IF ( X > XT(I+1) ) GO TO 300
      J = I + 1
      Y = YT(I) + ( YT(J) - YT(I) ) * ( X - XT(I) ) / ( XT(J) - XT(I) )
      RETURN
200   I = I - 1
      IF ( I <= 0 ) GO TO 400
      GO TO 100
300   I = I + 1
      IF ( I >= N ) GO TO 500
      GO TO 100
400   Y = YT(1)
      RETURN
500   Y = YT(N)
      RETURN
    END SUBROUTINE INTERL

    subroutine calcul_coefficient_extinction(C21,T0,coeff_extinction)
      double precision T0
      double precision, dimension(NZ) :: C21,coeff_extinction,epsilon1

      epsilon1(:) = (C21(:)/A21)*(1.d0-exp(-(h*nu_0)/(bolt*T0)))

      coeff_extinction(:) = epsilon1(:)/(1.d0+epsilon1(:))
      return
    end subroutine calcul_coefficient_extinction

    subroutine integration_trapezes(a,b,n,aire,k)
    double precision a,b,aire,h,app,fn
    integer n,i,k
  

    aire = 0.d0
    h = (b-a)/n

    app = (h/2.d0)*(VOIGT(a_voigt(k),a)+VOIGT(a_voigt(k),b))

    do i = 1,n-1
       aire = aire + VOIGT(a_voigt(k),a+i*h)

    enddo

    aire = app+aire*h

    return
  end subroutine integration_trapezes
    


  end module general_mod
