LCOV - code coverage report
Current view: top level - wannier - wann_get_mp.f (source / functions) Hit Total Coverage
Test: FLEUR test coverage Lines: 23 28 82.1 %
Date: 2024-04-25 04:21:55 Functions: 1 1 100.0 %

          Line data    Source code
       1             : !--------------------------------------------------------------------------------
       2             : ! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
       3             : ! This file is part of FLEUR and available as free software under the conditions
       4             : ! of the MIT license as expressed in the LICENSE file in more detail.
       5             : !--------------------------------------------------------------------------------
       6             : 
       7             :       module m_wann_get_mp
       8             :       use m_juDFT
       9             :       contains
      10           5 :       subroutine wann_get_mp(
      11           5 :      >               nkpts,kpoints,
      12           5 :      <               num)
      13             : c**************************************
      14             : c     Determine the structure of the
      15             : c     Monkhorst-Pack mesh.
      16             : c     
      17             : c     Frank Freimuth
      18             : c**************************************
      19             : 
      20             :       USE m_constants
      21             : 
      22             :       implicit none
      23             : 
      24             :       integer,intent(in)  :: nkpts
      25             :       real,intent(in)     :: kpoints(:,:)
      26             :       integer,intent(out) :: num(:)
      27             :       
      28             :       integer :: dim,iter
      29             :       real    :: maxi,mini,increm,compare
      30             : 
      31           5 :       call timestart("wann_get_mp")
      32             : 
      33           5 :       IF(SIZE(kpoints,1)/=3)      CALL juDFT_error("wann_get_mp: 1"
      34           0 :      +     ,calledby ="wann_get_mp")
      35           5 :       IF(SIZE(kpoints,2)/=nkpts)  CALL juDFT_error("wann_get_mp: 2"
      36           0 :      +     ,calledby ="wann_get_mp")
      37           5 :       IF(SIZE(num,1)/=3)          CALL juDFT_error("wann_get_mp: 3"
      38           0 :      +     ,calledby ="wann_get_mp")
      39             : 
      40          20 :       do dim=1,3
      41         135 :          maxi=maxval(kpoints(dim,:))
      42         135 :          mini=minval(kpoints(dim,:))
      43          20 :          if(mini==maxi)then
      44           0 :             num(dim)=1
      45             :          else   
      46          15 :             increm=maxi-mini
      47         135 :             do iter=1,nkpts
      48         120 :                compare=maxi-kpoints(dim,iter)
      49         120 :                if(abs(compare).lt.1e-6)cycle
      50          15 :                if(compare.lt.increm) then
      51         120 :                   increm=compare
      52             :                endif   
      53             :             enddo
      54          15 :             num(dim)=(maxi-mini)/increm+1.01
      55             :          endif   
      56             :       enddo
      57             :       write(oUnit,*)
      58           5 :      +   "wann_get_mp: determination of mp-grid parameters:"
      59           5 :       write(oUnit,*)"mp_1=",num(1),"mp_2=",num(2),"mp_3=",num(3)
      60           5 :       IF(num(1)*num(2)*num(3)/=nkpts)  CALL juDFT_error
      61           0 :      +     ("mysterious kpoints",calledby ="wann_get_mp")
      62             : 
      63           5 :       call timestop("wann_get_mp")
      64           5 :       end subroutine wann_get_mp
      65             :       end module m_wann_get_mp

Generated by: LCOV version 1.14