LCOV - code coverage report
Current view: top level - kpoints - fulstar.f (source / functions) Hit Total Coverage
Test: combined.info Lines: 0 87 0.0 %
Date: 2019-09-08 04:53:50 Functions: 0 1 0.0 %

          Line data    Source code
       1             :       MODULE m_fulstar
       2             :       use m_juDFT
       3             :       CONTAINS
       4           0 :       SUBROUTINE  fulstar(
       5             :      >                    iofile,iokpt,kpri,ktest,
       6             :      >                    ccr,nsym,
       7           0 :      >                    vkrep,nkstar,mkpt,mface,mdir,
       8           0 :      =                    nkpt,vkxyz,wghtkp)
       9             : c ====================================================================
      10             : c
      11             : c    this subroutine generates k-points in full stars
      12             : c    from representative k-points in irreducible wedge of BZ
      13             : c
      14             : c    Meaning of variables:
      15             : c    INPUT:
      16             : c
      17             : c    Symmetry elements of point group
      18             : c    nsym     : number of symmetry elements of points group
      19             : c    ccr     : rotation matrix for symmetry element
      20             : c                   in cartesian representation
      21             : c
      22             : c    representative k-points:
      23             : c    vkrep    : vkrep(ix,n); representative k-point vectors in irrBZ
      24             : c    nkstar   : number of representative k-vectors
      25             : c
      26             : c    OUTPUT: new k-point set
      27             : c    nkpt     : total number of k-points generated in full stars
      28             : c    vkxyz    : generated k-point vectors in cartesian representation
      29             : c    wghtkp   : (augmented) weight of vkxyz for BZ integration
      30             : c
      31             : c ====================================================================
      32             :       IMPLICIT NONE
      33             : C
      34             : C-----> PARAMETER STATEMENTS
      35             : C
      36             :        INTEGER, INTENT (IN) :: mkpt,mface,mdir
      37             : c
      38             : c ---> file number for read and write
      39             : c
      40             :       integer  iofile,iokpt
      41             : c
      42             : c ---> running mode parameter
      43             : c
      44             :       integer  kpri,ktest
      45             : C
      46             : C----->  Symmetry information
      47             : C
      48             :       integer  nsym,idsyst,idtype
      49             :       real     ccr(3,3,48)
      50             : C
      51             : C----->  BRAVAIS LATTICE INFORMATION
      52             : C
      53             :       real     bltv(3,3)
      54             : C
      55             : C----->  RECIPROCAL LATTICE INFORMATION
      56             : C
      57             : c     integer  ncorn,nface,nedge
      58             : c     real     xvec(3),rltv(3,3),fnorm(3,mface),fdist(mface)
      59             : C
      60             : C----->  BRILLOUINE ZONE INTEGRATION
      61             : C
      62             :       integer  nmop,nreg
      63           0 :       integer  nkpt,nkstar,ifstar(mkpt)
      64             :       real     vkxyz(3,mkpt),kzero(3),wghtkp(mkpt)
      65             : C
      66             : C --->  local variables
      67             : c
      68             :       character*80 blank
      69             :       integer  isumnkpt
      70             :       integer  i1,i2,i3,ii,ik,is,isym,ifac
      71             :       integer  dirmin,dirmax,ndir1,ndir2,idir,lim(3) ,nbound
      72             :       integer  iplus,iminus,iside(mface)
      73             :       integer  kpl,kpm,kpn,nstar(mdir)
      74           0 :       integer  ikpn(48,mkpt),irrkpn(mkpt),nirrbz,ntest
      75           0 :       real     vkrep(3,mkpt), vkstar(3,48), wght(mkpt)
      76             :       real     sumwght
      77             :       real     fract(mkpt),fsig(2),vktes(3)
      78             :       real     orient(mface),ortest
      79             :       real     aivnkpt,ainvnmop, sum,denom
      80             :       real     invtpi, zero,one,half, eps,eps1
      81             : C
      82             : C --->  intrinsic functions
      83             : c
      84             :       intrinsic   abs,max,real
      85             : C
      86             : C --->  save and data statements
      87             : c
      88             :       save     one,zero,half,eps,eps1,iplus,iminus
      89             :       data     zero/0.00/,one/1.00/,half/0.50/,
      90             :      +         eps/1.0e-8/,eps1/1.0e-9/,
      91             :      +         iplus/1/, iminus/-1/
      92             : c
      93             : c-----------------------------------------------------------------------
      94           0 :       if (kpri .ge. 3) then
      95           0 :         write(iofile,'(/)')
      96           0 :         write(iofile,'(3x,'' *<* fulstar *>* '')')
      97           0 :         write(iofile,'(3x,'' generate full stars of k-points'')')
      98           0 :         write(iofile,'(3x,'' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'')')
      99           0 :         write(iofile,'(3x,'' in 1. Brillouin zone'')')
     100           0 :         write(iofile,'(3x,'' ~~~~~~~~~~~~~~~~~~~~'')')
     101             :       end if
     102             : c
     103           0 :       if (ktest.ge. 5) then
     104           0 :         write(iofile,'(1x,i4,10x,''iofile'')') iofile
     105           0 :         write(iofile,'(1x,i4,10x,''iokpt'')')  iokpt
     106           0 :         write(iofile,'(1x,i4,10x,''kpri'')')  kpri
     107           0 :         write(iofile,'(1x,i4,10x,''ktest'')')  ktest
     108             : c       write(iofile,'(1x,3(f10.7,1x),10x,''xvec'')') (xvec(ii),ii=1,3)
     109             : c       write(iofile,'(1x,i4,10x,''ncorn'')')  ncorn
     110             : c       write(iofile,'(1x,i4,10x,''nedge'')')  nedge
     111             : c       write(iofile,'(1x,i4,10x,''nface'')')  nface
     112             : c       do 10 ifac = 1,nface
     113             : c       write(iofile,'(1x,i4,1x,3(f10.7,1x),10x,''fnorm'')')
     114             : c    +                 ifac,(fnorm(ii,ifac),ii=1,3)
     115             : c       write(iofile,'(1x,i4,1x,f10.7,1x,10x,''fdist'')')
     116             : c    +                 ifac,fdist(ifac)
     117             : c10     continue
     118           0 :         write(iofile,'(1x,i4,10x,''nkstar'')')  nkstar
     119           0 :         write(iofile,'(1x,i4,10x,''nkpt'')')  nkpt
     120             :       end if
     121             : c    printout heading
     122             :         write(iofile,'(1x,/,1x,''printout of generated stars '',
     123           0 :      >   ''of k-points'')')
     124           0 :         write(iofile,'(1x,i4,10x,''nkstar: number of stars '')') nkstar
     125             : c
     126             : c --->   save transferred wghtkp (applicable for set of vkrep in irrBZ)
     127             : c
     128           0 :              do 100 ik = 1,nkstar
     129           0 :                 wght(ik) = wghtkp(ik)
     130           0 : 100          continue
     131             : c
     132           0 :                nkpt = 0
     133             : c
     134           0 :              do 200 ik = 1,nkstar
     135             : c
     136             : c --->   assign repr k-vector vkrep(ik) to first k-point of full star
     137             : c
     138           0 :              do 205 ii   = 1,3
     139           0 :                vkstar(ii,1) = vkrep(ii,ik)
     140           0 :  205         continue
     141             : c
     142             : c --->   generate k-points establishing the symmetry star of vkrep(ik)
     143             : c
     144           0 :              do 210 isym = 2,nsym
     145             :                vkstar(1,isym) = ccr(1,1,isym)*vkrep(1,ik)
     146             :      +                        + ccr(1,2,isym)*vkrep(2,ik)
     147           0 :      +                        + ccr(1,3,isym)*vkrep(3,ik)
     148             :                vkstar(2,isym) = ccr(2,1,isym)*vkrep(1,ik)
     149             :      +                        + ccr(2,2,isym)*vkrep(2,ik)
     150           0 :      +                        + ccr(2,3,isym)*vkrep(3,ik)
     151             :                vkstar(3,isym) = ccr(3,1,isym)*vkrep(1,ik)
     152             :      +                        + ccr(3,2,isym)*vkrep(2,ik)
     153           0 :      +                        + ccr(3,3,isym)*vkrep(3,ik)
     154           0 :  210         continue
     155             : c
     156             : c
     157           0 :       if (ktest.ge. 5) then
     158           0 :                write(iofile,'(/,''star # '',i4,/)') ik
     159             :                write(iofile,'(1x,i4,3(1x,f10.7),10x,
     160             :      +                  '' vkrep(isym): represent k-point of star'')')
     161           0 :      +                                 1, (vkrep(i2,ik),i2=1,3)
     162           0 :              do 211 isym = 2,nsym
     163             :                write(iofile,'(1x,i4,3(1x,f10.7),15x,
     164             :      +              '' is, vkstar(isym): index and kpoint in star'')')
     165           0 :      +                                 isym, (vkstar(i2,isym),i2=1,3)
     166           0 :  211         continue
     167           0 :               write(iofile,'(/)')
     168             :        end if
     169             : c
     170             : c --->   eliminate equal k-points from symmetry star to form full star
     171             : c        generate ifstar(ik) accordingly
     172             : c
     173             : c        use an index field to assign the different k-points
     174             : c
     175           0 :                   ifstar(ik) = 1
     176           0 :                   ikpn(1,ik) = 1
     177           0 :                do 220 isym = 2,nsym
     178           0 :                   ikpn(isym,ik) = 0
     179           0 :  220           continue
     180             : c     scan over all generated points vkstar in current star
     181           0 :                do 225 isym = 2,nsym
     182             : c     compare with points already found to be distinct in current star
     183           0 :                do 226 is = 1,ifstar(ik)
     184           0 :                i1 = ikpn(is,ik)
     185             :                if   (abs(vkstar(1,i1)-vkstar(1,isym)).le.eps
     186             :      +         .and. abs(vkstar(2,i1)-vkstar(2,isym)).le.eps
     187           0 :      +         .and. abs(vkstar(3,i1)-vkstar(3,isym)).le.eps)
     188             :      +                                                      go to 225
     189           0 :  226         continue
     190             : c
     191             : c --->   we have found a distinct k-point
     192             : c
     193           0 :                   ifstar(ik) = ifstar(ik) +1
     194             :  
     195           0 :                   ikpn(ifstar(ik),ik) = isym
     196           0 :  225         continue
     197             : c
     198             : c --->   output of vectors in full star
     199             : c
     200           0 :            if (ktest.ge. 3) then
     201             :              write(iofile,'(1x,i4,1x,i4,43x,
     202             :      +           ''ik, ifstar(ik): index and order of full k-star'')')
     203           0 :      +                                                    ik, ifstar(ik)
     204           0 :              write(iofile,'(1x,''k-points in full star:'')')
     205           0 :             do 250 is = 1,ifstar(ik)
     206             :              write(iofile,'(1x,i4,3(1x,f10.7),15x,
     207             :      +                '' is, vkstar(is): index and kpoint in star'')')
     208           0 :      +                               is, (vkstar(i2,ikpn(is,ik)),i2=1,3)
     209           0 :  250        continue
     210             : c       output of parameters determining wghtkp
     211             :              write(iofile,'(1x,2(i4,1x),f17.14,10x,
     212             :      +                      '' ik, ifstar(ik),wght(ik)'')')
     213           0 :      +                                ik, ifstar(ik),wght(ik)
     214             :            end if
     215             : c
     216             : c --->   assign k-points and calculate weights
     217             : c              - assign vkxyz(ix,kpn) = vkstar(ix,ikpn(is,ik));
     218             : c                        ix=1,3; kpn=1,nkpt; ik=1,nstar; is=1,ifstar(ik)
     219             : c              - calculate wghtkp(kpn)=wghtkp_old(ik)/ifstar(ik)
     220             : c                                kpn=1,nkpt; ik=1,nstar
     221             : c
     222           0 :                  do 270 is = 1,ifstar(ik)
     223           0 :                      nkpt = nkpt + 1
     224           0 :                      vkxyz(1,nkpt) = vkstar(1,ikpn(is,ik))
     225           0 :                      vkxyz(2,nkpt) = vkstar(2,ikpn(is,ik))
     226           0 :                      vkxyz(3,nkpt) = vkstar(3,ikpn(is,ik))
     227           0 :                      wghtkp(nkpt)  = wght(ik)/real(ifstar(ik))
     228           0 :  270             continue
     229             : c
     230           0 :  200  continue
     231             : c
     232             : c
     233             : c --->   test sumrules for k-points in full stars
     234             : c
     235           0 :                  sumwght = zero
     236           0 :                 isumnkpt = 0
     237           0 :              do 280 kpn = 1,nkpt
     238           0 :                  sumwght = sumwght + wghtkp(kpn)
     239           0 :  280             continue
     240             : c
     241           0 :                  do 290 ik = 1,nkstar
     242           0 :                     isumnkpt = isumnkpt + ifstar(ik)
     243           0 :  290             continue
     244             : c
     245           0 :       if (nkpt .ne. isumnkpt) then
     246             :          write(iofile,'(2(1x,i4),'' nkpt,isumnkpt do not coincide'')' )
     247           0 :      +                                         nkpt,isumnkpt
     248             :       else
     249             :          write(iofile,'(2(1x,i4),'' nkpt and isumnkpt do coincide'')' )
     250           0 :      +                                         nkpt,isumnkpt
     251             :       end if
     252             : c
     253           0 :       if (abs(sumwght-one) .gt. eps1) then
     254           0 :          write(iofile,'(1x,'' WARNING!!!!'')')
     255             :          write(iofile,'(1x,f17.10,1x,
     256           0 :      +   ''sumwght not equal one'')' ) sumwght
     257           0 :           CALL juDFT_error("sum wghtkp",calledby="fulstar")
     258             :       else
     259             :          write(iofile,'(1x,f12.10,1x,''abs(sumwght-one) le '',d10.3)' )
     260           0 :      +                                                      sumwght,eps1
     261             :       end if
     262             : c
     263           0 :       return
     264             :       END SUBROUTINE fulstar
     265             :       END MODULE m_fulstar

Generated by: LCOV version 1.13