Skip to content

GitLab

fleur
fleur
Commit 13e1384b authored by Gustav Bihlmayer's avatar Gustav Bihlmayer
Browse files
Options

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
Hide whitespace changes
Inline Side-by-side
Showing with 654 additions and 61 deletions
eigen_soc/CMakeLists.txt
View file @ 13e1384b
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
......
eigen_soc/abclocdn_soc.F90 0 → 100644
View file @ 13e1384b
!--------------------------------------------------------------------------------
! 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
eigen_soc/abcof_soc.F90 0 → 100644
View file @ 13e1384b
MODULE m_abcof_soc
CONTAINS
SUBROUTINE abcof_soc(input,atoms,sym, cell,lapw,ne,usdus,&
noco,jspin,oneD,nat_start,nat_stop,nat_l,&
acof,bcof,ccof,zMat,eig,force)
! ************************************************************
! subroutine constructs the a,b coefficients of the linearized
! m.t. wavefunctions for each band and atom. c.l. fu
! ************************************************************
#include "cpp_double.h"
USE m_constants, ONLY : tpi_const
USE m_setabc1lo
USE m_sphbes
USE m_dsphbs
USE m_abclocdn_soc
USE m_ylm
USE m_types
USE m_juDFT
IMPLICIT NONE
TYPE(t_input),INTENT(IN) :: input
TYPE(t_usdus),INTENT(IN) :: usdus
TYPE(t_lapw),INTENT(IN) :: lapw
TYPE(t_oneD),INTENT(IN) :: oneD
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_mat),INTENT(IN) :: zMat
TYPE(t_force),OPTIONAL,INTENT(INOUT) :: force
! ..
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: ne,nat_start,nat_stop,nat_l
INTEGER, INTENT (IN) :: jspin
! ..
! .. Array Arguments ..
COMPLEX, INTENT (OUT) :: acof(:,0:,:)!(nobd,0:dimension%lmd,nat_l)
COMPLEX, INTENT (OUT) :: bcof(:,0:,:)!(nobd,0:dimension%lmd,nat_l)
COMPLEX, INTENT (OUT) :: ccof(-atoms%llod:,:,:,:)!(-llod:llod,nobd,atoms%nlod,nat_l)
REAL, OPTIONAL, INTENT (IN) :: eig(:)!(dimension%neigd)
! ..
! .. Local Scalars ..
COMPLEX cexp,phase,c_0,c_1,c_2,ci
REAL const,df,r1,s,tmk,wronk
REAL s2h, s2h_e(ne)
INTEGER i,j,k,l,ll1,lm,n,nap,natom,nn,iatom,jatom,lmp,m,nkvec
INTEGER inv_f,ie,ilo,kspin,iintsp,nintsp,nvmax,lo,inap,natom_l
LOGICAL l_force
! ..
! .. Local Arrays ..
INTEGER nbasf0(atoms%nlod,atoms%nat)
REAL dfj(0:atoms%lmaxd),fj(0:atoms%lmaxd),fg(3),fgp(3),fgr(3),fk(3),fkp(3),fkr(3)
REAL alo1(atoms%nlod),blo1(atoms%nlod),clo1(atoms%nlod)
COMPLEX ylm( (atoms%lmaxd+1)**2 )
COMPLEX ccchi(2,2)
LOGICAL apw(0:atoms%lmaxd,atoms%ntype)
REAL, ALLOCATABLE :: work_r(:)
COMPLEX, ALLOCATABLE :: work_c(:)
CALL timestart("abcof")
IF (zmat%l_real) THEN
IF (noco%l_soc.AND.sym%invs) CALL judft_error("BUG in abcof, SOC&INVS but real?")
IF (noco%l_noco) CALL judft_error("BUG in abcof, l_noco but real?")
ENDIF
ci = CMPLX(0.0,1.0)
const = 2 * tpi_const/SQRT(cell%omtil)
acof(:,:,:) = CMPLX(0.0,0.0)
bcof(:,:,:) = CMPLX(0.0,0.0)
ccof(:,:,:,:) = CMPLX(0.0,0.0)
!+APW_LO
DO n = 1, atoms%ntype
DO l = 0,atoms%lmax(n)
apw(l,n) = .FALSE.
DO lo = 1,atoms%nlo(n)
IF (atoms%l_dulo(lo,n)) apw(l,n) = .TRUE.
ENDDO
IF ((input%l_useapw).AND.(atoms%lapw_l(n).GE.l)) apw(l,n) = .FALSE.
ENDDO
DO lo = 1,atoms%nlo(n)
IF (atoms%l_dulo(lo,n)) apw(atoms%llo(lo,n),n) = .TRUE.
ENDDO
ENDDO
!+APW_LO
!
nintsp = 1
!---> loop over the interstitial spin
DO iintsp = 1,nintsp
!
nvmax=lapw%nv(jspin)
IF (noco%l_ss) nvmax=lapw%nv(iintsp)
natom_l = 0
!---> loop over atom types
DO n = 1,atoms%ntype
CALL setabc1lo(atoms,n,usdus,jspin,alo1,blo1,clo1)
! ----> loop over equivalent atoms
DO nn = 1,atoms%neq(n)
natom = SUM(atoms%neq(:n-1)) + nn
IF ((natom.GE.nat_start).AND.(natom.LE.nat_stop)) THEN
natom_l = natom_l + 1
IF (atoms%invsat(natom).EQ.2) THEN
jatom = sym%invsatnr(natom)
ELSE
jatom = natom
ENDIF
IF (zmat%l_real) THEN
ALLOCATE ( work_r(ne) )
ELSE
ALLOCATE ( work_c(ne) )
ENDIF
!---> loop over lapws
#ifndef CPP_OLDINTEL
!$OMP PARALLEL DO &
!$OMP& DEFAULT(none)&
!$OMP& PRIVATE(k,i,work_r,work_c,ccchi,kspin,fg,fk,s,r1,fj,dfj,l,df,wronk,tmk,phase,lo,nkvec,&
!$OMP& inap,nap,j,fgr,fgp,s2h,s2h_e,fkr,fkp,ylm,ll1,m,c_0,c_1,c_2,lmp,inv_f,lm)&
!$OMP& SHARED(n,nn,natom,natom_l,noco,atoms,sym,cell,oneD,lapw,nvmax,ne,zMat,usdus,ci,iintsp,eig,l_force,&
!$OMP& alo1,blo1,clo1,jatom,jspin,apw,const,nbasf0,acof,bcof,ccof,force,nat_start,nat_stop)
#endif
DO k = 1,nvmax
IF (zmat%l_real) THEN
work_r(:ne)=zMat%data_r(k,:ne)
ELSE
work_c(:ne)=zMat%data_c(k,:ne)
END IF
fg = lapw%gvec(:,k,jspin)
fk = lapw%bkpt + fg
s = DOT_PRODUCT(fk,MATMUL(cell%bbmat,fk))
s = SQRT(s)
r1 = atoms%rmt(n)*s
CALL sphbes(atoms%lmax(n),r1,fj)
CALL dsphbs(atoms%lmax(n),r1,fj,dfj)
! ----> construct a and b coefficients
DO l = 0,atoms%lmax(n)
df = s*dfj(l)
wronk = usdus%uds(l,n,jspin)*usdus%dus(l,n,jspin) - usdus%us(l,n,jspin)*usdus%duds(l,n,jspin)
IF (apw(l,n)) THEN
fj(l) = 1.0*const * fj(l)/usdus%us(l,n,jspin)
dfj(l) = 0.0d0
ELSE
dfj(l) = const* (usdus%dus(l,n,jspin)*fj(l)-df*usdus%us(l,n,jspin))/wronk
fj(l) = const* (df*usdus%uds(l,n,jspin)-fj(l)*usdus%duds(l,n,jspin))/wronk
ENDIF
ENDDO ! loop over l
tmk = tpi_const* (fk(1)*atoms%taual(1,jatom)+&
fk(2)*atoms%taual(2,jatom)+&
fk(3)*atoms%taual(3,jatom))
phase = CMPLX(COS(tmk),SIN(tmk))
IF (oneD%odi%d1) THEN
inap = oneD%ods%ngopr(jatom)
ELSE
nap = atoms%ngopr(jatom)
inap = sym%invtab(nap)
END IF
DO j = 1,3
fkr(j) = 0.0
fgr(j) = 0.0
DO i = 1,3
IF (oneD%odi%d1) THEN
fkr(j) = fkr(j) + fk(i)*oneD%ods%mrot(i,j,inap)
fgr(j) = fgr(j) + fg(i)*oneD%ods%mrot(i,j,inap)
ELSE
fkr(j) = fkr(j) + fk(i)*sym%mrot(i,j,inap)
fgr(j) = fgr(j) + fg(i)*sym%mrot(i,j,inap)
END IF
END DO
END DO
fkp = MATMUL(fkr,cell%bmat)
fgp = MATMUL(fgr,cell%bmat)
! ----> generate spherical harmonics
CALL ylm4(atoms%lmax(n),fkp,ylm)
! ----> loop over l
DO l = 0,atoms%lmax(n)
ll1 = l* (l+1)
! ----> loop over m
DO m = -l,l
lm = ll1 + m
c_0 = CONJG(ylm(lm+1))*phase
c_1 = c_0 * fj(l)
c_2 = c_0 * dfj(l)
IF (atoms%invsat(natom).EQ.2) THEN
lmp = ll1 - m
inv_f = (-1)**(l-m)
c_1 = conjg(c_1) * inv_f
c_2 = conjg(c_2) * inv_f
IF (zmat%l_real) THEN
acof(:ne,lmp,natom_l) = acof(:ne,lmp,natom_l) + c_1 * work_r(:ne)
bcof(:ne,lmp,natom_l) = bcof(:ne,lmp,natom_l) + c_2 * work_r(:ne)
ELSE
acof(:ne,lmp,natom_l) = acof(:ne,lmp,natom_l) + c_1 * work_c(:ne)
bcof(:ne,lmp,natom_l) = bcof(:ne,lmp,natom_l) + c_2 * work_c(:ne)
END IF
ELSE
! ----> loop over bands
IF (zmat%l_real) THEN
acof(:ne,lm,natom_l) = acof(:ne,lm,natom_l) + c_1 * work_r(:ne)
bcof(:ne,lm,natom_l) = bcof(:ne,lm,natom_l) + c_2 * work_r(:ne)
ELSE
acof(:ne,lm,natom_l) = acof(:ne,lm,natom_l) + c_1 * work_c(:ne)
bcof(:ne,lm,natom_l) = bcof(:ne,lm,natom_l) + c_2 * work_c(:ne)
END IF
ENDIF
ENDDO ! loop over m
ENDDO ! loop over l
DO lo=1,atoms%nlo(n)
DO nkvec=1,lapw%nkvec(lo,jatom)
IF (k==lapw%kvec(nkvec,lo,jatom)) THEN !check if this k-vector has LO attached
CALL abclocdn_soc(atoms,sym,noco,lapw,cell,ccchi(:,jspin),iintsp,phase,ylm,&
n,natom,natom_l,k,nkvec,lo,ne,alo1,blo1,clo1,acof,bcof,ccof,zMat,l_force,fgp,force)
ENDIF
ENDDO
END DO
ENDDO ! loop over LAPWs (k)
#ifndef CPP_OLDINTEL
!$OMP END PARALLEL DO
#endif
IF (zmat%l_real) THEN
DEALLOCATE(work_r)
ELSE
DEALLOCATE(work_c)
ENDIF
ENDIF ! nat_start <= natom <= nat_stop
ENDDO ! loop over equivalent atoms
ENDDO ! loop over atom types
ENDDO ! loop over interstitial spin
CALL timestop("abcof")
END SUBROUTINE abcof_soc
END MODULE m_abcof_soc
eigen_soc/alineso.F90
View file @ 13e1384b
......@@ -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
......
eigen_soc/eigenso.F90
View file @ 13e1384b
......@@ -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,20 +147,21 @@ CONTAINS
' the',i4,' SOC eigenvalues are:')
8020 FORMAT (5x,5f12.6)
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
CALL timestart("eigenso: write_eig")
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 timestop("eigenso: write_eig")
ENDDO
ENDIF ! (input%eonly) ELSE
deallocate(zso)
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
CALL timestart("eigenso: write_eig")
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 timestop("eigenso: write_eig")
ENDDO
ENDIF ! (input%eonly) ELSE
ENDIF ! n_rank == 0
DEALLOCATE (zso)
ENDDO ! DO nk
! Sorry for the following strange workaround to fill the results%neig and results%eig arrays.
......
eigen_soc/hsoham.f90 → eigen_soc/hsoham.F90
View file @ 13e1384b
......@@ -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)