LCOV - code coverage report
Current view: top level - kpoints - kprep.f (source / functions) Hit Total Coverage
Test: combined.info Lines: 21 44 47.7 %
Date: 2019-09-08 04:53:50 Functions: 1 1 100.0 %

          Line data    Source code
       1             :       MODULE m_kprep
       2             :       CONTAINS
       3      411641 :       SUBROUTINE  kprep(
       4             :      >                  iofile,iokpt,kpri,ktest,
       5      411641 :      >                  nface,fnorm,fdist,iside,
       6             :      >                  vktes,nkstar,mkpt,mface,mdir,
       7             :      =                  nkrep,vkrep)
       8             : c ====================================================================
       9             : c
      10             : c    this subroutine
      11             : c    checks, if k-point vktes lies within irreducible wedge of BZ
      12             : c    which is characterized by
      13             : c          iside(i)= sign( (xvec,fnorm(i))-fdist(i) ) ;(i=1,nface )
      14             : c
      15             : c    IF TRUE, it returns a nonzero counter nkrep
      16             : c             and the new repr k-vektor vkrep(i) (i=1,3)
      17             : c
      18             : c    Meaning of variables:
      19             : c    INPUT:
      20             : c
      21             : c    representation of the irreducible part of the BZ:
      22             : c    fnorm    : normal vector of the planes bordering the irrBZ
      23             : c    fdist    : distance vector of the planes bordering the irrBZ
      24             : c    iside    : characterizing the inner side of each face of the irrBZ
      25             : c    nface    : number of faces of the irrBZ
      26             : c
      27             : c    k-point to be tested:
      28             : c    vktes    : k-point vector to be tested
      29             : c    nkstar   : index of star to which vktes belongs
      30             : c
      31             : c    OUTPUT: representative k-point
      32             : c    nkrep    : index (for each star nkstar); set to 1 if
      33             : c               representative k-point in irrBZ has been found
      34             : c    vkrep    : representative k-point in irrBZ for current star;
      35             : c               set to vktes, if condition fulfilled.
      36             : c ====================================================================
      37             :       IMPLICIT NONE
      38             : C
      39             : C-----> PARAMETER STATEMENTS
      40             : C
      41             :       INTEGER, INTENT (IN) :: mface,mkpt,mdir
      42             : c
      43             : c ---> file number for read and write
      44             : c
      45             :       integer  iofile,iokpt
      46             : c
      47             : c ---> running mode parameter
      48             : c
      49             :       integer  kpri,ktest
      50             : C
      51             : C----->  Symmetry information
      52             : C
      53             : c     integer  nsym,idsyst,idtype
      54             : C
      55             : C----->  BRAVAIS LATTICE INFORMATION
      56             : C
      57             : c     real     bltv(3,3)
      58             : C
      59             : C----->  RECIPROCAL LATTICE INFORMATION
      60             : C
      61             :       integer  nface
      62             :       real     fnorm(3,mface),fdist(mface)
      63             : c     real     xvec(3),rltv(3,3)
      64             : C
      65             : C----->  BRILLOUINE ZONE INTEGRATION
      66             : C
      67             :       integer  nkstar
      68             : C
      69             : C --->  local variables
      70             : c
      71             :       integer  i1,ii,ifac
      72             :       integer  iside(mface)
      73             :       integer  nkrep
      74             :       real     vkrep(3)
      75             :       real     ortest,vktes(3)
      76             :       real     invtpi, zero,one,half, eps,eps1
      77             : C
      78             : C --->  intrinsic functions
      79             : c
      80             :       intrinsic   real,abs
      81             : C
      82             : C --->  save and data statements
      83             : c
      84             :       save     one,zero,half,eps,eps1
      85             :       data     zero/0.0/,one/1.0/,half/0.5/,
      86             :      +         eps/1e-8/,eps1/1e-5/
      87             : c
      88             : c-----------------------------------------------------------------------
      89      411641 :       if (kpri .ge. 3) then
      90           0 :         write(iofile,'(/)')
      91           0 :         write(iofile,'(3x,'' *<* kprep *>* '')')
      92           0 :         write(iofile,'(3x,'' check if k-vectors'')')
      93           0 :         write(iofile,'(3x,'' ~~~~~~~~~~~~~~~~'')')
      94           0 :         write(iofile,'(3x,'' are in irreducible wedge'')')
      95           0 :         write(iofile,'(3x,'' ~~~~~~~~~~~~~~~~~~~~'')')
      96           0 :         write(iofile,'(3x,'' of 1. Brillouin zone'')')
      97           0 :         write(iofile,'(3x,'' ~~~~~~~~~~~~~~~~~~~~'')')
      98           0 :         write(iofile,'(/)')
      99             :       end if
     100      411641 :       if (ktest.ge. 5) then
     101           0 :         write(iofile,'(1x,i4,10x,''iofile'')') iofile
     102           0 :         write(iofile,'(1x,i4,10x,''iokpt'')')  iokpt
     103           0 :         write(iofile,'(1x,i4,10x,''kpri'')')  kpri
     104           0 :         write(iofile,'(1x,i4,10x,''ktest'')')  ktest
     105             : c       write(iofile,'(1x,3(f10.7,1x),10x,''xvec'')') (xvec(ii),ii=1,3)
     106             : c       write(iofile,'(1x,i4,10x,''ncorn'')')  ncorn
     107             : c       write(iofile,'(1x,i4,10x,''nedge'')')  nedge
     108           0 :         write(iofile,'(1x,i4,10x,''nface'')')  nface
     109           0 :         do 10 ifac = 1,nface
     110             :         write(iofile,'(1x,i4,1x,3(f10.7,1x),10x,''fnorm'')')
     111           0 :      +                 ifac,(fnorm(ii,ifac),ii=1,3)
     112             :         write(iofile,'(6x,f10.7,1x,20x,''fdist'')')
     113           0 :      +                      fdist(ifac)
     114             :         write(iofile,'(6x,i4,1x,26x,''iside'')')
     115           0 :      +                      iside(ifac)
     116           0 :  10     continue
     117           0 :         write(iofile,'(1x,i4,10x,''nkstar'')')  nkstar
     118             : c       write(iofile,'(1x,i4,10x,''nkpt'')')  nkpt
     119           0 :         write(iofile,'(/)')
     120             :       end if
     121             : c ======================================================================
     122             : c    start calculation
     123             : c
     124             : c
     125             : c ---> check if vktes lies in irred wedge of BZ
     126             : c      (i.e. on the same side of all boundary faces of irr wedge of BZ
     127             : c                                                              as xvec);
     128             : c
     129      988406 :            do 70 ifac = 1,nface
     130      987639 :               ortest = zero
     131     3950556 :             do 71 ii = 1,3
     132     2962917 :               ortest = ortest + vktes(ii)*fnorm(ii,ifac)
     133      987639 :   71        continue
     134      987639 :               ortest = ortest - fdist(ifac)
     135      987639 :       if (ktest.ge. 4)
     136             :      +      write(iofile,'(1x,2(i4,2x),f10.7,10x,''ifac,iside,ortest'',
     137           0 :      +                         '' for vktes'')') ifac,iside(ifac),ortest
     138             : c
     139      987639 :             if (abs(ortest) .lt. eps) go to 70
     140      981848 :             if (ortest*iside(ifac) .lt. zero) go to 60
     141             : c
     142         767 :  70        continue
     143             : c
     144             : c    we have found a k-point inside irr BZ
     145             : c
     146             : c    (a) make sure it is not yet stored previously
     147             : c
     148             :             if(abs(vktes(1)-vkrep(1)).le.eps1
     149             :      +        .and. abs(vktes(2)-vkrep(2)).le.eps1
     150             :      +          .and. abs(vktes(3)-vkrep(3)).le.eps1
     151         767 :      +                                     .and. nkrep.gt.0) go to 60
     152             : c
     153         322 :                nkrep = nkrep+1
     154        1288 :             do 80 ii = 1,3
     155         966 :               vkrep(ii) = vktes(ii)
     156         322 :  80        continue
     157             : c
     158         322 :       if (ktest.ge. 3) then
     159             :               write(iofile,'(1x,2(i4,1x),3(1x,f10.7),/,1x,
     160             :      +           ''nkstar,nkrep,vkrep(nkstar): kpoint in irr BZ'')')
     161           0 :      +            nkstar,nkrep,(vkrep(i1),i1=1,3)
     162             :       end if
     163             : c
     164             :  60   continue
     165             : c
     166      411641 :       RETURN
     167             :       END SUBROUTINE kprep
     168             :       END MODULE m_kprep

Generated by: LCOV version 1.13