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