Skip to content

GitLab

fleur
fleur
Commit fdeca975 authored by Daniel Wortmann's avatar Daniel Wortmann
Browse files
Options

Removed lots of preprocessor dependencies, fixed BUG in last commit

parent 43beef12
Expand all Hide whitespace changes
Inline Side-by-side
Showing with 3474 additions and 3889 deletions
cdn/cdnval.F90
View file @ fdeca975
This diff is collapsed.
cdn/pwden.F90
View file @ fdeca975
......@@ -371,7 +371,7 @@ CONTAINS
isn = 1
#if ( defined(CPP_INVERSION) && !defined(CPP_SOC) )
CALL rfft(isn,stars%kq1_fft,stars%kq2_fft,stars%kq3_fft+1,stars%kq1_fft,stars%kq2_fft,stars%kq3_fft,&
nw1,nw2,nw3,wsave,psir(ifftq3d), psir(-ifftq2))
nw1,nw2,nw3,wsave,psir(ifftq3d), psir(-ifftq2))
! GM forces part
IF (input%l_f) THEN
......@@ -566,8 +566,8 @@ CONTAINS
isn = -1
#if ( defined(CPP_INVERSION) && !defined(CPP_SOC) )
CALL rfft(isn,stars%kq1_fft,stars%kq2_fft,stars%kq3_fft+1,stars%kq1_fft,stars%kq2_fft,stars%kq3_fft,&
stars%kq1_fft,stars%kq2_fft,stars%kq3_fft,wsave,psir(ifftq3d), rhon(-ifftq2))
CALL rfft(isn,stars%kq1_fft,stars%kq2_fft,stars%kq3_fft+1,stars%kq1_fft,stars%kq2_fft,stars%kq3_fft,&
stars%kq1_fft,stars%kq2_fft,stars%kq3_fft,wsave,psir(ifftq3d), rhon(-ifftq2))
IF (input%l_f) CALL rfft(isn,stars%kq1_fft,stars%kq2_fft,stars%kq3_fft+1,stars%kq1_fft,stars%kq2_fft,stars%kq3_fft,&
stars%kq1_fft,stars%kq2_fft,stars%kq3_fft,wsave,kpsir(ifftq3d), ekin(-ifftq2))
#else
......@@ -620,18 +620,19 @@ CONTAINS
DO istr = 1 , stars%ng3_fft
cwk(istr) = scale * cwk(istr) / REAL( stars%nstr(istr) )
ENDDO
#ifdef CPP_APW
IF (input%l_f) THEN
DO istr = 1 , stars%ng3_fft
ecwk(istr) = scale * ecwk(istr) / REAL( stars%nstr(istr) )
ENDDO
CALL forces_b8(&
atoms,ecwk,stars,&
sym,cell,&
jspin,&
forces,f_b8)
IF (input%l_useapw) THEN
IF (input%l_f) THEN
DO istr = 1 , stars%ng3_fft
ecwk(istr) = scale * ecwk(istr) / REAL( stars%nstr(istr) )
ENDDO
CALL force_b8(&
atoms,ecwk,stars,&
sym,cell,&
jspin,&
forces,f_b8)
ENDIF
ENDIF
#endif
!
!---> check charge neutralilty
!
......
cdn_mt/#abccoflo.f90# deleted 100644 → 0
View file @ 43beef12
MODULE m_abccoflo
USE m_juDFT
!*********************************************************************
! Calculates the (upper case) A, B and C coefficients for the local
! orbitals.
! Philipp Kurz 99/04
!*********************************************************************
CONTAINS
SUBROUTINE abccoflo(atoms, con1,rph,cph,ylm,ntyp,na,k,nv,&
l_lo1,alo1,blo1,clo1, nkvec, enough,alo,blo,clo,kvec)
!
!*************** ABBREVIATIONS ***************************************
! kvec : stores the number of the G-vectors, that have been used to
! construct the local orbitals
! nkvec : stores the number of G-vectors that have been found and
! accepted during the construction of the local orbitals.
! enough : enough is set to .true. when enough G-vectors have been
! accepted.
! linindq : if the norm of that part of a local orbital (contructed
! with a trial G-vector) that is orthogonal to the previous
! ones is larger than linindq, then this G-vector is
! accepted.
!*********************************************************************
!
USE m_constants
USE m_types
IMPLICIT NONE
TYPE(t_atoms),INTENT(IN) :: atoms
! ..
! .. Scalar Arguments ..
REAL, INTENT (IN) :: con1,cph ,rph
INTEGER, INTENT (IN) :: k,na,ntyp,nv
LOGICAL, INTENT (IN) :: l_lo1
LOGICAL, INTENT (OUT):: enough
! ..
! .. Array Arguments ..
INTEGER, INTENT (IN):: kvec(2* (2*atoms%llod+1),atoms%nlod) )
REAL, INTENT (IN) :: alo1(atoms%nlod),blo1(atoms%nlod),clo1(atoms%nlod)
COMPLEX, INTENT (IN) :: ylm( (atoms%lmaxd+1)**2 )
COMPLEX, INTENT (OUT):: alo(-atoms%llod:atoms%llod,2* (2*atoms%llod+1),atoms%nlod)
COMPLEX, INTENT (OUT):: blo(-atoms%llod:atoms%llod,2* (2*atoms%llod+1),atoms%nlod)
COMPLEX, INTENT (OUT):: clo(-atoms%llod:atoms%llod,2* (2*atoms%llod+1),atoms%nlod)
INTEGER,INTENT (INOUT):: nkvec(atoms%nlod)
! ..
! .. Local Scalars ..
COMPLEX term1
REAL,PARAMETER:: linindq=1.e-4
INTEGER l,lo ,mind,ll1,lm
LOGICAL linind
! ..
!
!---> 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.
!
!-abccoflo1
IF ( l_lo1) THEN
DO lo = 1,atoms%nlo(ntyp)
IF ( (nkvec(lo).EQ.0).AND.(atoms%llo(lo,ntyp).EQ.0) ) THEN
enough = .FALSE.
nkvec(lo) = 1
m = 0
clo(m,nkvec(lo),lo) = con1* ((atoms%rmt**2)/2) / SQRT(fpi_const)
alo(m,nkvec(lo),lo) = clo(m,nkvec(lo),lo)*alo1(lo)
blo(m,nkvec(lo),lo) = clo(m,nkvec(lo),lo)*blo1(lo)
clo(m,nkvec(lo),lo) = clo(m,nkvec(lo),lo)*clo1(lo)
IF (kvec(nkvec(lo),lo)/=k) CALL juDFT_error("abccoflo:1"&
& ,calledby ="abccoflo")
ENDIF
ENDDO
ELSE
enough = .TRUE.
term1 = con1* ((atoms%rmt**2)/2)*CMPLX(rph,cph)
DO lo = 1,atoms%nlo(ntyp)
IF (atoms%invsat(na).EQ.0) THEN
IF ((nkvec(lo)).LT. (2*atoms%llo(lo,ntyp)+1)) THEN
enough = .FALSE.
nkvec(lo) = nkvec(lo) + 1
l = atoms%llo(lo,ntyp)
ll1 = l*(l+1) + 1
DO m = -l,l
lm = ll1 + m
clo(m,nkvec(lo),lo) = term1*ylm(lm)
END DO
IF ( kvec(nkvec(lo),lo) == k ) THEN
DO m = -l,l
alo(m,nkvec(lo),lo) = clo(m,nkvec(lo),lo)*alo1(lo)
blo(m,nkvec(lo),lo) = clo(m,nkvec(lo),lo)*blo1(lo)
clo(m,nkvec(lo),lo) = clo(m,nkvec(lo),lo)*clo1(lo)
END DO
! WRITE(6,9000) nkvec(lo),k,lo,na,
! + (clo(m,nkvec(lo),lo),m=-l,l)
! 9000 format(2i4,2i2,7(' (',e9.3,',',e9.3,')'))
ELSE
nkvec(lo) = nkvec(lo) - 1
ENDIF
ENDIF
ELSE
IF ((atoms%invsat(na).EQ.1) .OR. (atoms%invsat(na).EQ.2)) THEN
! only invsat=1 is needed invsat=2 for testing
IF ((nkvec(lo)).LT. (2* (2*atoms%llo(lo,ntyp)+1))) THEN
enough = .FALSE.
nkvec(lo) = nkvec(lo) + 1
l = atoms%llo(lo,ntyp)
ll1 = l*(l+1) + 1
DO m = -l,l
lm = ll1 + m
clo(m,nkvec(lo),lo) = term1*ylm(lm)
END DO
IF ( kvec(nkvec(lo),lo) == k ) THEN
DO m = -l,l
! if(l.eq.1) then
! WRITE(*,*)'k=',k,' clotmp=',clo(m,nkvec(lo),lo)
! WRITE(*,*)'clo1=',clo1(lo),' term1=',term1
! endif
alo(m,nkvec(lo),lo) = clo(m,nkvec(lo),lo)*alo1(lo)
blo(m,nkvec(lo),lo) = clo(m,nkvec(lo),lo)*blo1(lo)
clo(m,nkvec(lo),lo) = clo(m,nkvec(lo),lo)*clo1(lo)
! kvec(nkvec(lo),lo) = k
END DO
ELSE
nkvec(lo) = nkvec(lo) - 1
END IF
END IF
END IF
END IF
END DO
IF ((k.EQ.nv) .AND. (.NOT.enough)) THEN
WRITE (6,FMT=*)&
& 'abccoflo did not find enough linearly independent'
WRITE (6,FMT=*)&
& 'clo coefficient-vectors. the linear independence'
WRITE (6,FMT=*) 'quality, linindq, is set to: ',linindq,'.'
WRITE (6,FMT=*) 'this value might be to large.'
CALL juDFT_error&
& ("abccoflo: did not find enough lin. ind. clo-vectors"&
& ,calledby ="abccoflo")
END IF
ENDIF ! abccoflo1
END SUBROUTINE abccoflo
END MODULE m_abccoflo
cdn_mt/abcof.F90
View file @ fdeca975
MODULE m_abcof
CONTAINS
SUBROUTINE abcof(atoms,nobd,sym, cell, bkpt,lapw,ne,z,usdus,&
SUBROUTINE abcof(input,atoms,nobd,sym, cell, bkpt,lapw,ne,z,usdus,&
noco,jspin,kveclo,oneD, acof,bcof,ccof)
! ************************************************************
! subroutine constructs the a,b coefficients of the linearized
......@@ -16,7 +16,8 @@ CONTAINS
USE m_ylm
USE m_types
IMPLICIT NONE
TYPE(t_usdus),INTENT(IN) :: usdus
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
......@@ -79,9 +80,7 @@ CONTAINS
DO lo = 1,atoms%nlo(n)
IF (atoms%l_dulo(lo,n)) apw(l,n) = .true.
ENDDO
#ifdef CPP_APW
IF (atoms%lapw_l(n).GE.l) apw(l,n) = .false.
#endif
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.
......
cdn_mt/abcof3.F90
View file @ fdeca975
MODULE m_abcof3
CONTAINS
SUBROUTINE abcof3(atoms,sym,jspin, cell, bkpt,lapw,&
SUBROUTINE abcof3(input,atoms,sym,jspin, cell, bkpt,lapw,&
usdus, kveclo,oneD,a,b,bascof_lo)
! ************************************************************
! subroutine constructs the a,b coefficients of the linearized
......@@ -16,6 +16,7 @@ CONTAINS
USE m_ylm
USE m_types
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
......@@ -61,9 +62,8 @@ CONTAINS
DO lo = 1,atoms%nlo(n)
IF (atoms%l_dulo(lo,n)) apw(l,n) = .true.
ENDDO
#ifdef CPP_APW
IF (atoms%lapw_l(n).GE.l) apw(l,n) = .false.
#endif
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.
......
cmake/Architectures.txt
View file @ fdeca975
......@@ -17,6 +17,8 @@ elseif ($ENV{FC} MATCHES "gfortran.*")
set (configfile "cmake/cmake.gfortran.config")
elseif ($ENV{FC} MATCHES "ifort.*")
set (configfile "cmake/cmake.ifort.config")
elseif (CMAKE_SYSTEM_NAME MATCHES "Darwin")
set (configfile "cmake/cmake.darwin.config")
elseif (${sitename} MATCHES "iff.*")
set (configfile "cmake/cmake.iff.config")
elseif (${sitename} MATCHES "jrl.*")
......@@ -28,8 +30,6 @@ elseif (${sitename} MATCHES "jrl.*")
endif()
elseif (${sitename} MATCHES "juquee.*")
set (configfile "cmake/cmake.juqueen.config")
elseif (CMAKE_SYSTEM_NAME MATCHES "Darwin")
set (configfile "cmake/cmake.darwin.config")
endif ()
if (${configfile} MATCHES "NOTFOUND")
......
diagonalization/chani.F90
View file @ fdeca975
......@@ -302,17 +302,11 @@ CONTAINS
WRITE (*,*) 'ERROR: chani.F: Allocating rwork failed'
CALL juDFT_error('Failed to allocated "rwork"', calledby ='chani')
ENDIF
#ifdef CPP_T90
CALL CPP_LAPACK_pzhegvx(1,'V','I','U',m,asca,1,1,desca,bsca,1,1, desca,&
0.0,1.0,1,m,abstol,num1,num2,eig2,orfac,eigvec,1,1,&
desceigv,work2,-1,rwork,-1,iwork,-1,ifail,iclustr,&
gap,ierr)
#else
CALL CPP_LAPACK_pzhegvx(1,'V','I','U',m,asca,1,1,desca,bsca,1,1, desca,&
0.0,1.0,1,num,abstol,num1,num2,eig2,orfac,eigvec,1,1,&
desceigv,work2,-1,rwork,-1,iwork,-1,ifail,iclustr,&
gap,ierr)
#endif
IF (ABS(work2(1)).GT.lwork2) THEN
lwork2=work2(1)
DEALLOCATE (work2)
......
diagonalization/eigen_diag.F90
View file @ fdeca975
......@@ -56,7 +56,7 @@ CONTAINS
#ifdef CPP_SCALAPACK
USE m_chani
#endif
#ifdef CPP_elemental
#ifdef CPP_ELEMENTAL
USE m_elemental
#endif
IMPLICIT NONE
......
diagonalization/geneigbrobl.F90
View file @ fdeca975
......@@ -24,17 +24,6 @@ CONTAINS
REAL, INTENT(OUT) :: eig(:)
INTEGER, INTENT(OUT) :: ne
#ifdef CPP_F90
#ifdef CPP_INVERSION
REAL, INTENT (INOUT) :: a(:),b(:)
REAL, INTENT (INOUT) :: z(:,:)
#else
COMPLEX, INTENT (INOUT)::a(:),b(:)
COMPLEX, INTENT (INOUT) :: z(:,:)
#endif
#else
#ifdef CPP_INVERSION
REAL, ALLOCATABLE, INTENT (INOUT) :: a(:),b(:)
......@@ -44,7 +33,6 @@ CONTAINS
COMPLEX, ALLOCATABLE, INTENT (INOUT) :: z(:,:)
#endif
#endif
! ... Local Variables ..
......@@ -82,9 +70,7 @@ CONTAINS
ENDDO
ENDDO
!save some storage by deallocation of unused array
#ifndef CPP_F90
DEALLOCATE (a)
#endif
!metric
ALLOCATE ( largeb(nsize,nsize), stat=err )
IF (err/=0) CALL juDFT_error("error allocating largeb",calledby ="geneigprobl")
......@@ -97,9 +83,7 @@ CONTAINS
ENDDO
ENDDO
!save some storage by deallocation of unused array
#ifndef CPP_F90
DEALLOCATE (b)
#endif
......@@ -120,7 +104,6 @@ CONTAINS
IF (err/=0) CALL juDFT_error(" error allocating work",calledby ="geneigprobl")
ALLOCATE ( isuppz(2*nsize), stat=err )
IF (err /= 0) CALL juDFT_error("error allocating isuppz",calledby ="geneigprobl")
#ifndef CPP_F90
IF (allocated(z)) THEN
IF (.not.(size(z,1)==nbasfcn.and.size(z,2)==neigd)) deallocate(z)
ENDIF
......@@ -131,10 +114,8 @@ CONTAINS
CALL juDFT_error("error allocating z",calledby ="geneigprobl")
ENDIF
ENDIF
#endif
sizez= size(z,1)
iu = min(nsize,neigd)
#ifndef CPP_F90
IF (l_J) THEN
CALL CPP_LAPACK_ssyevr('N','I','U',nsize,largea, nsize,lb,ub,1,iu,toler,ne,eigTemp,z,&
sizez,isuppz,work,lwork,iwork,liwork,info)
......@@ -142,10 +123,6 @@ CONTAINS
CALL CPP_LAPACK_ssyevr('V','I','U',nsize,largea,nsize,lb,ub,1,iu,toler,ne,eigTemp,z,&
sizez,isuppz,work,lwork,iwork,liwork,info)
ENDIF
#else
eig = 0.0
eigTemp = 0.0
#endif
IF (info /= 0) CALL juDFT_error("error in ssyevr",calledby ="geneigprobl")
DEALLOCATE (isuppz,work,iwork)
......@@ -174,7 +151,6 @@ CONTAINS
lrwork = 84*nsize
ALLOCATE (work(lrwork), stat=err )
IF (err/=0) CALL juDFT_error(" error allocating work",calledby ="geneigprobl")
#ifndef CPP_F90
IF (allocated(z)) THEN
IF (.not.(size(z,1)==nbasfcn.and.size(z,2)==neigd)) deallocate(z)
ENDIF
......@@ -185,27 +161,15 @@ CONTAINS
CALL juDFT_error("error allocating z",calledby ="geneigprobl")
ENDIF
ENDIF
#endif
sizez= size(z,1)
iu = min(nsize,neigd)
#ifndef CPP_F90
IF (l_J) THEN
CALL CPP_LAPACK_cheevr('N','I','U',nsize,largea, nsize,lb,ub,1,iu,toler,ne,eigTemp,z,&
sizez,isuppz,cwork,lwork,work,lrwork,iwork,liwork,info)
ELSE
#if (1==1)
CALL CPP_LAPACK_cheevr('V','I','U',nsize,largea, nsize,lb,ub,1,iu,toler,ne,eigTemp,z,&
sizez,isuppz,cwork,lwork,work,lrwork,iwork,liwork,info)
#else
CALL CPP_LAPACK_cheevx('V','I','U',nsize,largea, nsize,lb,ub,1,iu,toler,ne,eigTemp,z,&
sizez,cwork,lwork,work,iwork,isuppz,info)
#endif
ENDIF
#else
eig = 0.0
eigTemp = 0.0
#endif
IF (info /= 0) CALL juDFT_error("error in cheevr",calledby ="geneigprobl")
DEALLOCATE ( isuppz )
deallocate ( work )
......
diagonalization/zsymsecloc.F90
View file @ fdeca975
......@@ -50,17 +50,6 @@ CONTAINS
! .. Array Arguments ..
INTEGER, INTENT (IN) :: matind(dimension%nbasfcn,2)
REAL, INTENT (OUT) :: eig(dimension%neigd)
#ifdef CPP_F90
#ifdef CPP_INVERSION
REAL, INTENT (INOUT) :: a(:),b(:)
REAL, INTENT (INOUT) :: z(:,:)
#else
COMPLEX, INTENT (INOUT)::a(:),b(:)
COMPLEX, INTENT (INOUT) :: z(:,:)
#endif
#else
#ifdef CPP_INVERSION
REAL, ALLOCATABLE, INTENT (INOUT) :: a(:),b(:)
......@@ -70,7 +59,6 @@ CONTAINS
COMPLEX, ALLOCATABLE, INTENT (INOUT) :: z(:,:)
#endif
#endif
#ifdef CPP_INVERSION
real locrec(atoms%nlotot,atoms%nlotot)
......@@ -105,9 +93,7 @@ CONTAINS
! print*,"in zsymsecloc"
#ifndef CPP_F90
deallocate(z)
#endif
!******************************************
! l_zref=.false. => simply call eigensolver
......@@ -115,10 +101,8 @@ CONTAINS
if(.not.sym%l_zref)then
call geneigprobl(dimension%nbasfcn, nsize,dimension%neigd,jij%l_j,a,b, z,eig,ne)
#ifndef CPP_F90
allocate(a(dimension%nbasfcn*(dimension%nbasfcn+1)/2))
allocate(b(dimension%nbasfcn*(dimension%nbasfcn+1)/2))
#endif
return
!******************************************
! l_zref=.true. => blockdiagonalize
......@@ -461,9 +445,7 @@ CONTAINS
! z1 holds eigenvectors of even block.
! z2 holds eigenvectors of odd block.
!********************************************************************
#ifndef CPP_F90
allocate(z(dimension%nbasfcn,dimension%neigd))
#endif
allocate(evensort(ne))
etemp1(ne1+1)=99.9e9
etemp2(ne2+1)=99.9e9
......@@ -529,10 +511,8 @@ CONTAINS
endif !evensort
enddo !ii
#ifndef CPP_F90
allocate(a(dimension%nbasfcn*(dimension%nbasfcn+1)/2))
allocate(b(dimension%nbasfcn*(dimension%nbasfcn+1)/2))
#endif
endif !sym%l_zref
deallocate ( z1,z2,etemp1,etemp2,evensort )
......
eigen/eigen.F90
View file @ fdeca975
......@@ -453,7 +453,7 @@ CONTAINS
!---> set up interstitial hamiltonian and overlap matrices
!
call timestart("Interstitial Hamiltonian&Overlap")
CALL hsint(noco,jij,stars, vpw(:,jsp),lapw,jsp, n_size,n_rank,kpts%bk(:,nk),cell,atoms, a,b)
CALL hsint(input,noco,jij,stars, vpw(:,jsp),lapw,jsp, n_size,n_rank,kpts%bk(:,nk),cell,atoms, a,b)
call timestop("Interstitial Hamiltonian&Overlap")
!
......
eigen/hlomat.F90
View file @ fdeca975
This diff is collapsed.
eigen/hsint.F90
View file @ fdeca975
......@@ -6,7 +6,7 @@
MODULE m_hsint
CONTAINS
SUBROUTINE hsint(noco,jij,stars, vpw,lapw,jspin,&
SUBROUTINE hsint(input,noco,jij,stars, vpw,lapw,jspin,&
n_size,n_rank,bkpt,cell,atoms,aa,bb)
!*********************************************************************
! initializes and sets up the hamiltonian and overlap matrices
......@@ -35,6 +35,7 @@ CONTAINS
!*********************************************************************
USE m_types
IMPLICIT NONE
TYPE(t_input),INTENT(IN) :: input
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_jij),INTENT(IN) :: jij
TYPE(t_stars),INTENT(IN) :: stars
......@@ -114,16 +115,16 @@ CONTAINS
IF (in.EQ.0) CYCLE
phase = stars%rgphs(i1,i2,i3)
!+APW_LO
#ifdef CPP_APW
b1(1) = bkpt(1)+lapw%k1(i,ispin) ; b2(1) = bkpt(1)+lapw%k1(j,ispin)
b1(2) = bkpt(2)+lapw%k2(i,ispin) ; b2(2) = bkpt(2)+lapw%k2(j,ispin)
b1(3) = bkpt(3)+lapw%k3(i,ispin) ; b2(3) = bkpt(3)+lapw%k3(j,ispin)
r2 = DOT_PRODUCT(MATMUL(b2,cell%bbmat),b1)
th = phase*(0.5*r2*stars%ustep(in)+vpw(in))
#else
th = phase* (0.25* (lapw%rk(i,ispin)**2+lapw%rk(j,ispin)**2)*stars%ustep(in) + vpw(in))
#endif
IF (input%l_useapw) THEN
b1(1) = bkpt(1)+lapw%k1(i,ispin) ; b2(1) = bkpt(1)+lapw%k1(j,ispin)
b1(2) = bkpt(2)+lapw%k2(i,ispin) ; b2(2) = bkpt(2)+lapw%k2(j,ispin)
b1(3) = bkpt(3)+lapw%k3(i,ispin) ; b2(3) = bkpt(3)+lapw%k3(j,ispin)
r2 = DOT_PRODUCT(MATMUL(b2,cell%bbmat),b1)
th = phase*(0.5*r2*stars%ustep(in)+vpw(in))
ELSE
th = phase* (0.25* (lapw%rk(i,ispin)**2+lapw%rk(j,ispin)**2)*stars%ustep(in) + vpw(in))
ENDIF
!-APW_LO
!---> determine matrix element and store
ts = phase*stars%ustep(in)
......@@ -182,16 +183,16 @@ CONTAINS
ELSE
phase = stars%rgphs(i1,i2,i3)
!+APW_LO
#ifdef CPP_APW
b1(1) = bkpt(1)+lapw%k1(i,ispin) ; b2(1) = bkpt(1)+lapw%k1(j,ispin)
b1(2) = bkpt(2)+lapw%k2(i,ispin) ; b2(2) = bkpt(2)+lapw%k2(j,ispin)
b1(3) = bkpt(3)+lapw%k3(i,ispin) ; b2(3) = bkpt(3)+lapw%k3(j,ispin)
r2 = DOT_PRODUCT(MATMUL(b2,cell%bbmat),b1)
th = phase*( 0.5*r2*stars%ustep(in) + vpw(in) )
#else
th = phase* (0.25* (lapw%rk(i,ispin)**2+lapw%rk(j,ispin)**2)*stars%ustep(in) + vpw(in))
#endif
IF (input%l_useapw) THEN
b1(1) = bkpt(1)+lapw%k1(i,ispin) ; b2(1) = bkpt(1)+lapw%k1(j,ispin)
b1(2) = bkpt(2)+lapw%k2(i,ispin) ; b2(2) = bkpt(2)+lapw%k2(j,ispin)
b1(3) = bkpt(3)+lapw%k3(i,ispin) ; b2(3) = bkpt(3)+lapw%k3(j,ispin)
r2 = DOT_PRODUCT(MATMUL(b2,cell%bbmat),b1)
th = phase*( 0.5*r2*stars%ustep(in) + vpw(in) )
ELSE
th = phase* (0.25* (lapw%rk(i,ispin)**2+lapw%rk(j,ispin)**2)*stars%ustep(in) + vpw(in))
ENDIF
!-APW_LO
ts = phase*stars%ustep(in)
aa(ii) = th
......
eigen/hsmt_extra.F90
View file @ fdeca975
......@@ -248,11 +248,11 @@ CONTAINS
IF(l_socfirst) fjstart = isp
#ifndef CPP_INVERSION
CALL slomat(&
atoms, n,na,lapw,con1,n_size,n_rank, gk,rph,cph,&
input,atoms, n,na,lapw,con1,n_size,n_rank, gk,rph,cph,&
fj(:,0:,:,fjstart:), gj(:,0:,:,fjstart:),&
kvec,isp,usdus,alo1,blo1,clo1,noco, ab_dim,1,1,chi11,chi22,chi21,&
iilos,locols,nkvecprevats,bbhlp)
CALL hlomat(atoms,isp,isp,n_size,n_rank,&
CALL hlomat(input,atoms,isp,isp,n_size,n_rank,&
n,na,lapw,ar(:,0:,1),br(:,0:,1),ai(:,0:,1),bi(:,0:,1),&
el(:,n,isp),alo,blo,clo,usdus, noco,1,1,chi11,chi22,chi21,&
iiloh,locolh,nkvecprevath,tlmplm,aahlp)
......@@ -261,11 +261,11 @@ CONTAINS
jd = 1 ; IF (noco%l_noco) jd = isp
DO iintsp = 1,nintsp
DO jintsp = 1,nintsp
CALL slomat(atoms,n,na,lapw,con1,n_size,n_rank,&
CALL slomat(input,atoms,n,na,lapw,con1,n_size,n_rank,&
gk,rph,cph,fj,gj, kvec,isp,usdus,alo1,blo1,clo1,noco,&
ab_dim,iintsp,jintsp,chi11,chi22,chi21,&
iilos,locols,nkvecprevats,bb)
CALL hlomat(atoms,isp,jd,n_size,n_rank,&
CALL hlomat(input,atoms,isp,jd,n_size,n_rank,&
n,na,lapw,ar(:,0:,jintsp),br(:,0:,jintsp),ai(:,0:,jintsp),bi(:,0:,jintsp),&
el(:,n,isp),alo,blo,clo,usdus, noco,iintsp,jintsp,chi11,chi22,chi21,&
iiloh,locolh,nkvecprevath,tlmplm,aa)
......
eigen/hsmt_fjgj.F90
View file @ fdeca975
......@@ -7,7 +7,7 @@ MODULE m_hsmt_fjgj
use m_juDFT
implicit none
CONTAINS
SUBROUTINE hsmt_fjgj(atoms,isp,noco,l_socfirst,cell,nintsp, lapw,usdus,fj,gj)
SUBROUTINE hsmt_fjgj(input,atoms,isp,noco,l_socfirst,cell,nintsp, lapw,usdus,fj,gj)
!Calculate the fj&gj array which contain the part of the A,B matching coeff. depending on the
!radial functions at the MT boundary as contained in usdus
USE m_constants, ONLY : fpi_const
......@@ -15,6 +15,7 @@ CONTAINS
USE m_dsphbs
USE m_types
IMPLICIT NONE
TYPE(t_input),INTENT(IN) :: input
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_atoms),INTENT(IN) :: atoms
......@@ -43,9 +44,8 @@ CONTAINS
DO n = 1,atoms%ntype
DO l = 0,atoms%lmax(n)
apw(l)=any(atoms%l_dulo(:atoms%nlo(n),n))
#ifdef CPP_APW
IF (atoms%lapw_l(n).GE.l) apw(l) = .false.
#endif
IF ((input%l_useapw).AND.(atoms%lapw_l(n).GE.l)) apw(l) = .false.
ENDDO