Commit 13e1384b authored by Gustav Bihlmayer's avatar Gustav Bihlmayer

Changed alineso.F90 to parallelize over atoms in the SOC part (using

the leftover SUBCOMM from the 1st variation). For this, abcof was
adapted (now: abcof_soc.F90) to avoid problems with invsat(). Some
indexes changes in hsohelp.F90, so wann_socmat.F was changed as well.
parent 39ea1072
set(fleur_F77 ${fleur_F77} set(fleur_F77 ${fleur_F77}
) )
set(fleur_F90 ${fleur_F90} set(fleur_F90 ${fleur_F90}
eigen_soc/abclocdn_soc.F90
eigen_soc/abcof_soc.F90
eigen_soc/alineso.F90 eigen_soc/alineso.F90
eigen_soc/anglso.f90 eigen_soc/anglso.f90
eigen_soc/eigenso.F90 eigen_soc/eigenso.F90
eigen_soc/hsoham.f90 eigen_soc/hsoham.F90
eigen_soc/hsohelp.F90 eigen_soc/hsohelp.F90
eigen_soc/sgml.f90 eigen_soc/sgml.f90
eigen_soc/sointg.f90 eigen_soc/sointg.f90
......
!--------------------------------------------------------------------------------
! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
! This file is part of FLEUR and available as free software under the conditions
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------
MODULE m_abclocdn_soc
USE m_juDFT
!*********************************************************************
! Calculates the (upper case) A, B and C coefficients for the local
! orbitals. The difference to abccoflo is, that a summation over the
! Gs ist performed. The A, B and C coeff. are set up for each eigen-
! state.
! Philipp Kurz 99/04
!*********************************************************************
!*************** ABBREVIATIONS ***************************************
! nkvec : stores the number of G-vectors that have been found and
! accepted during the construction of the local orbitals.
! kvec : k-vector used in hssphn to attach the local orbital 'lo'
! of atom 'na' to it.
!*********************************************************************
CONTAINS
SUBROUTINE abclocdn_soc(atoms,sym,noco,lapw,cell,ccchi,iintsp,phase,ylm,&
ntyp,na,na_l,k,nkvec,lo,ne,alo1,blo1,clo1,acof,bcof,ccof,zMat,l_force,fgp,force)
USE m_types
USE m_constants
IMPLICIT NONE
TYPE(t_noco), INTENT(IN) :: noco
TYPE(t_sym), INTENT(IN) :: sym
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_lapw), INTENT(IN) :: lapw
TYPE(t_cell), INTENT(IN) :: cell
TYPE(t_mat), INTENT(IN) :: zMat
TYPE(t_force), OPTIONAL, INTENT(INOUT) :: force
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: iintsp
INTEGER, INTENT (IN) :: k,na,na_l,ne,ntyp,nkvec,lo
COMPLEX, INTENT (IN) :: phase
LOGICAL, INTENT (IN) :: l_force
! .. Array Arguments ..
REAL, INTENT (IN) :: alo1(:),blo1(:),clo1(:)
COMPLEX, INTENT (IN) :: ylm( (atoms%lmaxd+1)**2 )
COMPLEX, INTENT (IN) :: ccchi(2)
COMPLEX, INTENT (INOUT) :: acof(:,0:,:)!(nobd,0:dimension%lmd,atoms%nat_l)
COMPLEX, INTENT (INOUT) :: bcof(:,0:,:)!(nobd,0:dimension%lmd,atoms%nat_l)
COMPLEX, INTENT (INOUT) :: ccof(-atoms%llod:,:,:,:)!(-atoms%llod:atoms%llod,nobd,atoms%nlod,atoms%nat_l)
REAL, OPTIONAL, INTENT (IN) :: fgp(3)
! .. Local Scalars ..
COMPLEX ctmp,term1
INTEGER i,j,l,ll1,lm,nbasf,m,na2,lmp
! ..
! ..
term1 = 2 * tpi_const/SQRT(cell%omtil) * ((atoms%rmt(ntyp)**2)/2) * phase
!
!---> the whole program is in hartree units, therefore 1/wronskian is
!---> (rmt**2)/2. the factor i**l, which usually appears in the a, b
!---> and c coefficients, is included in the t-matrices. thus, it does
!---> not show up in the formula above.
IF ((atoms%invsat(na)==0).OR.(atoms%invsat(na)==1)) THEN
na2=na
ELSE
na2 = sym%invsatnr(na)
ENDIF
nbasf=lapw%nv(iintsp)+lapw%index_lo(lo,na2)+nkvec
l = atoms%llo(lo,ntyp)
ll1 = l* (l+1)
DO i = 1,ne
DO m = -l,l
lm = ll1 + m
!+gu_con
IF ((atoms%invsat(na)==0).OR.(atoms%invsat(na)==1)) THEN
IF (zMat%l_real) THEN
ctmp = zMat%data_r(nbasf,i)*term1*CONJG(ylm(ll1+m+1))
ELSE
ctmp = zMat%data_c(nbasf,i)*term1*CONJG(ylm(ll1+m+1))
ENDIF
acof(i,lm,na_l) = acof(i,lm,na_l) + ctmp*alo1(lo)
bcof(i,lm,na_l) = bcof(i,lm,na_l) + ctmp*blo1(lo)
ccof(m,i,lo,na_l) = ccof(m,i,lo,na_l) + ctmp*clo1(lo)
ELSE
ctmp = zMat%data_c(nbasf,i)*CONJG(term1)*ylm(ll1+m+1)*(-1)**(l-m)
lmp = ll1 - m
acof(i,lmp,na_l) = acof(i,lmp,na_l) +ctmp*alo1(lo)
bcof(i,lmp,na_l) = bcof(i,lmp,na_l) +ctmp*blo1(lo)
ccof(-m,i,lo,na_l) = ccof(-m,i,lo,na_l) +ctmp*clo1(lo)
ENDIF
END DO
END DO
END SUBROUTINE abclocdn_soc
END MODULE m_abclocdn_soc
This diff is collapsed.
...@@ -12,10 +12,10 @@ CONTAINS ...@@ -12,10 +12,10 @@ CONTAINS
nsize,nmat, eig_so,zso) nsize,nmat, eig_so,zso)
#include"cpp_double.h" #include"cpp_double.h"
USE m_types
USE m_hsohelp USE m_hsohelp
USE m_hsoham USE m_hsoham
USE m_eig66_io, ONLY : read_eig USE m_eig66_io, ONLY : read_eig
USE m_types
IMPLICIT NONE IMPLICIT NONE
TYPE(t_mpi),INTENT(IN) :: mpi TYPE(t_mpi),INTENT(IN) :: mpi
TYPE(t_lapw),INTENT(IN) :: lapw TYPE(t_lapw),INTENT(IN) :: lapw
...@@ -44,10 +44,11 @@ CONTAINS ...@@ -44,10 +44,11 @@ CONTAINS
! .. Local Scalars .. ! .. Local Scalars ..
REAL r2 REAL r2
INTEGER i,i1 ,j,jsp,jsp1,k,ne,nn,nn1,nrec,info INTEGER i,i1 ,j,jsp,jsp1,k,ne,nn,nn1,nrec,info
INTEGER idim_c,idim_r,jsp2,nbas,j1 INTEGER idim_c,idim_r,jsp2,nbas,j1,ierr
CHARACTER vectors CHARACTER vectors
LOGICAL l_socvec,l_qsgw,l_open,l_real LOGICAL l_socvec,l_qsgw,l_open,l_real
INTEGER irec,irecl_qsgw INTEGER irec,irecl_qsgw
INTEGER nat_l, extra, nat_start, nat_stop
COMPLEX cdum COMPLEX cdum
! .. ! ..
! .. Local Arrays .. ! .. Local Arrays ..
...@@ -55,7 +56,7 @@ CONTAINS ...@@ -55,7 +56,7 @@ CONTAINS
REAL :: eig(DIMENSION%neigd,DIMENSION%jspd),s(3) REAL :: eig(DIMENSION%neigd,DIMENSION%jspd),s(3)
REAL, ALLOCATABLE :: rwork(:) REAL, ALLOCATABLE :: rwork(:)
COMPLEX,ALLOCATABLE :: cwork(:),chelp(:,:,:,:,:) COMPLEX,ALLOCATABLE :: cwork(:),chelp(:,:,:,:,:)
COMPLEX,ALLOCATABLE :: ahelp(:,:,:,:,:),bhelp(:,:,:,:,:) COMPLEX,ALLOCATABLE :: ahelp(:,:,:,:),bhelp(:,:,:,:)
COMPLEX,ALLOCATABLE :: zhelp1(:,:),zhelp2(:,:) COMPLEX,ALLOCATABLE :: zhelp1(:,:),zhelp2(:,:)
COMPLEX,ALLOCATABLE :: hso(:,:),hsomtx(:,:,:,:) COMPLEX,ALLOCATABLE :: hso(:,:),hsomtx(:,:,:,:)
COMPLEX,ALLOCATABLE :: sigma_xc_apw(:,:),sigma_xc(:,:) COMPLEX,ALLOCATABLE :: sigma_xc_apw(:,:),sigma_xc(:,:)
...@@ -104,8 +105,6 @@ CONTAINS ...@@ -104,8 +105,6 @@ CONTAINS
eig_id,nk,jsp,& eig_id,nk,jsp,&
n_start=1,n_end=ne,& n_start=1,n_end=ne,&
zmat=zmat(jsp)) zmat=zmat(jsp))
write(6,*) "jspin=",jsp,",nk=",nk
write(6,"(5f12.4)") eig(:ne,jsp)
! write(*,*) 'process',irank,' reads ',nk ! write(*,*) 'process',irank,' reads ',nk
...@@ -134,11 +133,31 @@ CONTAINS ...@@ -134,11 +133,31 @@ CONTAINS
ENDIF ENDIF
ENDDO ENDDO
! !
! distribution of (abc)cof over atoms
!
!
! in case of ev-parallelization, now distribute the atoms:
!
IF (mpi%n_size > 1) THEN
nat_l = FLOOR(real(atoms%nat)/mpi%n_size)
extra = atoms%nat - nat_l*mpi%n_size
nat_start = mpi%n_rank*nat_l + 1 + extra
nat_stop = (mpi%n_rank+1)*nat_l + extra
IF (mpi%n_rank < extra) THEN
nat_start = nat_start - (extra - mpi%n_rank)
nat_stop = nat_stop - (extra - mpi%n_rank - 1)
ENDIF
ELSE
nat_start = 1
nat_stop = atoms%nat
ENDIF
nat_l = nat_stop - nat_start + 1
!
! set up A and B coefficients ! set up A and B coefficients
! !
ALLOCATE ( ahelp(-atoms%lmaxd:atoms%lmaxd,atoms%lmaxd,atoms%nat,DIMENSION%neigd,DIMENSION%jspd) ) ALLOCATE ( ahelp(atoms%lmaxd*(atoms%lmaxd+2),nat_l,DIMENSION%neigd,DIMENSION%jspd) )
ALLOCATE ( bhelp(-atoms%lmaxd:atoms%lmaxd,atoms%lmaxd,atoms%nat,DIMENSION%neigd,DIMENSION%jspd) ) ALLOCATE ( bhelp(atoms%lmaxd*(atoms%lmaxd+2),nat_l,DIMENSION%neigd,DIMENSION%jspd) )
ALLOCATE ( chelp(-atoms%llod :atoms%llod, DIMENSION%neigd,atoms%nlod,atoms%nat ,DIMENSION%jspd) ) ALLOCATE ( chelp(-atoms%llod :atoms%llod, DIMENSION%neigd,atoms%nlod,nat_l,DIMENSION%jspd) )
CALL timestart("alineso SOC: -help") CALL timestart("alineso SOC: -help")
CALL hsohelp(& CALL hsohelp(&
& DIMENSION,atoms,sym,& & DIMENSION,atoms,sym,&
...@@ -146,17 +165,24 @@ CONTAINS ...@@ -146,17 +165,24 @@ CONTAINS
& cell,& & cell,&
& zmat,usdus,& & zmat,usdus,&
& zso,noco,oneD,& & zso,noco,oneD,&
& mpi%n_rank,mpi%n_size,mpi%SUB_COMM,&
& nat_start,nat_stop,nat_l,&
& ahelp,bhelp,chelp) & ahelp,bhelp,chelp)
CALL timestop("alineso SOC: -help") write(*,*) 'process',mpi%irank,' after hsohelp',mpi%n_rank
! !
! set up hamilton matrix ! set up hamilton matrix
! !
CALL timestart("alineso SOC: -ham") CALL timestart("alineso SOC: -ham")
ALLOCATE ( hsomtx(2,2,DIMENSION%neigd,DIMENSION%neigd) ) #ifdef CPP_MPI
CALL hsoham(atoms,noco,input,nsz,chelp, rsoc,ahelp,bhelp, hsomtx) CALL MPI_BARRIER(mpi%MPI_COMM,ierr)
#endif
ALLOCATE ( hsomtx(DIMENSION%neigd,DIMENSION%neigd,2,2) )
CALL hsoham(atoms,noco,input,nsz,chelp,rsoc,ahelp,bhelp,&
nat_start,nat_stop,mpi%n_rank,mpi%n_size,mpi%SUB_COMM,&
hsomtx)
DEALLOCATE ( ahelp,bhelp,chelp ) DEALLOCATE ( ahelp,bhelp,chelp )
CALL timestop("alineso SOC: -ham") CALL timestop("alineso SOC: -ham")
IF (mpi%n_rank==0) THEN
! !
! add e.v. on diagonal ! add e.v. on diagonal
! !
...@@ -164,10 +190,10 @@ CONTAINS ...@@ -164,10 +190,10 @@ CONTAINS
! hsomtx = 0 !!!!!!!!!!!! ! hsomtx = 0 !!!!!!!!!!!!
DO jsp = 1,input%jspins DO jsp = 1,input%jspins
DO i = 1,nsz(jsp) DO i = 1,nsz(jsp)
hsomtx(jsp,jsp,i,i) = hsomtx(jsp,jsp,i,i) +& hsomtx(i,i,jsp,jsp) = hsomtx(i,i,jsp,jsp) +&
& CMPLX(eig(i,jsp),0.) & CMPLX(eig(i,jsp),0.)
IF (input%jspins.EQ.1) THEN IF (input%jspins.EQ.1) THEN
hsomtx(2,2,i,i) = hsomtx(2,2,i,i) +& hsomtx(i,i,2,2) = hsomtx(i,i,2,2) +&
& CMPLX(eig(i,jsp),0.) & CMPLX(eig(i,jsp),0.)
ENDIF ENDIF
ENDDO ENDDO
...@@ -184,9 +210,10 @@ CONTAINS ...@@ -184,9 +210,10 @@ CONTAINS
IF (jsp.EQ.2) nn = nsz(1) IF (jsp.EQ.2) nn = nsz(1)
IF (jsp1.EQ.2) nn1 = nsz(1) IF (jsp1.EQ.2) nn1 = nsz(1)
! !
!write(3333,'(2i3,4e15.8)') jsp,jsp1,hsomtx(jsp,jsp1,8,8),hsomtx(jsp,jsp1,32,109)
DO i = 1,nsz(jsp) DO i = 1,nsz(jsp)
DO j = 1,nsz(jsp1) DO j = 1,nsz(jsp1)
hso(i+nn,j+nn1) = hsomtx(jsp,jsp1,i,j) hso(i+nn,j+nn1) = hsomtx(i,j,jsp,jsp1)
ENDDO ENDDO
ENDDO ENDDO
! !
...@@ -265,7 +292,6 @@ else ...@@ -265,7 +292,6 @@ else
& eig_so,& & eig_so,&
& cwork, idim_c, rwork, & & cwork, idim_c, rwork, &
& info) & info)
IF (info.NE.0) WRITE (6,FMT=8000) info IF (info.NE.0) WRITE (6,FMT=8000) info
8000 FORMAT (' AFTER CPP_LAPACK_cheev: info=',i4) 8000 FORMAT (' AFTER CPP_LAPACK_cheev: info=',i4)
CALL timestop("alineso SOC: -diag") CALL timestop("alineso SOC: -diag")
...@@ -331,6 +357,7 @@ else ...@@ -331,6 +357,7 @@ else
ENDIF ! (.NOT.input%eonly) ENDIF ! (.NOT.input%eonly)
DEALLOCATE ( hso ) DEALLOCATE ( hso )
ENDIF ! (n_rank==0)
! !
nmat=lapw%nmat nmat=lapw%nmat
RETURN RETURN
......
...@@ -56,7 +56,8 @@ CONTAINS ...@@ -56,7 +56,8 @@ CONTAINS
! .. ! ..
! .. Local Scalars .. ! .. Local Scalars ..
INTEGER i,j,nk,jspin,n ,l INTEGER i,j,nk,jspin,n ,l
INTEGER n_loc,n_plus,i_plus,n_end,nsz,nmat ! INTEGER n_loc,n_plus,i_plus,
INTEGER n_end,nsz,nmat,n_stride
LOGICAL l_socvec !,l_all LOGICAL l_socvec !,l_all
INTEGER wannierspin INTEGER wannierspin
TYPE(t_usdus):: usdus TYPE(t_usdus):: usdus
...@@ -117,15 +118,20 @@ CONTAINS ...@@ -117,15 +118,20 @@ CONTAINS
! !
!---> loop over k-points: each can be a separate task !---> loop over k-points: each can be a separate task
! !
n_loc = INT(kpts%nkpt/mpi%isize) !n_loc = INT(kpts%nkpt/mpi%isize)
n_plus = kpts%nkpt - mpi%isize*n_loc !n_plus = kpts%nkpt - mpi%isize*n_loc
i_plus = -1 !i_plus = -1
IF (mpi%irank.LT.n_plus) i_plus = 0 !IF (mpi%irank.LT.n_plus) i_plus = 0
n_end = (mpi%irank+1)+(n_loc+i_plus)*mpi%isize !n_end = (mpi%irank+1)+(n_loc+i_plus)*mpi%isize
!
n_stride = kpts%nkpt/mpi%n_groups
n_end = kpts%nkpt
! write(*,'(4i12)') mpi%irank, mpi%n_groups, n_stride, mpi%n_start
! !
!---> start loop k-pts !---> start loop k-pts
! !
DO nk = mpi%irank+1,n_end,mpi%isize ! DO nk = mpi%irank+1,n_end,mpi%isize
DO nk = mpi%n_start,n_end,n_stride
CALL lapw%init(input,noco, kpts,atoms,sym,nk,cell,.FALSE., mpi) CALL lapw%init(input,noco, kpts,atoms,sym,nk,cell,.FALSE., mpi)
ALLOCATE( zso(lapw%nv(1)+atoms%nlotot,2*DIMENSION%neigd,wannierspin)) ALLOCATE( zso(lapw%nv(1)+atoms%nlotot,2*DIMENSION%neigd,wannierspin))
zso(:,:,:) = CMPLX(0.0,0.0) zso(:,:,:) = CMPLX(0.0,0.0)
...@@ -141,20 +147,21 @@ CONTAINS ...@@ -141,20 +147,21 @@ CONTAINS
' the',i4,' SOC eigenvalues are:') ' the',i4,' SOC eigenvalues are:')
8020 FORMAT (5x,5f12.6) 8020 FORMAT (5x,5f12.6)
IF (input%eonly) THEN IF (mpi%n_rank==0) THEN
CALL write_eig(eig_id, nk,jspin,neig=nsz,neig_total=nsz, eig=eig_so(:nsz)) IF (input%eonly) THEN
CALL write_eig(eig_id, nk,jspin,neig=nsz,neig_total=nsz, eig=eig_so(:nsz))
ELSE ELSE
CALL zmat%alloc(.FALSE.,SIZE(zso,1),nsz) CALL zmat%alloc(.FALSE.,SIZE(zso,1),nsz)
DO jspin = 1,wannierspin DO jspin = 1,wannierspin
CALL timestart("eigenso: write_eig") CALL timestart("eigenso: write_eig")
zmat%data_c=zso(:,:nsz,jspin) zmat%data_c=zso(:,:nsz,jspin)
CALL write_eig(eig_id, nk,jspin,neig=nsz,neig_total=nsz, eig=eig_so(:nsz),zmat=zmat) CALL write_eig(eig_id, nk,jspin,neig=nsz,neig_total=nsz, eig=eig_so(:nsz),zmat=zmat)
CALL timestop("eigenso: write_eig") CALL timestop("eigenso: write_eig")
ENDDO ENDDO
ENDIF ! (input%eonly) ELSE ENDIF ! (input%eonly) ELSE
deallocate(zso) ENDIF ! n_rank == 0
DEALLOCATE (zso)
ENDDO ! DO nk ENDDO ! DO nk
! Sorry for the following strange workaround to fill the results%neig and results%eig arrays. ! Sorry for the following strange workaround to fill the results%neig and results%eig arrays.
......
...@@ -17,11 +17,16 @@ MODULE m_hsohelp ...@@ -17,11 +17,16 @@ MODULE m_hsohelp
! !
CONTAINS CONTAINS
SUBROUTINE hsohelp(DIMENSION,atoms,sym,input,lapw,nsz, cell,& SUBROUTINE hsohelp(DIMENSION,atoms,sym,input,lapw,nsz, cell,&
zmat,usdus, zso,noco,oneD, ahelp,bhelp,chelp) zmat,usdus, zso,noco,oneD,n_rank,n_size,SUB_COMM,&
nat_start,nat_stop,nat_l,ahelp,bhelp,chelp)
! !
USE m_abcof USE m_abcof_soc
USE m_types USE m_types
IMPLICIT NONE IMPLICIT NONE
#ifdef CPP_MPI
INCLUDE 'mpif.h'
INTEGER ierr(3)
#endif
TYPE(t_dimension),INTENT(IN) :: DIMENSION TYPE(t_dimension),INTENT(IN) :: DIMENSION
TYPE(t_oneD),INTENT(IN) :: oneD TYPE(t_oneD),INTENT(IN) :: oneD
TYPE(t_input),INTENT(IN) :: input TYPE(t_input),INTENT(IN) :: input
...@@ -34,12 +39,16 @@ CONTAINS ...@@ -34,12 +39,16 @@ CONTAINS
! .. ! ..
! .. Scalar Arguments .. ! .. Scalar Arguments ..
! .. ! ..
INTEGER, INTENT (IN) :: nat_start,nat_stop,nat_l
INTEGER, INTENT (IN) :: n_rank,n_size,SUB_COMM
! .. Array Arguments .. ! .. Array Arguments ..
INTEGER, INTENT (IN) :: nsz(DIMENSION%jspd) INTEGER, INTENT (IN) :: nsz(DIMENSION%jspd)
COMPLEX, INTENT (INOUT) :: zso(:,:,:)!DIMENSION%nbasfcn,2*DIMENSION%neigd,DIMENSION%jspd) COMPLEX, INTENT (INOUT) :: zso(:,:,:)!DIMENSION%nbasfcn,2*DIMENSION%neigd,DIMENSION%jspd)
COMPLEX, INTENT (OUT):: ahelp(-atoms%lmaxd:atoms%lmaxd,atoms%lmaxd,atoms%nat,DIMENSION%neigd,DIMENSION%jspd) ! COMPLEX, INTENT (OUT):: ahelp(-atoms%lmaxd:atoms%lmaxd,atoms%lmaxd,nat_l,DIMENSION%neigd,DIMENSION%jspd)
COMPLEX, INTENT (OUT):: bhelp(-atoms%lmaxd:atoms%lmaxd,atoms%lmaxd,atoms%nat,DIMENSION%neigd,DIMENSION%jspd) ! COMPLEX, INTENT (OUT):: bhelp(-atoms%lmaxd:atoms%lmaxd,atoms%lmaxd,nat_l,DIMENSION%neigd,DIMENSION%jspd)
COMPLEX, INTENT (OUT):: chelp(-atoms%llod :atoms%llod, DIMENSION%neigd,atoms%nlod,atoms%nat, DIMENSION%jspd) COMPLEX, INTENT (OUT):: ahelp(atoms%lmaxd*(atoms%lmaxd+2),nat_l,DIMENSION%neigd,DIMENSION%jspd)
COMPLEX, INTENT (OUT):: bhelp(atoms%lmaxd*(atoms%lmaxd+2),nat_l,DIMENSION%neigd,DIMENSION%jspd)
COMPLEX, INTENT (OUT):: chelp(-atoms%llod :atoms%llod, DIMENSION%neigd,atoms%nlod,nat_l,DIMENSION%jspd)
TYPE(t_mat),INTENT(IN) :: zmat(:) ! (DIMENSION%nbasfcn,DIMENSION%neigd,DIMENSION%jspd) TYPE(t_mat),INTENT(IN) :: zmat(:) ! (DIMENSION%nbasfcn,DIMENSION%neigd,DIMENSION%jspd)
!-odim !-odim
!+odim !+odim
...@@ -74,7 +83,7 @@ CONTAINS ...@@ -74,7 +83,7 @@ CONTAINS
chelp(:,:,:,:,input%jspins) = CMPLX(0.0,0.0) chelp(:,:,:,:,input%jspins) = CMPLX(0.0,0.0)
ALLOCATE ( acof(DIMENSION%neigd,0:lmd,atoms%nat),bcof(DIMENSION%neigd,0:lmd,atoms%nat) ) ALLOCATE ( acof(DIMENSION%neigd,0:lmd,nat_l),bcof(DIMENSION%neigd,0:lmd,nat_l) )
DO ispin = 1, input%jspins DO ispin = 1, input%jspins
IF (zmat(1)%l_real.AND.noco%l_soc) THEN IF (zmat(1)%l_real.AND.noco%l_soc) THEN
zso(:,1:DIMENSION%neigd,ispin) = CMPLX(zmat(ispin)%data_r(:,1:DIMENSION%neigd),0.0) zso(:,1:DIMENSION%neigd,ispin) = CMPLX(zmat(ispin)%data_r(:,1:DIMENSION%neigd),0.0)
...@@ -83,21 +92,22 @@ CONTAINS ...@@ -83,21 +92,22 @@ CONTAINS
zMat_local%matsize2 = DIMENSION%neigd zMat_local%matsize2 = DIMENSION%neigd
ALLOCATE(zMat_local%data_c(zmat(1)%matsize1,DIMENSION%neigd)) ALLOCATE(zMat_local%data_c(zmat(1)%matsize1,DIMENSION%neigd))
zMat_local%data_c(:,:) = zso(:,1:DIMENSION%neigd,ispin) zMat_local%data_c(:,:) = zso(:,1:DIMENSION%neigd,ispin)
CALL abcof(input,atoms_local,sym,cell,lapw,nsz(ispin),& CALL abcof_soc(input,atoms_local,sym,cell,lapw,nsz(ispin),&
usdus, noco_local,ispin,oneD, acof,bcof,chelp(-atoms%llod:,:,:,:,ispin),zMat_local) usdus, noco_local,ispin,oneD,nat_start,nat_stop,nat_l,&
acof,bcof,chelp(-atoms%llod:,:,:,:,ispin),zMat_local)
DEALLOCATE(zMat_local%data_c) DEALLOCATE(zMat_local%data_c)
! !
! !
! transfer (a,b)cofs to (a,b)helps used in hsoham ! transfer (a,b)cofs to (a,b)helps used in hsoham
! !
DO ie = 1, DIMENSION%neigd DO ie = 1, DIMENSION%neigd
DO na = 1, atoms%nat DO na = 1, nat_l
DO l = 1, atoms%lmaxd DO l = 1, atoms%lmaxd
ll1 = l*(l+1) ll1 = l*(l+1)
DO m = -l,l DO m = -l,l
lm = ll1 + m lm = ll1 + m
ahelp(m,l,na,ie,ispin) = (acof(ie,lm,na)) ahelp(lm,na,ie,ispin) = (acof(ie,lm,na))
bhelp(m,l,na,ie,ispin) = (bcof(ie,lm,na)) bhelp(lm,na,ie,ispin) = (bcof(ie,lm,na))
ENDDO ENDDO
ENDDO ENDDO
ENDDO ENDDO
...@@ -109,20 +119,21 @@ CONTAINS ...@@ -109,20 +119,21 @@ CONTAINS
zMat_local%matsize2 = DIMENSION%neigd zMat_local%matsize2 = DIMENSION%neigd
ALLOCATE(zMat_local%data_c(zmat(1)%matsize1,DIMENSION%neigd)) ALLOCATE(zMat_local%data_c(zmat(1)%matsize1,DIMENSION%neigd))
zMat_local%data_c(:,:) = zmat(ispin)%data_c(:,:) zMat_local%data_c(:,:) = zmat(ispin)%data_c(:,:)
CALL abcof(input,atoms_local,sym,cell,lapw,nsz(ispin),& CALL abcof_soc(input,atoms_local,sym,cell,lapw,nsz(ispin),&
usdus, noco_local,ispin,oneD, acof,bcof,chelp(-atoms%llod:,:,:,:,ispin),zMat_local) usdus, noco_local,ispin,oneD,nat_start,nat_stop,nat_l,&
acof,bcof,chelp(-atoms%llod:,:,:,:,ispin),zMat_local)
DEALLOCATE(zMat_local%data_c) DEALLOCATE(zMat_local%data_c)
! !
! transfer (a,b)cofs to (a,b)helps used in hsoham ! transfer (a,b)cofs to (a,b)helps used in hsoham
! !
DO ie = 1, DIMENSION%neigd DO ie = 1, DIMENSION%neigd
DO na = 1, atoms%nat DO na = 1, nat_l
DO l = 1, atoms%lmaxd DO l = 1, atoms%lmaxd
ll1 = l*(l+1) ll1 = l*(l+1)
DO m = -l,l DO m = -l,l
lm = ll1 + m lm = ll1 + m
ahelp(m,l,na,ie,ispin) = (acof(ie,lm,na)) ahelp(lm,na,ie,ispin) = (acof(ie,lm,na))
bhelp(m,l,na,ie,ispin) = (bcof(ie,lm,na)) bhelp(lm,na,ie,ispin) = (bcof(ie,lm,na))
ENDDO ENDDO
ENDDO ENDDO
ENDDO ENDDO
......
...@@ -89,8 +89,8 @@ c*********************************************************************** ...@@ -89,8 +89,8 @@ c***********************************************************************
real,allocatable :: uulon(:,:,:) ! nlod,ntypd,jspd real,allocatable :: uulon(:,:,:) ! nlod,ntypd,jspd
real,allocatable :: dulon(:,:,:) ! nlod,ntypd,jspd real,allocatable :: dulon(:,:,:) ! nlod,ntypd,jspd
COMPLEX,ALLOCATABLE :: ahelp(:,:,:,:,:) COMPLEX,ALLOCATABLE :: ahelp(:,:,:,:)
complex,allocatable :: bhelp(:,:,:,:,:) complex,allocatable :: bhelp(:,:,:,:)
TYPE(t_rsoc)::rsoc TYPE(t_rsoc)::rsoc
TYPE(t_usdus):: usdus TYPE(t_usdus):: usdus
...@@ -110,8 +110,8 @@ c*********************************************************************** ...@@ -110,8 +110,8 @@ c***********************************************************************
! is equivalent to the def in the noco-routines ! is equivalent to the def in the noco-routines
ENDIF ENDIF
ALLOCATE ( ahelp(-lmaxd:lmaxd,lmaxd,natd,neigd,jspd) ) ALLOCATE ( ahelp(lmaxd*(lmaxd+2),natd,neigd,jspd) )
ALLOCATE ( bhelp(-lmaxd:lmaxd,lmaxd,natd,neigd,jspd) ) ALLOCATE ( bhelp(lmaxd*(lmaxd+2),natd,neigd,jspd) )
do ispin=1,jspd do ispin=1,jspd
DO ie = 1, neigd DO ie = 1, neigd
...@@ -120,8 +120,8 @@ c*********************************************************************** ...@@ -120,8 +120,8 @@ c***********************************************************************
ll1 = l*(l+1) ll1 = l*(l+1)
DO m = -l,l DO m = -l,l
lm = ll1 + m lm = ll1 + m
ahelp(m,l,na,ie,ispin) = (acof(ie,lm,na,ispin)) ahelp(lm,na,ie,ispin) = (acof(ie,lm,na,ispin))
bhelp(m,l,na,ie,ispin) = (bcof(ie,lm,na,ispin)) bhelp(lm,na,ie,ispin) = (bcof(ie,lm,na,ispin))
ENDDO !m ENDDO !m
ENDDO !l ENDDO !l
ENDDO !na ENDDO !na
...@@ -150,7 +150,9 @@ c*********************************************************************** ...@@ -150,7 +150,9 @@ c***********************************************************************
rsoc%soangl= conjg(rsoc%soangl) rsoc%soangl= conjg(rsoc%soangl)
CALL hsoham(atoms,noco,input,nsz,chelp, rsoc, ahelp,bhelp, hsomtx) CALL hsoham(atoms,noco,input,nsz,chelp,rsoc,ahelp,bhelp,
> 1,natd,mpi%n_rank,mpi%n_size,mpi%SUB_COMM,
< hsomtx)
end subroutine wann_socmat end subroutine wann_socmat
end module m_wann_socmat end module m_wann_socmat
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment