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,homosyst,        &
   5 |      &                     ngbands,n_SNBmax,nkabs)
   6 | 
   7 |       IMPLICIT NONE
   8 | 
   9 |       DOM_REAL, PARAMETER              :: pi = 3.141592654
  10 |       CHARACTER*3                      :: homosyst 
  11 |       DOM_INT                          :: ielt,ncells,ngbands
  12 |       DOM_INT                          :: i_bande,n_cl,i
  13 |       DOM_INT                          :: n_SNBmax
  14 |       DOM_INT                          :: nkabs
  15 |       DOM_REAL,DIMENSION(nkabs)        :: w
  16 |       DOM_REAL,DIMENSION(2)            :: SNBDATA
  17 |       DOM_REAL,DIMENSION(2,ngbands)    :: gasdata
  18 |       DOM_REAL,DIMENSION(n_SNBmax)     :: F
  19 |       DOM_REAL,DIMENSION(14,n_SNBmax)  :: KCO,DCO,KC,DC,KH,DH
  20 |       DOM_REAL                         :: blae,planck
  21 |       DOM_REAL,DIMENSION(nkabs)        :: k_absmel
  22 |       DOM_REAL                         :: WVNB, DWVNB
  23 |       DOM_REAL                         :: WVNB_SI, DWVNB_SI
  24 |       DOM_REAL,DIMENSION(ncells,nkabs) :: all_k_abs
  25 |       DOM_REAL,DIMENSION(n_SNBmax)     :: all_WVNB,all_DWVNB
  26 |       DOM_REAL,DIMENSION(ncells)       :: Lb
  27 |       DOM_REAL,DIMENSION(ncells)       :: K_SOOT, FSK_SOOT
  28 |       DOM_REAL,DIMENSION(ncells,8)     :: celldata     
  29 |       DOM_INT  :: ICO,ICO2,IH2O
  30 |       LOGICAL  :: LICO,LICO2,LIH2O
  31 | 
  32 |       all_k_abs=0.
  33 |       FSK_SOOT=0.
  34 | 
  35 | !     ---------------------------------------------!
  36 | !     Non-homogeneous system or homogeneous system !
  37 | !     ---------------------------------------------!
  38 | 
  39 |       IF (homosyst.eq.'NO') THEN
  40 |         n_cl=ncells
  41 |       ELSEIF (homosyst.eq.'YES') THEN
  42 |         n_cl=1
  43 |       ENDIF 
  44 | 
  45 |       DO ielt=1,n_cl
  46 |         k_absmel=0.
  47 |         PRINT*, '>> Cell:',ielt,'/',n_cl
  48 | 
  49 | !       -----------------------------------!
  50 | !       Seting spectral data for each band !
  51 | !       -----------------------------------!
  52 | 
  53 |         gasdata = 0.
  54 | 
  55 |         DO i_bande=1,ngbands
  56 | 
  57 | !         PRINT*, '>> Bande:',i_bande,'/',n_SNBmax
  58 | 
  59 |           WVNB    = all_WVNB(i_bande)
  60 |           DWVNB   = all_DWVNB(i_bande)
  61 |           WVNB_SI = 100.*WVNB
  62 |           DWVNB_SI= 100.*DWVNB
  63 | 
  64 | !         ----------------------------------------!
  65 | !         Spectral index lecture for each species !
  66 | !         ----------------------------------------!
  67 | 
  68 |           IF (WVNB.le.9300.0) THEN
  69 | 
  70 |             CALL FINDI(LICO,LICO2,LIH2O,ICO,ICO2,IH2O,WVNB,DWVNB)
  71 | 
  72 |             CALL KBARANDPHI(celldata(ielt,:),LICO,LICO2,LIH2O,ICO,      &
  73 |      &           ICO2,IH2O,KCO,KC,KH,DCO,DC,DH,SNBDATA,n_SNBmax)
  74 | 
  75 |             gasdata(1:2,i_bande)=SNBDATA(1:2)
  76 | 
  77 |           ENDIF
  78 | 
  79 | !         -------------------------------------!
  80 | !         Band groupment multiplicative factor !
  81 | !         -------------------------------------!
  82 | 
  83 |           F(i_bande)   = blae(WVNB_SI,celldata(ielt,1))*DWVNB_SI
  84 |           K_SOOT(ielt) = 5.5*celldata(ielt,8)*WVNB_SI
  85 | 
  86 |           FSK_SOOT(ielt)=FSK_SOOT(ielt)+F(i_bande)*K_SOOT(ielt)
  87 | 
  88 |         ENDDO
  89 | 
  90 |         FSK_SOOT(ielt) = FSK_SOOT(ielt) / SUM(F)
  91 |         F              = F / SUM (F)
  92 | 
  93 | !       -------------------------------------------!
  94 | !       Quadrature calculation using spectral data !
  95 | !       -------------------------------------------!
  96 | 
  97 |         CALL k_distributeur(F, ngbands, gasdata, nkabs, k_absmel,w)
  98 | 
  99 |         all_k_abs(ielt,:)=k_absmel+FSK_SOOT(ielt)
 100 | 
 101 |       ENDDO
 102 | 
 103 |       IF (homosyst.eq.'YES') THEN
 104 |         DO i=2,ncells
 105 |           all_k_abs(i,:) = all_k_abs(1,:)
 106 |         ENDDO
 107 |       ENDIF
 108 | 
 109 |       END SUBROUTINE FSCK_CASE
 110 |