Line data Source code
1 : MODULE m_eigenso
2 : !
3 : !*********************************************************************
4 : ! sets ur and solves the spin-orbit eigenvalue problem in the
5 : ! second variation procedure.
6 : !
7 : ! way: takes e.v. and e.f. from previous scalar-rel. calc.
8 : ! makes spin-orbit matrix elements solves e.v. and put it on 'eig'
9 : !
10 : ! Tree: eigenso-|- readPotential
11 : ! |- spnorb : sets up s-o parameters
12 : ! | |- soinit - sorad : radial part
13 : ! | |- sgml : diagonal angular parts
14 : ! | |- anglso : non-diagonal -"-
15 : ! |
16 : ! |- alineso : sets up and solves e.v. problem
17 : ! |- hsohelp
18 : ! |- hsoham
19 : !
20 : !**********************************************************************
21 : !
22 :
23 : #ifdef CPP_MPI
24 : use mpi
25 : #endif
26 : CONTAINS
27 68 : SUBROUTINE eigenso(eig_id,fmpi,stars,sphhar,nococonv,vTot,enpara,results,hub1inp,hub1data,fi)
28 :
29 : USE m_types
30 : USE m_constants
31 : USE m_eig66_io, ONLY : read_eig,write_eig
32 : USE m_spnorb
33 : USE m_alineso
34 : USE m_judft
35 : USE m_unfold_band_kpts
36 : IMPLICIT NONE
37 :
38 : TYPE(t_mpi),INTENT(IN) :: fmpi
39 : type(t_fleurinput), intent(in) :: fi
40 : TYPE(t_nococonv),INTENT(IN) :: nococonv
41 : TYPE(t_stars),INTENT(IN) :: stars
42 : TYPE(t_sphhar),INTENT(IN) :: sphhar
43 : TYPE(t_potden),INTENT(IN) :: vTot
44 : TYPE(t_enpara),INTENT(IN) :: enpara
45 : TYPE(t_results),INTENT(INOUT) :: results
46 : TYPE(t_hub1inp),OPTIONAL,INTENT(IN) :: hub1inp
47 : TYPE(t_hub1data),OPTIONAL,INTENT(INOUT) :: hub1data
48 :
49 : ! ..
50 : ! .. Scalar Arguments ..
51 : INTEGER, INTENT (IN) :: eig_id
52 : ! ..
53 : ! ..
54 : ! .. Local Scalars ..
55 : INTEGER i,j,nk,nk_i,jspin,n ,l
56 : ! INTEGER n_loc,n_plus,i_plus,
57 : INTEGER nsz,nmat,n_stride
58 : LOGICAL l_socvec !,l_all
59 : INTEGER wannierspin
60 68 : TYPE(t_usdus) :: usdus
61 : ! ..
62 : ! .. Local Arrays..
63 : CHARACTER*3 chntype
64 :
65 68 : TYPE(t_rsoc) :: rsoc
66 68 : INTEGER, ALLOCATABLE :: neigBuffer(:,:)
67 :
68 68 : COMPLEX :: unfoldingBuffer(SIZE(results%unfolding_weights,1),fi%kpts%nkpt,fi%input%jspins) ! needed for unfolding bandstructure fmpi case
69 :
70 68 : REAL, ALLOCATABLE :: eig_so(:), eigBuffer(:,:,:)
71 68 : COMPLEX, ALLOCATABLE :: zso(:,:,:)
72 :
73 68 : TYPE(t_mat)::zmat
74 68 : TYPE(t_lapw)::lapw
75 68 : TYPE(t_sym) :: sym_l
76 :
77 : INTEGER :: ierr, jsp
78 :
79 : ! ..
80 :
81 68 : INQUIRE (4649,opened=l_socvec)
82 :
83 : ! To be consistent with angles should be redefined here!
84 : !noco%theta= -noco%theta
85 : !noco%phi= noco%phi+pi_const
86 : ! now the definition of rotation matrices
87 : ! is equivalent to the def in the noco-routines
88 :
89 : ALLOCATE( usdus%us(0:fi%atoms%lmaxd,fi%atoms%ntype,fi%input%jspins), usdus%dus(0:fi%atoms%lmaxd,fi%atoms%ntype,fi%input%jspins),&
90 : usdus%uds(0:fi%atoms%lmaxd,fi%atoms%ntype,fi%input%jspins),usdus%duds(0:fi%atoms%lmaxd,fi%atoms%ntype,fi%input%jspins),&
91 : usdus%ddn(0:fi%atoms%lmaxd,fi%atoms%ntype,fi%input%jspins),&
92 : usdus%ulos(fi%atoms%nlod,fi%atoms%ntype,fi%input%jspins),usdus%dulos(fi%atoms%nlod,fi%atoms%ntype,fi%input%jspins),&
93 2040 : usdus%uulon(fi%atoms%nlod,fi%atoms%ntype,fi%input%jspins),usdus%dulon(fi%atoms%nlod,fi%atoms%ntype,fi%input%jspins))
94 :
95 68 : IF (fi%input%l_wann.OR.l_socvec) THEN
96 : wannierspin = 2
97 : ELSE
98 68 : wannierspin = fi%input%jspins
99 : ENDIF
100 :
101 : !
102 : !---> set up and solve the eigenvalue problem
103 : ! ---> radial k-idp s-o matrix elements calc. and storage
104 : !
105 : #if defined(CPP_MPI)
106 : !RMA synchronization
107 68 : CALL MPI_BARRIER(fmpi%MPI_COMM,ierr)
108 : #endif
109 68 : CALL timestart("eigenso: spnorb")
110 : ! ..
111 :
112 : !Get spin-orbit coupling matrix elements
113 68 : CALL spnorb( fi%atoms,fi%noco,nococonv,fi%input,fmpi, enpara,vTot%mt,usdus,rsoc,.TRUE.,hub1inp,hub1data)
114 : !
115 :
116 68 : sym_l=fi%sym
117 172 : sym_l%ngopr=1 !No rotated k-points
118 204 : ALLOCATE (eig_so(2*fi%input%neig))
119 340 : ALLOCATE (eigBuffer(2*fi%input%neig,fi%kpts%nkpt,wannierspin))
120 272 : ALLOCATE (neigBuffer(fi%kpts%nkpt,wannierspin))
121 109358 : results%eig = 1.0e300
122 109358 : eigBuffer = 1.0e300
123 109358 : unfoldingBuffer = CMPLX(0.0,0.0)
124 1238 : results%neig = 0
125 1238 : neigBuffer = 0
126 11006236 : rsoc%soangl(:,:,:,:,:,:) = CONJG(rsoc%soangl(:,:,:,:,:,:))
127 68 : CALL timestop("eigenso: spnorb")
128 : !
129 : !---> loop over k-points: each can be a separate task
130 616 : DO nk_i=1,SIZE(fmpi%k_list)
131 548 : nk=fmpi%k_list(nk_i)
132 : !DO nk = fmpi%n_start,n_end,n_stride
133 548 : CALL lapw%init(fi%input,fi%noco, nococonv,fi%kpts,fi%atoms,sym_l,nk,fi%cell, fmpi)
134 2740 : ALLOCATE( zso(lapw%nv(1)+fi%atoms%nlotot,2*fi%input%neig,wannierspin))
135 15315810 : zso(:,:,:) = CMPLX(0.0,0.0)
136 :
137 548 : CALL timestart("eigenso: alineso")
138 : CALL alineso(eig_id,lapw, fmpi,fi%atoms,sym_l,fi%kpts,&
139 548 : fi%input,fi%noco,nococonv,fi%cell, nk,usdus,rsoc,nsz,nmat, eig_so,zso)
140 548 : CALL timestop("eigenso: alineso")
141 548 : IF (fmpi%irank.EQ.0) THEN
142 274 : WRITE (oUnit,FMT=8010) nk,nsz
143 274 : WRITE (oUnit,FMT=8020) (eig_so(i),i=1,nsz)
144 : ENDIF
145 : 8010 FORMAT (1x,/,/,' #k=',i6,':',/,' the',i4,' SOC eigenvalues are:')
146 : 8020 FORMAT (5x,5f12.6)
147 :
148 548 : IF (fmpi%n_rank==0) THEN
149 276 : IF (fi%input%eonly) THEN
150 0 : CALL write_eig(eig_id, nk,jspin,neig=nsz,neig_total=nsz, eig=eig_so(:nsz))
151 0 : STOP 'jspin is undefined here (eigenso - eonly branch)'
152 : eigBuffer(:nsz,nk,jspin) = eig_so(:nsz)
153 : neigBuffer(nk,jspin) = nsz
154 : ELSE
155 276 : CALL zmat%alloc(.FALSE.,SIZE(zso,1),nsz)
156 810 : DO jspin = 1,wannierspin
157 534 : CALL timestart("eigenso: write_eig")
158 :
159 534 : call timestart("cpy zmat")
160 7767076 : zmat%data_c=zso(:,:nsz,jspin)
161 534 : call timestop("cpy zmat")
162 :
163 534 : CALL write_eig(eig_id, nk,jspin,neig=nsz,neig_total=nsz, eig=eig_so(:nsz),zmat=zmat)
164 :
165 534 : call timestart("cpy buffers")
166 54594 : eigBuffer(:nsz,nk,jspin) = eig_so(:nsz)
167 534 : neigBuffer(nk,jspin) = nsz
168 534 : call timestop("cpy buffers")
169 :
170 810 : CALL timestop("eigenso: write_eig")
171 : ENDDO
172 : ENDIF ! (input%eonly) ELSE
173 : ENDIF ! n_rank == 0
174 548 : IF (fi%banddos%unfoldband) THEN
175 : !IF(modulo (fi%kpts%nkpt,fmpi%n_size).NE.0) call !juDFT_error("number fi%kpts needs to be multiple of number fmpi threads", &
176 : ! hint=errmsg, calledby="eigenso.F90")
177 : !write(*,*) 'unfodling for SOC - remember to use useOlap=F'
178 0 : jsp=1
179 0 : CALL calculate_plot_w_n(fi%banddos,fi%cell,fi%kpts,zMat,lapw,nk,jsp,eig_so(:nsz),results,fi%input,fi%atoms,unfoldingBuffer,fmpi,fi%noco%l_soc,zso=zso)
180 0 : IF (fi%input%jspins==2) THEN
181 0 : jsp=2
182 0 : CALL calculate_plot_w_n(fi%banddos,fi%cell,fi%kpts,zMat,lapw,nk,jsp,eig_so(:nsz),results,fi%input,fi%atoms,unfoldingBuffer,fmpi,fi%noco%l_soc,zso=zso)
183 : ENDIF
184 : END IF
185 1164 : DEALLOCATE (zso)
186 : ENDDO ! DO nk
187 :
188 : #ifdef CPP_MPI
189 68 : IF (fi%banddos%unfoldband) THEN
190 0 : results%unfolding_weights = CMPLX(0.0,0.0)
191 0 : CALL MPI_ALLREDUCE(unfoldingBuffer,results%unfolding_weights,SIZE(results%unfolding_weights,1)*SIZE(results%unfolding_weights,2)*SIZE(results%unfolding_weights,3),MPI_DOUBLE_COMPLEX,MPI_SUM,fmpi%mpi_comm,ierr)
192 : END IF
193 68 : CALL MPI_ALLREDUCE(neigBuffer,results%neig,fi%kpts%nkpt*wannierspin,MPI_INTEGER,MPI_SUM,fmpi%mpi_comm,ierr)
194 : CALL MPI_ALLREDUCE(eigBuffer(:2*fi%input%neig,:,:),results%eig(:2*fi%input%neig,:,:),&
195 68 : 2*fi%input%neig*fi%kpts%nkpt*wannierspin,MPI_DOUBLE_PRECISION,MPI_MIN,fmpi%mpi_comm,ierr)
196 68 : CALL MPI_BARRIER(fmpi%MPI_COMM,ierr)
197 : #else
198 : results%unfolding_weights(:,:,:) = unfoldingBuffer(:,:,:)
199 : results%neig(:,:) = neigBuffer(:,:)
200 : results%eig(:2*fi%input%neig,:,:) = eigBuffer(:2*fi%input%neig,:,:)
201 : #endif
202 :
203 68 : RETURN
204 136 : END SUBROUTINE eigenso
205 : END MODULE m_eigenso
|
