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 | !       PARAMETERS
  12 |         DOM_REAL, PARAMETER             :: x_min = 0.0
  13 |         DOM_REAL, PARAMETER             :: x_max = 1.0
  14 | 
  15 | !       IN
  16 |         DOM_INT                         :: nkabs, ngbands
  17 |         DOM_REAL, DIMENSION (ngbands,2) :: gazdata
  18 |         DOM_REAL, DIMENSION (ngbands)   :: F
  19 | 
  20 | !       OUT
  21 |         DOM_REAL, DIMENSION (nkabs)     :: w, ka_g_i
  22 | 
  23 | !       LOCAL
  24 |         DOM_INT   :: i
  25 |         DOM_REAL, DIMENSION (nkabs)     :: x
  26 |         DOM_REAL, DIMENSION (0:nkabs+1) :: g
  27 | 
  28 | !       ----------------------------!
  29 | !       Definition de la quadrature !
  30 | !       ----------------------------!
  31 | 
  32 |         CALL gauleg(x_min, x_max, x, w, nkabs)
  33 | 
  34 | !       -----------------------------------------!
  35 | !       Parametrisation du tableau de quadrature !
  36 | !       -----------------------------------------!
  37 | 
  38 |         g = 0.
  39 |         DO i=1,nkabs
  40 |           g(i) = x(i)
  41 |         ENDDO
  42 | 
  43 | !      -----------!
  44 | !       Test g(k) !
  45 | !      -----------!
  46 | !      if (pmm_rank.eq.PMM_HOST) then
  47 | !        open(unit=696,file="gdek.dat")
  48 | !        write(696,*) "-- ", phi, kbar
  49 | !        do kk=0.,5.5,0.1
  50 | !          CALL cdss(phi, kbar, 0., kk, gg)
  51 | !          write(696,*) kk, gg
  52 | !        enddo
  53 | !        close(696)
  54 | !      endif
  55 | 
  56 | !       ----------------------------------------------!
  57 | !       Calcul de la transmittance par k-distribution !
  58 | !       ----------------------------------------------!
  59 | 
  60 |         DO i=1,nkabs
  61 |           CALL COFG (F, ngbands, gazdata(:,2), gazdata(:,1), g(i),      &
  62 |      &               g(nkabs), ka_g_i(i))
  63 |         ENDDO
  64 | 
  65 | !      ---------------------------------------------------------------
  66 | !      This part is used when the medium is optically thin and g(k)
  67 | !      could be considered a Dirac pulse. In that case, the absorption
  68 | !      coefficient could be taken as euqal to the mean_k_abs of the
  69 | !      narrow band:
  70 | !      ---------------------------------------------------------------
  71 | 
  72 | !       kk = 0
  73 | !       DO i=1, ngbands
  74 | !         kk = kk + F(i)*gazdata(i,1)
  75 | !       ENDDO
  76 | !       ka_g_i(:) = kk
  77 | 
  78 |       END SUBROUTINE k_distributeur