Commit da2884ab authored by Daniel Wortmann's avatar Daniel Wortmann

Merge to development branch

parent 9b06c35b
init/compileinfo.h init/compileinfo.h
*~ *~
#* \#*
build build
build.* build.*
*.o *.o
......
...@@ -149,7 +149,7 @@ CONTAINS ...@@ -149,7 +149,7 @@ CONTAINS
LOGICAL l_fmpl,l_mcd,l_evp,l_orbcomprot LOGICAL l_fmpl,l_mcd,l_evp,l_orbcomprot
! ...Local Arrays .. ! ...Local Arrays ..
INTEGER n_bands(0:dimension%neigd),ncore(atoms%ntype) 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 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 epar(0:atoms%lmaxd,atoms%ntype,dimension%jspd),evdu(2,dimension%jspd)
REAL eig(dimension%neigd) REAL eig(dimension%neigd)
...@@ -169,7 +169,7 @@ CONTAINS ...@@ -169,7 +169,7 @@ CONTAINS
REAL, ALLOCATABLE :: qis(:,:,:) REAL, ALLOCATABLE :: qis(:,:,:)
!-new_sl !-new_sl
!-dw !-dw
INTEGER, ALLOCATABLE :: gvac1d(:),gvac2d(:) ,kveclo(:) INTEGER, ALLOCATABLE :: gvac1d(:),gvac2d(:)
INTEGER, ALLOCATABLE :: jsym(:),ksym(:) INTEGER, ALLOCATABLE :: jsym(:),ksym(:)
REAL, ALLOCATABLE :: aclo(:,:,:),acnmt(:,:,:,:,:) REAL, ALLOCATABLE :: aclo(:,:,:),acnmt(:,:,:,:,:)
...@@ -248,7 +248,6 @@ CONTAINS ...@@ -248,7 +248,6 @@ CONTAINS
ALLOCATE ( usdus%dus(0:atoms%lmaxd,atoms%ntype,jsp_start:jsp_end) ) 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%duds(0:atoms%lmaxd,atoms%ntype,jsp_start:jsp_end) )
ALLOCATE ( usdus%ddn(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 ( jsym(dimension%neigd),ksym(dimension%neigd) )
ALLOCATE ( gvac1d(dimension%nv2d),gvac2d(dimension%nv2d) ) ALLOCATE ( gvac1d(dimension%nv2d),gvac2d(dimension%nv2d) )
ALLOCATE ( usdus%ulos(atoms%nlod,atoms%ntype,jsp_start:jsp_end) ) ALLOCATE ( usdus%ulos(atoms%nlod,atoms%ntype,jsp_start:jsp_end) )
...@@ -339,6 +338,7 @@ CONTAINS ...@@ -339,6 +338,7 @@ CONTAINS
ALLOCATE ( kveclo(atoms%nlotot) ) ALLOCATE ( kveclo(atoms%nlotot) )
IF (mpi%irank==0) THEN IF (mpi%irank==0) THEN
WRITE (6,FMT=8000) jspin WRITE (6,FMT=8000) jspin
WRITE (16,FMT=8000) jspin WRITE (16,FMT=8000) jspin
...@@ -350,7 +350,7 @@ CONTAINS ...@@ -350,7 +350,7 @@ CONTAINS
eig_id,& eig_id,&
mpi%irank,mpi%isize,jspin,dimension%jspd,& mpi%irank,mpi%isize,jspin,dimension%jspd,&
noco%l_noco,& noco%l_noco,&
ello,evac,epar,bkpt,wk,n_bands,n_size)!keep ello,evac,epar,wk,n_bands,n_size)
#ifdef CPP_MPI #ifdef CPP_MPI
! Sinchronizes the RMA operations ! Sinchronizes the RMA operations
CALL MPI_BARRIER(mpi%mpi_comm,ie) CALL MPI_BARRIER(mpi%mpi_comm,ie)
...@@ -512,6 +512,7 @@ CONTAINS ...@@ -512,6 +512,7 @@ CONTAINS
! !
! -> Gu test: distribute ev's among the processors... ! -> Gu test: distribute ev's among the processors...
! !
CALL lapw%init(input,noco, kpts,atoms,sym,ikpt,cell,.false., mpi)
skip_t = skip_tt skip_t = skip_tt
IF (l_evp.AND.(mpi%isize.GT.1)) THEN IF (l_evp.AND.(mpi%isize.GT.1)) THEN
IF (banddos%dos) THEN IF (banddos%dos) THEN
...@@ -549,31 +550,30 @@ CONTAINS ...@@ -549,31 +550,30 @@ CONTAINS
n_end = noccbd n_end = noccbd
END IF END IF
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 (zmat%l_real) THEN
IF (.NOT.ALLOCATED(zMat%z_r)) THEN IF (.NOT.ALLOCATED(zMat%z_r)) THEN
ALLOCATE (zMat%z_r(dimension%nbasfcn,dimension%neigd)) ALLOCATE (zMat%z_r(zmat%nbasfcn,dimension%neigd))
zMat%nbasfcn = dimension%nbasfcn
zMat%nbands = dimension%neigd zMat%nbands = dimension%neigd
END IF END IF
zMat%z_r = 0 zMat%z_r = 0
ELSE ELSE
IF (.NOT.ALLOCATED(zMat%z_c)) THEN IF (.NOT.ALLOCATED(zMat%z_c)) THEN
ALLOCATE (zMat%z_c(dimension%nbasfcn,dimension%neigd)) ALLOCATE (zMat%z_c(zmat%nbasfcn,dimension%neigd))
zMat%nbasfcn = dimension%nbasfcn
zMat%nbands = dimension%neigd zMat%nbands = dimension%neigd
END IF END IF
zMat%z_c = 0 zMat%z_c = 0
endif endif
CALL cdn_read(& CALL cdn_read(&
eig_id,dimension%nvd,dimension%jspd,mpi%irank,mpi%isize,& 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,& noccbd,n_start,n_end,&
lapw%nmat,lapw%nv,ello,evdu,epar,kveclo,& ello,evdu,epar,&
lapw%k1,lapw%k2,lapw%k3,bkpt,wk,nbands,eig,zMat) lapw,wk,nbands,eig,zMat)
#ifdef CPP_MPI #ifdef CPP_MPI
! Synchronizes the RMA operations ! Sinchronizes the RMA operations
!if (l_evp) CALL MPI_BARRIER(mpi%mpi_comm,ie) if (l_evp) CALL MPI_BARRIER(mpi%mpi_comm,ie)
CALL MPI_BARRIER(mpi%mpi_comm,ie)
#endif #endif
!IF (l_evp.AND.(isize.GT.1)) THEN !IF (l_evp.AND.(isize.GT.1)) THEN
! eig(1:noccbd) = eig(n_start:n_end) ! eig(1:noccbd) = eig(n_start:n_end)
...@@ -667,7 +667,7 @@ CONTAINS ...@@ -667,7 +667,7 @@ CONTAINS
IF (.NOT.((jspin.EQ.2) .AND. noco%l_noco)) THEN IF (.NOT.((jspin.EQ.2) .AND. noco%l_noco)) THEN
CALL timestart("cdnval: pwden") CALL timestart("cdnval: pwden")
CALL pwden(stars,kpts,banddos,oneD, input,mpi,noco,cell,atoms,sym,ikpt,& 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") CALL timestop("cdnval: pwden")
END IF END IF
!+new !+new
...@@ -688,7 +688,7 @@ CONTAINS ...@@ -688,7 +688,7 @@ CONTAINS
IF (.NOT.((jspin.EQ.2) .AND. noco%l_noco)) THEN IF (.NOT.((jspin.EQ.2) .AND. noco%l_noco)) THEN
CALL timestart("cdnval: vacden") CALL timestart("cdnval: vacden")
CALL vacden(vacuum,dimension,stars,oneD, kpts,input, cell,atoms,noco,banddos,& 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) rhtxy,rht,qvac,qvlay, qstars,cdomvz,cdomvxy,zMat)
CALL timestop("cdnval: vacden") CALL timestop("cdnval: vacden")
END IF END IF
...@@ -726,14 +726,14 @@ CONTAINS ...@@ -726,14 +726,14 @@ CONTAINS
aveccof(3,noccbd,0:atoms%lmaxd*(atoms%lmaxd+2),atoms%nat),& aveccof(3,noccbd,0:atoms%lmaxd*(atoms%lmaxd+2),atoms%nat),&
bveccof(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) ) 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,& CALL to_pulay(input,atoms,noccbd,sym, lapw, noco,cell,noccbd,eig,usdus,&
kveclo,ispin,oneD, acof(:,0:,:,ispin),bcof(:,0:,:,ispin),& ispin,oneD, acof(:,0:,:,ispin),bcof(:,0:,:,ispin),&
e1cof,e2cof,aveccof,bveccof, ccof(-atoms%llod,1,1,1,ispin),acoflo,bcoflo,cveccof,zMat) e1cof,e2cof,aveccof,bveccof, ccof(-atoms%llod,1,1,1,ispin),acoflo,bcoflo,cveccof,zMat)
CALL timestop("cdnval: to_pulay") CALL timestop("cdnval: to_pulay")
ELSE ELSE
CALL timestart("cdnval: abcof") 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) acof(:,0:,:,ispin),bcof(:,0:,:,ispin),ccof(-atoms%llod:,:,:,:,ispin),zMat)
CALL timestop("cdnval: abcof") CALL timestop("cdnval: abcof")
...@@ -867,9 +867,9 @@ CONTAINS ...@@ -867,9 +867,9 @@ CONTAINS
! write data to direct access file first, write to formated file later by PE 0 only! ! 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! !--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 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) lapw%k3(:,jspin),sym,dimension,nbands,cell,eig,noco, ksym,jsym,zMat)
END IF END IF
! !
......
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
MODULE m_pwden MODULE m_pwden
CONTAINS CONTAINS
SUBROUTINE pwden(stars,kpts,banddos,oneD, input,mpi,noco,cell,atoms,sym, & 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 ! In this subroutine the star function expansion coefficients of
! the plane wave charge density is determined. ! the plane wave charge density is determined.
...@@ -96,7 +96,6 @@ CONTAINS ...@@ -96,7 +96,6 @@ CONTAINS
INTEGER, INTENT (IN) :: igq_fft(0:stars%kq1_fft*stars%kq2_fft*stars%kq3_fft-1) INTEGER, INTENT (IN) :: igq_fft(0:stars%kq1_fft*stars%kq2_fft*stars%kq3_fft-1)
REAL,INTENT(IN) :: we(:) !(nobd) REAL,INTENT(IN) :: we(:) !(nobd)
REAL,INTENT(IN) :: eig(:)!(dimension%neigd) REAL,INTENT(IN) :: eig(:)!(dimension%neigd)
REAL,INTENT(IN) :: bkpt(3)
!-----> BASIS FUNCTION INFORMATION !-----> BASIS FUNCTION INFORMATION
INTEGER,INTENT(IN):: ne INTEGER,INTENT(IN):: ne
!-----> CHARGE DENSITY INFORMATION !-----> CHARGE DENSITY INFORMATION
...@@ -121,7 +120,7 @@ CONTAINS ...@@ -121,7 +120,7 @@ CONTAINS
INTEGER,PARAMETER:: ist(-1:1)=(/1,0,0/) INTEGER,PARAMETER:: ist(-1:1)=(/1,0,0/)
REAL,PARAMETER:: zero = 0.00, tol_3=1.0e-3 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 wtf(ne),wsave(stars%kq3_fft+15)
REAL, ALLOCATABLE :: psir(:),psii(:),rhon(:) REAL, ALLOCATABLE :: psir(:),psii(:),rhon(:)
REAL, ALLOCATABLE :: psi1r(:),psi1i(:),psi2r(:),psi2i(:) REAL, ALLOCATABLE :: psi1r(:),psi1i(:),psi2r(:),psi2i(:)
...@@ -284,9 +283,9 @@ CONTAINS ...@@ -284,9 +283,9 @@ CONTAINS
! -k1d <= L <= k1d ! -k1d <= L <= k1d
! -k2d <= M <= k2d ! -k2d <= M <= k2d
! -k3d <= N <= k3d ! -k3d <= N <= k3d
il = lapw%k1(iv,ispin) il = lapw%gvec(1,iv,ispin)
im = lapw%k2(iv,ispin) im = lapw%gvec(2,iv,ispin)
in = lapw%k3(iv,ispin) in = lapw%gvec(3,iv,ispin)
! !
!------> L,M,N LATTICE POINTS OF G-VECTOR IN POSITIVE DOMAIN !------> L,M,N LATTICE POINTS OF G-VECTOR IN POSITIVE DOMAIN
! (since charge density box = two times charge density box ! (since charge density box = two times charge density box
...@@ -382,9 +381,7 @@ CONTAINS ...@@ -382,9 +381,7 @@ CONTAINS
kpsir(ifftq3d:)=0.0 kpsir(ifftq3d:)=0.0
kpsir(-ifftq2d:ifftq3d)=0.0 kpsir(-ifftq2d:ifftq3d)=0.0
DO iv = 1 , lapw%nv(jspin) DO iv = 1 , lapw%nv(jspin)
xk(1)=lapw%k1(iv,jspin)+bkpt(1) xk=lapw%gvec(:,iv,jspin)+lapw%bkpt
xk(2)=lapw%k2(iv,jspin)+bkpt(2)
xk(3)=lapw%k3(iv,jspin)+bkpt(3)
s = 0.0 s = 0.0
DO i = 1,3 DO i = 1,3
s = s + xk(i)*cell%bmat(i,j) s = s + xk(i)*cell%bmat(i,j)
...@@ -427,9 +424,7 @@ CONTAINS ...@@ -427,9 +424,7 @@ CONTAINS
kpsir=0.0 kpsir=0.0
kpsii=0.0 kpsii=0.0
DO iv = 1 , lapw%nv(jspin) DO iv = 1 , lapw%nv(jspin)
xk(1)=lapw%k1(iv,jspin)+bkpt(1) xk=lapw%gvec(:,iv,jspin)+lapw%bkpt
xk(2)=lapw%k2(iv,jspin)+bkpt(2)
xk(3)=lapw%k3(iv,jspin)+bkpt(3)
s = 0.0 s = 0.0
DO i = 1,3 DO i = 1,3
s = s + xk(i)*cell%bmat(i,j) s = s + xk(i)*cell%bmat(i,j)
......
...@@ -10,7 +10,7 @@ CONTAINS ...@@ -10,7 +10,7 @@ CONTAINS
kpts,input,cell,atoms,noco,banddos,& kpts,input,cell,atoms,noco,banddos,&
gvac1,gvac2,& gvac1,gvac2,&
we,ikpt,jspin,vz,vz0,& we,ikpt,jspin,vz,vz0,&
ne,bkpt,lapw,& ne,lapw,&
evac,eig,rhtxy,rht,qvac,qvlay,& evac,eig,rhtxy,rht,qvac,qvlay,&
stcoeff,cdomvz,cdomvxy,zMat) stcoeff,cdomvz,cdomvxy,zMat)
...@@ -72,7 +72,6 @@ CONTAINS ...@@ -72,7 +72,6 @@ CONTAINS
INTEGER,PARAMETER :: n2max=13 INTEGER,PARAMETER :: n2max=13
REAL,PARAMETER :: emax=2.0/hartree_to_ev_const REAL,PARAMETER :: emax=2.0/hartree_to_ev_const
! .. Array Arguments .. ! .. Array Arguments ..
REAL, INTENT (IN) :: bkpt(3)
REAL, INTENT (IN) :: evac(2,DIMENSION%jspd) REAL, INTENT (IN) :: evac(2,DIMENSION%jspd)
COMPLEX, INTENT (INOUT):: rhtxy(vacuum%nmzxyd,oneD%odi%n2d-1,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) REAL, INTENT (INOUT):: rht(vacuum%nmzd,2,DIMENSION%jspd)
...@@ -204,16 +203,16 @@ CONTAINS ...@@ -204,16 +203,16 @@ CONTAINS
n2 = 0 n2 = 0
k_loop2:DO k = 1,lapw%nv(ispin) k_loop2:DO k = 1,lapw%nv(ispin)
DO j = 1,n2 DO j = 1,n2
IF ( lapw%k1(k,ispin).EQ.kvac1(j,ispin) .AND.& IF ( lapw%gvec(1,k,ispin).EQ.kvac1(j,ispin) .AND.&
lapw%k2(k,ispin).EQ.kvac2(j,ispin) ) THEN lapw%gvec(2,k,ispin).EQ.kvac2(j,ispin) ) THEN
map2(k,ispin) = j map2(k,ispin) = j
CYCLE k_loop2 CYCLE k_loop2
END IF END IF
ENDDO ENDDO
n2 = n2 + 1 n2 = n2 + 1
IF (n2>DIMENSION%nv2d) CALL juDFT_error("vacden0","vacden") IF (n2>DIMENSION%nv2d) CALL juDFT_error("vacden0","vacden")
kvac1(n2,ispin) = lapw%k1(k,ispin) kvac1(n2,ispin) = lapw%gvec(1,k,ispin)
kvac2(n2,ispin) = lapw%k2(k,ispin) kvac2(n2,ispin) = lapw%gvec(2,k,ispin)
map2(k,ispin) = n2 map2(k,ispin) = n2
ENDDO k_loop2 ENDDO k_loop2
nv2(ispin) = n2 nv2(ispin) = n2
...@@ -302,7 +301,7 @@ CONTAINS ...@@ -302,7 +301,7 @@ CONTAINS
cell,vacuum,DIMENSION,stars,& cell,vacuum,DIMENSION,stars,&
oneD,qssbti(3,ispin),& oneD,qssbti(3,ispin),&
oneD%odi%n2d,& 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),& 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),& 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),& te_1(1,-oneD%odi%mb),dte_1(1,-oneD%odi%mb),&
...@@ -311,7 +310,7 @@ CONTAINS ...@@ -311,7 +310,7 @@ CONTAINS
DO k = 1,lapw%nv(ispin) DO k = 1,lapw%nv(ispin)
kspin = (lapw%nv(1)+atoms%nlotot)*(ispin-1) + k kspin = (lapw%nv(1)+atoms%nlotot)*(ispin-1) + k
l = map1(k,ispin) 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 IF (irec3.NE.0) THEN
irec2 = stars%ig2(irec3) irec2 = stars%ig2(irec3)
zks = stars%sk2(irec2)*cell%z1 zks = stars%sk2(irec2)*cell%z1
...@@ -343,8 +342,8 @@ CONTAINS ...@@ -343,8 +342,8 @@ CONTAINS
vz0(ispin) = vz(vacuum%nmz,ispin) vz0(ispin) = vz(vacuum%nmz,ispin)
evacp = evac(ivac,ispin) evacp = evac(ivac,ispin)
DO ik = 1,nv2(ispin) DO ik = 1,nv2(ispin)
v(1) = bkpt(1) + kvac1(ik,ispin) + qssbti(1,ispin) v(1) = lapw%bkpt(1) + kvac1(ik,ispin) + qssbti(1,ispin)
v(2) = bkpt(2) + kvac2(ik,ispin) + qssbti(2,ispin) v(2) = lapw%bkpt(2) + kvac2(ik,ispin) + qssbti(2,ispin)
v(3) = 0. v(3) = 0.
ev = evacp - 0.5*DOT_PRODUCT(v,MATMUL(v,cell%bbmat)) 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),& CALL vacuz(ev,vz(1,ispin),vz0(ispin),vacuum%nmz,vacuum%delz,t(ik),&
...@@ -404,7 +403,7 @@ CONTAINS ...@@ -404,7 +403,7 @@ CONTAINS
& cell,vacuum,DIMENSION,stars,& & cell,vacuum,DIMENSION,stars,&
& oneD,qssbtii,& & oneD,qssbtii,&
& oneD%odi%n2d,& & 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),& & 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),& & 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),& & te_1(1,-oneD%odi%mb),dte_1(1,-oneD%odi%mb),&
...@@ -412,7 +411,7 @@ CONTAINS ...@@ -412,7 +411,7 @@ CONTAINS
& ue_1(1,1,-oneD%odi%mb,jspin)) & ue_1(1,1,-oneD%odi%mb,jspin))
DO k = 1,lapw%nv(jspin) DO k = 1,lapw%nv(jspin)
l = map1(k,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 IF (irec3.NE.0) THEN
irec2 = stars%ig2(irec3) irec2 = stars%ig2(irec3)
zks = stars%sk2(irec2)*cell%z1 zks = stars%sk2(irec2)*cell%z1
...@@ -442,8 +441,8 @@ CONTAINS ...@@ -442,8 +441,8 @@ CONTAINS
ELSE !oneD%odi%d1 ELSE !oneD%odi%d1
evacp = evac(ivac,jspin) evacp = evac(ivac,jspin)
DO ik = 1,nv2(jspin) DO ik = 1,nv2(jspin)
v(1) = bkpt(1) + kvac1(ik,jspin) v(1) = lapw%bkpt(1) + kvac1(ik,jspin)
v(2) = bkpt(2) + kvac2(ik,jspin) v(2) = lapw%bkpt(2) + kvac2(ik,jspin)
v(3) = 0. v(3) = 0.
ev = evacp - 0.5*DOT_PRODUCT(v,MATMUL(v,cell%bbmat)) 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)) 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 ...@@ -519,7 +518,7 @@ CONTAINS
DO n = 1, ne DO n = 1, ne
IF (ABS(eig(n)-vacuum%tworkf).LE.emax) i=i+1 IF (ABS(eig(n)-vacuum%tworkf).LE.emax) i=i+1
END DO 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 DO n = 1, ne
IF (ABS(eig(n)-vacuum%tworkf).LE.emax) THEN IF (ABS(eig(n)-vacuum%tworkf).LE.emax) THEN
WRITE (87,FMT=1000) eig(n) WRITE (87,FMT=1000) eig(n)
......
...@@ -20,161 +20,68 @@ MODULE m_abclocdn ...@@ -20,161 +20,68 @@ MODULE m_abclocdn
! of atom 'na' to it. ! of atom 'na' to it.
!********************************************************************* !*********************************************************************
CONTAINS CONTAINS
SUBROUTINE abclocdn(atoms, sym, noco,ccchi,kspin,iintsp,con1,phase,ylm,& SUBROUTINE abclocdn(atoms,sym,noco,lapw,cell,ccchi,iintsp,phase,ylm,&
ntyp,na,k,s,nv,ne,nbasf0,alo1,blo1,clo1,kvec,nkvec,enough,acof,bcof,ccof,zMat) ntyp,na,k,nkvec,lo,ne,alo1,blo1,clo1,acof,bcof,ccof,zMat)
! !
USE m_types USE m_types
USE m_constants
IMPLICIT NONE IMPLICIT NONE
TYPE(t_noco),INTENT(IN) :: noco TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_sym),INTENT(IN) :: sym TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_atoms),INTENT(IN) :: atoms TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_lapw),INTENT(IN) :: lapw
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_zMat),INTENT(IN) :: zMat TYPE(t_zMat),INTENT(IN) :: zMat
! .. ! ..
! .. Scalar Arguments .. ! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: kspin,iintsp INTEGER, INTENT (IN) :: iintsp
INTEGER, INTENT (IN) :: k,na,ne,ntyp,nv INTEGER, INTENT (IN) :: k,na,ne,ntyp,nkvec,lo
REAL, INTENT (IN) :: con1 ,s
COMPLEX, INTENT (IN) :: phase COMPLEX, INTENT (IN) :: phase
! .. ! ..
! .. Array Arguments .. ! .. Array Arguments ..
INTEGER, INTENT (IN) :: nbasf0(atoms%nlod,atoms%nat) REAL, INTENT (IN) :: alo1(:),blo1(:),clo1(:)
REAL, INTENT (IN) :: alo1(atoms%nlod,atoms%ntype),blo1(atoms%nlod,atoms%ntype)
REAL, INTENT (IN) :: clo1(atoms%nlod,atoms%ntype)
COMPLEX, INTENT (IN) :: ylm( (atoms%lmaxd+1)**2 ) COMPLEX, INTENT (IN) :: ylm( (atoms%lmaxd+1)**2 )
COMPLEX, INTENT (IN) :: ccchi(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) :: acof(:,0:,:)!(nobd,0:dimension%lmd,atoms%nat)
COMPLEX, INTENT (INOUT) :: bcof(:,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) 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 .. ! .. Local Scalars ..
COMPLEX ctmp,term1 COMPLEX ctmp,term1
REAL,PARAMETER:: eps=1.0e-30 INTEGER i,l,ll1,lm,nbasf,m
INTEGER i,l,ll1,lm,lo ,mind,nbasf,na2,lmp,m
! .. ! ..
! .. Local Arrays ..
COMPLEX clotmp(-atoms%llod:atoms%llod)
! .. ! ..
LOGICAL :: l_real term1 = 2 * tpi_const/SQRT(cell%omtil) * ((atoms%rmt(ntyp)**2)/2) * phase
l_real=zMat%l_real
! ..
enough = .TRUE.
term1 = con1 * ((atoms%rmt(ntyp)**2)/2) * phase
!---> the whole program is in hartree units, therefore 1/wronskian is !---> 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 !---> (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 !---> and c coefficients, is included in the t-matrices. thus, it does
!---> not show up in the formula above. !---> not show up in the formula above.
DO lo = 1,atoms%nlo(ntyp) l = atoms%llo(lo,ntyp)
l = atoms%llo(lo,ntyp) ll1 = l* (l+1)
IF (.NOT.((s.LE.eps).AND.(l.GE.1))) THEN nbasf=lapw%nv(iintsp)+lapw%index_lo(lo,na)+nkvec
IF (atoms%invsat(na).EQ.0) THEN DO i = 1,ne
DO m = -l,l
IF ((nkvec(lo,na)).LT. (2*atoms%llo(lo,ntyp)+1)) THEN lm = ll1 + m
enough = .FALSE. !+gu_con
nkvec(lo,na) = nkvec(lo,na) + 1 IF (noco%l_noco) THEN
nbasf = nbasf0(lo,na) + nkvec(lo,na) IF (noco%l_ss) THEN
l = atoms%llo(lo,ntyp) ctmp = term1*CONJG(ylm(ll1+m+1))*ccchi(iintsp)*zMat%z_c(lapw%nv(1)+atoms%nlotot+nbasf,i)
ll1 = l* (l+1) ELSE
DO m = -l,l 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) )
clotmp(m) = term1*CONJG(ylm(ll1+m+1)) ENDIF
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) )