1 | include(dom.inc)
   2 | 
   3 |       SUBROUTINE CK_CASE(all_k_abs, w, Lb, celldata, ielmts, all_WVNB,  &
   4 |      &                    all_DWVNB, ngbands,                           &   
   5 |      &                    i_bande, 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 | !     IN
  16 |       DOM_INT                          :: nallbandes
  17 |       DOM_INT                          :: nkabs, ieltd, ieltf
  18 |       DOM_INT                          :: ielmts,ngbands
  19 |       DOM_REAL,DIMENSION(nallbandes)   :: all_WVNB,all_DWVNB
  20 |       DOM_REAL,DIMENSION(ielmts)       :: Lb
  21 |       DOM_REAL,DIMENSION(8,ielmts)     :: celldata
  22 | 
  23 | !     OUT
  24 |       DOM_REAL,DIMENSION(nkabs)        :: w
  25 |       DOM_REAL,DIMENSION(nkabs,ielmts) :: all_k_abs
  26 | 
  27 | !     LOCAL
  28 |       DOM_REAL,DIMENSION(nkabs,ielmts) :: local_all_k_abs
  29 |       DOM_REAL,DIMENSION(2,ngbands)    :: SNBDATA
  30 |       DOM_REAL,DIMENSION(ielmts)       :: WVSOOT
  31 |       DOM_REAL,DIMENSION(nkabs)        :: k_absmel
  32 |       DOM_REAL,DIMENSION(ngbands)      :: F
  33 |       DOM_REAL                         :: blae
  34 |       DOM_REAL                         :: WVNB,DWVNB,WVNB_SI,DWVNB_SI
  35 |       DOM_INT                          :: ielt, i, ierr
  36 |       DOM_INT                          :: i_bande
  37 |       DOM_INT                          :: ICO,ICO2,IH2O
  38 |       LOGICAL                          :: LICO,LICO2,LIH2O
  39 | 
  40 |       WVNB      = all_WVNB(i_bande)
  41 |       DWVNB     = all_DWVNB(i_bande)
  42 |       WVNB_SI   = 100.*WVNB
  43 |       DWVNB_SI  = 100.*DWVNB 
  44 |       WVSOOT    = WVNB_SI*5.5*celldata(8,:) 
  45 | 
  46 |       local_all_k_abs = 0.
  47 |       all_k_abs       = 0.
  48 |       k_absmel        = 0.
  49 | 
  50 | !     ----------------------------------------!
  51 | !     Spectral index lecture for each species !
  52 | !     ----------------------------------------!
  53 |    
  54 |       IF (WVNB.le.9300.0) THEN
  55 |         CALL FINDI(LICO,LICO2,LIH2O,ICO,ICO2,IH2O,WVNB,DWVNB)
  56 |       ENDIF
  57 | 
  58 | !     -----------------------!
  59 | !     Non-homogeneous system !
  60 | !     -----------------------!
  61 |       IF (homosyst.eq.'NO') THEN
  62 | 
  63 |         DO ielt = ieltd, ieltf
  64 | 
  65 | !         print*, pmm_rank, "Doing cell:",ielt,"/",ieltd,"->",ieltf
  66 | 
  67 |           IF (WVNB<=9300.0) THEN
  68 | 
  69 |             CALL KBARANDPHI(celldata(:,ielt),LICO,LICO2,LIH2O,ICO,ICO2, &
  70 |      &           IH2O,SNBDATA,nallbandes)
  71 | 
  72 | !           print*, pmm_rank, "       phi_mix, k_mix=", SNBDATA(2,1),   &
  73 | !    &                                                  SNBDATA(1,1)
  74 | 
  75 | !         -------------------------------------------------!
  76 | !         Band groupment multiplicative factor (=1 for ck) !
  77 | !         -------------------------------------------------!
  78 |           DO i = 1, ngbands
  79 |             F(i) = 1.
  80 |           ENDDO
  81 |           
  82 |           CALL k_distributeur(F, ngbands, SNBDATA, nkabs, k_absmel, w)
  83 | 
  84 |           ENDIF
  85 | 
  86 |           local_all_k_abs(:,ielt)=k_absmel(:)+WVSOOT(ielt)
  87 | 
  88 |         ENDDO
  89 | 
  90 | !     -------------------!
  91 | !     Homogeneous system !
  92 | !     -------------------!
  93 | 
  94 |       ELSEIF (homosyst.eq.'YES') THEN 
  95 | 
  96 |         IF (WVNB<=9300.0) THEN
  97 |           CALL KBARANDPHI(celldata(:,1),LICO,LICO2,LIH2O,ICO,ICO2,IH2O, &
  98 |      &         SNBDATA,nallbandes)
  99 | 
 100 | !         -------------------------------------------------!
 101 | !         Band groupment multiplicative factor (=1 for ck) !
 102 | !         -------------------------------------------------!
 103 |           DO i = 1, ngbands
 104 |             F(i) = 1.
 105 |           ENDDO
 106 | 
 107 |           CALL k_distributeur(F, ngbands, SNBDATA, nkabs, k_absmel, w)
 108 | 
 109 |         ENDIF
 110 | 
 111 |         DO ielt = ieltd, ieltf
 112 |           local_all_k_abs(:,ielt) = k_absmel(:) + WVSOOT(1)
 113 |         ENDDO
 114 | 
 115 |       ENDIF
 116 | 
 117 | !     ------------------------------------------------!
 118 | !     sending all_k_abs....change to a pmm subroutine !
 119 | !     ------------------------------------------------!
 120 | 
 121 |        CALL MPI_ALLREDUCE(local_all_k_abs, all_k_abs, nkabs*ielmts,     &
 122 |      &                    MPI_DOUBLE_PRECISION, MPI_SUM, COMM_PARA ,    &
 123 |      &                    ierr)
 124 | 
 125 | !     if (pmm_rank.eq.0) then
 126 | !     do i = 1, ielmts
 127 | !       print*, "kabs:",all_k_abs(:,i)
 128 | !     enddo
 129 | !     endif
 130 | 
 131 |       END SUBROUTINE CK_CASE
 132 |