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