wann_rw_eig.F 8.49 KB
Newer Older
1 2 3 4 5 6
!--------------------------------------------------------------------------------
! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
! This file is part of FLEUR and available as free software under the conditions
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------

7 8 9 10 11 12 13 14 15 16 17
      MODULE m_wann_rw_eig
      use m_juDFT
#ifdef CPP_MPI
#define CPP_HYBEIG
#endif
c****************************************************************
c    write WF1.eig and determine maximum of number of bands
c      Frank Freimuth, October 2006
c****************************************************************
      CONTAINS
      SUBROUTINE wann_write_eig(
18
     >              eig_id,l_real,
19 20
     >              lmaxd,ntypd,nlod,neigd,nvd,jspd,
     >              isize,jspin,nbasfcn,nlotot,
21
     >              l_ss,l_noco,nrec,fullnkpts,
22 23 24
     >              l_bzsym,l_byindex,l_bynumber,l_byenergy,
     >              irreduc,odi,band_min,band_max,numbands,
     >              e1s,e2s,ef,l_paulimag,nkpt,    
25
     <              nbnd,kpoints,l_gwf,iqpt)
26 27

      use m_cdnread, only:cdn_read
28
      use m_types
29 30

      IMPLICIT NONE
31
      integer,intent(in) :: eig_id
32 33
      integer,intent(in) :: lmaxd,ntypd,nlod,neigd,nvd,jspd
      integer,intent(in) :: isize,jspin,nbasfcn,nlotot
34
      logical,intent(in) :: l_ss,l_noco,l_real
35
      integer,intent(in) :: nrec,fullnkpts
36

37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63
      logical,intent(in) :: l_byindex,l_bynumber,l_byenergy
      integer,intent(in) :: irreduc(fullnkpts)
      type (od_inp),intent(in) :: odi
      integer,intent(in) :: band_min,band_max,numbands
      logical,intent(in) :: l_bzsym
      real,intent(in)    :: e1s,e2s,ef
      logical,intent(in) :: l_paulimag
      integer,intent(in) :: nkpt

      integer,intent(out):: nbnd
      real,intent(out)   :: kpoints(fullnkpts)

      logical          :: l_eig
      character(len=3) :: spin12(2)
      data spin12/'WF1' , 'WF2'/
      integer          :: ikpt,kptibz
      integer          :: nmat,nbands,nv(jspd)
      real             :: wk, bkpt(3),eig(neigd),cp_time(9)
      integer          :: k1(nvd,jspd),k2(nvd,jspd),k3(nvd,jspd)
      integer          :: nkbnd,i
      REAL             :: ello(nlod,ntypd,jspd),evdu(2,jspd)
      REAL             :: epar(0:lmaxd,ntypd,jspd)
      integer          :: n_start,n_end,co
      integer          :: bnd1,bnd2,kpt
      complex, allocatable :: paulimat(:,:,:,:) 
      real             :: sum1,sum2,sum3
      integer          :: num_bands,err
64 65 66 67 68 69
      
! BEGIN QPOINTS
      LOGICAL, INTENT(IN) :: l_gwf
      INTEGER, INTENT(IN) :: iqpt
      CHARACTER(len=12) :: fname
! END QPOINTS
70 71
      real,parameter   :: hartree=27.21138505

72
      TYPE(t_mat) :: zMat !z(nbasfcn,noccbd) !can be real/complex
73 74

      zMat%l_real = l_real
75 76
      zMat%matsize1 = nbasfcn
      zMat%matsize2 = neigd
77
      IF(l_real) THEN
78
         ALLOCATE (zMat%data_r(zMat%matsize1,zMat%matsize2))
79
      ELSE
80
         ALLOCATE (zMat%data_c(zMat%matsize1,zMat%matsize2))
81
      END IF
82

83 84
!      WRITE(*,*)'min',band_min,'max',band_max,'num',numbands
!      WRITE(*,*)'wann_rw_eig: neigd',neigd
85 86
      n_start=1
      n_end=neigd
87 88 89 90 91 92 93 94
      IF (l_gwf) THEN
         WRITE(fname,'("_",i4.4,".eig")')iqpt
         fname=spin12(jspin)//trim(fname)
      ELSE
         fname=spin12(jspin)//'.eig'
      ENDIF

!      WRITE(*,*)'wann_rw_eig.F: writing eig file ',fname
95

96
      inquire (file=fname,exist=l_eig)
97
      if (l_eig) then
98
         open (306,file=fname,
99 100 101
     &                               form='formatted',status='old')
         rewind (306)
      else
102
         open (306,file=fname,
103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135
     &                               form='formatted',status='new')
      endif!l_eig

      if(l_paulimag.and..false.)then
        num_bands=band_max-band_min+1
        allocate( paulimat(num_bands,num_bands,3,nkpt),stat=err )
        IF (err/=0)  CALL juDFT_error
     +       ("error allocating paulimat",calledby
     +       ="wann_rw_eig")
        open(655,file='wpmat')
        do ikpt=1,nkpt
          read(655,*)
          do co=1,3
            read(655,*)
            do bnd2=1,num_bands
               do bnd1=1,num_bands
                  read(655,*)paulimat(bnd1,bnd2,co,ikpt)
               enddo
            enddo
          enddo
        enddo      
        close(655)
      endif
      sum1=0.0
      sum2=0.0
      sum3=0.0

      nbnd=0
      do ikpt = 1,fullnkpts

        kptibz=ikpt 
        if(l_bzsym) kptibz=irreduc(ikpt)
            call wann_read_eig(
136
     >              eig_id,     
137 138
     >              lmaxd,ntypd,nlod,neigd,nvd,jspd,
     >              0,isize,kptibz,jspin,nbasfcn,nlotot,
139
     >              l_ss,l_noco,nrec,
140
     <              nmat,nv,ello,evdu,epar,
141
     <              k1,k2,k3,bkpt,wk,nbands,eig,zMat,
142
     >              l_gwf,iqpt)
143 144 145


        nkbnd = 0
146
!        WRITE(*,*)'wann_rw_eig: nbands',nbands
147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163
        do i = 1,nbands
         if((eig(i).ge.e1s .and. nkbnd.lt.numbands.and.l_bynumber).or.
     &      (eig(i).ge.e1s.and.eig(i).le.e2s.and.l_byenergy ).or.
     &      (i.ge.band_min.and.i.le.band_max.and.l_byindex))  then
           nkbnd = nkbnd + 1
           if(l_bynumber.or.l_byindex)then
              write (306,'(2i12,f19.13)') nkbnd,ikpt,(eig(i)-ef)*
     &                                    hartree
           endif
           if(l_paulimag.and..false.)then
              if(eig(i).le.ef)then
                 sum1=sum1+paulimat(nkbnd,nkbnd,1,kptibz)
                 sum2=sum2+paulimat(nkbnd,nkbnd,2,kptibz)
                 sum3=sum3+paulimat(nkbnd,nkbnd,3,kptibz)
              endif
           endif   
         endif 
164 165
        enddo
!        WRITE(*,*)'wann_rw_eig: nkbnd',nkbnd,'nbnd',nbnd 
166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183
        if (nkbnd.ge.nbnd) nbnd = nkbnd

        if (odi%d1) kpoints(ikpt) = bkpt(3)

      enddo !ikpt

      if(l_paulimag)then
        write(6,*)"sum1=",sum1/fullnkpts
        write(6,*)"sum2=",sum2/fullnkpts
        write(6,*)"sum3=",sum3/fullnkpts
      endif  


      if(l_byenergy)then   !now we know the maximum of bands
         do ikpt=1,fullnkpts
            kptibz=ikpt
            if(l_bzsym)kptibz=irreduc(ikpt)
            call wann_read_eig(     
184
     >              eig_id,       
185 186
     >              lmaxd,ntypd,nlod,neigd,nvd,jspd,
     >              0,isize,kptibz,jspin,nbasfcn,nlotot,
187
     >              l_ss,l_noco,nrec,
188
     <              nmat,nv,ello,evdu,epar,
189
     <              k1,k2,k3,bkpt,wk,nbands,eig,zMat,
190
     >              l_gwf,iqpt)
191 192 193 194 195 196 197 198 199 200 201 202 203 204


              nkbnd = 0
              do i = 1,nbands
                if(eig(i).ge.e1s .and. nkbnd.lt.nbnd)then
                     nkbnd = nkbnd + 1
                  write (306,'(2i12,f19.13)')nkbnd,ikpt,(eig(i)-ef)*
     &                                       hartree
                endif
              enddo 
         enddo   
      endif
      close (306)
      end subroutine wann_write_eig
205 206 207 208 209 210
 
c*****************************************************************
c     read in eig file
c*****************************************************************
      subroutine wann_read_eig(     
     >              eig_id,
211 212
     >              lmaxd,ntypd,nlod,neigd,nvd,jspd,
     >              irank,isize,kptibz,jspin,nbasfcn,nlotot,
213
     >              l_ss,l_noco,nrec,
214
     <              nmat,nv,ello,evdu,epar,
215
     <              k1,k2,k3,bkpt,wk,nbands,eig,zMat,
216
     >              l_gwf,iqpt)
217
      USE m_judft
218
      USE m_types
219
      use m_cdnread, only:cdn_read
220
      implicit none
221
      integer, intent (in) :: eig_id
222 223
      INTEGER, INTENT (IN) :: irank,isize,kptibz,nbasfcn,neigd,nlotot
      INTEGER, INTENT (IN) :: nrec,nvd,jspd,jspin
224 225
      INTEGER, INTENT (IN) :: lmaxd,ntypd,nlod,iqpt
      LOGICAL, INTENT (IN) :: l_ss,l_noco,l_gwf
226

227 228 229 230
      INTEGER, INTENT (OUT) :: nbands,nmat
      REAL,    INTENT (OUT) :: wk

      INTEGER, INTENT (OUT) :: k1(nvd,jspd),k2(nvd,jspd),k3(nvd,jspd)
231
      INTEGER, INTENT (OUT) :: nv(jspd)
232 233 234 235
      REAL,    INTENT (OUT) :: bkpt(3),eig(neigd)
      REAL,    INTENT (OUT) :: ello(nlod,ntypd,jspd),evdu(2,jspd)
      REAL,    INTENT (OUT) :: epar(0:lmaxd,ntypd,jspd)

236
      TYPE(t_mat), INTENT (INOUT) :: zMat !z(nbasfcn,noccbd) !can be real/complex
237

238 239 240 241 242
      integer :: n_start,n_end

      n_start=1
      n_end=neigd

243 244 245 246 247 248 249
!      CALL cdn_read(
!     >              eig_id,
!     >              nvd,jspd,irank,isize,kptibz,jspin,nbasfcn,
!     >              l_ss,l_noco,neigd,n_start,n_end,
!     <              nmat,nv,ello,evdu,epar,
!     <              bkpt,wk,nbands,eig,zMat)
      CALL judft_error("BUG: wann_read in wann_rw_eig not implemented")
250 251
      END SUBROUTINE wann_read_eig  
      END MODULE m_wann_rw_eig