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