LCOV - code coverage report
Current view: top level - wannier - wann_gwf_tools.f (source / functions) Hit Total Coverage
Test: combined.info Lines: 0 54 0.0 %
Date: 2019-09-08 04:53:50 Functions: 0 8 0.0 %

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

Generated by: LCOV version 1.13