LCOV - code coverage report
Current view: top level - wannier - wann_projgen.F (source / functions) Hit Total Coverage
Test: combined.info Lines: 0 85 0.0 %
Date: 2019-09-08 04:53:50 Functions: 0 1 0.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_projgen
       8             :       contains
       9           0 :       subroutine wann_projgen(
      10           0 :      >               ntype,neq,natd,zatom,l_nocosoc,wann)
      11             : c*****************************************
      12             : c     Generate the proj-file.
      13             : c     Frank Freimuth
      14             : c*****************************************
      15             :       use m_types, only: t_wann
      16             :       implicit none
      17             :       integer, intent(in) :: ntype
      18             :       integer, intent(in) :: neq(ntype)
      19             :       integer, intent(in) :: natd
      20             :       real,intent(in)     :: zatom(ntype)
      21             :       logical,intent(in)  :: l_nocosoc
      22             :       type(t_wann), intent(in) :: wann
      23             : 
      24             :       integer             :: j,nat,n,at,k,num_proj
      25             :       integer             :: num_wann,kk
      26           0 :       character(len=2)    :: symbol(100*ntype)
      27           0 :       character(len=2)    :: symb(natd)
      28           0 :       integer             :: lwf(100*ntype)
      29           0 :       integer             :: mrwf(100*ntype)
      30           0 :       integer             :: rwf(100*ntype)
      31           0 :       real                :: alpha(100*ntype),beta(100*ntype)
      32           0 :       real                :: gamma(100*ntype),zona(100*ntype)
      33           0 :       real                :: regio(100*ntype)      
      34             :       character*2         :: namat(0:103)
      35             :       integer             :: projections(-5:5)
      36             :       integer             :: projspin
      37             : 
      38             :       DATA namat/'va',' H','He','Li','Be',' B',' C',' N',' O',' F','Ne',
      39             :      +     'Na','Mg','Al','Si',' P',' S','Cl','Ar',' K','Ca','Sc','Ti',
      40             :      +     ' V','Cr','Mn','Fe','Co','Ni','Cu','Zn','Ga','Ge','As','Se',
      41             :      +     'Br','Kr','Rb','Sr',' Y','Zr','Nb','Mo','Tc','Ru','Rh','Pd',
      42             :      +     'Ag','Cd','In','Sn','Sb','Te',' I','Xe','Cs','Ba','La','Ce',
      43             :      +     'Pr','Nd','Pm','Sm','Eu','Gd','Tb','Dy','Ho','Er','Tm','Yb',
      44             :      +     'Lu','Hf','Ta',' W','Re','Os','Ir','Pt','Au','Hg','Tl','Pb',
      45             :      +     'Bi','Po','At','Rn','Fr','Ra','Ac','Th','Pa',' U','Np','Pu',
      46             :      +     'Am','Cm','Bk','Cf','Es','Fm','Md','No','Lw'/
      47             : 
      48           0 :       projections(:)=0
      49           0 :       projections(-5)=6
      50           0 :       projections(-4)=5
      51           0 :       projections(-3)=4
      52           0 :       projections(-2)=3
      53           0 :       projections(-1)=2
      54           0 :       projections(0)=1
      55           0 :       projections(1)=3
      56           0 :       projections(2)=5
      57           0 :       projections(3)=7
      58             : 
      59             : 
      60           0 :       nat=0
      61           0 :       do n=1,ntype
      62           0 :          do at=1,neq(n)
      63           0 :             nat=nat+1
      64           0 :             symb(nat)=namat(nint(zatom(n)))
      65             :          enddo
      66             :       enddo
      67             : 
      68           0 :       open(200,file='projgen_inp',status='old')
      69           0 :       j=0
      70             :       do 
      71           0 :          j=j+1
      72           0 :          read(200,*,end=299,err=299)symbol(j),lwf(j),mrwf(j),rwf(j)
      73           0 :          num_proj=j
      74             :       enddo   
      75             :  299  continue
      76           0 :       print*,"found ",num_proj,"projections"
      77           0 :       write(6,*)"found ",num_proj,"projections"
      78           0 :       close(200)
      79             : 
      80           0 :       open(300,file='proj')
      81           0 :       alpha=0.0
      82           0 :       beta=0.0
      83           0 :       gamma=0.0
      84           0 :       zona=0.0
      85           0 :       regio=1.0
      86           0 :       num_wann=0
      87           0 :       do j=1,nat
      88           0 :          do k=1,num_proj
      89           0 :             print*,"symbols:",symbol(k)," ",symb(j)
      90           0 :             write(6,*)"symbols:",symbol(k)," ",symb(j)
      91           0 :             if(trim(adjustl(symbol(k))).eq.
      92           0 :      &             trim(adjustl(symb(j))))then
      93           0 :                if(mrwf(k).ne.0)then
      94           0 :                   num_wann=num_wann+1
      95             :                else
      96           0 :                   num_wann=num_wann+projections(lwf(k))
      97             :                endif
      98             :             endif
      99             :          enddo
     100             :       enddo
     101           0 :       if(l_nocosoc)num_wann=num_wann*2
     102           0 :       print*,num_wann," wannier functions have been defined"
     103           0 :       if(l_nocosoc)then
     104           0 :          write(300,*) num_wann, 
     105           0 :      &                MAX(wann%band_max(1)-wann%band_min(1)+1,num_wann),
     106           0 :      &                "  t  "
     107             :       else
     108           0 :          write(300,*) num_wann, 
     109           0 :      &                MAX(wann%band_max(1)-wann%band_min(1)+1,num_wann)
     110             :       endif
     111           0 :       if(l_nocosoc)then
     112           0 :        do projspin=1,-1,-2  
     113           0 :         do j=1,nat
     114           0 :          do k=1,num_proj
     115             :             if(
     116           0 :      &          trim(adjustl(symbol(k)))
     117             :      &                    .eq.
     118             :      &          trim(adjustl(symb(j)))
     119           0 :      &                    )then
     120           0 :                if(mrwf(k).ne.0)then
     121             :                  write (300,'(i3,1x,i2,1x,i2,1x,i2,1x,i2)') 
     122           0 :      &                j,lwf(k),mrwf(k),rwf(k),projspin
     123             :                  write (300,'(2x,4f10.6,1x,f4.2)') 
     124           0 :      &                alpha(k),beta(k),gamma(k),
     125           0 :      &                zona(k),regio(k)
     126             :                else
     127           0 :                   do kk=1,projections(lwf(k))
     128             :                      write (300,'(i3,1x,i2,1x,i2,1x,i2,1x,i2)') 
     129           0 :      &                j,lwf(k),kk,rwf(k),projspin
     130             :                      write (300,'(2x,4f10.6,1x,f4.2)') 
     131           0 :      &                alpha(k),beta(k),gamma(k),
     132           0 :      &                zona(k),regio(k)
     133             :                   enddo
     134             :                endif
     135             :             endif
     136             :          enddo
     137             :         enddo
     138             :        enddo 
     139             :       else
     140           0 :         do j=1,nat
     141           0 :          do k=1,num_proj
     142             :             if(
     143           0 :      &          trim(adjustl(symbol(k)))
     144             :      &                    .eq.
     145             :      &          trim(adjustl(symb(j)))
     146           0 :      &                    )then
     147           0 :                if(mrwf(k).ne.0)then
     148             :                  write (300,'(i3,1x,i2,1x,i2,1x,i2)') 
     149           0 :      &                j,lwf(k),mrwf(k),rwf(k)
     150             :                  write (300,'(2x,4f10.6,1x,f4.2)') 
     151           0 :      &                alpha(k),beta(k),gamma(k),
     152           0 :      &                zona(k),regio(k)
     153             :                else
     154           0 :                   do kk=1,projections(lwf(k))
     155             :                      write (300,'(i3,1x,i2,1x,i2,1x,i2)') 
     156           0 :      &                j,lwf(k),kk,rwf(k)
     157             :                      write (300,'(3x,4f10.6,1x,f4.2)') 
     158           0 :      &                alpha(k),beta(k),gamma(k),
     159           0 :      &                zona(k),regio(k)
     160             :                   enddo
     161             :                endif
     162             :             endif
     163             :          enddo
     164             :         enddo
     165             :       endif
     166           0 :       close(300)
     167             : 
     168           0 :       end subroutine wann_projgen
     169             :       end module m_wann_projgen

Generated by: LCOV version 1.13