Commit ed1b48ad authored by Miriam Hinzen's avatar Miriam Hinzen

Merge branch 'develop' into kerker

parents 5e9fa574 e1e66a44
......@@ -28,6 +28,9 @@ test-gfortran:
- build
script:
- ulimit -s unlimited ;export juDFT_MPI="mpirun -n 2 --allow-run-as-root ";cd /builds/fleur/fleur/build;ctest
artifacts:
paths:
- build/Testing/test.oldlogs
# only:
# - schedules
# - triggers
......
......@@ -493,7 +493,7 @@ CONTAINS
CMPLX(psi1r(stars%igq_fft(ik)),psi1i(stars%igq_fft(ik)))
ENDDO
DO istr = 1,stars%ng3_fft
CALL pwint(stars,atoms,sym, oneD,cell,stars%kv3(1,istr),x)
CALL pwint(stars,atoms,sym, oneD,cell,istr,x)
dos%qis(nu,ikpt,1) = dos%qis(nu,ikpt,1) + REAL(cwk(istr)*x)/cell%omtil/REAL(ifftq3)
ENDDO
......@@ -503,7 +503,7 @@ CONTAINS
CMPLX(psi2r(stars%igq_fft(ik)),psi2i(stars%igq_fft(ik)))
ENDDO
DO istr = 1,stars%ng3_fft
CALL pwint(stars,atoms,sym, oneD,cell, stars%kv3(1,istr), x)
CALL pwint(stars,atoms,sym, oneD,cell, istr, x)
dos%qis(nu,ikpt,input%jspins) = dos%qis(nu,ikpt,input%jspins) + REAL(cwk(istr)*x)/cell%omtil/REAL(ifftq3)
ENDDO
ENDIF
......
......@@ -70,7 +70,7 @@ CONTAINS
!+gu_con
IF (noco%l_noco) THEN
IF (noco%l_ss) THEN
ctmp = term1*CONJG(ylm(ll1+m+1))*ccchi(iintsp)*zMat%data_c(lapw%nv(1)+atoms%nlotot+nbasf,i)
ctmp = term1*CONJG(ylm(ll1+m+1))*ccchi(iintsp)*zMat%data_c((iintsp-1)*(lapw%nv(1)+atoms%nlotot)+nbasf,i)
ELSE
ctmp = term1*CONJG(ylm(ll1+m+1))*( ccchi(1)*zMat%data_c(nbasf,i)+ccchi(2)*zMat%data_c(lapw%nv(1)+atoms%nlotot+nbasf,i) )
ENDIF
......
......@@ -3,6 +3,7 @@ if (XXD_PROG)
ADD_CUSTOM_COMMAND(
OUTPUT ${CMAKE_SOURCE_DIR}/io/xml/inputSchema.h
COMMAND ${XXD_PROG} -i FleurInputSchema.xsd inputSchema.h
DEPENDS ${CMAKE_SOURCE_DIR}/io/xml/FleurInputSchema.xsd
WORKING_DIRECTORY ${CMAKE_SOURCE_DIR}/io/xml/
COMMENT "Putting current Schema into inputSchema.h")
else()
......@@ -11,4 +12,4 @@ else()
COMMAND mv ${CMAKE_SOURCE_DIR}/io/xml/inputSchema.h.backup ${CMAKE_SOURCE_DIR}/io/xml/inputSchema.h
COMMENT "No xxd found using backup")
message("No xxd command found! Using backup of inputSchema.h")
endif()
\ No newline at end of file
endif()
......@@ -30,23 +30,60 @@ IMPLICIT NONE
end subroutine chase_r
end interface
PRIVATE
INTEGER :: chase_eig_id
PUBLIC init_chase, chase_diag
CONTAINS
SUBROUTINE chase_diag(mpi,hmat,smat,ikpt,jsp,chase_eig_id,iter,ne,eig,zmat)
SUBROUTINE init_chase(mpi,dimension,input,atoms,kpts,noco,vacuum,banddos,l_real)
USE m_types
USE m_types_mpi
USE m_judft
USE m_eig66_io
IMPLICIT NONE
TYPE(t_mpi), INTENT(IN) :: mpi
TYPE(t_dimension), INTENT(IN) :: dimension
TYPE(t_input), INTENT(IN) :: input
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_kpts), INTENT(IN) :: kpts
TYPE(t_noco), INTENT(IN) :: noco
TYPE(t_vacuum), INTENT(IN) :: vacuum
TYPE(t_banddos), INTENT(IN) :: banddos
LOGICAL, INTENT(IN) :: l_real
INTEGER :: nevd, nexd
IF (juDFT_was_argument("-diag:chase")) THEN
nevd = min(dimension%neigd,dimension%nvd+atoms%nlotot)
nexd = min(max(nevd/4, 45),dimension%nvd+atoms%nlotot-nevd) !dimensioning for workspace
chase_eig_id=open_eig(mpi%mpi_comm,DIMENSION%nbasfcn,nevd+nexd,kpts%nkpt,DIMENSION%jspd,atoms%lmaxd,&
atoms%nlod,atoms%ntype,atoms%nlotot,noco%l_noco,.TRUE.,l_real,noco%l_soc,.FALSE.,&
mpi%n_size,layers=vacuum%layers,nstars=vacuum%nstars,ncored=DIMENSION%nstd,&
nsld=atoms%nat,nat=atoms%nat,l_dos=banddos%dos.OR.input%cdinf,l_mcd=banddos%l_mcd,&
l_orb=banddos%l_orb)
END IF
END SUBROUTINE init_chase
SUBROUTINE chase_diag(hmat,smat,ikpt,jsp,iter,ne,eig,zmat)
USE m_types
USE m_judft
USE iso_c_binding
USE m_eig66_io
!Simple driver to solve Generalized Eigenvalue Problem using the ChASE library
IMPLICIT NONE
TYPE(t_mpi), INTENT(IN) :: mpi
TYPE(t_mat), INTENT(INOUT) :: hmat,smat
INTEGER, INTENT(IN) :: ikpt
INTEGER, INTENT(IN) :: jsp
INTEGER, INTENT(IN) :: chase_eig_id
INTEGER, INTENT(IN) :: iter
INTEGER, INTENT(INOUT) :: ne
CLASS(t_mat), ALLOCATABLE, INTENT(OUT) :: zmat
......@@ -100,14 +137,14 @@ IMPLICIT NONE
if(iter.EQ.1) then
call chase_r(hmat%data_r, hmat%matsize1, zMatTemp%data_r, eigenvalues, nev, nex, 25, 1e-10, 'R', 'S' )
else
CALL read_eig(chase_eig_id,ikpt,jsp,n_start=mpi%n_size,n_end=mpi%n_rank,neig=nbands,eig=eigenvalues,zmat=zMatTemp)
CALL read_eig(chase_eig_id,ikpt,jsp,neig=nbands,eig=eigenvalues,zmat=zMatTemp)
call chase_r(hmat%data_r, hmat%matsize1, zMatTemp%data_r, eigenvalues, nev, nex, 25, 1e-10, 'A', 'S' )
end if
ne = nev
CALL write_eig(chase_eig_id,ikpt,jsp,nev+nex,nev+nex,&
eigenvalues(:(nev+nex)),n_start=mpi%n_size,n_end=mpi%n_rank,zmat=zMatTemp)
eigenvalues(:(nev+nex)),zmat=zMatTemp)
! --> recover the generalized eigenvectors z by solving z' = l^t * z
CALL dtrtrs('U','N','N',hmat%matsize1,nev,smat%data_r,smat%matsize1,zMatTemp%data_r,zmat%matsize1,info)
......@@ -155,14 +192,14 @@ IMPLICIT NONE
if(iter.EQ.1) then
call chase_c(hmat%data_c, hmat%matsize1, zMatTemp%data_c, eigenvalues, nev, nex, 25, 1e-10, 'R', 'S' )
else
CALL read_eig(chase_eig_id,ikpt,jsp,n_start=mpi%n_size,n_end=mpi%n_rank,neig=nbands,eig=eigenvalues,zmat=zMatTemp)
CALL read_eig(chase_eig_id,ikpt,jsp,neig=nbands,eig=eigenvalues,zmat=zMatTemp)
call chase_c(hmat%data_c, hmat%matsize1, zMatTemp%data_c, eigenvalues, nev, nex, 25, 1e-10, 'A', 'S' )
end if
ne = nev
CALL write_eig(chase_eig_id,ikpt,jsp,nev+nex,nev+nex,&
eigenvalues(:(nev+nex)),n_start=mpi%n_size,n_end=mpi%n_rank,zmat=zMatTemp)
eigenvalues(:(nev+nex)),zmat=zMatTemp)
! --> recover the generalized eigenvectors z by solving z' = l^t * z
CALL ztrtrs('U','N','N',hmat%matsize1,nev,smat%data_c,smat%matsize1,zMatTemp%data_c,zmat%matsize1,info)
......
......@@ -39,25 +39,22 @@ CONTAINS
parallel_solver_available=any((/diag_elpa,diag_elemental,diag_scalapack/)>0)
END FUNCTION parallel_solver_available
SUBROUTINE eigen_diag(mpi,hmat,smat,ikpt,jsp,chase_eig_id,iter,ne,eig,ev)
SUBROUTINE eigen_diag(hmat,smat,ikpt,jsp,iter,ne,eig,ev)
USE m_lapack_diag
USE m_magma
USE m_elpa
USE m_scalapack
USE m_elemental
USE m_chase_diag
USE m_types_mpi
USE m_types_mpimat
IMPLICIT NONE
#ifdef CPP_MPI
include 'mpif.h'
#endif
TYPE(t_mpi), INTENT(IN) :: mpi
CLASS(t_mat), INTENT(INOUT) :: smat,hmat
CLASS(t_mat), ALLOCATABLE, INTENT(OUT) :: ev
INTEGER, INTENT(IN) :: ikpt
INTEGER, INTENT(IN) :: jsp
INTEGER, INTENT(IN) :: chase_eig_id
INTEGER, INTENT(IN) :: iter
INTEGER, INTENT(INOUT) :: ne
REAL, INTENT(OUT) :: eig(:)
......@@ -86,7 +83,7 @@ CONTAINS
CALL lapack_diag(hmat,smat,ne,eig,ev)
CASE (diag_chase)
#ifdef CPP_CHASE
CALL chase_diag(mpi,hmat,smat,ikpt,jsp,chase_eig_id,iter,ne,eig,ev)
CALL chase_diag(hmat,smat,ikpt,jsp,iter,ne,eig,ev)
#else
CALL juDFT_error('ChASE eigensolver selected but not available', calledby = 'eigen_diag')
#endif
......
......@@ -19,7 +19,7 @@ CONTAINS
!> The matrices generated and diagonalized here are of type m_mat as defined in m_types_mat.
!>@author D. Wortmann
SUBROUTINE eigen(mpi,stars,sphhar,atoms,obsolete,xcpot,sym,kpts,DIMENSION,vacuum,input,&
cell,enpara,banddos,noco,oneD,hybrid,iter,eig_id,chase_eig_id,results,inden,v,vx)
cell,enpara,banddos,noco,oneD,hybrid,iter,eig_id,results,inden,v,vx)
USE m_constants, ONLY : pi_const,sfp_const
USE m_types
......@@ -69,7 +69,6 @@ CONTAINS
! .. Scalar Arguments ..
INTEGER,INTENT(IN) :: iter
INTEGER,INTENT(INOUT) :: eig_id
INTEGER,INTENT(INOUT) :: chase_eig_id
! ..
!-odim
!+odim
......@@ -163,7 +162,7 @@ CONTAINS
l_wu=.FALSE.
ne_all=DIMENSION%neigd
if (allocated(zmat)) deallocate(zmat)
CALL eigen_diag(mpi,hmat,smat,nk,jsp,chase_eig_id,iter,ne_all,eig,zMat)
CALL eigen_diag(hmat,smat,nk,jsp,iter,ne_all,eig,zMat)
DEALLOCATE(hmat,smat)
!
!---> output results
......
......@@ -105,7 +105,7 @@ CONTAINS
CALL hsmt_nonsph(n,mpi,sym,atoms,ispin,iintsp,jintsp,chi(iintsp,jintsp),noco,cell,&
lapw,td,fj(:,0:,ispin,:),gj(:,0:,ispin,:),hmat(iintsp,jintsp))
CALL hsmt_lo(input,atoms,sym,cell,mpi,noco,lapw,usdus,td,fj(:,0:,ispin,:),gj(:,0:,ispin,:),&
n,chi_one,ispin,iintsp,jintsp,hmat(iintsp,jintsp),smat(iintsp,jintsp))
n,chi(iintsp,jintsp),ispin,iintsp,jintsp,hmat(iintsp,jintsp),smat(iintsp,jintsp))
ENDDO
ENDDO
ENDIF
......
......@@ -127,12 +127,12 @@ CONTAINS
INTEGER:: nn,na,ab_size,l,ll,m,i,ii
COMPLEX,ALLOCATABLE:: ab(:,:),ab1(:,:),ab_select1(:,:),ab_select(:,:)
COMPLEX,ALLOCATABLE:: ab(:,:),ab1(:,:),ab_select(:,:)
real :: rchi
ALLOCATE(ab(MAXVAL(lapw%nv),2*atoms%lnonsph(n)*(atoms%lnonsph(n)+2)+2),ab1(lapw%nv(iintsp),2*atoms%lnonsph(n)*(atoms%lnonsph(n)+2)+2),ab_select(lapw%num_local_cols(jintsp),2*atoms%lnonsph(n)*(atoms%lnonsph(n)+2)+2))
IF (iintsp.NE.jintsp) ALLOCATE(ab_select1(lapw%num_local_cols(jintsp),2*atoms%lnonsph(n)*(atoms%lnonsph(n)+2)+2))
!IF (iintsp.NE.jintsp) ALLOCATE(ab_select1(lapw%num_local_cols(jintsp),2*atoms%lnonsph(n)*(atoms%lnonsph(n)+2)+2))
IF (hmat%l_real) THEN
IF (ANY(SHAPE(hmat%data_c)/=SHAPE(hmat%data_r))) THEN
......@@ -151,17 +151,16 @@ CONTAINS
!Calculate Hamiltonian
CALL zgemm("N","N",lapw%nv(iintsp),ab_size,ab_size,CMPLX(1.0,0.0),ab,SIZE(ab,1),td%h_loc(0:,0:,n,isp),SIZE(td%h_loc,1),CMPLX(0.,0.),ab1,SIZE(ab1,1))
!Cut out of ab1 only the needed elements here
ab_select=ab1(mpi%n_rank+1:lapw%nv(iintsp):mpi%n_size,:)
IF (iintsp==jintsp) THEN
!Cut out of ab1 only the needed elements here
ab_select=ab1(mpi%n_rank+1:lapw%nv(iintsp):mpi%n_size,:)
CALL zgemm("N","T",lapw%nv(iintsp),lapw%num_local_cols(jintsp),ab_size,CMPLX(rchi,0.0),CONJG(ab1),SIZE(ab1,1),ab_select,lapw%num_local_cols(jintsp),CMPLX(1.,0.0),hmat%data_c,SIZE(hmat%data_c,1))
CALL zgemm("N","T",lapw%nv(iintsp),lapw%num_local_cols(iintsp),ab_size,CMPLX(rchi,0.0),CONJG(ab1),SIZE(ab1,1),ab_select,lapw%num_local_cols(iintsp),CMPLX(1.,0.0),hmat%data_c,SIZE(hmat%data_c,1))
ELSE
!Second set of ab is needed
CALL hsmt_ab(sym,atoms,noco,isp,jintsp,n,na,cell,lapw,fj,gj,ab,ab_size,.TRUE.)
ab_select1=ab(mpi%n_rank+1:lapw%nv(jintsp):mpi%n_size,:)
CALL zgemm("N","N",lapw%num_local_cols(jintsp),ab_size,ab_size,CMPLX(1.0,0.0),ab_select1,SIZE(ab_select1,1),td%h_loc(:,:,n,isp),SIZE(td%h_loc,1),CMPLX(0.,0.),ab_select,SIZE(ab_select,1))
CALL zgemm("N","N",lapw%nv(iintsp),ab_size,ab_size,CMPLX(1.0,0.0),ab,SIZE(ab,1),td%h_loc(:,:,n,isp),SIZE(td%h_loc,1),CMPLX(0.,0.),ab1,SIZE(ab1,1))
!Multiply for Hamiltonian
CALL zgemm("N","t",lapw%nv(iintsp),lapw%num_local_cols(jintsp),ab_size,CMPLX(rchi,0.0),CONJG(ab1),SIZE(ab1,1),ab_select,SIZE(ab_select,1)*mpi%n_size,CMPLX(1.,0.0),hmat%data_c,SIZE(hmat%data_c,1))
CALL zgemm("N","t",lapw%nv(iintsp),lapw%num_local_cols(iintsp),ab_size,chi,conjg(ab1),SIZE(ab1,1),ab_select,lapw%num_local_cols(iintsp),CMPLX(1.,0.0),hmat%data_c,SIZE(hmat%data_c,1))
ENDIF
ENDIF
END DO
......
......@@ -118,8 +118,10 @@
pkpt( : ,kpts%nkpt3(2)+1, : ) = pkpt(:,1,:)
pkpt( : , : ,kpts%nkpt3(3)+1) = pkpt(:,:,1)
IF(any(pkpt.eq.0))
&STOP 'kptgen: Definition of pkpt-pointer failed.'
IF(any(pkpt.eq.0)) THEN
CALL juDFT_error('kptgen: Definition of pkpt-pointer failed.',
& calledby='kptgen_hybrid')
END IF
iarr = 1
ldum = .false.
DO i = 1,nkpt
......
......@@ -85,11 +85,8 @@
! REAL, PARAMETER :: eps=0.00000001
! ..
!HF added for HF and hybrid functionals
REAL :: gcutm,tolerance
REAL :: taual_hyb(3,atoms%nat)
INTEGER :: selct(4,atoms%ntype),lcutm(atoms%ntype)
INTEGER :: selct2(4,atoms%ntype)
INTEGER :: bands
INTEGER :: bands
LOGICAL :: l_gamma
INTEGER :: nkpt3(3)
!HF
......@@ -295,18 +292,9 @@
ENDIF
!HF added for HF and hybrid functionals
gcutm = input%rkmax - 0.5
tolerance = 1e-4
hybrid%gcutm1 = input%rkmax - 0.5
hybrid%tolerance1 = 1e-4
taual_hyb = atoms%taual
selct(1,:) = 4
selct(2,:) = 0
selct(3,:) = 4
selct(4,:) = 2
lcutm = 4
selct2(1,:) = 4
selct2(2,:) = 0
selct2(3,:) = 4
selct2(4,:) = 2
ALLOCATE(hybrid%lcutwf(atoms%ntype))
ALLOCATE(hybrid%lcutm1(atoms%ntype))
ALLOCATE(hybrid%select1(4,atoms%ntype))
......@@ -319,25 +307,28 @@
hybrid%select1(3,:) = 4
hybrid%select1(4,:) = 2
bands = max( nint(input%zelec)*10, 60 )
nkpt3 = (/ 4, 4, 4 /)
l_gamma = .false.
IF ( l_hyb ) THEN
input%ellow = input%ellow - 2.0
input%elup = input%elup + 10.0
input%gw_neigd = bands
l_gamma = .true.
hybrid%l_hybrid = l_hyb
IF (l_hyb) THEN
input%ellow = input%ellow - 2.0
input%elup = input%elup + 10.0
input%gw_neigd = bands
l_gamma = .true.
IF(juDFT_was_argument("-old")) THEN
CALL juDFT_error('No hybrid functionals input for old input file implemented', calledby='set_inp')
END IF
ELSE
input%gw_neigd = 0
END IF
!HF
! rounding
atoms%rmt(:) = real(NINT( atoms%rmt(:) * 100 ) / 100.)
atoms%dx(:) = real(NINT( atoms%dx(:) * 1000) / 1000.)
stars%gmax = real(NINT( stars%gmax * 10 ) / 10.)
input%rkmax = real(NINT( input%rkmax * 10 ) / 10.)
xcpot%gmaxxc = real(NINT( xcpot%gmaxxc * 10 ) / 10.)
gcutm = real(INT( gcutm * 10 ) / 10.)
atoms%rmt(:) = real(NINT(atoms%rmt(:) * 100 ) / 100.)
atoms%dx(:) = real(NINT(atoms%dx(:) * 1000) / 1000.)
stars%gmax = real(NINT(stars%gmax * 10 ) / 10.)
input%rkmax = real(NINT(input%rkmax * 10 ) / 10.)
xcpot%gmaxxc = real(NINT(xcpot%gmaxxc * 10 ) / 10.)
hybrid%gcutm1 = real(NINT(hybrid%gcutm1 * 10 ) / 10.)
IF (input%film) THEN
vacuum%dvac = real(NINT(vacuum%dvac*100)/100.)
dtild = real(NINT(dtild*100)/100.)
......@@ -432,6 +423,17 @@
kpts%nkpt = kpts%nkpt3(1) * kpts%nkpt3(2) * kpts%nkpt3(3)
END IF
IF (l_hyb) THEN
! Changes for hybrid functionals
input%isec1 = 999
namex = 'hse '
input%frcor = .true. ; input%ctail = .false. ; atoms%l_geo = .false.
input%itmax = 15 ; input%maxiter = 25!; input%imix = 17
IF (ANY(kpts%nkpt3(:).EQ.0)) kpts%nkpt3(:) = 4
div(:) = kpts%nkpt3(:)
kpts%specificationType = 2
END IF
IF(.NOT.juDFT_was_argument("-old")) THEN
nkptOld = kpts%nkpt
latnamTemp = cell%latnam
......@@ -445,12 +447,15 @@
IF(l_explicit) THEN
! kpts generation
kpts%l_gamma = l_gamma
sym%symSpecType = 3
CALL kpoints(oneD,sym,cell,input,noco,banddos,kpts,l_kpts)
kpts%specificationType = 3
IF (l_hyb) kpts%specificationType = 2
END IF
IF(l_explicit) THEN
sym%symSpecType = 3
!set latnam to any
cell%latnam = 'any'
......@@ -507,26 +512,23 @@
CLOSE (6)
IF (atoms%ntype.GT.999) THEN
WRITE(*,*) 'More than 999 atom types -> no conventional inp file generated!'
WRITE(*,*) 'Use inp.xml file instead!'
ELSE IF (juDFT_was_argument("-old")) THEN
IF (juDFT_was_argument("-old")) THEN
IF (atoms%ntype.GT.999) THEN
CALL juDFT_error('More than 999 atom types only work with the inp.xml input file',calledby='set_inp')
END IF
IF (kpts%specificationType.EQ.4) THEN
CALL juDFT_error('No k point set specification by density supported for old inp file',&
calledby = 'set_inp')
END IF
CALL rw_inp(&
& ch_rw,atoms,obsolete,vacuum,input,stars,sliceplot,banddos,&
& cell,sym,xcpot,noco,oneD,hybrid,kpts,&
& noel,namex,relcor,a1,a2,a3,dtild,input%comment)
CALL rw_inp(ch_rw,atoms,obsolete,vacuum,input,stars,sliceplot,banddos,&
cell,sym,xcpot,noco,oneD,hybrid,kpts,&
noel,namex,relcor,a1,a2,a3,dtild,input%comment)
iofile = 6
OPEN (iofile,file='inp',form='formatted',status='old',position='append')
IF( l_hyb ) THEN
WRITE (iofile,FMT=9999) product(nkpt3),nkpt3,l_gamma
ELSE IF( (div(1) == 0).OR.(div(2) == 0) ) THEN
IF((div(1) == 0).OR.(div(2) == 0)) THEN
WRITE (iofile,'(a5,i5)') 'nkpt=',kpts%nkpt
ELSE
WRITE (iofile,'(a5,i5,3(a4,i2))') 'nkpt=',kpts%nkpt,',nx=',div(1),',ny=',div(2),',nz=',div(3)
......@@ -535,34 +537,6 @@
CLOSE (iofile)
END IF
iofile = 6
!HF create hybrid functional input file
IF ( l_hyb ) THEN
OPEN (iofile,file='inp_hyb',form='formatted',status='new',&
& iostat=iostat)
IF (iostat /= 0) THEN
STOP &
& 'Cannot create new file "inp_hyb". Maybe it already exists?'
ENDIF
! Changes for hybrid functionals
input%strho = .false. ; input%isec1 = 999
namex = 'hse '
input%frcor = .true. ; input%ctail = .false. ; atoms%l_geo = .false.
input%itmax = 15 ; input%maxiter = 25 ; input%imix = 17
CALL rw_inp(&
& ch_rw,atoms,obsolete,vacuum,input,stars,sliceplot,banddos,&
& cell,sym,xcpot,noco,oneD,hybrid,kpts,&
& noel,namex,relcor,a1,a2,a3,dtild,input%comment)
IF ( ALL(div /= 0) ) nkpt3 = div
WRITE (iofile,FMT=9999) product(nkpt3),nkpt3,l_gamma
9999 FORMAT ( 'nkpt=',i5,',nx=',i2,',ny=',i2,',nz=',i2,',gamma=',l1)
CLOSE (iofile)
END IF ! l_hyb
DEALLOCATE(hybrid%lcutwf)
!HF
END SUBROUTINE set_inp
END MODULE m_setinp
......@@ -1135,7 +1135,7 @@ SUBROUTINE r_inpXML(&
END IF
hybrid%l_hybrid=xcpot%is_hybrid()
IF (hybrid%l_hybrid) ALLOCATE(hybrid%lcutm1(atoms%ntype),hybrid%lcutwf(atoms%ntype),hybrid%select1(4,atoms%ntype))
ALLOCATE(hybrid%lcutm1(atoms%ntype),hybrid%lcutwf(atoms%ntype),hybrid%select1(4,atoms%ntype))
obsolete%lwb=.FALSE.
IF (xcpot%is_gga()) THEN
......@@ -1148,17 +1148,16 @@ SUBROUTINE r_inpXML(&
END IF
!!! Hybrid stuff
numberNodes = xmlGetNumberOfNodes('/fleurInput/xcFunctional/hybridFunctional')
!!! Mixed product basis stuff
numberNodes = xmlGetNumberOfNodes('/fleurInput/calculationSetup/prodBasis')
IF (numberNodes==0) THEN
IF (hybrid%l_hybrid) CALL judft_error("Hybrid input missing in inp.xml")
IF (hybrid%l_hybrid) CALL judft_error("Mixed product basis input missing in inp.xml")
ELSE
IF (.NOT.hybrid%l_hybrid) CALL judft_error("Hybrid parameters specified but no hybrid functional used")
hybrid%gcutm1=evaluateFirstOnly(xmlGetAttributeValue('/fleurInput/xcFunctional/hybridFunctional/@gcutm'))
hybrid%tolerance1=evaluateFirstOnly(xmlGetAttributeValue('/fleurInput/xcFunctional/hybridFunctional/@tolerance'))
hybrid%ewaldlambda=evaluateFirstOnly(xmlGetAttributeValue('/fleurInput/xcFunctional/hybridFunctional/@ewaldlambda'))
hybrid%lexp=evaluateFirstOnly(xmlGetAttributeValue('/fleurInput/xcFunctional/hybridFunctional/@lexp'))
hybrid%bands1=evaluateFirstOnly(xmlGetAttributeValue('/fleurInput/xcFunctional/hybridFunctional/@bands'))
hybrid%gcutm1=evaluateFirstOnly(xmlGetAttributeValue('/fleurInput/calculationSetup/prodBasis/@gcutm'))
hybrid%tolerance1=evaluateFirstOnly(xmlGetAttributeValue('/fleurInput/calculationSetup/prodBasis/@tolerance'))
hybrid%ewaldlambda=evaluateFirstIntOnly(xmlGetAttributeValue('/fleurInput/calculationSetup/prodBasis/@ewaldlambda'))
hybrid%lexp=evaluateFirstIntOnly(xmlGetAttributeValue('/fleurInput/calculationSetup/prodBasis/@lexp'))
hybrid%bands1=evaluateFirstIntOnly(xmlGetAttributeValue('/fleurInput/calculationSetup/prodBasis/@bands'))
ENDIF
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
......
......@@ -196,6 +196,10 @@ SUBROUTINE w_inpXML(&
150 FORMAT(' <soc theta="',f0.8,'" phi="',f0.8,'" l_soc="',l1,'" spav="',l1,'"/>')
WRITE (fileNum,150) noco%theta,noco%phi,noco%l_soc,noco%l_spav
IF (l_explicit.OR.hybrid%l_hybrid) THEN
155 FORMAT(' <prodBasis gcutm="',f0.8,'" tolerance="',f0.8,'" ewaldlambda="',i0,'" lexp="',i0,'" bands="',i0,'"/>')
WRITE (fileNum,155) hybrid%gcutm1,hybrid%tolerance1,hybrid%ewaldlambda,hybrid%lexp,hybrid%bands1
END IF
IF (l_nocoOpt.OR.l_explicit) THEN
160 FORMAT(' <nocoParams l_ss="',l1,'" l_mperp="',l1,'" l_constr="',l1,&
......@@ -451,6 +455,13 @@ SUBROUTINE w_inpXML(&
WRITE (fileNum,321) enpara%qn_el(0:3,iAtomType,1)
END IF
IF(l_explicit.OR.hybrid%l_hybrid) THEN
315 FORMAT(' <prodBasis lcutm="',i0,'" lcutwf="',i0,'" select="',a,'"/>')
line = ''
WRITE(line,'(i0,1x,i0,1x,i0,1x,i0)') hybrid%select1(1:4,iAtomType)
WRITE (fileNum,315) hybrid%lcutm1(iAtomType), hybrid%lcutwf(iAtomType), TRIM(ADJUSTL(line))
END IF
IF(ANY(xmlElectronStates(:,iAtomType).NE.noState_const)) THEN
endCoreStates = 1
startCoreStates = 1
......
......@@ -44,6 +44,7 @@
<xsd:element name="coreElectrons" type="CoreElectronsType"/>
<xsd:element name="magnetism" type="MagnetismType"/>
<xsd:element name="bzIntegration" type="BZIntegrationType"/>
<xsd:element maxOccurs="1" minOccurs="0" name="prodBasis" type="ProdBasisIRType"/>
<xsd:element maxOccurs="1" minOccurs="0" name="soc" type="SOCType"/>
<xsd:element maxOccurs="1" minOccurs="0" name="nocoParams" type="NocoParamsType"/>
<xsd:element maxOccurs="1" minOccurs="0" name="oneDParams" type="OneDParamType"/>
......@@ -268,22 +269,19 @@
<xsd:element maxOccurs="1" minOccurs="0" name="libXC" type="XCLibXCType"/>
<xsd:element maxOccurs="1" minOccurs="0" name="xcParams" type="XCParamsType"/>
<xsd:element maxOccurs="1" minOccurs="0" name="ggaPrinting" type="GGAPrintingType"/>
<xsd:element maxOccurs="1" minOccurs="0" name="hybridFunctional" type="HybFunctionalType"/>
</xsd:sequence>
<xsd:attribute name="name" type="XCFunctionalEnum" use="required"/>
<xsd:attribute default="F" name="relativisticCorrections" type="FleurBool" use="optional"/>
</xsd:complexType>
<xsd:complexType name="HybFunctionalType">
<xsd:attribute name="gcutm" type="xsd:integer" use="required"/>
<xsd:complexType name="ProdBasisIRType">
<xsd:attribute name="gcutm" type="xsd:double" use="required"/>
<xsd:attribute name="bands" type="xsd:integer" use="required"/>
<xsd:attribute name="tolerance" type="xsd:double" use="optional" default="0.00001"/>
<xsd:attribute name="lexp" type="xsd:integer" use="optional" default="16"/>
<xsd:attribute name="ewaldlambda" type="xsd:integer" use="optional" default="3"/>
</xsd:complexType>
<xsd:simpleType name="XCFunctionalEnum">
<xsd:restriction base="xsd:string">
<xsd:enumeration value="x-a"/>
......@@ -335,7 +333,7 @@
</xsd:sequence>
</xsd:complexType>
<xsd:complexType name="ProdBasisType">
<xsd:complexType name="ProdBasisMTType">
<xsd:attribute name="lcutm" type="xsd:integer" use="required"/>
<xsd:attribute name="lcutwf" type="xsd:integer" use="required"/>
<xsd:attribute name="select" type="xsd:string" use="optional" default="4 0 4 2"/>
......@@ -360,7 +358,7 @@
<xsd:element name="mtSphere" type="MTSphereType"/>
<xsd:element name="atomicCutoffs" type="AtomicCutoffsType"/>
<xsd:element maxOccurs="1" minOccurs="0" name="energyParameters" type="EnergyParametersType"/>
<xsd:element maxOccurs="1" minOccurs="0" name="prodBasis" type="ProdBasisType"/>
<xsd:element maxOccurs="1" minOccurs="0" name="prodBasis" type="ProdBasisMTType"/>
<xsd:element maxOccurs="1" minOccurs="0" name="special" type="SpecialType"/>
<xsd:element maxOccurs="1" minOccurs="0" name="force" type="ForceType"/>
<xsd:element maxOccurs="1" minOccurs="0" name="electronConfig" type="ElectronConfigType"/>
......
......@@ -69,6 +69,7 @@ CONTAINS
USE m_mpi_bc_potden
#endif
USE m_eig66_io, ONLY : open_eig, close_eig
USE m_chase_diag
IMPLICIT NONE
INTEGER,INTENT(IN) :: mpi_comm
......@@ -101,9 +102,9 @@ CONTAINS
CLASS(t_forcetheo),ALLOCATABLE:: forcetheo
! .. Local Scalars ..
INTEGER:: eig_id,chase_eig_id, archiveType
INTEGER:: n,it,ithf,nevd,nexd
LOGICAL:: l_opti,l_cont,l_qfix, l_wann_inp, l_real
INTEGER:: eig_id, archiveType
INTEGER:: n,it,ithf
LOGICAL:: l_opti,l_cont,l_qfix, l_wann_inp
REAL :: fermiEnergyTemp, fix
#ifdef CPP_MPI
INCLUDE 'mpif.h'
......@@ -135,17 +136,9 @@ CONTAINS
!-Wannier
l_real = sym%invs.AND..NOT.noco%l_noco
IF (juDFT_was_argument("-diag:chase")) THEN