1 | include(dom.inc)
   2 | 
   3 |       SUBROUTINE WSGG_CASE(all_k_abs,global_WSGG_W,Lb,celldata,ncells,  &
   4 |      &                     alpha_wsgg,k_wsgg,all_WVNB,all_DWVNB,        &
   5 |      &                     ngg,nallbandes,celld,cellf)
   6 | 
   7 |       USE mod_inout
   8 |       USE mod_pmm
   9 | 
  10 |       IMPLICIT NONE
  11 | 
  12 |       include 'dom_constants.h'
  13 | 
  14 | !     IN
  15 |       DOM_INT                          :: nallbandes
  16 |       DOM_INT                          :: ngg, celld, cellf
  17 |       DOM_INT                          :: ncells
  18 |       DOM_REAL,DIMENSION(nallbandes)   :: all_WVNB,all_DWVNB
  19 |       DOM_REAL,DIMENSION(ncells)       :: Lb
  20 |       DOM_REAL,DIMENSION(8,ncells)     :: celldata
  21 |       DOM_REAL,DIMENSION(ngg)          :: k_wsgg
  22 |       DOM_REAL,DIMENSION(6,ngg)        :: alpha_wsgg
  23 | 
  24 | !     OUT
  25 |       DOM_REAL,DIMENSION(ngg,ncells)   :: all_k_abs
  26 |       DOM_REAL,DIMENSION(ngg,ncells)   :: global_WSGG_W
  27 | 
  28 | !     LOCAL
  29 |       DOM_REAL,DIMENSION(ngg,ncells)   :: local_all_k_abs
  30 |       DOM_REAL,DIMENSION(ngg,ncells)   :: WSGG_W
  31 |       DOM_REAL,DIMENSION(ncells)       :: K_SOOT, FSK_SOOT
  32 |       DOM_REAL,DIMENSION(ngg)          :: k_absmel
  33 |       DOM_REAL,DIMENSION(nallbandes)   :: F
  34 |       DOM_REAL                         :: blae, planck
  35 |       DOM_REAL                         :: WVNB_SI,DWVNB_SI
  36 |       DOM_INT                          :: ielt, i, ierr
  37 |       DOM_INT                          :: i_bande, n_cl
  38 |       DOM_INT                          :: j_gas,jk_gas
  39 | 
  40 |       global_WSGG_W   = 0.
  41 |       local_all_k_abs = 0.
  42 |       all_k_abs       = 0.
  43 |       FSK_SOOT        = 0.
  44 | 
  45 | !     This initialisation seem to create a bug...why?
  46 |       WSGG_W          = 0.
  47 | 
  48 | !     ---------------------------------------------!
  49 | !     Non-homogeneous system or homogeneous system !
  50 | !     ---------------------------------------------!
  51 | 
  52 |       IF (homosyst.eq.'NO') THEN
  53 |         n_cl=cellf
  54 |       ELSEIF (homosyst.eq.'YES') THEN
  55 |         n_cl=celld
  56 |       ENDIF
  57 | 
  58 |       DO ielt=celld,n_cl
  59 |         
  60 | !       ---------------------------------!
  61 | !       Mean soot absorption calculation !
  62 | !       ---------------------------------!
  63 | 
  64 |         DO i_bande=1,nallbandes
  65 | 
  66 |           WVNB_SI = 100.*all_WVNB(i_bande)
  67 |           DWVNB_SI= 100.*all_DWVNB(i_bande)
  68 | 
  69 |           F(i_bande)=blae(WVNB_SI,celldata(1,ielt))/(pi*Lb(ielt))*      &
  70 |      &               DWVNB_SI
  71 | 
  72 |           K_SOOT(ielt)=WVNB_SI*5.5*celldata(8,ielt)
  73 | 
  74 |           FSK_SOOT(ielt)=FSK_SOOT(ielt)+F(i_bande)*K_SOOT(ielt)
  75 | 
  76 |         ENDDO
  77 | 
  78 |         FSK_SOOT(ielt) = FSK_SOOT(ielt) / SUM(F)
  79 | 
  80 | !       -----------------------!
  81 | !       Mean kabs and weight w !
  82 | !       -----------------------!
  83 | 
  84 |         DO j_gas=1,ngg
  85 | 
  86 |           WSGG_W(j_gas,ielt)     = alpha_wsgg(1,j_gas)
  87 | 
  88 |           DO jk_gas=1,5
  89 | 
  90 |             WSGG_W(j_gas,ielt)     = WSGG_W(j_gas,ielt)+                &
  91 |      &      alpha_wsgg(jk_gas+1,j_gas)*celldata(1,ielt)**jk_gas
  92 | 
  93 |           ENDDO
  94 | 
  95 |           local_all_k_abs(j_gas,ielt) = k_wsgg(j_gas)*celldata(3,ielt)* &
  96 |      &    celldata(2,ielt)+FSK_SOOT(ielt)/WSGG_W(j_gas,ielt)
  97 | 
  98 |         ENDDO
  99 | 
 100 |       ENDDO
 101 | 
 102 |       IF (homosyst.eq.'YES') THEN
 103 |         DO i=celld+1,cellf
 104 |           local_all_k_abs(:,i) = local_all_k_abs(:,celld)
 105 |           WSGG_W(:,i)          = WSGG_W(:,celld)
 106 |         ENDDO
 107 |       ENDIF
 108 | 
 109 | !     ------------------------------------------------------!
 110 | !     sending local_all_k_abs....change to a pmm subroutine !
 111 | !     ------------------------------------------------------!
 112 | 
 113 |       CALL MPI_ALLREDUCE(local_all_k_abs, all_k_abs, ngg*ncells,        &
 114 |      &                   MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, &
 115 |      &                   ierr)
 116 | 
 117 |       CALL MPI_ALLREDUCE(WSGG_W, global_WSGG_W, ngg*ncells,             &
 118 |      &                   MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, &
 119 |      &                   ierr)
 120 | 
 121 |       END SUBROUTINE WSGG_CASE