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