wann_gwf_tools.f 4.37 KB
Newer Older
Daniel Wortmann's avatar
Daniel Wortmann committed
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 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 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 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 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166
c************************************c
c  routines to                       c
c      a) find index of (k,q) point  c
c      b) write plot template file   c
c************************************c
      module m_wann_gwf_tools
      implicit none
      contains

      subroutine get_dimension(l_dim,dim)
      implicit none
      logical,intent(in) :: l_dim(3)
      integer,intent(inout) :: dim
      integer :: i

      dim=3
      do i=1,3
         if(l_dim(i))dim=dim+1
      enddo

      end subroutine get_dimension


      subroutine get_shift(l_dim,shift)
      implicit none
      logical,intent(in) :: l_dim(3)
      integer,intent(inout) :: shift(3)

      shift=0
      if(l_dim(1))then
         shift(2)=shift(2)+1
         shift(3)=shift(3)+1
      endif

      if(l_dim(2))then
         shift(3)=shift(3)+1
      endif

      end subroutine get_shift


      integer function get_index_kq(ikpt,iqpt,nkpts)
      implicit none
      integer,intent(in) :: ikpt,iqpt,nkpts
      get_index_kq = ikpt+(iqpt-1)*nkpts
      end function get_index_kq


      integer function get_index_k(ikqpt,nkpts)
      implicit none
      integer,intent(in) :: ikqpt,nkpts
      get_index_k = ikqpt -(get_index_q(ikqpt,nkpts)-1)*nkpts
      end function get_index_k


      integer function get_index_q(ikqpt,nkpts)
      implicit none
      integer,intent(in) :: ikqpt,nkpts
      get_index_q = (ikqpt-1)/nkpts + 1
      end function get_index_q


      integer function get_index_nn_k(bpt,nntot,ikpt_b,gb_kq,gb,dim)
      implicit none
      integer,intent(in) :: nntot,ikpt_b,dim
      integer,intent(in) :: bpt(nntot)
      integer,intent(in) :: gb(3,nntot),gb_kq(dim)
      integer :: nn

c      if(ANY(gb_kq(4:).ne.0)) write(*,*)'problem get_index_nn_k'

      do nn=1,nntot
         if((bpt(nn).eq.ikpt_b) .and. (gb(1,nn).eq.gb_kq(1))
     >            .and.(gb(2,nn).eq.gb_kq(2))
     >            .and.(gb(3,nn).eq.gb_kq(3))) exit
      enddo
      if((nn.eq.(nntot+1)).or.(ANY(gb_kq(4:).ne.0))) then
c       write(*,*)'nn not found!'
       nn=-1
      endif

      get_index_nn_k = nn
      end function get_index_nn_k


      integer function get_index_nn_q(bpt,nntot,ikpt_b,gb_kq,gb,
     >                                dim,shift,l_dim)
      implicit none
      integer,intent(in) :: nntot,ikpt_b,dim,shift(3)
      integer,intent(in) :: bpt(nntot)
      integer,intent(in) :: gb(3,nntot),gb_kq(dim)
      logical,intent(in) :: l_dim(3)
      integer :: nn,ind(3),g(3)

      g = 0
      do nn=1,3
         ind(nn)=4+shift(nn)
         if(l_dim(nn))g(nn)=gb_kq(ind(nn))
      enddo

c      if(any(gb_kq(1:3).ne.0)) write(*,*)'problem get_index_nn_q'

      do nn=1,nntot
         if((bpt(nn).eq.ikpt_b) .and. (gb(1,nn).eq.g(1))
     >              .and.(gb(2,nn).eq.g(2)).and.(gb(3,nn).eq.g(3))) exit
      enddo
      if((nn.eq.(nntot+1)).or.(ANY(gb_kq(1:3).ne.0))) then
c       write(*,*)'nn not found!'
       nn=-1
      endif

      get_index_nn_q = nn
      end function get_index_nn_q


!      integer function get_index_nn_kq(bpt,nntot,kqb,gb_kq,gb,gb_q)
!      implicit none
!      integer,intent(in) :: nntot,kqb
!      integer,intent(in) :: bpt(nntot)
!      integer,intent(in) :: gb_kq(4,nntot),gb(3),gb_q(3)
!      integer :: nn
!
!      do nn=1,nntot
!         if((bpt(nn).eq.kqb) .and. (gb_kq(4,nn).eq.gb_q(3))
!     >                       .and. (gb_kq(3,nn).eq.gb(3))
!     >                       .and. (gb_kq(2,nn).eq.gb(2))
!     >                       .and. (gb_kq(1,nn).eq.gb(1))) exit
!      enddo
!      if(nn==(nntot+1)) stop 'nn not found!'
!
!      get_index_nn_kq = nn
!      end function get_index_nn_kq


      subroutine gwf_plottemplate()
      use m_juDFT
      implicit none
      integer :: i,nwfs,numbands
      logical :: l_exist

      inquire(file='proj',exist=l_exist)
      if(.not.l_exist) then
         call juDFT_error('Where is proj?',
     >                    calledby='gwf_plottemplate')
      endif

      open(8888,file='proj',status='old')
      read(8888,*)nwfs,numbands
      close(8888)

      open(8888,file='printhdwf',status='unknown')
      write(8888,'(i4,3x,a1,3x,a4,i3)')nwfs,'F','nga=',5
      do i=1,nwfs
         write(8888,'(i4,3x,i1,3x,i4)')i,4,0
      enddo

      close(8888)

      write(*,*)'******************************'
      write(*,*)'* created printhdwf template *'
      write(*,*)'******************************'

      end subroutine gwf_plottemplate


      end module m_wann_gwf_tools