wann_rw_eig.F 8.23 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,
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 34 35
      integer,intent(in) :: lmaxd,ntypd,nlod,neigd,nvd,jspd
      integer,intent(in) :: isize,jspin,nbasfcn,nlotot
      logical,intent(in) :: l_ss,l_noco
      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 64
      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          :: kveclo(nlotot)
      integer          :: n_start,n_end,co
      integer          :: bnd1,bnd2,kpt
      complex, allocatable :: paulimat(:,:,:,:) 
      real             :: sum1,sum2,sum3
      integer          :: num_bands,err
65 66 67 68 69 70
      
! BEGIN QPOINTS
      LOGICAL, INTENT(IN) :: l_gwf
      INTEGER, INTENT(IN) :: iqpt
      CHARACTER(len=12) :: fname
! END QPOINTS
71 72
      real,parameter   :: hartree=27.21138505

73 74
      TYPE(t_zmat) :: zmat !z(nbasfcn,noccbd) !can be real/complex

75 76
!      WRITE(*,*)'min',band_min,'max',band_max,'num',numbands
!      WRITE(*,*)'wann_rw_eig: neigd',neigd
77 78
      n_start=1
      n_end=neigd
79 80 81 82 83 84 85 86
      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
87

88
      inquire (file=fname,exist=l_eig)
89
      if (l_eig) then
90
         open (306,file=fname,
91 92 93
     &                               form='formatted',status='old')
         rewind (306)
      else
94
         open (306,file=fname,
95 96 97 98 99 100 101 102 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
     &                               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(
128
     >              eig_id,     
129 130
     >              lmaxd,ntypd,nlod,neigd,nvd,jspd,
     >              0,isize,kptibz,jspin,nbasfcn,nlotot,
131
     >              l_ss,l_noco,nrec,
132
     <              nmat,nv,ello,evdu,epar,kveclo,
133
     <              k1,k2,k3,bkpt,wk,nbands,eig,zMat,
134
     >              l_gwf,iqpt)
135 136 137


        nkbnd = 0
138
!        WRITE(*,*)'wann_rw_eig: nbands',nbands
139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155
        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 
156 157
        enddo
!        WRITE(*,*)'wann_rw_eig: nkbnd',nkbnd,'nbnd',nbnd 
158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175
        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(     
176
     >              eig_id,       
177 178
     >              lmaxd,ntypd,nlod,neigd,nvd,jspd,
     >              0,isize,kptibz,jspin,nbasfcn,nlotot,
179
     >              l_ss,l_noco,nrec,
180
     <              nmat,nv,ello,evdu,epar,kveclo,
181
     <              k1,k2,k3,bkpt,wk,nbands,eig,zMat,
182
     >              l_gwf,iqpt)
183 184 185 186 187 188 189 190 191 192 193 194 195 196


              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
197 198 199 200 201 202
 
c*****************************************************************
c     read in eig file
c*****************************************************************
      subroutine wann_read_eig(     
     >              eig_id,
203 204
     >              lmaxd,ntypd,nlod,neigd,nvd,jspd,
     >              irank,isize,kptibz,jspin,nbasfcn,nlotot,
205
     >              l_ss,l_noco,nrec,
206
     <              nmat,nv,ello,evdu,epar,kveclo,
207
     <              k1,k2,k3,bkpt,wk,nbands,eig,zMat,
208
     >              l_gwf,iqpt)
209

210
      USE m_types
211
      use m_cdnread, only:cdn_read
212
      implicit none
213
      integer, intent (in) :: eig_id
214 215
      INTEGER, INTENT (IN) :: irank,isize,kptibz,nbasfcn,neigd,nlotot
      INTEGER, INTENT (IN) :: nrec,nvd,jspd,jspin
216 217
      INTEGER, INTENT (IN) :: lmaxd,ntypd,nlod,iqpt
      LOGICAL, INTENT (IN) :: l_ss,l_noco,l_gwf
218

219 220 221 222 223 224 225 226 227
      INTEGER, INTENT (OUT) :: nbands,nmat
      REAL,    INTENT (OUT) :: wk

      INTEGER, INTENT (OUT) :: k1(nvd,jspd),k2(nvd,jspd),k3(nvd,jspd)
      INTEGER, INTENT (OUT) :: nv(jspd),kveclo(nlotot)
      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)

228 229
      TYPE(t_zmat), INTENT (INOUT) :: zmat !z(nbasfcn,noccbd) !can be real/complex

230 231 232 233 234
      integer :: n_start,n_end

      n_start=1
      n_end=neigd

235
      CALL cdn_read(
236 237 238
     >              eig_id,
     >              nvd,jspd,irank,isize,kptibz,jspin,nbasfcn,
     >              l_ss,l_noco,neigd,n_start,n_end,
239
     <              nmat,nv,ello,evdu,epar,kveclo,
240
     <              k1,k2,k3,bkpt,wk,nbands,eig,zMat)
241

242 243
      END SUBROUTINE wann_read_eig  
      END MODULE m_wann_rw_eig