do_rho.f90 3.85 KB
Newer Older
Marco Govoni's avatar
Marco Govoni committed
1
!
2
! Copyright (C) 2015-2017 M. Govoni 
Marco Govoni's avatar
Marco Govoni committed
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
! This file is distributed under the terms of the
! GNU General Public License. See the file `License'
! in the root directory of the present distribution,
! or http://www.gnu.org/copyleft/gpl.txt .
!
! This file is part of WEST.
!
! Contributors to this file: 
! Marco Govoni
!
!----------------------------------------------------------------------------
SUBROUTINE do_rho ( )
  !----------------------------------------------------------------------------
  !
  USE kinds,                 ONLY : DP
  USE uspp,                  ONLY : vkb,nkb
  USE io_global,             ONLY : stdout
Govoni's avatar
Govoni committed
20
  USE pwcom,                 ONLY : current_spin,wk,nks,nelup,neldw,isk,igk_k,xk,npw,npwx,lsda,nkstot,current_k,ngk
Govoni's avatar
Govoni committed
21
  USE cell_base,             ONLY : tpiba2
Marco Govoni's avatar
Marco Govoni committed
22
  USE io_push,               ONLY : io_push_title,io_push_bar
23
  USE westcom,               ONLY : westpp_sign,iuwfc,lrwfc,westpp_calculation,westpp_range,westpp_save_dir,nbnd_occ 
Marco Govoni's avatar
Marco Govoni committed
24
25
26
27
28
29
30
31
32
33
34
  USE mp_global,             ONLY : inter_image_comm,my_image_id,intra_image_comm
  USE mp,                    ONLY : mp_bcast,mp_sum
  USE fft_base,              ONLY : dfftp,dffts
  USE wvfct,                 ONLY : nbnd
  USE buffers,               ONLY : get_buffer
  USE wavefunctions_module,  ONLY : evc,psic
  USE bar,                   ONLY : bar_type,start_bar_type,update_bar_type,stop_bar_type
  USE fft_at_gamma,          ONLY : single_invfft_gamma
  USE fft_at_k,              ONLY : single_invfft_k
  USE distribution_center,   ONLY : aband
  USE control_flags,         ONLY : gamma_only 
35
  USE types_bz_grid,         ONLY : k_grid
Marco Govoni's avatar
Marco Govoni committed
36
37
38
39
40
41
42
  !
  IMPLICIT NONE
  !
  ! ... LOCAL variables
  !
  INTEGER :: i1,i2, ipol, ir, local_j, global_j, i, ig, iks, ibnd, local_ib, global_ib
  REAL(DP),ALLOCATABLE :: auxr(:)
43
  CHARACTER(LEN=512)    :: fname
Marco Govoni's avatar
Marco Govoni committed
44
45
46
47
48
49
50
51
52
53
  TYPE(bar_type) :: barra
  CHARACTER(LEN=6) :: label
  !
  CALL io_push_title("(R)ho")
  !
  ALLOCATE(auxr(dffts%nnr))
  !
  auxr = 0._DP
  psic = 0._DP
  !
54
  CALL start_bar_type( barra, 'westpp', k_grid%nps ) 
Marco Govoni's avatar
Marco Govoni committed
55
  !
56
  DO iks = 1, k_grid%nps  ! KPOINT-SPIN LOOP
Marco Govoni's avatar
Marco Govoni committed
57
58
59
60
61
62
63
64
65
66
67
68
69
70
     !
     ! ... Set k-point, spin, kinetic energy, needed by Hpsi
     !
     current_k = iks
     IF ( lsda ) current_spin = isk(iks)
     call g2_kin( iks )
     !
     ! ... More stuff needed by the hamiltonian: nonlocal projectors
     !
     !IF ( nkb > 0 ) CALL init_us_2( ngk(iks), igk_k(1,iks), xk(1,iks), vkb )
     npw = ngk(iks)
     !
     ! ... read in wavefunctions from the previous iteration
     !
71
     IF(k_grid%nps>1) THEN
Marco Govoni's avatar
Marco Govoni committed
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
        !iuwfc = 20
        !lrwfc = nbnd * npwx * npol 
        !!CALL get_buffer( evc, nwordwfc, iunwfc, iks )
        IF(my_image_id==0) CALL get_buffer( evc, lrwfc, iuwfc, iks )
        !CALL mp_bcast(evc,0,inter_image_comm)
        !CALL davcio(evc,lrwfc,iuwfc,iks,-1)
        CALL mp_bcast(evc,0,inter_image_comm)
     ENDIF
     !
     !nbndval = nbnd_occ(iks)
     !
     DO local_ib=1,aband%nloc
        !
        ! local -> global
        !
        global_ib = aband%l2g(local_ib)
        IF( global_ib > nbnd_occ(iks) ) CYCLE
        !
        IF( gamma_only ) THEN 
           CALL single_invfft_gamma(dffts,npw,npwx,evc(1,global_ib),psic,'Wave')
           DO ir = 1, dffts%nnr
93
              auxr(ir) = auxr(ir) + REAL( psic(ir), KIND=DP) *  REAL( psic(ir), KIND=DP) * k_grid%weight(iks)  
Marco Govoni's avatar
Marco Govoni committed
94
95
96
97
           ENDDO 
        ELSE
           CALL single_invfft_k(dffts,npw,npwx,evc(1,global_ib),psic,'Wave',igk_k(1,current_k))
           DO ir = 1, dffts%nnr
98
              auxr(ir) = auxr(ir) + REAL( CONJG( psic(ir) ) * psic(ir), KIND=DP) * k_grid%weight(iks)
Marco Govoni's avatar
Marco Govoni committed
99
100
101
102
103
104
105
106
107
108
109
           ENDDO 
        ENDIF
        !
     ENDDO
     !
     CALL update_bar_type( barra,'westpp', 1 )
     !
  ENDDO
  !
  CALL mp_sum( auxr, inter_image_comm ) 
  !
110
  fname = TRIM( westpp_save_dir ) // "/rho"
Marco Govoni's avatar
Marco Govoni committed
111
112
113
114
115
116
117
  IF(my_image_id==0) CALL dump_r( auxr, fname)
  !
  DEALLOCATE( auxr )
  !
  CALL stop_bar_type( barra, 'westpp' )
  !
END SUBROUTINE