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_ioncharge_gen
       8             :       contains
       9           0 :       subroutine wann_ioncharge_gen(
      10             :      >               num_atoms,ntype,natd,
      11           0 :      >               neq,zatom,pos,
      12           0 :      <               ioncharge)
      13             : c********************************************
      14             : c     Utility routine used to set up or read 
      15             : c     the file 'ioncharge'.
      16             : c     Frank Freimuth
      17             : c********************************************
      18             :       implicit none
      19             :       integer, intent(in)          :: num_atoms
      20             :       integer, intent(in)          :: ntype
      21             :       integer, intent(in)          :: natd
      22             :       integer, intent(in)          :: neq(ntype)
      23             :       real,    intent(in)          :: pos(3,natd)
      24             :       real,    intent(in)          :: zatom(ntype)
      25             :       real,    intent(out)         :: ioncharge(num_atoms)
      26             : 
      27             :       character*2                  :: namat2(0:103)
      28           0 :       character(len=2),allocatable :: namat(:)
      29             :       integer                      :: ind,k,j
      30             :       logical                      :: l_file
      31             :       integer                      :: num_symbols
      32             :       real                         :: charge
      33             :       character(len=2)             :: symbol
      34             : 
      35             :       DATA namat2/'va',' H','He','Li','Be',
      36             :      +     ' B',' C',' N',' O',' F','Ne',
      37             :      +     'Na','Mg','Al','Si',' P',' S','Cl','Ar',' K','Ca','Sc','Ti',
      38             :      +     ' V','Cr','Mn','Fe','Co','Ni','Cu','Zn','Ga','Ge','As','Se',
      39             :      +     'Br','Kr','Rb','Sr',' Y','Zr','Nb','Mo','Tc','Ru','Rh','Pd',
      40             :      +     'Ag','Cd','In','Sn','Sb','Te',' I','Xe','Cs','Ba','La','Ce',
      41             :      +     'Pr','Nd','Pm','Sm','Eu','Gd','Tb','Dy','Ho','Er','Tm','Yb',
      42             :      +     'Lu','Hf','Ta',' W','Re','Os','Ir','Pt','Au','Hg','Tl','Pb',
      43             :      +     'Bi','Po','At','Rn','Fr','Ra','Ac','Th','Pa',' U','Np','Pu',
      44             :      +     'Am','Cm','Bk','Cf','Es','Fm','Md','No','Lw'/
      45             : 
      46           0 :       allocate( namat(num_atoms) )
      47             :       ind=0
      48           0 :       do j=1,ntype
      49           0 :          do k=1,neq(j)
      50           0 :             ind=ind+1
      51           0 :             namat(ind)=namat2(nint(zatom(j)))
      52             :          enddo
      53             :       enddo
      54             : 
      55           0 :       inquire(file='ioncharge',exist=l_file)
      56           0 :       if(.not.l_file)then
      57           0 :        ioncharge=0.0
      58           0 :        open(400,file='IONS',status='old')
      59           0 :        read(400,*)num_symbols
      60           0 :        do j=1,num_symbols
      61           0 :          read(400,fmt=333)symbol,charge
      62           0 :          write(*,fmt=333)symbol,charge
      63           0 :          do k=1,num_atoms
      64           0 :             if(namat(k)==symbol)then
      65           0 :                ioncharge(k)=charge
      66             :             endif
      67             :          enddo
      68             :        enddo
      69           0 :        close(400)
      70             :  333   format(a2,1x,f10.6)
      71           0 :        open(300,file='ioncharge')
      72           0 :        do j=1,num_atoms
      73           0 :           write(300,*)ioncharge(j)
      74             :        enddo
      75           0 :        close(300)
      76             :       endif 
      77             : 
      78           0 :       open(300,file='ioncharge')
      79           0 :       do j=1,num_atoms
      80           0 :          read(300,*)ioncharge(j)
      81             :       enddo
      82           0 :       close(300)
      83             : 
      84           0 :       write(666,*)"ionic charges:"
      85           0 :       do j=1,num_atoms
      86           0 :          write(666,fmt=111)namat(j),ioncharge(j),pos(:,j)
      87             :       enddo
      88             :  111  format(a2," ",f6.3," ",3f8.3)
      89             : 
      90           0 :       end subroutine wann_ioncharge_gen
      91             :       end module m_wann_ioncharge_gen