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_spnorb
8 : !*********************************************************************
9 : ! calls soinit to calculate the radial spin-orbit matrix elements:
10 : ! rsopp,rsopdpd,rsoppd,rsopdp
11 : ! and sets up the so - angular matrix elements (soangl)
12 : ! using the functions anglso and sgml.
13 : !*********************************************************************
14 : CONTAINS
15 132 : SUBROUTINE spnorb(atoms,noco,nococonv,input,fmpi, enpara, vr, usdus, rsoc,l_angles,hub1inp,hub1data)
16 : USE m_sorad
17 : USE m_constants
18 : USE m_types
19 : IMPLICIT NONE
20 :
21 : TYPE(t_mpi),INTENT(IN) :: fmpi
22 : TYPE(t_enpara),INTENT(IN) :: enpara
23 : TYPE(t_input),INTENT(IN) :: input
24 : TYPE(t_noco),INTENT(IN) :: noco
25 : TYPE(t_nococonv),INTENT(IN) :: nococonv
26 : TYPE(t_atoms),INTENT(IN) :: atoms
27 : TYPE(t_usdus),INTENT(INOUT) :: usdus
28 : TYPE(t_rsoc),INTENT(OUT) :: rsoc
29 : LOGICAL,INTENT(IN) :: l_angles
30 : TYPE(t_hub1inp),OPTIONAL, INTENT(IN) :: hub1inp
31 : TYPE(t_hub1data),OPTIONAL,INTENT(INOUT) :: hub1data
32 : ! ..
33 : ! ..
34 : ! .. Array Arguments ..
35 : REAL, INTENT (IN) :: vr(:,0:,:,:) !(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,input%jspins)
36 : ! ..
37 : ! .. Local Scalars ..
38 : INTEGER is1,is2,jspin1,jspin2,l,l1,l2,m1,m2,n,i_hia
39 : LOGICAL, SAVE :: first_k = .TRUE.
40 : ! ..
41 :
42 : !Allocate space for SOC matrix elements; set to zero at the same time
43 13312 : ALLOCATE(rsoc%rsopp (atoms%ntype,atoms%lmaxd,2,2));rsoc%rsopp =0.0
44 12916 : ALLOCATE(rsoc%rsoppd (atoms%ntype,atoms%lmaxd,2,2));rsoc%rsoppd=0.0
45 12916 : ALLOCATE(rsoc%rsopdp (atoms%ntype,atoms%lmaxd,2,2));rsoc%rsopdp=0.0
46 12916 : ALLOCATE(rsoc%rsopdpd(atoms%ntype,atoms%lmaxd,2,2));rsoc%rsopdpd=0.0
47 2960 : ALLOCATE(rsoc%rsoplop (atoms%ntype,atoms%nlod,2,2));rsoc%rsoplop=0.0
48 2564 : ALLOCATE(rsoc%rsoplopd(atoms%ntype,atoms%nlod,2,2));rsoc%rsoplopd=0.0
49 2564 : ALLOCATE(rsoc%rsopdplo(atoms%ntype,atoms%nlod,2,2));rsoc%rsopdplo=0.0
50 2564 : ALLOCATE(rsoc%rsopplo (atoms%ntype,atoms%nlod,2,2));rsoc%rsopplo=0.0
51 4724 : ALLOCATE(rsoc%rsoploplop(atoms%ntype,atoms%nlod,atoms%nlod,2,2));rsoc%rsoploplop=0.0
52 132 : IF (l_angles) ALLOCATE(rsoc%soangl(atoms%lmaxd,-atoms%lmaxd:atoms%lmaxd,2,&
53 544 : atoms%lmaxd,-atoms%lmaxd:atoms%lmaxd,2))
54 :
55 : !Calculate radial soc-matrix elements
56 336 : DO n = 1,atoms%ntype
57 336 : CALL sorad(atoms,input,n,vr(:,0,n,:),enpara,noco%l_spav,rsoc,usdus,hub1data)
58 : END DO
59 :
60 :
61 : !Read in SOC-parameter for shell with hubbard 1
62 132 : IF(PRESENT(hub1inp).AND.fmpi%irank.EQ.0) THEN
63 66 : DO i_hia = 1, atoms%n_hia
64 0 : IF(hub1inp%l_soc_given(i_hia)) CYCLE
65 0 : n = atoms%lda_u(atoms%n_u+i_hia)%atomType
66 0 : l = atoms%lda_u(atoms%n_u+i_hia)%l
67 66 : IF(PRESENT(hub1data)) hub1data%xi(i_hia) = 2.0*rsoc%rsopp(n,l,1,1)*hartree_to_ev_const
68 : ENDDO
69 : ENDIF
70 :
71 : !
72 : !Scale SOC
73 336 : DO n= 1,atoms%ntype
74 336 : IF (ABS(noco%socscale(n)-1)>1E-5) THEN
75 16 : IF (fmpi%irank==0) WRITE(oUnit,"(a,i0,a,f10.8)") "Scaled SOC for atom ",n," by ",noco%socscale(n)
76 624 : rsoc%rsopp(n,:,:,:) = rsoc%rsopp(n,:,:,:)*noco%socscale(n)
77 624 : rsoc%rsopdp(n,:,:,:) = rsoc%rsopdp(n,:,:,:)*noco%socscale(n)
78 624 : rsoc%rsoppd(n,:,:,:) = rsoc%rsoppd(n,:,:,:)*noco%socscale(n)
79 624 : rsoc%rsopdpd(n,:,:,:) = rsoc%rsopdpd(n,:,:,:)*noco%socscale(n)
80 240 : rsoc%rsoplop(n,:,:,:) = rsoc%rsoplop(n,:,:,:)*noco%socscale(n)
81 240 : rsoc%rsoplopd(n,:,:,:) = rsoc%rsoplopd(n,:,:,:)*noco%socscale(n)
82 240 : rsoc%rsopdplo(n,:,:,:) = rsoc%rsopdplo(n,:,:,:)*noco%socscale(n)
83 240 : rsoc%rsopplo(n,:,:,:) = rsoc%rsopplo(n,:,:,:)*noco%socscale(n)
84 496 : rsoc%rsoploplop(n,:,:,:,:) = rsoc%rsoploplop(n,:,:,:,:)*noco%socscale(n)
85 : ENDIF
86 : ENDDO
87 :
88 : !DO some IO into out file
89 132 : IF ((first_k).AND.(fmpi%irank.EQ.0)) THEN
90 36 : DO n = 1,atoms%ntype
91 21 : WRITE (oUnit,FMT=8000)
92 21 : WRITE (oUnit,FMT=9000)
93 84 : WRITE (oUnit,FMT=8001) (2*rsoc%rsopp(n,l,1,1),l=1,3)
94 84 : WRITE (oUnit,FMT=8001) (2*rsoc%rsopp(n,l,2,2),l=1,3)
95 99 : WRITE (oUnit,FMT=8001) (2*rsoc%rsopp(n,l,2,1),l=1,3)
96 : ENDDO
97 15 : IF (noco%l_spav) THEN
98 4 : WRITE(oUnit,fmt='(A)') 'SOC Hamiltonian is constructed by neglecting B_xc.'
99 : ENDIF
100 15 : first_k=.FALSE.
101 : ENDIF
102 : 8000 FORMAT (' spin - orbit parameter HR ')
103 : 8001 FORMAT (8f8.4)
104 : 9000 FORMAT (5x,' p ',5x,' d ', 5x, ' f ')
105 : !
106 :
107 : !Calculate angular matrix elements if requested
108 132 : IF (l_angles) &
109 68 : CALL spnorb_angles(atoms,fmpi,nococonv%theta,nococonv%phi,rsoc%soangl)
110 132 : END SUBROUTINE spnorb
111 :
112 68 : SUBROUTINE spnorb_angles(atoms,fmpi,theta,phi,soangl,compo)
113 : USE m_constants
114 : USE m_anglso
115 : USE m_sgml
116 : USE m_sorad
117 : USE m_types
118 : IMPLICIT NONE
119 : TYPE(t_atoms),INTENT(IN) :: atoms
120 : TYPE(t_mpi),INTENT(IN) :: fmpi
121 : REAL,INTENT(IN) :: theta,phi
122 : COMPLEX,INTENT(INOUT) :: soangl(:,-atoms%lmaxd:,:,:,-atoms%lmaxd:,:)
123 : INTEGER, INTENT(IN),OPTIONAL :: compo
124 : ! ..
125 : ! ..
126 : ! .. Local Scalars ..
127 : INTEGER is1,is2,jspin1,jspin2,l,l1,l2,m1,m2,n
128 : ! ..
129 : ! .. Local Arrays ..
130 : INTEGER ispjsp(2)
131 : ! ..
132 : ! ..
133 : DATA ispjsp/1,-1/
134 :
135 :
136 : IF ((ABS(theta).LT.0.00001).AND.(ABS(phi).LT.0.00001)&
137 68 : .AND..NOT.PRESENT(compo)) THEN
138 : !
139 : ! TEST for real function sgml(l1,m1,is1,l2,m2,is2)
140 : !
141 594 : DO l1 = 1,atoms%lmaxd
142 5618 : DO l2 = 1,atoms%lmaxd
143 15608 : DO jspin1 = 1,2
144 35168 : DO jspin2 = 1,2
145 20096 : is1=ispjsp(jspin1)
146 20096 : is2=ispjsp(jspin2)
147 261312 : DO m1 = -l1,l1,1
148 2934656 : DO m2 = -l2,l2,1
149 : soangl(l1,m1,jspin1,l2,m2,jspin2) =&
150 2914560 : CMPLX(sgml(l1,m1,is1,l2,m2,is2),0.0)
151 : ENDDO
152 : ENDDO
153 : ENDDO
154 : ENDDO
155 : ENDDO
156 : ENDDO
157 :
158 : ELSE
159 : !
160 : ! TEST for complex function anglso(teta,phi,l1,m1,is1,l2,m2,is2)
161 : !
162 110 : DO l1 = 1,atoms%lmaxd
163 1110 : DO l2 = 1,atoms%lmaxd
164 3100 : DO jspin1 = 1,2
165 7000 : DO jspin2 = 1,2
166 4000 : is1=ispjsp(jspin1)
167 4000 : is2=ispjsp(jspin2)
168 : !
169 54000 : DO m1 = -l1,l1,1
170 628000 : DO m2 = -l2,l2,1
171 : soangl(l1,m1,jspin1,l2,m2,jspin2) =&
172 624000 : anglso(theta,phi,l1,m1,is1,l2,m2,is2,compo)
173 : ENDDO
174 : ENDDO
175 : !
176 : ENDDO
177 : ENDDO
178 : ENDDO
179 : ENDDO
180 : !
181 : ENDIF
182 :
183 68 : IF (fmpi%irank.EQ.0) THEN
184 34 : WRITE (oUnit,FMT=8002)
185 102 : DO jspin1 = 1,2
186 238 : DO jspin2 = 1,2
187 136 : WRITE (oUnit,FMT=*) 'd-states:is1=',jspin1,',is2=',jspin2
188 1088 : WRITE (oUnit,FMT='(7x,7i8)') (m1,m1=-3,3,1)
189 7820 : WRITE (oUnit,FMT=8003) (m2, (soangl(3,m1,jspin1,3,m2,jspin2),m1=-3,3,1),m2=-3,3,1)
190 : ENDDO
191 : ENDDO
192 : ENDIF
193 : 8002 FORMAT (' so - angular matrix elements')
194 : 8003 FORMAT (i8,14f8.4)
195 :
196 68 : END SUBROUTINE spnorb_angles
197 : END MODULE m_spnorb
|