← Back to branch summary

~ubuntu-branches/debian/sid/abinit/sid

« back to all changes in this revision

Viewing changes to src/15gw/assemblychi0_sym.F90

  • Committer: Bazaar Package Importer
  • Author(s): Christophe Prud'homme
  • Date: 2007-09-14 13:05:00 UTC
  • Revision ID: james.westby@ubuntu.com-20070914130500-1kzh2mrgo6ir4b6i
Tags: upstream-5.3.4.dfsg
Import upstream version 5.3.4.dfsg

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/15gw/assemblychi0_sym.F90
 
1
!{\src2tex{textfont=tt}}
 
2
!!****f* ABINIT/assemblychi0_sym
 
3
!! NAME
 
4
!! assemblychi0_sym
 
5
!!
 
6
!! FUNCTION
 
7
!! Update the independent particle susceptibility for the contribution
 
8
!! of one pair of occupied-unoccupied band, for each frequencies
 
9
!! taking into account the symmetries of the little group of the external 
 
10
!! point q
 
11
!!
 
12
!! Compute chi0(G,G'',io)=chi0(G,G'',io)+\sum_S (rhotwg(G)*rhotwg*(G''))*den(io)
 
13
!! where S are the symmetries of the little group of the external q-point.
 
14
!!
 
15
!! COPYRIGHT
 
16
!! Copyright (C) 1999-2007 ABINIT group (MG, GMR, VO, LR, RWG)
 
17
!! This file is distributed under the terms of the
 
18
!! GNU General Public License, see ~abinit/COPYING
 
19
!! or http://www.gnu.org/copyleft/gpl.txt .
 
20
!! For the initials of contributors, see ~abinit/doc/developers/contributors.txt .
 
21
!!
 
22
!! INPUTS
 
23
!!  npwsigx=number of plane waves for sigma exchange or epsilon (input variable)
 
24
!!  npwvec=maximum number of G vectors
 
25
!!  nomega=number of frequencies
 
26
!!  rhotwg(npwsigx)=density of a pair of occupied-unoccupied states, in reciprocal space
 
27
!!  den(nomega)=denominator of the susceptibility expression
 
28
!!  nop=number of symmetry operations
 
29
!!  ninv=if 2, inversion is considered; if 1, inversion is not considered
 
30
!!  nkbz=number of kpoints in the full BZ
 
31
!!  wtksym(2,nop)= equal to 1 if the symmetry (with or without time reversal) for this kpoint must be considered
 
32
!!   in the calculation of \chi_o, 0 otherwise  
 
33
!!  grottbm1(npwvec,2,nop)= contains the index of (IR) G where I is the identity or the inversion 
 
34
!!   operation and G is one of the npwvec vectors in reciprocal space 
 
35
!!    
 
36
!! OUTPUT
 
37
!!  (see side effects)
 
38
!!
 
39
!! SIDE EFFECTS
 
40
!!  chi0(npwsigx,npwsigx,nomega)=independent-particle susceptibility matrix in reciprocal space
 
41
!!
 
42
!! PARENTS
 
43
!!   
 
44
!!
 
45
!! CHILDREN
 
46
!!   
 
47
!!
 
48
!! SOURCE
 
49
 
 
50
#if defined HAVE_CONFIG_H
 
51
#include "config.h"
 
52
#endif
 
53
 
 
54
subroutine assemblychi0_sym(npwvec,npwsigx,ninv,nop,nkbz,wtksym,grottbm1,nomega,chi0,rhotwg,den)
 
55
 
 
56
 use defs_basis
 
57
 
 
58
 implicit none
 
59
 
 
60
!Arguments ------------------------------------
 
61
!scalars
 
62
 integer,intent(in) :: ninv,nkbz,nomega,nop,npwsigx,npwvec
 
63
!arrays
 
64
 integer,intent(in) :: grottbm1(npwvec,2,nop),wtksym(2,nop)
 
65
 complex,intent(in) :: rhotwg(npwsigx)
 
66
 complex,target :: chi0(npwsigx,npwsigx,nomega)
 
67
!no_abirules
 
68
 complex (kind(0.0d0)),intent(in) :: den(nomega)
 
69
 
 
70
!Local variables-------------------------------
 
71
!scalars
 
72
 integer :: i,i2,ig,igp,iinv,io,iop,npwsigx2
 
73
 complex :: dd
 
74
 logical,parameter :: vectorialized=.false.
 
75
!arrays
 
76
 complex,allocatable :: rhotwg_sym(:),rhotwgs(:)
 
77
 
 
78
! *************************************************************************
 
79
 
 
80
#ifdef VMS
 
81
!DEC$ ATTRIBUTES ALIAS:'CGERC' :: cgerc
 
82
#endif
 
83
 
 
84
!MG FIXME  this part is not used and symmetries are not used 
 
85
 if(vectorialized) then
 
86
!  calculate rhotwg*(G)
 
87
   allocate(rhotwgs(npwsigx))
 
88
   rhotwgs(:)=conjg(rhotwg(:))
 
89
   npwsigx2=npwsigx*npwsigx
 
90
!  do i=0, npwsigx*npwsigx*nomega-1
 
91
!    io =i/npwsigx2+1
 
92
!    ig =(i-(i/npwsigx2)*npwsigx2)/npwsigx+1
 
93
!    igp=i-(i/npwsigx2)*npwsigx2-&
 
94
!&    ((i-(i/npwsigx2)*npwsigx2)/npwsigx)*npwsigx+1
 
95
!    chi0(ig,igp,io)=chi0(ig,igp,io)+&
 
96
!&                 rhotwg(ig)*rhotwgs(igp)*den(io)
 
97
!  end do
 
98
   do ig=1,npwsigx
 
99
     do igp=1,npwsigx
 
100
       do io=1,nomega
 
101
         chi0(ig,igp,io)=chi0(ig,igp,io)+&
 
102
&                          rhotwg(ig)*rhotwgs(igp)*den(io)
 
103
       end do
 
104
     end do
 
105
   end do
 
106
   deallocate(rhotwgs)
 
107
 else
 
108
!   m(:,:)=0.0
 
109
!   call cher('U',npwsigx,1.0,rhotwg,1,m,npwsigx)
 
110
!   do ig=1, npwsigx
 
111
!     do igp=1, ig-1
 
112
!       m(ig,igp)=conjg(m(igp,ig))
 
113
!     end do
 
114
!   end do
 
115
!   do io=1, nomega
 
116
!     chi0(:,:,io)=chi0(:,:,io)+den(io)*m(:,:)
 
117
!   end do
 
118
 
 
119
!MG Symmetrization stuff
 
120
! should use a pointer!
 
121
  allocate(rhotwg_sym(npwsigx))
 
122
 
 
123
  do iop=1,nop
 
124
   do iinv=1,ninv
 
125
    if (wtksym(iinv,iop)==1) then 
 
126
     !here we should add the phase 
 
127
     if (iinv==1) then 
 
128
      rhotwg_sym(1:npwsigx)=rhotwg(grottbm1(1:npwsigx,iinv,iop))
 
129
     else 
 
130
      rhotwg_sym(1:npwsigx)=conjg(rhotwg(grottbm1(1:npwsigx,iinv,iop)))
 
131
     end if 
 
132
     do io=1,nomega
 
133
      !dd is single precision needed for cgerc
 
134
      dd=den(io)
 
135
      call cgerc(npwsigx,npwsigx,dd,rhotwg_sym,1,rhotwg_sym,1,chi0(:,:,io),npwsigx)
 
136
     end do
 
137
    end if 
 
138
   end do 
 
139
  end do 
 
140
 
 
141
 end if
 
142
  
 
143
 deallocate(rhotwg_sym)
 
144
 
 
145
end subroutine assemblychi0_sym
 
146
!!***