1 | include(dom.inc)
   2 | 
   3 |       SUBROUTINE FSCK_CASE(all_k_abs, w, Lb, celldata, ncells, all_WVNB,  &
   4 |      &                     all_DWVNB, KCO, DCO, KC, DC, KH, DH, ngbands,  & 
   5 |      &                     nallbandes, nkabs, 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                          :: nkabs, celld, cellf
  17 |       DOM_INT                          :: ncells, ngbands
  18 |       DOM_REAL,DIMENSION(14,nallbandes):: KCO,DCO,KC,DC,KH,DH
  19 |       DOM_REAL,DIMENSION(nallbandes)   :: all_WVNB,all_DWVNB
  20 |       DOM_REAL,DIMENSION(ncells)       :: Lb
  21 |       DOM_REAL,DIMENSION(8,ncells)     :: celldata
  22 | 
  23 | !     OUT
  24 |       DOM_REAL,DIMENSION(nkabs)        :: w
  25 |       DOM_REAL,DIMENSION(nkabs,ncells) :: all_k_abs
  26 | 
  27 | !     LOCAL
  28 |       DOM_REAL,DIMENSION(nkabs,ncells) :: local_all_k_abs
  29 |       DOM_REAL,DIMENSION(2)            :: SNBDATA
  30 |       DOM_REAL,DIMENSION(ngbands,2)    :: gasdata
  31 |       DOM_REAL,DIMENSION(ncells)       :: K_SOOT, FSK_SOOT
  32 |       DOM_REAL,DIMENSION(nkabs)        :: k_absmel
  33 |       DOM_REAL,DIMENSION(ngbands)      :: F
  34 |       DOM_REAL                         :: blae, planck
  35 |       DOM_REAL                         :: WVNB,DWVNB,WVNB_SI,DWVNB_SI
  36 |       DOM_INT                          :: ielt, i, ierr
  37 |       DOM_INT                          :: i_bande, n_cl
  38 |       DOM_INT                          :: ICO,ICO2,IH2O
  39 |       LOGICAL                          :: LICO,LICO2,LIH2O
  40 | 
  41 |       local_all_k_abs = 0.
  42 |       all_k_abs       = 0.
  43 |       FSK_SOOT        = 0.
  44 | 
  45 | !     ---------------------------------------------!
  46 | !     Non-homogeneous system or homogeneous system !
  47 | !     ---------------------------------------------!
  48 | 
  49 |       IF (homosyst.eq.'NO') THEN
  50 |         n_cl=cellf
  51 |       ELSEIF (homosyst.eq.'YES') THEN
  52 |         n_cl=celld
  53 |       ENDIF 
  54 | 
  55 |       DO ielt=celld,n_cl
  56 | 
  57 |         k_absmel = 0.
  58 | 
  59 | !       -----------------------------------!
  60 | !       Seting spectral data for each band !
  61 | !       -----------------------------------!
  62 | 
  63 |         gasdata = 0.
  64 | 
  65 |         DO i_bande=1,ngbands
  66 | 
  67 | !         IF (pmm_rank.eq.0) WRITE(*,*) ">> Bande:",i_bande,"/",ngbands
  68 | 
  69 |           WVNB    = all_WVNB(i_bande)
  70 |           DWVNB   = all_DWVNB(i_bande)
  71 |           WVNB_SI = 100.*WVNB
  72 |           DWVNB_SI= 100.*DWVNB
  73 | 
  74 | !         ----------------------------------------!
  75 | !         Spectral index lecture for each species !
  76 | !         ----------------------------------------!
  77 | 
  78 |           IF (WVNB.le.9300.0) THEN
  79 | 
  80 | !           print*, pmm_rank, " >> Findi"
  81 |             CALL FINDI(LICO,LICO2,LIH2O,ICO,ICO2,IH2O,WVNB,DWVNB)
  82 | 
  83 | !           print*, pmm_rank, " >> kbarandphi"
  84 |             CALL KBARANDPHI(celldata(:,ielt),LICO,LICO2,LIH2O,ICO,      &
  85 |      &                      ICO2,IH2O,KCO,KC,KH,DCO,DC,DH,SNBDATA,      &
  86 |      &                      nallbandes)
  87 | 
  88 |             gasdata(i_bande,1:2)=SNBDATA(1:2)
  89 | 
  90 |           ENDIF
  91 | 
  92 | !         -------------------------------------!
  93 | !         Band groupment multiplicative factor !
  94 | !         -------------------------------------!
  95 | 
  96 | !         IF (pmm_rank.eq.0) print*, "soot"
  97 | 
  98 |           F(i_bande)   = blae(WVNB_SI,celldata(1,ielt))*DWVNB_SI
  99 |           K_SOOT(ielt) = 5.5*celldata(8,ielt)*WVNB_SI
 100 | 
 101 |           FSK_SOOT(ielt)=FSK_SOOT(ielt)+F(i_bande)*K_SOOT(ielt)
 102 | 
 103 |         ENDDO
 104 | 
 105 |         FSK_SOOT(ielt) = FSK_SOOT(ielt) / SUM(F)
 106 |         F              = F / SUM (F)
 107 | 
 108 | !       -------------------------------------------!
 109 | !       Quadrature calculation using spectral data !
 110 | !       -------------------------------------------!
 111 | 
 112 |         CALL k_distributeur(F, ngbands, gasdata, nkabs, k_absmel,w)
 113 | 
 114 |         local_all_k_abs(:,ielt)=k_absmel+FSK_SOOT(ielt)
 115 | 
 116 |         IF ((MOD(ielt,100).eq.0).and.(pmm_rank.eq.0)) THEN
 117 |           print*, ">> Cell:",ielt-celld,"/",n_cl-celld
 118 |         ENDIF
 119 | 
 120 |       ENDDO
 121 | 
 122 |       IF (homosyst.eq.'YES') THEN
 123 |         DO i=celld+1,cellf
 124 |           local_all_k_abs(:,i) = local_all_k_abs(:,celld)
 125 |         ENDDO
 126 |       ENDIF
 127 | 
 128 | !     ------------------------------------------------!
 129 | !     sending all_k_abs....change to a pmm subroutine !
 130 | !     ------------------------------------------------!
 131 | 
 132 |        CALL MPI_ALLREDUCE(local_all_k_abs, all_k_abs, nkabs*ncells,     &
 133 |      &                    MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD,&
 134 |      &                    ierr)
 135 | 
 136 |       END SUBROUTINE FSCK_CASE
 137 |