1 | include(dom.inc)
   2 | 
   3 |       SUBROUTINE DERI_KAPPA_SNB(ivar, delta, order, dkptot)
   4 | !     ================================================================!
   5 | !                                                                     !
   6 | !     deri_kappa.F : Calculate kappa derivative for snb case          !
   7 | !                                                                     !
   8 | !     author         : D. Poitou                                      !
   9 | !                                                                     !
  10 | !     ================================================================!
  11 | 
  12 |       USE mod_slave
  13 |       USE mod_inout
  14 |       USE mod_pmm
  15 | 
  16 |       IMPLICIT NONE
  17 | 
  18 |       include 'dom_constants.h'
  19 | 
  20 | !     IN
  21 |       DOM_INT                           :: ivar, order
  22 |       DOM_REAL                          :: delta
  23 | 
  24 | !     LOCAL
  25 |       DOM_INT                           :: iquad, idelta, i, i_bande
  26 |       DOM_INT                           :: ngbands
  27 |       DOM_REAL                          :: WVNB_SI, DWVNB_SI, blae
  28 |       DOM_REAL,DIMENSION(order,is_nkabs,is_nnodes) :: all_kabs
  29 |       DOM_REAL,DIMENSION(is_nkabs)             :: wkabs
  30 |       DOM_REAL,DIMENSION(is_nnodes)            :: Lb, dkptot, dkabs
  31 |       DOM_REAL,DIMENSION(8,is_nnodes)          :: data
  32 |       DOM_REAL,DIMENSION(order)                :: delta_data
  33 |       DOM_REAL,DIMENSION(is_ncells)            :: dkabs_cell, Lb_cell
  34 | 
  35 | 
  36 |       dkptot  = 0
  37 |       ngbands = 1
  38 | 
  39 |       IF(order.eq. 2) THEN
  40 |         delta_data(1) = -delta
  41 |         delta_data(2) =  delta
  42 |       ENDIF
  43 | 
  44 |       DO i_bande=1, is_nallbandes
  45 | 
  46 |         WVNB_SI   = 100.*s_all_WVNB(i_bande)
  47 |         DWVNB_SI  = 100.*s_all_DWVNB(i_bande)
  48 | 
  49 |         IF (pmm_rank.eq.0) THEN
  50 |           PRINT*, "      Band: ", i_bande,"/", is_nallbandes
  51 |         ENDIF
  52 | 
  53 |         all_kabs = 0.
  54 |         data     = s_celldata
  55 | 
  56 |         DO i=1, is_nnodes
  57 |           Lb(i)  = blae(WVNB_SI,s_celldata(1,i))/pi
  58 |         ENDDO
  59 | 
  60 |         DO idelta = 1, order
  61 | 
  62 |           data(ivar, :) = s_celldata(ivar,:) + delta_data(idelta)
  63 | 
  64 |           CALL CK_CASE(all_kabs(idelta,:,:), wkabs, data,               &
  65 |      &                 is_nnodes, s_all_WVNB, s_all_DWVNB, s_KCO, s_DCO,&
  66 |      &                 s_KC, s_DC, s_KH, s_DH, ngbands, i_bande,        &
  67 |      &                 is_nallbandes, is_nkabs, is_lbcd, is_lbcf)
  68 | 
  69 |         ENDDO
  70 | 
  71 |         call gather(Lb, Lb_cell, 1)
  72 |         call scatter(Lb_cell, Lb,1)
  73 | 
  74 |         DO iquad = 1, is_nkabs
  75 | 
  76 |           IF(delta.eq.0.or.order.lt.2) THEN
  77 |             dkabs(:) = all_kabs(1,iquad,:)
  78 |           ELSEIF (order.eq.2) THEN
  79 |             dkabs(:) = (all_kabs(2,iquad,:)                             &
  80 |      &                - all_kabs(1,iquad,:))/delta
  81 |           ENDIF
  82 | 
  83 | ! With Gather/scatter
  84 |           call gather(dkabs, dkabs_cell,1)
  85 |           call scatter(dkabs_cell, dkabs, 1)
  86 | 
  87 |           dkptot(:) = dkptot(:) + Lb(:)*4*pi*dkabs(:)*wkabs(iquad)      &
  88 |      &                 *DWVNB_SI
  89 | 
  90 | ! Without Gather/Scatter
  91 | !         dkptot(:) = dkptot(:) + Lb(:)*4*pi*dkabs(:)*wkabs(iquad)      &
  92 | !    &                 *DWVNB_SI*s_WSGG_W(iquad,:)
  93 | 
  94 |         ENDDO
  95 | 
  96 |       ENDDO
  97 | 
  98 |       dkptot(:) = dkptot(:) / (4*pi*sigma*s_celldata(1,:)**4)
  99 | 
 100 |       ENDSUBROUTINE DERI_KAPPA_SNB