1 | include(dom.inc)
   2 | 
   3 |       SUBROUTINE FSK_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 |  
  48 |         IF (MOD(ielt,100).eq.0) PRINT*, '>> Cell:',ielt,'/',n_cl
  49 | 
  50 | !       -----------------------------------!
  51 | !       Seting spectral data for each band !
  52 | !       -----------------------------------!
  53 | 
  54 |         gasdata = 0.
  55 | 
  56 |         DO i_bande=1,ngbands
  57 | 
  58 | !         PRINT*, '>> Bande:',i_bande,'/',n_SNBmax
  59 | 
  60 |           WVNB    = all_WVNB(i_bande)
  61 |           DWVNB   = all_DWVNB(i_bande)
  62 |           WVNB_SI = 100.*WVNB
  63 |           DWVNB_SI= 100.*DWVNB
  64 | 
  65 | !         ----------------------------------------!
  66 | !         Spectral index lecture for each species !
  67 | !         ----------------------------------------!
  68 | 
  69 |           IF (WVNB.le.9300.0) THEN
  70 | 
  71 |             CALL FINDI(LICO,LICO2,LIH2O,ICO,ICO2,IH2O,WVNB,DWVNB)
  72 | 
  73 |             CALL KBARANDPHI(celldata(ielt,:),LICO,LICO2,LIH2O,ICO,      &
  74 |      &           ICO2,IH2O,KCO,KC,KH,DCO,DC,DH,SNBDATA,n_SNBmax)
  75 | 
  76 |             gasdata(1:2,i_bande)=SNBDATA(1:2)
  77 | 
  78 |           ENDIF
  79 | 
  80 | !         -------------------------------------!
  81 | !         Band groupment multiplicative factor !
  82 | !         -------------------------------------!
  83 | 
  84 |           F(i_bande)   = blae(WVNB_SI,celldata(ielt,1))*DWVNB_SI
  85 |           K_SOOT(ielt) = 5.5*celldata(ielt,8)*WVNB_SI
  86 | 
  87 |           FSK_SOOT(ielt)=FSK_SOOT(ielt)+F(i_bande)*K_SOOT(ielt)
  88 | 
  89 |         ENDDO
  90 | 
  91 |         FSK_SOOT(ielt) = FSK_SOOT(ielt) / SUM(F)
  92 |         F              = F / SUM (F)
  93 | 
  94 | !       -------------------------------------------!
  95 | !       Quadrature calculation using spectral data !
  96 | !       -------------------------------------------!
  97 | 
  98 |         CALL k_distributeur(F, ngbands, gasdata, nkabs, k_absmel,w)
  99 | 
 100 |         all_k_abs(ielt,:)=k_absmel+FSK_SOOT(ielt)
 101 | 
 102 |       ENDDO
 103 | 
 104 |       IF (homosyst.eq.'YES') THEN
 105 |         DO i=2,ncells
 106 |           all_k_abs(i,:) = all_k_abs(1,:)
 107 |         ENDDO
 108 |       ENDIF
 109 | 
 110 |       END SUBROUTINE FSK_CASE
 111 |