1 | include(dom.inc)
   2 | 
   3 |        SUBROUTINE k_distributeur(F,ngbands,gazdata,nkabs,ka_g_i,w)
   4 | 
   5 |        !-------------------------------------------!
   6 |        ! CALCUL DE LA QUADRATURE EN K-DISTRIBUTION !
   7 |        !-------------------------------------------!
   8 | 
   9 |        IMPLICIT NONE
  10 | 
  11 | !      IN
  12 |        DOM_INT                            :: ngbands, nkabs
  13 |        DOM_REAL, DIMENSION (ngbands)      :: F
  14 |        DOM_REAL, DIMENSION (2,ngbands)    :: gazdata
  15 | 
  16 | !      OUT
  17 |        DOM_REAL, DIMENSION (nkabs)        :: w, ka_g_i
  18 | 
  19 | !      LOCAL
  20 |        DOM_INT                            :: i
  21 |        DOM_REAL, PARAMETER                :: x_min=0.0
  22 |        DOM_REAL, PARAMETER                :: x_max=1.0
  23 |        DOM_REAL, DIMENSION (0:nkabs+1)    :: g
  24 |        DOM_REAL, DIMENSION (nkabs)        :: x
  25 |        DOM_REAL                           :: kk,gg
  26 | 
  27 | !      --------------------------------------------!
  28 | !      Get quadrature points x(n) and weights w(n) !
  29 | !      --------------------------------------------!
  30 | 
  31 |        CALL gauleg(x_min,x_max,x,w,nkabs)
  32 | 
  33 | !      -----------------------------------------!
  34 | !      Parametrisation du tableau de quadrature !
  35 | !      -----------------------------------------!
  36 | 
  37 |        g = 0.
  38 |        DO i=1,nkabs
  39 |          g(i)=x(i)
  40 |        ENDDO
  41 | 
  42 | !      ----------!
  43 | !      Test g(k) !
  44 | !      ----------!
  45 | !       open(unit=696,file="gdek.dat")
  46 | !       do kk=0.,60,0.5
  47 | !         CALL cdss(gazdata(2,:), gazdata(1,:), kk, gg)
  48 | !         write(696,*) kk, gg
  49 | !       enddo
  50 | !       close(696)
  51 | 
  52 | !      ----------------------------------------------!
  53 | !      Transmitance calculation using k-distribution !
  54 | !      ----------------------------------------------!
  55 | 
  56 |        DO i=1,nkabs
  57 | !        print*, '    > Quadrature point:',i,'/',nkabs
  58 |          CALL COFG(F, ngbands, gazdata(2,:), gazdata(1,:), g(i),        &
  59 |      &             g(nkabs), ka_g_i(i))
  60 |        ENDDO
  61 | 
  62 | !      ---------------------------------------------------------------
  63 | !      This part is used when the medium is optically thin and g(k) 
  64 | !      could be considered a Dirac pulse. In that case, the absorption
  65 | !      coefficient could be taken as euqal to the mean_k_abs of the
  66 | !      narrow band:
  67 | !      ---------------------------------------------------------------
  68 | !
  69 | !      kk = 0
  70 | !      DO i=1, ngbands
  71 | !        kk = kk + F(i)*gazdata(1,i)
  72 | !      ENDDO
  73 | !      ka_g_i(:) = kk
  74 | 
  75 |        END SUBROUTINE k_distributeur