Commit da2884ab authored by Daniel Wortmann's avatar Daniel Wortmann

Merge to development branch

parent 9b06c35b
init/compileinfo.h
*~
#*
\#*
build
build.*
*.o
......
......@@ -149,7 +149,7 @@ CONTAINS
LOGICAL l_fmpl,l_mcd,l_evp,l_orbcomprot
! ...Local Arrays ..
INTEGER n_bands(0:dimension%neigd),ncore(atoms%ntype)
REAL cartk(3),bkpt(3),xp(3,dimension%nspd),e_mcd(atoms%ntype,input%jspins,dimension%nstd)
REAL cartk(3),xp(3,dimension%nspd),e_mcd(atoms%ntype,input%jspins,dimension%nstd)
REAL ello(atoms%nlod,atoms%ntype,dimension%jspd),evac(2,dimension%jspd)
REAL epar(0:atoms%lmaxd,atoms%ntype,dimension%jspd),evdu(2,dimension%jspd)
REAL eig(dimension%neigd)
......@@ -169,7 +169,7 @@ CONTAINS
REAL, ALLOCATABLE :: qis(:,:,:)
!-new_sl
!-dw
INTEGER, ALLOCATABLE :: gvac1d(:),gvac2d(:) ,kveclo(:)
INTEGER, ALLOCATABLE :: gvac1d(:),gvac2d(:)
INTEGER, ALLOCATABLE :: jsym(:),ksym(:)
REAL, ALLOCATABLE :: aclo(:,:,:),acnmt(:,:,:,:,:)
......@@ -248,7 +248,6 @@ CONTAINS
ALLOCATE ( usdus%dus(0:atoms%lmaxd,atoms%ntype,jsp_start:jsp_end) )
ALLOCATE ( usdus%duds(0:atoms%lmaxd,atoms%ntype,jsp_start:jsp_end) )
ALLOCATE ( usdus%ddn(0:atoms%lmaxd,atoms%ntype,jsp_start:jsp_end) )
ALLOCATE ( lapw%k1(dimension%nvd,dimension%jspd),lapw%k2(dimension%nvd,dimension%jspd),lapw%k3(dimension%nvd,dimension%jspd) )
ALLOCATE ( jsym(dimension%neigd),ksym(dimension%neigd) )
ALLOCATE ( gvac1d(dimension%nv2d),gvac2d(dimension%nv2d) )
ALLOCATE ( usdus%ulos(atoms%nlod,atoms%ntype,jsp_start:jsp_end) )
......@@ -339,6 +338,7 @@ CONTAINS
ALLOCATE ( kveclo(atoms%nlotot) )
IF (mpi%irank==0) THEN
WRITE (6,FMT=8000) jspin
WRITE (16,FMT=8000) jspin
......@@ -350,7 +350,7 @@ CONTAINS
eig_id,&
mpi%irank,mpi%isize,jspin,dimension%jspd,&
noco%l_noco,&
ello,evac,epar,bkpt,wk,n_bands,n_size)!keep
ello,evac,epar,wk,n_bands,n_size)
#ifdef CPP_MPI
! Sinchronizes the RMA operations
CALL MPI_BARRIER(mpi%mpi_comm,ie)
......@@ -512,6 +512,7 @@ CONTAINS
!
! -> Gu test: distribute ev's among the processors...
!
CALL lapw%init(input,noco, kpts,atoms,sym,ikpt,cell,.false., mpi)
skip_t = skip_tt
IF (l_evp.AND.(mpi%isize.GT.1)) THEN
IF (banddos%dos) THEN
......@@ -549,31 +550,30 @@ CONTAINS
n_end = noccbd
END IF
END IF
zMat%nbasfcn=lapw%nv(1)+atoms%nlotot
IF (noco%l_noco) zMat%nbasfcn=zMat%nbasfcn+lapw%nv(2)+atoms%nlotot
IF (zmat%l_real) THEN
IF (.NOT.ALLOCATED(zMat%z_r)) THEN
ALLOCATE (zMat%z_r(dimension%nbasfcn,dimension%neigd))
zMat%nbasfcn = dimension%nbasfcn
ALLOCATE (zMat%z_r(zmat%nbasfcn,dimension%neigd))
zMat%nbands = dimension%neigd
END IF
zMat%z_r = 0
ELSE
IF (.NOT.ALLOCATED(zMat%z_c)) THEN
ALLOCATE (zMat%z_c(dimension%nbasfcn,dimension%neigd))
zMat%nbasfcn = dimension%nbasfcn
ALLOCATE (zMat%z_c(zmat%nbasfcn,dimension%neigd))
zMat%nbands = dimension%neigd
END IF
zMat%z_c = 0
endif
CALL cdn_read(&
eig_id,dimension%nvd,dimension%jspd,mpi%irank,mpi%isize,&
ikpt,jspin,dimension%nbasfcn,noco%l_ss,noco%l_noco,&
ikpt,jspin,zmat%nbasfcn,noco%l_ss,noco%l_noco,&
noccbd,n_start,n_end,&
lapw%nmat,lapw%nv,ello,evdu,epar,kveclo,&
lapw%k1,lapw%k2,lapw%k3,bkpt,wk,nbands,eig,zMat)
ello,evdu,epar,&
lapw,wk,nbands,eig,zMat)
#ifdef CPP_MPI
! Synchronizes the RMA operations
!if (l_evp) CALL MPI_BARRIER(mpi%mpi_comm,ie)
CALL MPI_BARRIER(mpi%mpi_comm,ie)
! Sinchronizes the RMA operations
if (l_evp) CALL MPI_BARRIER(mpi%mpi_comm,ie)
#endif
!IF (l_evp.AND.(isize.GT.1)) THEN
! eig(1:noccbd) = eig(n_start:n_end)
......@@ -667,7 +667,7 @@ CONTAINS
IF (.NOT.((jspin.EQ.2) .AND. noco%l_noco)) THEN
CALL timestart("cdnval: pwden")
CALL pwden(stars,kpts,banddos,oneD, input,mpi,noco,cell,atoms,sym,ikpt,&
jspin,lapw,noccbd,igq_fft,we, eig,bkpt,qpw,cdom,qis,results%force,f_b8,zMat)
jspin,lapw,noccbd,igq_fft,we, eig,qpw,cdom,qis,results%force,f_b8,zMat)
CALL timestop("cdnval: pwden")
END IF
!+new
......@@ -688,7 +688,7 @@ CONTAINS
IF (.NOT.((jspin.EQ.2) .AND. noco%l_noco)) THEN
CALL timestart("cdnval: vacden")
CALL vacden(vacuum,dimension,stars,oneD, kpts,input, cell,atoms,noco,banddos,&
gvac1d,gvac2d, we,ikpt,jspin,vz,vz0, noccbd,bkpt,lapw, evac,eig,&
gvac1d,gvac2d, we,ikpt,jspin,vz,vz0, noccbd,lapw, evac,eig,&
rhtxy,rht,qvac,qvlay, qstars,cdomvz,cdomvxy,zMat)
CALL timestop("cdnval: vacden")
END IF
......@@ -726,14 +726,14 @@ CONTAINS
aveccof(3,noccbd,0:atoms%lmaxd*(atoms%lmaxd+2),atoms%nat),&
bveccof(3,noccbd,0:atoms%lmaxd*(atoms%lmaxd+2),atoms%nat),&
cveccof(3,-atoms%llod:atoms%llod,noccbd,atoms%nlod,atoms%nat) )
CALL to_pulay(input,atoms,noccbd,sym, lapw, noco,cell,bkpt,noccbd,eig,usdus,&
kveclo,ispin,oneD, acof(:,0:,:,ispin),bcof(:,0:,:,ispin),&
CALL to_pulay(input,atoms,noccbd,sym, lapw, noco,cell,noccbd,eig,usdus,&
ispin,oneD, acof(:,0:,:,ispin),bcof(:,0:,:,ispin),&
e1cof,e2cof,aveccof,bveccof, ccof(-atoms%llod,1,1,1,ispin),acoflo,bcoflo,cveccof,zMat)
CALL timestop("cdnval: to_pulay")
ELSE
CALL timestart("cdnval: abcof")
CALL abcof(input,atoms,noccbd,sym, cell, bkpt,lapw,noccbd,usdus, noco,ispin,kveclo,oneD,&
CALL abcof(input,atoms,sym, cell,lapw,noccbd,usdus, noco,ispin,oneD,&
acof(:,0:,:,ispin),bcof(:,0:,:,ispin),ccof(-atoms%llod:,:,:,:,ispin),zMat)
CALL timestop("cdnval: abcof")
......@@ -867,9 +867,9 @@ CONTAINS
! write data to direct access file first, write to formated file later by PE 0 only!
!--dw since z is no longer an argument of cdninf sympsi has to be called here!
!
cartk=matmul(bkpt,cell%bmat)
cartk=matmul(lapw%bkpt,cell%bmat)
IF (banddos%ndir.GT.0) THEN
CALL sympsi(bkpt,lapw%nv(jspin),lapw%k1(:,jspin),lapw%k2(:,jspin),&
CALL sympsi(lapw%bkpt,lapw%nv(jspin),lapw%k1(:,jspin),lapw%k2(:,jspin),&
lapw%k3(:,jspin),sym,dimension,nbands,cell,eig,noco, ksym,jsym,zMat)
END IF
!
......
......@@ -7,7 +7,7 @@
MODULE m_pwden
CONTAINS
SUBROUTINE pwden(stars,kpts,banddos,oneD, input,mpi,noco,cell,atoms,sym, &
ikpt,jspin,lapw,ne, igq_fft,we,eig,bkpt, qpw,cdom, qis,forces,f_b8,zMat)
ikpt,jspin,lapw,ne, igq_fft,we,eig, qpw,cdom, qis,forces,f_b8,zMat)
!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
! In this subroutine the star function expansion coefficients of
! the plane wave charge density is determined.
......@@ -96,7 +96,6 @@ CONTAINS
INTEGER, INTENT (IN) :: igq_fft(0:stars%kq1_fft*stars%kq2_fft*stars%kq3_fft-1)
REAL,INTENT(IN) :: we(:) !(nobd)
REAL,INTENT(IN) :: eig(:)!(dimension%neigd)
REAL,INTENT(IN) :: bkpt(3)
!-----> BASIS FUNCTION INFORMATION
INTEGER,INTENT(IN):: ne
!-----> CHARGE DENSITY INFORMATION
......@@ -121,7 +120,7 @@ CONTAINS
INTEGER,PARAMETER:: ist(-1:1)=(/1,0,0/)
REAL,PARAMETER:: zero = 0.00, tol_3=1.0e-3
!
INTEGER iv1d(SIZE(lapw%k1,1),input%jspins)
INTEGER iv1d(SIZE(lapw%gvec,2),input%jspins)
REAL wtf(ne),wsave(stars%kq3_fft+15)
REAL, ALLOCATABLE :: psir(:),psii(:),rhon(:)
REAL, ALLOCATABLE :: psi1r(:),psi1i(:),psi2r(:),psi2i(:)
......@@ -284,9 +283,9 @@ CONTAINS
! -k1d <= L <= k1d
! -k2d <= M <= k2d
! -k3d <= N <= k3d
il = lapw%k1(iv,ispin)
im = lapw%k2(iv,ispin)
in = lapw%k3(iv,ispin)
il = lapw%gvec(1,iv,ispin)
im = lapw%gvec(2,iv,ispin)
in = lapw%gvec(3,iv,ispin)
!
!------> L,M,N LATTICE POINTS OF G-VECTOR IN POSITIVE DOMAIN
! (since charge density box = two times charge density box
......@@ -382,9 +381,7 @@ CONTAINS
kpsir(ifftq3d:)=0.0
kpsir(-ifftq2d:ifftq3d)=0.0
DO iv = 1 , lapw%nv(jspin)
xk(1)=lapw%k1(iv,jspin)+bkpt(1)
xk(2)=lapw%k2(iv,jspin)+bkpt(2)
xk(3)=lapw%k3(iv,jspin)+bkpt(3)
xk=lapw%gvec(:,iv,jspin)+lapw%bkpt
s = 0.0
DO i = 1,3
s = s + xk(i)*cell%bmat(i,j)
......@@ -427,9 +424,7 @@ CONTAINS
kpsir=0.0
kpsii=0.0
DO iv = 1 , lapw%nv(jspin)
xk(1)=lapw%k1(iv,jspin)+bkpt(1)
xk(2)=lapw%k2(iv,jspin)+bkpt(2)
xk(3)=lapw%k3(iv,jspin)+bkpt(3)
xk=lapw%gvec(:,iv,jspin)+lapw%bkpt
s = 0.0
DO i = 1,3
s = s + xk(i)*cell%bmat(i,j)
......
......@@ -10,7 +10,7 @@ CONTAINS
kpts,input,cell,atoms,noco,banddos,&
gvac1,gvac2,&
we,ikpt,jspin,vz,vz0,&
ne,bkpt,lapw,&
ne,lapw,&
evac,eig,rhtxy,rht,qvac,qvlay,&
stcoeff,cdomvz,cdomvxy,zMat)
......@@ -72,7 +72,6 @@ CONTAINS
INTEGER,PARAMETER :: n2max=13
REAL,PARAMETER :: emax=2.0/hartree_to_ev_const
! .. Array Arguments ..
REAL, INTENT (IN) :: bkpt(3)
REAL, INTENT (IN) :: evac(2,DIMENSION%jspd)
COMPLEX, INTENT (INOUT):: rhtxy(vacuum%nmzxyd,oneD%odi%n2d-1,2,DIMENSION%jspd)
REAL, INTENT (INOUT):: rht(vacuum%nmzd,2,DIMENSION%jspd)
......@@ -204,16 +203,16 @@ CONTAINS
n2 = 0
k_loop2:DO k = 1,lapw%nv(ispin)
DO j = 1,n2
IF ( lapw%k1(k,ispin).EQ.kvac1(j,ispin) .AND.&
lapw%k2(k,ispin).EQ.kvac2(j,ispin) ) THEN
IF ( lapw%gvec(1,k,ispin).EQ.kvac1(j,ispin) .AND.&
lapw%gvec(2,k,ispin).EQ.kvac2(j,ispin) ) THEN
map2(k,ispin) = j
CYCLE k_loop2
END IF
ENDDO
n2 = n2 + 1
IF (n2>DIMENSION%nv2d) CALL juDFT_error("vacden0","vacden")
kvac1(n2,ispin) = lapw%k1(k,ispin)
kvac2(n2,ispin) = lapw%k2(k,ispin)
kvac1(n2,ispin) = lapw%gvec(1,k,ispin)
kvac2(n2,ispin) = lapw%gvec(2,k,ispin)
map2(k,ispin) = n2
ENDDO k_loop2
nv2(ispin) = n2
......@@ -302,7 +301,7 @@ CONTAINS
cell,vacuum,DIMENSION,stars,&
oneD,qssbti(3,ispin),&
oneD%odi%n2d,&
wronk,evacp,bkpt,oneD%odi%M,oneD%odi%mb,&
wronk,evacp,lapw%bkpt,oneD%odi%M,oneD%odi%mb,&
vz(1,ispin),kvac3(1,ispin),nv2(ispin),&
t_1(1,-oneD%odi%mb),dt_1(1,-oneD%odi%mb),u_1(1,1,-oneD%odi%mb,ispin),&
te_1(1,-oneD%odi%mb),dte_1(1,-oneD%odi%mb),&
......@@ -311,7 +310,7 @@ CONTAINS
DO k = 1,lapw%nv(ispin)
kspin = (lapw%nv(1)+atoms%nlotot)*(ispin-1) + k
l = map1(k,ispin)
irec3 = stars%ig(lapw%k1(k,ispin),lapw%k2(k,ispin),lapw%k3(k,ispin))
irec3 = stars%ig(lapw%gvec(1,k,ispin),lapw%gvec(2,k,ispin),lapw%gvec(3,k,ispin))
IF (irec3.NE.0) THEN
irec2 = stars%ig2(irec3)
zks = stars%sk2(irec2)*cell%z1
......@@ -343,8 +342,8 @@ CONTAINS
vz0(ispin) = vz(vacuum%nmz,ispin)
evacp = evac(ivac,ispin)
DO ik = 1,nv2(ispin)
v(1) = bkpt(1) + kvac1(ik,ispin) + qssbti(1,ispin)
v(2) = bkpt(2) + kvac2(ik,ispin) + qssbti(2,ispin)
v(1) = lapw%bkpt(1) + kvac1(ik,ispin) + qssbti(1,ispin)
v(2) = lapw%bkpt(2) + kvac2(ik,ispin) + qssbti(2,ispin)
v(3) = 0.
ev = evacp - 0.5*DOT_PRODUCT(v,MATMUL(v,cell%bbmat))
CALL vacuz(ev,vz(1,ispin),vz0(ispin),vacuum%nmz,vacuum%delz,t(ik),&
......@@ -404,7 +403,7 @@ CONTAINS
& cell,vacuum,DIMENSION,stars,&
& oneD,qssbtii,&
& oneD%odi%n2d,&
& wronk,evacp,bkpt,oneD%odi%M,oneD%odi%mb,&
& wronk,evacp,lapw%bkpt,oneD%odi%M,oneD%odi%mb,&
& vz(1,ivac),kvac3(1,jspin),nv2(jspin),&
& t_1(1,-oneD%odi%mb),dt_1(1,-oneD%odi%mb),u_1(1,1,-oneD%odi%mb,jspin),&
& te_1(1,-oneD%odi%mb),dte_1(1,-oneD%odi%mb),&
......@@ -412,7 +411,7 @@ CONTAINS
& ue_1(1,1,-oneD%odi%mb,jspin))
DO k = 1,lapw%nv(jspin)
l = map1(k,jspin)
irec3 = stars%ig(lapw%k1(k,jspin),lapw%k2(k,jspin),lapw%k3(k,jspin))
irec3 = stars%ig(lapw%gvec(1,k,jspin),lapw%gvec(2,k,jspin),lapw%gvec(3,k,jspin))
IF (irec3.NE.0) THEN
irec2 = stars%ig2(irec3)
zks = stars%sk2(irec2)*cell%z1
......@@ -442,8 +441,8 @@ CONTAINS
ELSE !oneD%odi%d1
evacp = evac(ivac,jspin)
DO ik = 1,nv2(jspin)
v(1) = bkpt(1) + kvac1(ik,jspin)
v(2) = bkpt(2) + kvac2(ik,jspin)
v(1) = lapw%bkpt(1) + kvac1(ik,jspin)
v(2) = lapw%bkpt(2) + kvac2(ik,jspin)
v(3) = 0.
ev = evacp - 0.5*DOT_PRODUCT(v,MATMUL(v,cell%bbmat))
CALL vacuz(ev,vz(1,ivac),vz0(ivac),vacuum%nmz,vacuum%delz,t(ik),dt(ik),u(1,ik,jspin))
......@@ -519,7 +518,7 @@ CONTAINS
DO n = 1, ne
IF (ABS(eig(n)-vacuum%tworkf).LE.emax) i=i+1
END DO
WRITE (87,FMT=990) bkpt(1), bkpt(2), i, n2max
WRITE (87,FMT=990) lapw%bkpt(1),lapw%bkpt(2), i, n2max
DO n = 1, ne
IF (ABS(eig(n)-vacuum%tworkf).LE.emax) THEN
WRITE (87,FMT=1000) eig(n)
......
......@@ -20,161 +20,68 @@ MODULE m_abclocdn
! of atom 'na' to it.
!*********************************************************************
CONTAINS
SUBROUTINE abclocdn(atoms, sym, noco,ccchi,kspin,iintsp,con1,phase,ylm,&
ntyp,na,k,s,nv,ne,nbasf0,alo1,blo1,clo1,kvec,nkvec,enough,acof,bcof,ccof,zMat)
SUBROUTINE abclocdn(atoms,sym,noco,lapw,cell,ccchi,iintsp,phase,ylm,&
ntyp,na,k,nkvec,lo,ne,alo1,blo1,clo1,acof,bcof,ccof,zMat)
!
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_zMat),INTENT(IN) :: zMat
! ..
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: kspin,iintsp
INTEGER, INTENT (IN) :: k,na,ne,ntyp,nv
REAL, INTENT (IN) :: con1 ,s
INTEGER, INTENT (IN) :: iintsp
INTEGER, INTENT (IN) :: k,na,ne,ntyp,nkvec,lo
COMPLEX, INTENT (IN) :: phase
! ..
! .. Array Arguments ..
INTEGER, INTENT (IN) :: nbasf0(atoms%nlod,atoms%nat)
REAL, INTENT (IN) :: alo1(atoms%nlod,atoms%ntype),blo1(atoms%nlod,atoms%ntype)
REAL, INTENT (IN) :: clo1(atoms%nlod,atoms%ntype)
REAL, INTENT (IN) :: alo1(:),blo1(:),clo1(:)
COMPLEX, INTENT (IN) :: ylm( (atoms%lmaxd+1)**2 )
COMPLEX, INTENT (IN) :: ccchi(2)
INTEGER, INTENT (IN) :: kvec(2*(2*atoms%llod+1),atoms%nlod )
LOGICAL, INTENT (OUT) :: enough ! enough(na)
COMPLEX, INTENT (INOUT) :: acof(:,0:,:)!(nobd,0:dimension%lmd,atoms%nat)
COMPLEX, INTENT (INOUT) :: bcof(:,0:,:)!(nobd,0:dimension%lmd,atoms%nat)
COMPLEX, INTENT (INOUT) :: ccof(-atoms%llod:,:,:,:)!(-atoms%llod:atoms%llod,nobd,atoms%nlod,atoms%nat)
INTEGER, INTENT (INOUT) :: nkvec(atoms%nlod,atoms%nat)
! ..
! .. Local Scalars ..
COMPLEX ctmp,term1
REAL,PARAMETER:: eps=1.0e-30
INTEGER i,l,ll1,lm,lo ,mind,nbasf,na2,lmp,m
INTEGER i,l,ll1,lm,nbasf,m
! ..
! .. Local Arrays ..
COMPLEX clotmp(-atoms%llod:atoms%llod)
! ..
LOGICAL :: l_real
l_real=zMat%l_real
! ..
enough = .TRUE.
term1 = con1 * ((atoms%rmt(ntyp)**2)/2) * phase
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.
DO lo = 1,atoms%nlo(ntyp)
l = atoms%llo(lo,ntyp)
IF (.NOT.((s.LE.eps).AND.(l.GE.1))) THEN
IF (atoms%invsat(na).EQ.0) THEN
IF ((nkvec(lo,na)).LT. (2*atoms%llo(lo,ntyp)+1)) THEN
enough = .FALSE.
nkvec(lo,na) = nkvec(lo,na) + 1
nbasf = nbasf0(lo,na) + nkvec(lo,na)
l = atoms%llo(lo,ntyp)
ll1 = l* (l+1)
DO m = -l,l
clotmp(m) = term1*CONJG(ylm(ll1+m+1))
END DO
IF ( kvec(nkvec(lo,na),lo) == k ) THEN
! write(*,'(i3,5(2f10.5,2x))')k,(z(nbasf,i),i=11,15)
DO i = 1,ne
DO m = -l,l
lm = ll1 + m
!+gu_con
IF (noco%l_noco) THEN
IF (noco%l_ss) THEN
ctmp = clotmp(m)*ccchi(iintsp)*zMat%z_c(kspin+nbasf,i)
ELSE
ctmp = clotmp(m)*( ccchi(1)*zMat%z_c(nbasf,i)+ccchi(2)*zMat%z_c(kspin+nbasf,i) )
ENDIF
ELSE
IF (l_real) THEN
ctmp = zMat%z_r(nbasf,i)*clotmp(m)
ELSE
ctmp = zMat%z_c(nbasf,i)*clotmp(m)
ENDIF
ENDIF
acof(i,lm,na) = acof(i,lm,na) +ctmp*alo1(lo,ntyp)
bcof(i,lm,na) = bcof(i,lm,na) +ctmp*blo1(lo,ntyp)
ccof(m,i,lo,na) = ccof(m,i,lo,na) +ctmp*clo1(lo,ntyp)
END DO
END DO
! write(6,9000) nbasf,k,lo,na,
! + (clo1(lo,ntyp)*clotmp(m),m=-l,l)
! 9000 format(2i4,2i2,7(' (',e9.3,',',e9.3,')'))
ELSE
nkvec(lo,na) = nkvec(lo,na) - 1
ENDIF ! kvec = k
ENDIF ! nkvec < 2*atoms%llo
ELSEIF (atoms%invsat(na).EQ.1) THEN
IF ((nkvec(lo,na)).LT. (2* (2*atoms%llo(lo,ntyp)+1))) THEN
enough = .FALSE.
nkvec(lo,na) = nkvec(lo,na) + 1
nbasf = nbasf0(lo,na) + nkvec(lo,na)
l = atoms%llo(lo,ntyp)
ll1 = l* (l+1)
DO m = -l,l
clotmp(m) = term1*CONJG(ylm(ll1+m+1))
END DO
IF ( kvec(nkvec(lo,na),lo) == k ) THEN
! write(*,*)'k vector nr ',k,' has been accepted'
! write(*,'(i3,5(2f10.5,2x))')k,(z(nbasf,i),i=11,15)
DO i = 1,ne
DO m = -l,l
lm = ll1 + m
! if(i.eq.1 .and. l.eq.1) then
! write(*,*)'k=',k,' z=',z(nbasf,i),' clotmp=',clotmp(m)
! write(*,*)'clo1=',clo1(lo,ntyp),' term1=',term1
! endif
!+gu_con
IF (noco%l_noco) THEN
IF (noco%l_ss) THEN
ctmp = clotmp(m)*ccchi(iintsp)*zMat%z_c(kspin+nbasf,i)
ELSE
ctmp = clotmp(m)*( ccchi(1)*zMat%z_c(nbasf,i)+ ccchi(2)*zMat%z_c(kspin+nbasf,i) )
ENDIF
ELSE
IF (l_real) THEN
ctmp = zMat%z_r(nbasf,i)*clotmp(m)
ELSE
ctmp = zMat%z_c(nbasf,i)*clotmp(m)
ENDIF
ENDIF
acof(i,lm,na) = acof(i,lm,na) +ctmp*alo1(lo,ntyp)
bcof(i,lm,na) = bcof(i,lm,na) +ctmp*blo1(lo,ntyp)
ccof(m,i,lo,na) = ccof(m,i,lo,na) +ctmp*clo1(lo,ntyp)
IF (noco%l_soc.AND.sym%invs) THEN
ctmp = zMat%z_c(nbasf,i)*CONJG(clotmp(m))*(-1)**(l-m)
na2 = sym%invsatnr(na)
lmp = ll1 - m
acof(i,lmp,na2) = acof(i,lmp,na2) +ctmp*alo1(lo,ntyp)
bcof(i,lmp,na2) = bcof(i,lmp,na2) +ctmp*blo1(lo,ntyp)
ccof(-m,i,lo,na2) = ccof(-m,i,lo,na2) +ctmp*clo1(lo,ntyp)
ENDIF
ENDDO ! m
ENDDO ! i = 1,ne
ELSE
nkvec(lo,na) = nkvec(lo,na) - 1
ENDIF ! kvec = k
ENDIF ! nkvec < 2*atoms%llo
l = atoms%llo(lo,ntyp)
ll1 = l* (l+1)
nbasf=lapw%nv(iintsp)+lapw%index_lo(lo,na)+nkvec
DO i = 1,ne
DO m = -l,l
lm = ll1 + m
!+gu_con
IF (noco%l_noco) THEN
IF (noco%l_ss) THEN
ctmp = term1*CONJG(ylm(ll1+m+1))*ccchi(iintsp)*zMat%z_c(lapw%nv(1)+atoms%nlotot+nbasf,i)
ELSE
ctmp = term1*CONJG(ylm(ll1+m+1))*( ccchi(1)*zMat%z_c(nbasf,i)+ccchi(2)*zMat%z_c(lapw%nv(1)+atoms%nlotot+nbasf,i) )
ENDIF
ELSE
CALL juDFT_error("invsat =/= 0 or 1",calledby ="abclocdn")
IF (zMat%l_real) THEN
ctmp = zMat%z_r(nbasf,i)*term1*CONJG(ylm(ll1+m+1))
ELSE
ctmp = zMat%z_c(nbasf,i)*term1*CONJG(ylm(ll1+m+1))
ENDIF
ENDIF
ELSE
enough = .FALSE.
ENDIF ! s > eps & l >= 1
acof(i,lm,na) = acof(i,lm,na) +ctmp*alo1(lo)
bcof(i,lm,na) = bcof(i,lm,na) +ctmp*blo1(lo)
ccof(m,i,lo,na) = ccof(m,i,lo,na) +ctmp*clo1(lo)
END DO
END DO
IF ((k.EQ.nv) .AND. (.NOT.enough)) THEN
WRITE (6,FMT=*) 'abclocdn did not find enough linearly independent'
WRITE (6,FMT=*) 'ccof coefficient-vectors.'
CALL juDFT_error("did not find enough lin. ind. ccof-vectors" ,calledby ="abclocdn")
END IF
END SUBROUTINE abclocdn
END MODULE m_abclocdn
......@@ -12,7 +12,7 @@ CONTAINS
& noco,ccchi,kspin,iintsp,&
& con1,phase,ylm,ntyp,na,k,fgp,&
& s,nv,ne,nbasf0,alo1,blo1,clo1,&
& kvec,nkvec,enough,acof,bcof,ccof,&
& kvec,enough,acof,bcof,ccof,&
& acoflo,bcoflo,aveccof,bveccof,cveccof,zMat)
!
!*********************************************************************
......@@ -48,7 +48,7 @@ CONTAINS
COMPLEX, INTENT (INOUT) :: bveccof(:,:,0:,:)!(3,nobd,0:dimension%lmd,atoms%nat)
COMPLEX, INTENT (INOUT) :: cveccof(:,-atoms%llod:,:,:,:)!(3,-atoms%llod:llod,nobd,atoms%nlod,atoms%nat)
LOGICAL, INTENT (OUT) :: enough(atoms%nat)
INTEGER, INTENT (INOUT) :: nkvec(atoms%nlod,atoms%nat)
INTEGER :: nkvec(atoms%nlod,atoms%nat)
! ..
! .. Local Scalars ..
COMPLEX ctmp,term1
......@@ -59,6 +59,7 @@ CONTAINS
! .. Local Arrays ..
COMPLEX clotmp(-atoms%llod:atoms%llod)
! ..
nkvec=0
enough(na) = .TRUE.
term1 = con1* ((atoms%rmt(ntyp)**2)/2)*phase
!
......
MODULE m_abcof
CONTAINS
SUBROUTINE abcof(input,atoms,nobd,sym, cell, bkpt,lapw,ne,usdus,&
noco,jspin,kveclo,oneD, acof,bcof,ccof,zMat)
SUBROUTINE abcof(input,atoms,sym, cell,lapw,ne,usdus,&
noco,jspin,oneD, acof,bcof,ccof,zMat)
! ************************************************************
! subroutine constructs the a,b coefficients of the linearized
! m.t. wavefunctions for each band and atom. c.l. fu
......@@ -9,7 +9,7 @@ CONTAINS
#include "cpp_double.h"
USE m_constants, ONLY : tpi_const
USE m_setabc1locdn
USE m_setabc1lo
USE m_sphbes
USE m_dsphbs
USE m_abclocdn
......@@ -27,28 +27,24 @@ CONTAINS
TYPE(t_zMat),INTENT(IN) :: zMat
! ..
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: nobd
INTEGER, INTENT (IN) :: ne
INTEGER, INTENT (IN) :: jspin
! ..
! .. Array Arguments ..
INTEGER, INTENT (IN) :: kveclo(atoms%nlotot)
REAL, INTENT (IN) :: bkpt(3)
COMPLEX, INTENT (OUT):: acof(:,0:,:)!(nobd,0:dimension%lmd,atoms%nat)
COMPLEX, INTENT (OUT):: bcof(:,0:,:)!(nobd,0:dimension%lmd,atoms%nat)
COMPLEX, INTENT (OUT):: ccof(-atoms%llod:,:,:,:)!(-llod:llod,nobd,atoms%nlod,atoms%nat)
! ..
! .. Local Scalars ..
COMPLEX cexp,phase,c_0,c_1,c_2,ci
REAL const,df,r1,s,tmk,wronk,qss1,qss2,qss3
INTEGER i,j,k,l,ll1,lm ,n,nap,natom,nn,iatom,jatom,lmp,m
REAL const,df,r1,s,tmk,wronk,qss(3)
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
! ..
! .. Local Arrays ..
INTEGER kvec(2*(2*atoms%llod+1),atoms%nlod,atoms%nat )
INTEGER nbasf0(atoms%nlod,atoms%nat),nkvec(atoms%nlod,atoms%nat)
INTEGER nbasf0(atoms%nlod,atoms%nat)
REAL dfj(0:atoms%lmaxd),fj(0:atoms%lmaxd),fk(3),fkp(3),fkr(3)
REAL alo1(atoms%nlod,atoms%ntype),blo1(atoms%nlod,atoms%ntype),clo1(atoms%nlod,atoms%ntype)
REAL alo1(atoms%nlod),blo1(atoms%nlod),clo1(atoms%nlod)
COMPLEX ylm( (atoms%lmaxd+1)**2 )
COMPLEX ccchi(2,2)
LOGICAL enough(atoms%nat),apw(0:atoms%lmaxd,atoms%ntype)
......@@ -67,6 +63,7 @@ CONTAINS
!
acof(:,:,:) = CMPLX(0.0,0.0)
bcof(:,:,:) = CMPLX(0.0,0.0)
ccof(:,:,:,:)=CMPLX(0.,0.)
! ..
!+APW_LO
DO n = 1, atoms%ntype
......@@ -90,30 +87,25 @@ CONTAINS
!
nvmax=lapw%nv(jspin)
IF (noco%l_ss) nvmax=lapw%nv(iintsp)
CALL setabc1locdn(jspin, atoms,lapw,ne,noco,iintsp, sym,usdus,&
kveclo, enough,nkvec,kvec,nbasf0,ccof, alo1,blo1,clo1)
!
IF (iintsp .EQ. 1) THEN
qss1= - noco%qss(1)/2
qss2= - noco%qss(2)/2
qss3= - noco%qss(3)/2
qss= - noco%qss/2
ELSE
qss1= + noco%qss(1)/2
qss2= + noco%qss(2)/2
qss3= + noco%qss(3)/2
qss= + noco%qss/2
ENDIF
!---> loop over atom types
!$OMP PARALLEL DO &
!$OMP& DEFAULT(none)&
!$OMP& PRIVATE(n,nn,natom,k,i,work_r,work_c,ccchi,kspin,fk,s,r1,fj,dfj,l,df,wronk,tmk,phase,&
!$OMP& inap,nap,j,fkr,fkp,ylm,ll1,m,c_0,c_1,c_2,jatom,lmp,inv_f,lm)&
!$OMP& alo1,blo1,clo1,inap,nap,j,fkr,fkp,ylm,ll1,m,c_0,c_1,c_2,jatom,lmp,inv_f,lm)&
!$OMP& SHARED(noco,atoms,sym,cell,oneD,lapw,nvmax,ne,zMat,usdus,ci,iintsp,&
!$OMP& jspin,bkpt,qss1,qss2,qss3,&
!$OMP& apw,const,nobd,&
!$OMP& alo1,blo1,clo1,kvec,nbasf0,nkvec,enough,&
!$OMP& jspin,qss,&
!$OMP& apw,const,&