1 | include(dom.inc)
   2 | 
   3 |       SUBROUTINE BAND_INTEG_SNB(wkabs, kabs, kscat, Lb, Lo, DWVNB_SI,   &
   4 |      &                      Gtot, Lbtot,  Htot, Q_rtot, Q_ptot)
   5 | 
   6 |         USE mod_slave
   7 |         USE mod_inout
   8 |         USE mod_pmm
   9 | 
  10 |         IMPLICIT NONE
  11 | 
  12 |         include 'dom_constants.h'
  13 |         include 'pmm_constants.h'
  14 | 
  15 | !       IN
  16 |         DOM_REAL                              :: DWVNB_SI
  17 |         DOM_REAL,DIMENSION(is_nkabs)          :: wkabs
  18 |         DOM_REAL,DIMENSION(is_nkabs,is_ncells):: kabs
  19 |         DOM_REAL,DIMENSION(is_ncells)         :: Lb, kscat
  20 |         DOM_REAL,DIMENSION(is_nbfaces)        :: Lo
  21 | 
  22 | !       OUT
  23 |         DOM_REAL,DIMENSION(3,is_ncells)          :: Q_rtot
  24 |         DOM_REAL,DIMENSION(is_ncells)            :: Gtot, Lbtot
  25 |         DOM_REAL,DIMENSION(is_nbfaces)           :: Htot
  26 |         DOM_REAL,DIMENSION(3,is_nprobes)         :: Q_ptot
  27 | 
  28 | !       LOCAL
  29 |         DOM_INT                                  :: iquad, i
  30 |         DOM_INT                                  :: n_iter, maxiter
  31 |         DOM_INT                                  :: mloc(1)
  32 |         DOM_REAL                                 :: error
  33 |         DOM_REAL,DIMENSION(is_ncells)            :: G, Gi
  34 |         DOM_REAL,DIMENSION(is_nbfaces)           :: H, Hi
  35 |         DOM_REAL,DIMENSION(3,is_ncells)          :: Qr
  36 |         DOM_REAL,DIMENSION(3,is_nprobes)         :: Qp
  37 | 
  38 | !       print*, " (",pmm_rank,") Doing band integration"
  39 | 
  40 | !       --------------------------!
  41 | !       Integrate the narrow band !
  42 | !       --------------------------!
  43 | 
  44 |         DO iquad=1,is_nkabs
  45 | 
  46 | !         -----------------------------------------------------!
  47 | !         Initialisation values before reflection subiteration !
  48 | !         -----------------------------------------------------!
  49 | 
  50 |           G  = 0.
  51 |           H  = 0.
  52 | 
  53 |           error   = 1.
  54 |           n_iter  = 0
  55 |           maxiter = 500
  56 | 
  57 |           DO WHILE ((error.gt.critconv).and.(n_iter.lt.maxiter))
  58 | 
  59 |             IF(SUM(s_epsil)/is_nbfaces.eq.1) n_iter = maxiter
  60 | 
  61 | !           -------------------------------------------!
  62 | !           Update values for reflection sub iteration !
  63 | !           -------------------------------------------!
  64 | 
  65 |             Gi = G
  66 |             Hi = H
  67 | 
  68 | !           ---------------!
  69 | !           SPATIAL SCHEME !
  70 | !           ---------------!
  71 | 
  72 |             CALL SPATIAL_SCHEME(I_SCHEME, Lb, Gi, G, kabs(iquad,:),     &
  73 |      &                          kscat, Qr, H, alpha, Qp, Lo)
  74 | 
  75 | !           --------------------------------!
  76 | !           Convergence test for reflection !
  77 | !           --------------------------------!
  78 | 
  79 |             mloc  = MAXLOC(abs(H-Hi))
  80 |             IF ((n_iter.ne.0).and.((abs(Hi(mloc(1)))).ne.0.)) THEN
  81 |               error = (abs(H(mloc(1))-Hi(mloc(1))))/abs(Hi(mloc(1)))
  82 |             ELSE
  83 |               error = 1.
  84 |             ENDIF
  85 | 
  86 |             n_iter = n_iter + 1
  87 | 
  88 | !           IF (pmm_rank.eq.0) print*, "Nq=",iquad,"/",is_nkabs,"-",    &
  89 | !    &                         "n_iter=",n_iter,"- err=", error
  90 | 
  91 | !           IF (pmm_rank.eq.0) print*, "mloc=",mloc(1),"- H=",          &
  92 | !    &                         H(mloc(1)),"- Hi=",Hi(mloc(1))
  93 | 
  94 |           ENDDO
  95 | 
  96 | !         -------------------------------!
  97 | !         Sum over band quadrature point !
  98 | !         -------------------------------!
  99 | 
 100 |           Gtot(:)  = Gtot(:)  + G(:)*kabs(iquad,:)*                   &
 101 |      &                 wkabs(iquad)*DWVNB_SI
 102 |           Lbtot(:) = Lbtot(:) + Lb(:)*4*pi*kabs(iquad,:)*             &
 103 |      &                 wkabs(iquad)*DWVNB_SI
 104 |           Htot(:)  = Htot(:)  + H(:)*wkabs(iquad)*DWVNB_SI
 105 |           DO i=1,3
 106 |             Q_rtot(i,:) = Q_rtot(i,:)+Qr(i,:)*wkabs(iquad)*DWVNB_SI
 107 |             Q_ptot(i,:) = Q_ptot(i,:)+Qp(i,:)*wkabs(iquad)*DWVNB_SI
 108 |           ENDDO
 109 | 
 110 |         ENDDO
 111 | 
 112 |       END SUBROUTINE BAND_INTEG_SNB