wann_get_kpts.f 3.25 KB
Newer Older
1 2 3 4 5 6
!--------------------------------------------------------------------------------
! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
! This file is part of FLEUR and available as free software under the conditions
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------

7 8
      module m_wann_get_kpts
      use m_juDFT
9
      USE m_types
10
      contains
11
      subroutine wann_get_kpts(input,kpts,
12 13 14 15 16 17 18 19
     >               l_bzsym,film,l_onedimens,l_readkpts,
     <               nkpts,kpoints)
c********************************************************
c     Read in the k-points from kpts/w90kpts file.
c 
c     Frank Freimuth
c********************************************************
      implicit none
20 21
      TYPE(t_input), INTENT(IN) :: input
      TYPE(t_kpts), INTENT(IN)  :: kpts
22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41
      logical,intent(in)  :: l_bzsym,film
      logical,intent(in)  :: l_onedimens,l_readkpts
      integer,intent(out) :: nkpts
      real,intent(inout)  :: kpoints(:,:)

      real             :: scale
      integer          :: at,j
      integer          :: iter,len,num_wann,num_bands,nn,i
      logical          :: l_file

      if(l_bzsym)then
         inquire(file='w90kpts',exist=l_file)
         IF(.NOT.l_file) CALL juDFT_error("where is w90kpts?",calledby
     +        ="wann_get_kpts")
         open(987,file='w90kpts',status='old',form='formatted')
         read(987,*)nkpts, scale
         write(6,*)"wann_get_kpts: nkpts=",nkpts
         if(l_readkpts)then
            IF(SIZE(kpoints,1)/=3) CALL juDFT_error("wann_get_kpts: 1"
     +           ,calledby ="wann_get_kpts")
42
            IF(SIZE(kpoints,2)/=nkpts)CALL juDFT_error("wann_get_kpts:2"
43 44 45 46
     +           ,calledby ="wann_get_kpts")
            do iter=1,nkpts
               read(987,*)kpoints(:,iter)
            enddo
47 48
         endif
         close(987)
49
      else
50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76
         IF(.NOT.input%l_inpXML) THEN
            inquire(file='kpts',exist=l_file)
            IF(.NOT.l_file) CALL juDFT_error("where is kpts?",calledby
     +           ="wann_get_kpts")
            open(987,file='kpts',status='old',form='formatted')
            read(987,*)nkpts,scale
            write(6,*)"wann_get_kpts: nkpts=",nkpts
            if(l_readkpts)then
               IF(SIZE(kpoints,1)/=3) 
     +            CALL juDFT_error("wann_get_kpts: 1",
     +                             calledby ="wann_get_kpts")
               IF(SIZE(kpoints,2)/=nkpts)
     +            CALL juDFT_error("wann_get_kpts:2",
     +                             calledby ="wann_get_kpts")
               do iter=1,nkpts
                  read(987,*)kpoints(:,iter)
               enddo
            endif
            close(987)
         ELSE
            nkpts = kpts%nkpt
            if(l_readkpts)then
               do iter=1,nkpts
                  kpoints(:,iter) = kpts%bk(:,iter)
               enddo
            endif
         END IF
77 78
      endif

79
      if(l_readkpts.AND..NOT.input%l_inpXML)then
80 81 82 83 84 85 86 87 88 89 90
         kpoints=kpoints/scale
         if(film.and..not.l_onedimens)then 
            kpoints(3,:)=0.0
         endif   
         do iter=1,nkpts
            write(6,*)kpoints(:,iter)
         enddo
      endif

      end subroutine wann_get_kpts
      end module m_wann_get_kpts