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_etabinit
8 : USE m_juDFT
9 : ! *******************************************************
10 : ! ***** set up etab via old core program *****
11 : ! *******************************************************
12 : ! modified to run with core-levels as provided by setcor
13 : ! ntab & ltab transport this info to core.F gb`02
14 : !------------------------------------------------------------
15 : CONTAINS
16 1 : SUBROUTINE etabinit(atoms,input, vr,&
17 1 : etab,ntab,ltab,nkmust)
18 :
19 : USE m_constants
20 : !USE m_setcor
21 : USE m_differ
22 : USE m_types
23 : IMPLICIT NONE
24 :
25 : TYPE(t_atoms),INTENT(IN) :: atoms
26 : TYPE(t_input),INTENT(IN) :: input
27 : !
28 : ! .. Scalar Arguments ..
29 : ! ..
30 : ! .. Array Arguments ..
31 : REAL , INTENT (IN) :: vr(atoms%jmtd,atoms%ntype)
32 : REAL , INTENT (OUT):: etab(100,atoms%ntype)
33 : INTEGER, INTENT (OUT):: ntab(100,atoms%ntype),ltab(100,atoms%ntype)
34 : INTEGER, INTENT (OUT):: nkmust(atoms%ntype)
35 : ! ..
36 : ! .. Local Scalars ..
37 : REAL c,d,dxx,e,fj,fl,fn,rn,rnot,t2 ,z,t1,rr,weight
38 : INTEGER i,ic,iksh,ilshell,j,jatom,korb,l, nst,ncmsh ,nshell,ipos,ierr
39 : ! ..
40 : ! .. Local Arrays ..
41 3 : INTEGER kappa(maxval(atoms%econf%num_states)),nprnc(maxval(atoms%econf%num_states))
42 4 : REAL eig(maxval(atoms%econf%num_states)),occ(maxval(atoms%econf%num_states),1),vrd(atoms%msh),a(atoms%msh),b(atoms%msh)
43 : ! ..
44 : !
45 1 : c = c_light(1.0)
46 : !
47 1 : WRITE (oUnit,FMT=8020)
48 : !
49 1 : ncmsh = atoms%msh
50 : ! ---> set up densities
51 2 : DO jatom = 1,atoms%ntype
52 1 : z = atoms%zatom(jatom)
53 1 : rn = atoms%rmt(jatom)
54 1 : dxx = atoms%dx(jatom)
55 : !CALL setcor(jatom,1,atoms,input,bmu,nst,kappa,nprnc,occ)
56 1 : CALL atoms%econf(jatom)%get_core(nst,nprnc,kappa,occ)
57 1 : rnot = atoms%rmsh(1,jatom)
58 1 : d = EXP(atoms%dx(jatom))
59 1 : rn = rnot* (d** (ncmsh-1))
60 1 : WRITE (oUnit,FMT=8000) z,rnot,dxx,atoms%jri(jatom)
61 566 : DO j = 1,atoms%jri(jatom)
62 566 : vrd(j) = vr(j,jatom)
63 : ENDDO
64 1 : IF (input%l_core_confpot) THEN
65 : !---> linear extension of the potential with slope t1 / a.u.
66 1 : t1=0.125
67 1 : t2 = vrd(atoms%jri(jatom))/atoms%rmt(jatom)-atoms%rmt(jatom)*t1
68 1 : rr = atoms%rmt(jatom)
69 1 : d = EXP(atoms%dx(jatom))
70 : ELSE
71 0 : t2 = vrd(atoms%jri(jatom))/ (atoms%jri(jatom)-atoms%msh)
72 : ENDIF
73 1 : IF (atoms%jri(jatom).LT.atoms%msh) THEN
74 109 : DO i = atoms%jri(jatom) + 1,atoms%msh
75 109 : if (input%l_core_confpot) THEN
76 108 : rr = d*rr
77 108 : vrd(i) = rr*( t2 + rr*t1 )
78 : ELSE
79 :
80 0 : vrd(i) = vrd(atoms%jri(jatom)) + t2* (i-atoms%jri(jatom))
81 : ENDIF
82 : ENDDO
83 : END IF
84 :
85 1 : nst = atoms%econf(jatom)%num_core_states
86 8 : DO korb = 1,nst
87 7 : fn = nprnc(korb)
88 7 : fj = iabs(kappa(korb)) - .5e0
89 7 : weight = 2*fj + 1.e0
90 7 : fl = fj + (.5e0)*isign(1,kappa(korb))
91 7 : e = -2* (z/ (fn+fl))**2
92 : CALL differ(fn,fl,fj,c,z,dxx,rnot,rn,d,atoms%msh,vrd,&
93 7 : e, a,b,ierr)
94 7 : IF (ierr/=0) CALL juDFT_error("error in core-levels",calledby="etabinit")
95 7 : WRITE (oUnit,FMT=8010) fn,fl,fj,e,weight
96 15 : eig(korb) = e
97 : ENDDO
98 : ic = 0
99 8 : DO korb = 1,nst
100 7 : fn = nprnc(korb)
101 7 : fj = iabs(kappa(korb)) - .5e0
102 7 : weight = 2*fj + 1.e0
103 7 : fl = fj + (.5e0)*isign(1,kappa(korb))
104 26 : DO i = 1, INT(weight)
105 18 : ic = ic + 1
106 18 : IF (kappa(korb).GT.0) THEN
107 4 : ipos = ic + 1 + i
108 14 : ELSEIF (kappa(korb).LT.-1) THEN
109 8 : ipos = ic - 2*(iabs(kappa(korb))-1) + MAX(i-2,0)
110 : ELSE
111 : ipos = ic
112 : ENDIF
113 18 : etab(ipos,jatom) = eig(korb)
114 18 : ntab(ipos,jatom) = NINT(fn)
115 25 : ltab(ipos,jatom) = NINT(fl)
116 : ENDDO
117 : ENDDO
118 1 : nkmust(jatom) = ic
119 :
120 20 : DO i=1,nkmust(jatom)
121 19 : WRITE(oUnit,'(f12.6,2i3)') etab(i,jatom),ntab(i,jatom), ltab(i,jatom)
122 : ENDDO
123 :
124 : ENDDO
125 : 8000 FORMAT (/,/,10x,'z=',f4.0,5x,'r(1)=',e14.6,5x,'dx=',f8.6,5x,&
126 : 'm.t.index=',i4,/,15x,'n',4x,'l',5x,'j',4x,'energy',7x, 'weight')
127 : 8010 FORMAT (12x,2f5.0,f6.1,f10.4,f12.4)
128 : 8020 FORMAT (/,/,12x,'core e.v. initialization')
129 :
130 1 : END SUBROUTINE etabinit
131 : END MODULE m_etabinit
|
