1 | include(dom.inc)
   2 | 
   3 |        SUBROUTINE SCHEME_EXP(neighs,nfcelt, wkabs,mu, eta, ksi, w,Dm_ij,&
   4 |      &                Lb,Lpi,Gi,G,V,k_scat,k_abs,Li,Le,H,               &
   5 |      &                S, epsil, norm, ndir, ncells,i_gij,nfacemax,      &
   6 |      &                pathway,maxlen,s_s,nkabs)
   7 | 
   8 |        IMPLICIT NONE
   9 | 
  10 |        include 'dom_constants.h'
  11 | 
  12 |        DOM_INT :: ndir, ncells,i_gij,nfacemax,nkabs
  13 |        DOM_INT :: iquad, n, k_cell, k_coef, icell, j, i
  14 |        DOM_INT, DIMENSION (ncells,2*nfacemax) :: neighs
  15 |        DOM_INT, DIMENSION (ncells) :: nfcelt
  16 | 
  17 |        DOM_INT, DIMENSION(ndir,ncells) :: pathway
  18 |        DOM_REAL, DIMENSION(ndir,ncells) :: maxlen
  19 |        DOM_REAL, DIMENSION(ndir,ncells,nfacemax) :: s_s
  20 |        DOM_REAL,DIMENSION (nkabs) :: wkabs
  21 |        DOM_REAL,DIMENSION(ndir) ::  mu, eta, ksi, w
  22 |        DOM_REAL,DIMENSION(nfacemax) ::  Dm_ij
  23 |        DOM_REAL,DIMENSION(ncells) :: Lb, Lpi, Gi, G, V, k_scat, k_abs
  24 |        DOM_REAL, DIMENSION (ncells,nfacemax) :: Li, Le, H, S, epsil
  25 |        DOM_REAL, DIMENSION (ncells,nfacemax,3) ::  norm
  26 | 
  27 |        DO iquad=1,ndir
  28 | 
  29 |           DO icell=1,ncells
  30 | 
  31 |              j=pathway(iquad,icell)
  32 | 
  33 |              DO i=1,nfcelt(j)
  34 |                 Dm_ij(i)=norm(j,i,1)*mu(iquad)+norm(j,i,2)*             &
  35 |      &             eta(iquad)+norm(j,i,3)*ksi(iquad)
  36 |              ENDDO
  37 | 
  38 |              CALL EXPOSCHEME(k_abs(j),wkabs(i_gij),k_scat(j),           &
  39 |      &        V(j),S(j,:),Dm_ij,maxlen(iquad,icell),s_s(iquad,icell,:), &
  40 |      &        Lb(j),Gi(j),Li(j,:),epsil(j,:),Le(j,:),Lpi(j),nfacemax)
  41 | 
  42 |              G(j)=G(j)+Lpi(j)*w(iquad)
  43 | 
  44 |              !***********************************************!
  45 |              ! Mise a jour des faces de sorties de la cellule!
  46 |              ! Calcul du flux incident Hw a la parois        !
  47 |              !***********************************************!
  48 | 
  49 |              DO i=1,nfcelt(j)
  50 |                 IF (Dm_ij(i)>=0) THEN
  51 |                    IF (epsil(j,i)==-1.) THEN
  52 |                       Li(neighs(j,(2*i-1)),neighs(j,(2*i)))=Le(j,i)
  53 |                    ELSE
  54 |                       H(j,i)=H(j,i)+Le(j,i)*w(iquad)*Dm_ij(i)
  55 |                    ENDIF
  56 |                 ENDIF
  57 |              ENDDO
  58 | 
  59 |           ENDDO
  60 | 
  61 |        ENDDO
  62 | 
  63 |        END SUBROUTINE SCHEME_EXP