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