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