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_F90 ${fleur_F90}
eigen_soc/abclocdn_soc.F90
eigen_soc/abcof_soc.F90
eigen_soc/alineso.F90
eigen_soc/anglso.f90
eigen_soc/eigenso.F90
eigen_soc/hsoham.f90
eigen_soc/hsoham.F90
eigen_soc/hsohelp.F90
eigen_soc/sgml.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
nsize,nmat, eig_so,zso)
#include"cpp_double.h"
USE m_types
USE m_hsohelp
USE m_hsoham
USE m_eig66_io, ONLY : read_eig
USE m_types
IMPLICIT NONE
TYPE(t_mpi),INTENT(IN) :: mpi
TYPE(t_lapw),INTENT(IN) :: lapw
......@@ -44,10 +44,11 @@ CONTAINS
! .. Local Scalars ..
REAL r2
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
LOGICAL l_socvec,l_qsgw,l_open,l_real
INTEGER irec,irecl_qsgw
INTEGER nat_l, extra, nat_start, nat_stop
COMPLEX cdum
! ..
! .. Local Arrays ..
......@@ -55,7 +56,7 @@ CONTAINS
REAL :: eig(DIMENSION%neigd,DIMENSION%jspd),s(3)
REAL, ALLOCATABLE :: rwork(:)
COMPLEX,ALLOCATABLE :: cwork(:),chelp(:,:,:,:,:)
COMPLEX,ALLOCATABLE :: ahelp(:,:,:,:,:),bhelp(:,:,:,:,:)
COMPLEX,ALLOCATABLE :: ahelp(:,:,:,:),bhelp(:,:,:,:)
COMPLEX,ALLOCATABLE :: zhelp1(:,:),zhelp2(:,:)
COMPLEX,ALLOCATABLE :: hso(:,:),hsomtx(:,:,:,:)
COMPLEX,ALLOCATABLE :: sigma_xc_apw(:,:),sigma_xc(:,:)
......@@ -104,8 +105,6 @@ CONTAINS
eig_id,nk,jsp,&
n_start=1,n_end=ne,&
zmat=zmat(jsp))
write(6,*) "jspin=",jsp,",nk=",nk
write(6,"(5f12.4)") eig(:ne,jsp)
! write(*,*) 'process',irank,' reads ',nk
......@@ -134,11 +133,31 @@ CONTAINS
ENDIF
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
!
ALLOCATE ( ahelp(-atoms%lmaxd:atoms%lmaxd,atoms%lmaxd,atoms%nat,DIMENSION%neigd,DIMENSION%jspd) )
ALLOCATE ( bhelp(-atoms%lmaxd:atoms%lmaxd,atoms%lmaxd,atoms%nat,DIMENSION%neigd,DIMENSION%jspd) )
ALLOCATE ( chelp(-atoms%llod :atoms%llod, DIMENSION%neigd,atoms%nlod,atoms%nat ,DIMENSION%jspd) )
ALLOCATE ( ahelp(atoms%lmaxd*(atoms%lmaxd+2),nat_l,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,nat_l,DIMENSION%jspd) )
CALL timestart("alineso SOC: -help")
CALL hsohelp(&
& DIMENSION,atoms,sym,&
......@@ -146,17 +165,24 @@ CONTAINS
& cell,&
& zmat,usdus,&
& zso,noco,oneD,&
& mpi%n_rank,mpi%n_size,mpi%SUB_COMM,&
& nat_start,nat_stop,nat_l,&
& ahelp,bhelp,chelp)
CALL timestop("alineso SOC: -help")
write(*,*) 'process',mpi%irank,' after hsohelp',mpi%n_rank
!
! set up hamilton matrix
!
CALL timestart("alineso SOC: -ham")
ALLOCATE ( hsomtx(2,2,DIMENSION%neigd,DIMENSION%neigd) )
CALL hsoham(atoms,noco,input,nsz,chelp, rsoc,ahelp,bhelp, hsomtx)
#ifdef CPP_MPI
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 )
CALL timestop("alineso SOC: -ham")
IF (mpi%n_rank==0) THEN
!
! add e.v. on diagonal
!
......@@ -164,10 +190,10 @@ CONTAINS
! hsomtx = 0 !!!!!!!!!!!!
DO jsp = 1,input%jspins
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.)
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.)
ENDIF
ENDDO
......@@ -184,9 +210,10 @@ CONTAINS
IF (jsp.EQ.2) nn = 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 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
!
......@@ -265,7 +292,6 @@ else
& eig_so,&
& cwork, idim_c, rwork, &
& info)
IF (info.NE.0) WRITE (6,FMT=8000) info
8000 FORMAT (' AFTER CPP_LAPACK_cheev: info=',i4)
CALL timestop("alineso SOC: -diag")
......@@ -331,6 +357,7 @@ else
ENDIF ! (.NOT.input%eonly)
DEALLOCATE ( hso )
ENDIF ! (n_rank==0)
!
nmat=lapw%nmat
RETURN
......
......@@ -56,7 +56,8 @@ CONTAINS
! ..
! .. Local Scalars ..
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
INTEGER wannierspin
TYPE(t_usdus):: usdus
......@@ -117,15 +118,20 @@ CONTAINS
!
!---> loop over k-points: each can be a separate task
!
n_loc = INT(kpts%nkpt/mpi%isize)
n_plus = kpts%nkpt - mpi%isize*n_loc
i_plus = -1
IF (mpi%irank.LT.n_plus) i_plus = 0
n_end = (mpi%irank+1)+(n_loc+i_plus)*mpi%isize
!n_loc = INT(kpts%nkpt/mpi%isize)
!n_plus = kpts%nkpt - mpi%isize*n_loc
!i_plus = -1
!IF (mpi%irank.LT.n_plus) i_plus = 0
!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
!
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)
ALLOCATE( zso(lapw%nv(1)+atoms%nlotot,2*DIMENSION%neigd,wannierspin))
zso(:,:,:) = CMPLX(0.0,0.0)
......@@ -141,9 +147,9 @@ CONTAINS
' the',i4,' SOC eigenvalues are:')
8020 FORMAT (5x,5f12.6)
IF (mpi%n_rank==0) THEN
IF (input%eonly) THEN
CALL write_eig(eig_id, nk,jspin,neig=nsz,neig_total=nsz, eig=eig_so(:nsz))
ELSE
CALL zmat%alloc(.FALSE.,SIZE(zso,1),nsz)
DO jspin = 1,wannierspin
......@@ -154,7 +160,8 @@ CONTAINS
CALL timestop("eigenso: write_eig")
ENDDO
ENDIF ! (input%eonly) ELSE
deallocate(zso)
ENDIF ! n_rank == 0
DEALLOCATE (zso)
ENDDO ! DO nk
! Sorry for the following strange workaround to fill the results%neig and results%eig arrays.
......
......@@ -6,11 +6,18 @@ MODULE m_hsoham
!
CONTAINS
SUBROUTINE hsoham(&
atoms,noco,input,nsz,chelp,&
rsoc,ahelp,bhelp,&
atoms,noco,input,nsz,chelp,rsoc,ahelp,bhelp,&
nat_start,nat_stop,n_rank,n_size,SUB_COMM,&
hsomtx)
#include"cpp_double.h"
USE m_types
IMPLICIT NONE
#ifdef CPP_MPI
INCLUDE 'mpif.h'
INTEGER ierr(3)
#endif
TYPE(t_input),INTENT(IN) :: input
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_atoms),INTENT(IN) :: atoms
......@@ -18,19 +25,20 @@ CONTAINS
! ..
! .. Scalar Arguments ..
! ..
INTEGER, INTENT (IN) :: nat_start,nat_stop,n_rank,n_size,SUB_COMM
! .. Array Arguments ..
INTEGER, INTENT (IN) :: nsz(:)!(dimension%jspd)
COMPLEX, INTENT (IN) :: ahelp(-atoms%lmaxd:,:,:,:,:)!(-lmaxd:lmaxd,lmaxd,atoms%nat,dimension%neigd,dimension%jspd)
COMPLEX, INTENT (IN) :: bhelp(-atoms%lmaxd:,:,:,:,:)!(-lmaxd:lmaxd,lmaxd,atoms%nat,dimension%neigd,dimension%jspd)
COMPLEX, INTENT (IN) :: chelp(-atoms%llod :,:,:,:,:)!(-llod:llod ,dimension%neigd,atoms%nlod,atoms%nat ,dimension%jspd)
COMPLEX, INTENT (OUT):: hsomtx(:,:,:,:)!(2,2,dimension%neigd,neigd)
COMPLEX, INTENT (IN) :: ahelp(:,:,:,:)!(lmd,nat_l,dimension%neigd,dimension%jspd)
COMPLEX, INTENT (IN) :: bhelp(:,:,:,:)!(lmd,nat_l,dimension%neigd,dimension%jspd)
COMPLEX, INTENT (IN) :: chelp(-atoms%llod :,:,:,:,:)!(-llod:llod ,dimension%neigd,atoms%nlod,nat_l,dimension%jspd)
COMPLEX, INTENT (OUT):: hsomtx(:,:,:,:)!(dimension%neigd,neigd,2,2)
! ..
! .. Local Scalars ..
COMPLEX c_1,c_2,c_3,c_4,c_5
INTEGER i,j,jsp,jsp1,l,lwn ,m1,n,na,nn,i1,j1,ilo,ilop,m
INTEGER i,j,jsp,jsp1,l,lwn ,m1,n,na,nn,i1,j1,ilo,ilop,m,nat_l,na_g,lm,ll1
! ..
! .. Local Arrays ..
COMPLEX, ALLOCATABLE :: c_b(:,:,:),c_a(:,:,:),c_c(:,:,:)
COMPLEX, ALLOCATABLE :: c_b(:,:,:),c_a(:,:,:),c_c(:,:,:),c_buf(:)
! ..
!
!---------------------------------------------------------------------
......@@ -42,46 +50,51 @@ CONTAINS
! x,y = a,b
!---------------------------------------------------------------------
!
nat_l = nat_stop - nat_start + 1 ! atoms processed by this pe
!
!---> update hamiltonian matrices: upper triangle
!
DO i1 = 1,2
jsp = i1
IF (input%jspins.EQ.1) jsp = 1
DO j1 = 1,2
jsp1 = j1
IF (input%jspins.EQ.1) jsp1 = 1
!$OMP PARALLEL DEFAULT(none)&
!$OMP PRIVATE(j,na,n,nn,l,m,m1,ilo,i,lwn,ilop)&
!$OMP PRIVATE(c_a,c_b,c_c,c_1,c_2,c_3,c_4,c_5) &
!$OMP SHARED(hsomtx,i1,jsp,j1,jsp1,nsz,atoms)&
!$OMP SHARED(ahelp,bhelp,chelp,noco)&
!$OMP SHARED(rsoc)
!!$OMP PARALLEL DEFAULT(none)&
!!$OMP PRIVATE(j,na,na_g,n,nn,l,m,m1,ilo,i,lwn,ilop)&
!!$OMP PRIVATE(c_a,c_b,c_c,c_1,c_2,c_3,c_4,c_5) &
!!$OMP SHARED(hsomtx,i1,jsp,j1,jsp1,nsz,atoms)&
!!$OMP SHARED(ahelp,bhelp,chelp,noco,nat_start,nat_stop,nat_l)&
!!$OMP SHARED(rsoc)
ALLOCATE ( c_b(-atoms%lmaxd:atoms%lmaxd,atoms%lmaxd,atoms%nat),&
c_a(-atoms%lmaxd:atoms%lmaxd,atoms%lmaxd,atoms%nat),&
c_c(-atoms%llod :atoms%llod ,atoms%nlod ,atoms%nat) )
ALLOCATE ( c_b(-atoms%lmaxd:atoms%lmaxd,atoms%lmaxd,nat_l),&
c_a(-atoms%lmaxd:atoms%lmaxd,atoms%lmaxd,nat_l),&
c_c(-atoms%llod :atoms%llod ,atoms%nlod ,nat_l) )
!$OMP DO
!!$OMP DO
DO j = 1,nsz(jsp1)
!
! prepare \sum_m' conjg( xhelp(m',l,na,j,jsp1) ) * soangl(l,m,i1,l,m',j1)
!
na = 0
na = 0 ; na_g = 0
DO n = 1,atoms%ntype
DO nn = 1, atoms%neq(n)
na_g = na_g + 1
IF ((na_g.GE.nat_start).AND.(na_g.LE.nat_stop)) THEN
na = na + 1
!--> regular part
DO l = 1,atoms%lmax(n)
ll1 = l*(l+1)
DO m = -l,l
c_a(m,l,na) = CMPLX(0.,0.)
c_b(m,l,na) = CMPLX(0.,0.)
DO m1 = -l,l
lm = ll1 + m1
c_a(m,l,na) = c_a(m,l,na) + rsoc%soangl(l,m,i1,l,m1,j1)&
*CONJG(ahelp(m1,l,na,j,jsp1))
*CONJG(ahelp(lm,na,j,jsp1))
c_b(m,l,na) = c_b(m,l,na) + rsoc%soangl(l,m,i1,l,m1,j1)&
*CONJG(bhelp(m1,l,na,j,jsp1))
*CONJG(bhelp(lm,na,j,jsp1))
ENDDO
ENDDO
ENDDO
......@@ -99,14 +112,15 @@ CONTAINS
ENDIF
ENDDO
! end lo's
ENDDO
ENDDO
ENDIF
ENDDO ! nn
ENDDO ! n
!
! continue loop structure
!
DO i = 1,nsz(jsp)
hsomtx(i1,j1,i,j) = CMPLX(0.,0.)
na = 0
hsomtx(i,j,i1,j1) = CMPLX(0.,0.)
na = 0 ; na_g = 0
!
!---> loop over each atom type
!
......@@ -116,15 +130,18 @@ CONTAINS
!---> loop over equivalent atoms
!
DO nn = 1,atoms%neq(n)
na_g = na_g + 1
IF ((na_g.GE.nat_start).AND.(na_g.LE.nat_stop)) THEN
na = na + 1
DO l = 1,lwn
!
ll1 = l*(l+1)
DO m = -l,l
c_1 = rsoc%rsopp(n,l,i1,j1) * ahelp(m,l,na,i,jsp) +&
rsoc%rsopdp(n,l,i1,j1) * bhelp(m,l,na,i,jsp)
c_2 = rsoc%rsoppd(n,l,i1,j1) * ahelp(m,l,na,i,jsp) +&
rsoc%rsopdpd(n,l,i1,j1) * bhelp(m,l,na,i,jsp)
hsomtx(i1,j1,i,j) = hsomtx(i1,j1,i,j) +&
lm = ll1 + m
c_1 = rsoc%rsopp(n,l,i1,j1) * ahelp(lm,na,i,jsp) +&
rsoc%rsopdp(n,l,i1,j1) * bhelp(lm,na,i,jsp)
c_2 = rsoc%rsoppd(n,l,i1,j1) * ahelp(lm,na,i,jsp) +&
rsoc%rsopdpd(n,l,i1,j1) * bhelp(lm,na,i,jsp)
hsomtx(i,j,i1,j1) = hsomtx(i,j,i1,j1) +&
c_1*c_a(m,l,na) + c_2*c_b(m,l,na)
ENDDO
!
......@@ -132,20 +149,22 @@ CONTAINS
!--> LO contribution
DO ilo = 1,atoms%nlo(n)
l = atoms%llo(ilo,n)
ll1 = l*(l+1)
IF (l.GT.0) THEN
DO m = -l,l
c_3 = rsoc%rsopplo(n,ilo,i1,j1) *ahelp(m,l,na,i,jsp) +&
rsoc%rsopdplo(n,ilo,i1,j1) *bhelp(m,l,na,i,jsp)
lm = ll1 + m
c_3 = rsoc%rsopplo(n,ilo,i1,j1) *ahelp(lm,na,i,jsp) +&
rsoc%rsopdplo(n,ilo,i1,j1) *bhelp(lm,na,i,jsp)
c_4 = rsoc%rsoplop(n,ilo,i1,j1) *chelp(m,i,ilo,na,jsp)
c_5 =rsoc%rsoplopd(n,ilo,i1,j1) *chelp(m,i,ilo,na,jsp)
hsomtx(i1,j1,i,j) = hsomtx(i1,j1,i,j) + &
hsomtx(i,j,i1,j1) = hsomtx(i,j,i1,j1) + &
c_4*c_a(m,l,na) + c_5*c_b(m,l,na) +&
c_3*c_c(m,ilo,na)
ENDDO
DO ilop = 1,atoms%nlo(n)
IF (atoms%llo(ilop,n).EQ.l) THEN
DO m = -l,l
hsomtx(i1,j1,i,j) = hsomtx(i1,j1,i,j) + &
hsomtx(i,j,i1,j1) = hsomtx(i,j,i1,j1) + &
rsoc%rsoploplop(n,ilop,ilo,i1,j1) * &
chelp(m,i,ilop,na,jsp) * c_c(m,ilo,na)
ENDDO
......@@ -154,17 +173,16 @@ CONTAINS
ENDIF
ENDDO
! end lo's
ENDIF
ENDDO
ENDDO
!
ENDDO ! atoms
ENDDO
!!i
ENDDO
!!j
!$OMP END DO
!!$OMP END DO
DEALLOCATE (c_a,c_b,c_c)
!$OMP END PARALLEL
!!$OMP END PARALLEL
ENDDO
!!jsp1
ENDDO
......@@ -174,10 +192,21 @@ CONTAINS
!
DO i = 1,nsz(1)
DO j = 1,nsz(input%jspins)
hsomtx(2,1,j,i) = CONJG(hsomtx(1,2,i,j))
hsomtx(j,i,2,1) = CONJG(hsomtx(i,j,1,2))
ENDDO
ENDDO
!
#ifdef CPP_MPI
CALL MPI_BARRIER(SUB_COMM,ierr)
n = 4*nsz(1)*nsz(input%jspins)
ALLOCATE(c_buf(n))
CALL MPI_REDUCE(hsomtx(1,1,1,1),c_buf,n,CPP_MPI_COMPLEX,MPI_SUM,0,SUB_COMM,ierr)
IF (n_rank.EQ.0) THEN
CALL CPP_BLAS_ccopy(n, c_buf, 1, hsomtx(1,1,1,1), 1)
ENDIF
DEALLOCATE(c_buf)
#endif
!
RETURN
END SUBROUTINE hsoham
END MODULE m_hsoham
......@@ -17,11 +17,16 @@ MODULE m_hsohelp
!
CONTAINS
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
IMPLICIT NONE
#ifdef CPP_MPI
INCLUDE 'mpif.h'
INTEGER ierr(3)
#endif
TYPE(t_dimension),INTENT(IN) :: DIMENSION
TYPE(t_oneD),INTENT(IN) :: oneD
TYPE(t_input),INTENT(IN) :: input
......@@ -34,12 +39,16 @@ CONTAINS
! ..
! .. Scalar Arguments ..
! ..
INTEGER, INTENT (IN) :: nat_start,nat_stop,nat_l
INTEGER, INTENT (IN) :: n_rank,n_size,SUB_COMM
! .. Array Arguments ..
INTEGER, INTENT (IN) :: nsz(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):: bhelp(-atoms%lmaxd:atoms%lmaxd,atoms%lmaxd,atoms%nat,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,atoms%lmaxd,nat_l,DIMENSION%neigd,DIMENSION%jspd)
! COMPLEX, INTENT (OUT):: bhelp(-atoms%lmaxd:atoms%lmaxd,atoms%lmaxd,nat_l,DIMENSION%neigd,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)
!-odim
!+odim
......@@ -74,7 +83,7 @@ CONTAINS
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
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)
......@@ -83,21 +92,22 @@ CONTAINS
zMat_local%matsize2 = DIMENSION%neigd
ALLOCATE(zMat_local%data_c(zmat(1)%matsize1,DIMENSION%neigd))
zMat_local%data_c(:,:) = zso(:,1:DIMENSION%neigd,ispin)
CALL abcof(input,atoms_local,sym,cell,lapw,nsz(ispin),&
usdus, noco_local,ispin,oneD, acof,bcof,chelp(-atoms%llod:,:,:,:,ispin),zMat_local)
CALL abcof_soc(input,atoms_local,sym,cell,lapw,nsz(ispin),&
usdus, noco_local,ispin,oneD,nat_start,nat_stop,nat_l,&
acof,bcof,chelp(-atoms%llod:,:,:,:,ispin),zMat_local)
DEALLOCATE(zMat_local%data_c)
!
!
! transfer (a,b)cofs to (a,b)helps used in hsoham
!
DO ie = 1, DIMENSION%neigd
DO na = 1, atoms%nat
DO na = 1, nat_l
DO l = 1, atoms%lmaxd
ll1 = l*(l+1)
DO m = -l,l
lm = ll1 + m
ahelp(m,l,na,ie,ispin) = (acof(ie,lm,na))
bhelp(m,l,na,ie,ispin) = (bcof(ie,lm,na))
ahelp(lm,na,ie,ispin) = (acof(ie,lm,na))
bhelp(lm,na,ie,ispin) = (bcof(ie,lm,na))
ENDDO
ENDDO
ENDDO
......@@ -109,20 +119,21 @@ CONTAINS
zMat_local%matsize2 = DIMENSION%neigd
ALLOCATE(zMat_local%data_c(zmat(1)%matsize1,DIMENSION%neigd))
zMat_local%data_c(:,:) = zmat(ispin)%data_c(:,:)
CALL abcof(input,atoms_local,sym,cell,lapw,nsz(ispin),&
usdus, noco_local,ispin,oneD, acof,bcof,chelp(-atoms%llod:,:,:,:,ispin),zMat_local)
CALL abcof_soc(input,atoms_local,sym,cell,lapw,nsz(ispin),&
usdus, noco_local,ispin,oneD,nat_start,nat_stop,nat_l,&
acof,bcof,chelp(-atoms%llod:,:,:,:,ispin),zMat_local)
DEALLOCATE(zMat_local%data_c)