LCOV - code coverage report
Current view: top level - wannier - wann_gwf_tools.f (source / functions) Coverage Total Hit
Test: FLEUR test coverage Lines: 22.6 % 62 14
Test Date: 2025-06-16 04:34:18 Functions: 25.0 % 8 2

            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
        

Generated by: LCOV version 2.0-1