Line data    Source code

       1             : c************************************c
       2             : c  routines to                       c
       3             : c      a) find index of (k,q) point  c
       4             : c      b) write plot template file   c
       5             : c************************************c
       6             :       module m_wann_gwf_tools
       7             :       use m_juDFT
       8             :       implicit none
       9             :       contains
      10             : 
      11           1 :       subroutine get_dimension(l_dim,dim)
      12             :       implicit none
      13             :       logical,intent(in) :: l_dim(3)
      14             :       integer,intent(inout) :: dim
      15             :       integer :: i
      16             : 
      17           1 :       call timestart("get_dimension")
      18           1 :       dim=3
      19           4 :       do i=1,3
      20           4 :          if(l_dim(i))dim=dim+1
      21             :       enddo
      22             : 
      23           1 :       call timestop("get_dimension")
      24           1 :       end subroutine get_dimension
      25             : 
      26             : 
      27           1 :       subroutine get_shift(l_dim,shift)
      28             :       implicit none
      29             :       logical,intent(in) :: l_dim(3)
      30             :       integer,intent(inout) :: shift(3)
      31             : 
      32           1 :       call timestart("get_shift")
      33           1 :       shift=0
      34           1 :       if(l_dim(1))then
      35           0 :          shift(2)=shift(2)+1
      36           0 :          shift(3)=shift(3)+1
      37             :       endif
      38             : 
      39           1 :       if(l_dim(2))then
      40           0 :          shift(3)=shift(3)+1
      41             :       endif
      42             : 
      43           1 :       call timestop("get_shift")
      44           1 :       end subroutine get_shift
      45             : 
      46             : 
      47           0 :       integer function get_index_kq(ikpt,iqpt,nkpts)
      48             :       implicit none
      49             :       integer,intent(in) :: ikpt,iqpt,nkpts
      50           0 :       get_index_kq = ikpt+(iqpt-1)*nkpts
      51           0 :       end function get_index_kq
      52             : 
      53             : 
      54           0 :       integer function get_index_k(ikqpt,nkpts)
      55             :       implicit none
      56             :       integer,intent(in) :: ikqpt,nkpts
      57           0 :       get_index_k = ikqpt -(get_index_q(ikqpt,nkpts)-1)*nkpts
      58           0 :       end function get_index_k
      59             : 
      60             : 
      61           0 :       integer function get_index_q(ikqpt,nkpts)
      62             :       implicit none
      63             :       integer,intent(in) :: ikqpt,nkpts
      64           0 :       get_index_q = (ikqpt-1)/nkpts + 1
      65           0 :       end function get_index_q
      66             : 
      67             : 
      68           0 :       integer function get_index_nn_k(bpt,nntot,ikpt_b,gb_kq,gb,dim)
      69             :       implicit none
      70             :       integer,intent(in) :: nntot,ikpt_b,dim
      71             :       integer,intent(in) :: bpt(nntot)
      72             :       integer,intent(in) :: gb(3,nntot),gb_kq(dim)
      73             :       integer :: nn
      74             : 
      75             : c      if(ANY(gb_kq(4:).ne.0)) write(*,*)'problem get_index_nn_k'
      76             : 
      77           0 :       do nn=1,nntot
      78             :          if((bpt(nn).eq.ikpt_b) .and. (gb(1,nn).eq.gb_kq(1))
      79             :      >            .and.(gb(2,nn).eq.gb_kq(2))
      80           0 :      >            .and.(gb(3,nn).eq.gb_kq(3))) exit
      81             :       enddo
      82           0 :       if((nn.eq.(nntot+1)).or.(ANY(gb_kq(4:).ne.0))) then
      83             : c       write(*,*)'nn not found!'
      84           0 :        nn=-1
      85             :       endif
      86             : 
      87           0 :       get_index_nn_k = nn
      88           0 :       end function get_index_nn_k
      89             : 
      90             : 
      91           0 :       integer function get_index_nn_q(bpt,nntot,ikpt_b,gb_kq,gb,
      92             :      >                                dim,shift,l_dim)
      93             :       implicit none
      94             :       integer,intent(in) :: nntot,ikpt_b,dim,shift(3)
      95             :       integer,intent(in) :: bpt(nntot)
      96             :       integer,intent(in) :: gb(3,nntot),gb_kq(dim)
      97             :       logical,intent(in) :: l_dim(3)
      98             :       integer :: nn,ind(3),g(3)
      99             : 
     100           0 :       g = 0
     101           0 :       do nn=1,3
     102           0 :          ind(nn)=4+shift(nn)
     103           0 :          if(l_dim(nn))g(nn)=gb_kq(ind(nn))
     104             :       enddo
     105             : 
     106             : c      if(any(gb_kq(1:3).ne.0)) write(*,*)'problem get_index_nn_q'
     107             : 
     108           0 :       do nn=1,nntot
     109             :          if((bpt(nn).eq.ikpt_b) .and. (gb(1,nn).eq.g(1))
     110           0 :      >              .and.(gb(2,nn).eq.g(2)).and.(gb(3,nn).eq.g(3))) exit
     111             :       enddo
     112           0 :       if((nn.eq.(nntot+1)).or.(ANY(gb_kq(1:3).ne.0))) then
     113             : c       write(*,*)'nn not found!'
     114           0 :        nn=-1
     115             :       endif
     116             : 
     117           0 :       get_index_nn_q = nn
     118           0 :       end function get_index_nn_q
     119             : 
     120             : 
     121             : !      integer function get_index_nn_kq(bpt,nntot,kqb,gb_kq,gb,gb_q)
     122             : !      implicit none
     123             : !      integer,intent(in) :: nntot,kqb
     124             : !      integer,intent(in) :: bpt(nntot)
     125             : !      integer,intent(in) :: gb_kq(4,nntot),gb(3),gb_q(3)
     126             : !      integer :: nn
     127             : !
     128             : !      do nn=1,nntot
     129             : !         if((bpt(nn).eq.kqb) .and. (gb_kq(4,nn).eq.gb_q(3))
     130             : !     >                       .and. (gb_kq(3,nn).eq.gb(3))
     131             : !     >                       .and. (gb_kq(2,nn).eq.gb(2))
     132             : !     >                       .and. (gb_kq(1,nn).eq.gb(1))) exit
     133             : !      enddo
     134             : !      if(nn==(nntot+1)) stop 'nn not found!'
     135             : !
     136             : !      get_index_nn_kq = nn
     137             : !      end function get_index_nn_kq
     138             : 
     139             : 
     140           0 :       subroutine gwf_plottemplate()
     141             :       use m_juDFT
     142             :       implicit none
     143             :       integer :: i,nwfs,numbands
     144             :       logical :: l_exist
     145             : 
     146           0 :       call timestart("gwf_plottemplate")
     147             : 
     148           0 :       inquire(file='proj',exist=l_exist)
     149           0 :       if(.not.l_exist) then
     150             :          call juDFT_error('Where is proj?',
     151           0 :      >                    calledby='gwf_plottemplate')
     152             :       endif
     153             : 
     154           0 :       open(8888,file='proj',status='old')
     155           0 :       read(8888,*)nwfs,numbands
     156           0 :       close(8888)
     157             : 
     158           0 :       open(8888,file='printhdwf',status='unknown')
     159           0 :       write(8888,'(i4,3x,a1,3x,a4,i3)')nwfs,'F','nga=',5
     160           0 :       do i=1,nwfs
     161           0 :          write(8888,'(i4,3x,i1,3x,i4)')i,4,0
     162             :       enddo
     163             : 
     164           0 :       close(8888)
     165             : 
     166           0 :       write(*,*)'******************************'
     167           0 :       write(*,*)'* created printhdwf template *'
     168           0 :       write(*,*)'******************************'
     169             : 
     170           0 :       call timestop("gwf_plottemplate")
     171           0 :       end subroutine gwf_plottemplate
     172             : 
     173             : 
     174             :       end module m_wann_gwf_tools