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