Commit d14979f7 authored by Gregor Michalicek's avatar Gregor Michalicek

Merge branch 'develop' into wannier_patrick

parents 626f83d4 03b7c479
......@@ -2,9 +2,9 @@
if (${CMAKE_Fortran_COMPILER_ID} MATCHES "Intel")
message("Intel Fortran detected")
if (${CMAKE_Fortran_COMPILER_VERSION} VERSION_LESS "14.1.0.0")
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -mkl -r8 -openmp")
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -mkl -r8 -openmp -assume byterecl")
else()
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -mkl -r8 -qopenmp")
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -mkl -r8 -qopenmp -assume byterecl")
endif()
set(CMAKE_Fortran_FLAGS_RELEASE "${CMAKE_Fortran_FLAGS_RELEASE} -xHost -O2")
set(CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_DEBUG} -C -traceback -O0 -g -ftrapuv -check uninit -check pointers -CB ")
......
/*
Copyright (c) 2014, Daniel Wortmann
All rights reserved.
This file provides an interface from FLEUR to Elemental
*/
#include "elemental.hpp"
using namespace std;
using namespace elem;
// Typedef our real or complex types to 'C' for convenience
#ifdef CPP_INVERSION
typedef double C;
#else
typedef Complex<double> C;
#endif
class global_data {
public:
Grid *g;
mpi::Comm mpi_comm;
int matrix_dimension;
DistMatrix<C> *H_mat,*S_mat;
DistMatrix<C,STAR,VC> eigenvectors;
DistMatrix<double,VC,STAR> eigenvalues;
};
//Global variables
static global_data *gd;
DistMatrix<C>* fleur_matrix(int n,C* buffer)
{
// Create the distributed matrix
DistMatrix<C,STAR,VC> *mat;
// The Matrix should be a n x n matrix in 1-D cyclic distribution
mat= new DistMatrix<C,STAR,VC>(n,n,*(gd->g));
C* localbuffer=mat->Buffer(); // this is the local buffer of the matrix
const int buffersize1=mat->LocalWidth();
const int buffersize2=mat->LocalHeight();
int localindex=0;
int fleur_index=0;
// Now copy all the data into local buffer to initialize the matrix
// Loop over columns of local data
for (int i=mpi::CommRank(gd->mpi_comm);i<n;i+=mpi::CommSize(gd->mpi_comm))
{
for (int j=0;j<=i;j++)
{
localbuffer[localindex++]=buffer[fleur_index++];
}
// further Off-diagonal elements are set to zero !Probably not needed
for (int j=0;j<n-i-1;j++)
{
localbuffer[localindex++]=0.0;
}
}
DistMatrix<C> *mat2=new DistMatrix<C>(*mat);
delete mat;
//*mat2=*mat;
return mat2;
}
extern "C"{
void fl_el_initialize(int n, C* hbuf, C* sbuf, int mpi_used_comm)
// Set the two matrices
{
// Initialize the Library
int argc=0; char** argv;
Initialize( argc, argv );
//Store the matrix dimension& the mpi_communicator
gd = new global_data;
gd->mpi_comm=MPI_Comm_f2c(mpi_used_comm);
gd->matrix_dimension=n;
// First we need a mpi-grid
gd->g= new Grid(gd->mpi_comm);
// Store the Matrices
gd->H_mat=fleur_matrix(n,hbuf);
gd->S_mat=fleur_matrix(n,sbuf);
}
void fl_el_diagonalize(int no_of_eigenpairs)
// Diagonalize the Matrix and return the number of local eigenvalues
{
/* this is for the development version
// The subset determines the no of eigenvalues found
HermitianEigSubset<double> subset;
subset.indexSubset=true;
subset.lowerIndex=0;
subset.upperIndex=no_of_global_eigenpairs;
// Space for eigenvalues
DistMatrix<double> eigenval(g);
DistMatrix<C> eigenvec(g);
//default sorting
const SortType sort = static_cast<SortType>(0);
//call diagonalization
HermitianGenDefEig( AXBX, LOWER, H_mat, S_mat, eigenval, eigenvec, sort, subset );
*/
DistMatrix<double, VR, STAR> eigenval(*(gd->g));
DistMatrix<C> evec(*(gd->g));
HermitianGenDefiniteEigType eigtype=AXBX;
UpperOrLower uplo=UPPER;
if (mpi::CommRank(gd->mpi_comm)==0) {
cout<<"H/S-matrix of size "<<gd->matrix_dimension<<endl;
}
Display(*(gd->H_mat));
Display(*(gd->S_mat));
HermitianGenDefiniteEig(eigtype, uplo, *(gd->H_mat), *(gd->S_mat), eigenval, evec,0,no_of_eigenpairs);
//redistribute matrices
//eigenvalues are of type DistMatrix(C,STAR,VC);
gd->eigenvalues=eigenval;
gd->eigenvectors=evec;
no_of_eigenpairs=gd->eigenvectors.LocalWidth();
}
void fl_el_eigenvalues(int neig, double* eig){
//Return the eigenvalues
double* buf=gd->eigenvalues.Buffer();
if (neig > gd->eigenvalues.LocalWidth()*gd->eigenvalues.LocalHeight())
{
cerr<<"Error in dimensions in fleur_elemental\n";
}
for (int i=0; i<neig;i++){
eig[i]=buf[i];
}
}
void fl_el_eigenvectors(int neig, double* eig, C* eigvec){
//Return all the local eigenvectors&eigenvalues
double* eigbuf=gd->eigenvalues.Buffer();
Display(gd->eigenvalues);
Display(gd->eigenvectors);
C* eigbuff=gd->eigenvectors.Buffer();
int local_index=0;
for (int i=0; i<neig;i++)
{
//Copy eigenvalue
int pe=mpi::CommRank(gd->mpi_comm);
int in=i*mpi::CommSize(gd->mpi_comm)+pe;
cout<< "PE:"<<pe<<":"<<i<<"->"<<in<<endl;
eig[i]=eigbuf[i];
//Copy eigenvector
for (int j=0;j<gd->matrix_dimension; j++){
eigvec[local_index]=eigbuff[local_index];
local_index++;
}
}
}
}
......@@ -214,7 +214,7 @@ CONTAINS
CALL rw_inp('r',atoms_temp,obsolete_temp,vacuum_temp,input_temp,stars_temp,sliceplot_temp,&
banddos_temp,cell_temp,sym_temp,xcpot_temp,noco_temp,Jij_temp,oneD_temp,hybrid_temp,&
kpts_temp,noel_temp,namex_temp,relcor_temp,a1_temp,a2_temp,a3_temp,scale_temp,dtild_temp,&
kpts_temp,noel_temp,namex_temp,relcor_temp,a1_temp,a2_temp,a3_temp,dtild_temp,&
input_temp%comment)
input_temp%l_f = input%l_f
input_temp%tkb = input%tkb
......@@ -224,7 +224,7 @@ CONTAINS
vacuum_temp = vacuum
CALL rw_inp('W',atoms_new,obsolete_temp,vacuum_temp,input_temp,stars_temp,sliceplot_temp,&
banddos_temp,cell_temp,sym_temp,xcpot_temp,noco_temp,Jij_temp,oneD_temp,hybrid_temp,&
kpts_temp,noel_temp,namex_temp,relcor_temp,a1_temp,a2_temp,a3_temp,scale_temp,a3_temp(3),&
kpts_temp,noel_temp,namex_temp,relcor_temp,a1_temp,a2_temp,a3_temp,a3_temp(3),&
input_temp%comment)
ELSE
......@@ -236,7 +236,7 @@ CONTAINS
CALL r_inpXML(atoms_temp,obsolete_temp,vacuum_temp,input_temp,stars_temp,sliceplot_temp,&
banddos_temp,dimension_temp,cell_temp,sym_temp,xcpot_temp,noco_temp,Jij_temp,&
oneD_temp,hybrid_temp,kpts_temp,enpara_temp,coreSpecInput_temp,wann_temp,noel_temp,&
namex_temp,relcor_temp,a1_temp,a2_temp,a3_temp,scale_temp,dtild_temp,xmlElectronStates,&
namex_temp,relcor_temp,a1_temp,a2_temp,a3_temp,dtild_temp,xmlElectronStates,&
xmlPrintCoreStates,xmlCoreOccs,atomTypeSpecies,speciesRepAtomType,l_kpts_temp)
numSpecies = SIZE(speciesRepAtomType)
filename = 'inp_new.xml'
......@@ -247,7 +247,7 @@ CONTAINS
CALL w_inpXML(atoms_new,obsolete_temp,vacuum_temp,input_temp,stars_temp,sliceplot_temp,&
banddos_temp,cell_temp,sym_temp,xcpot_temp,noco_temp,jij_temp,oneD_temp,hybrid_temp,&
kpts_temp,kpts_temp%nkpt3,kpts_temp%l_gamma,noel_temp,namex_temp,relcor_temp,a1_temp,a2_temp,a3_temp,&
scale_temp,dtild_temp,input_temp%comment,xmlElectronStates,xmlPrintCoreStates,xmlCoreOccs,&
dtild_temp,input_temp%comment,xmlElectronStates,xmlPrintCoreStates,xmlCoreOccs,&
atomTypeSpecies,speciesRepAtomType,.FALSE.,filename,.TRUE.,numSpecies,enpara_temp)
DEALLOCATE(atomTypeSpecies,speciesRepAtomType)
DEALLOCATE(xmlElectronStates,xmlPrintCoreStates,xmlCoreOccs)
......
......@@ -556,7 +556,6 @@ MODULE m_types
REAL :: tkb
LOGICAL :: gauss
LOGICAL :: l_bmt
!INTEGER:: scale
INTEGER:: jspins
INTEGER:: kcrel
LOGICAL:: frcor
......@@ -574,6 +573,10 @@ MODULE m_types
LOGICAL:: sso_opt(2)
LOGICAL:: total
LOGICAL:: l_inpXML
REAL :: scaleCell
REAL :: scaleA1
REAL :: scaleA2
REAL :: scaleC
REAL :: ellow
REAL :: elup
REAL :: rkmax
......@@ -919,6 +922,7 @@ MODULE m_types
PROCEDURE :: init_potden_types
PROCEDURE :: init_potden_simple
GENERIC :: init=>init_potden_types,init_potden_simple
PROCEDURE :: resetPotDen
END TYPE t_potden
CONTAINS
SUBROUTINE usdus_init(ud,atoms,jsp)
......@@ -1010,5 +1014,21 @@ CONTAINS
pd%mmpMat = CMPLX(0.0,0.0)
END SUBROUTINE init_potden_simple
SUBROUTINE resetPotDen(pd)
IMPLICIT NONE
CLASS(t_potden),INTENT(INOUT) :: pd
pd%pw=CMPLX(0.0,0.0)
pd%mt=0.0
pd%vacz=0.0
pd%vacxy=CMPLX(0.0,0.0)
pd%cdom = CMPLX(0.0,0.0)
pd%cdomvz = CMPLX(0.0,0.0)
pd%cdomvxy = CMPLX(0.0,0.0)
pd%mmpMat = CMPLX(0.0,0.0)
END SUBROUTINE resetPotDen
END MODULE m_types
......@@ -57,7 +57,7 @@
!-------------------------------------------------------------------
! .. Local Scalars ..
REAL :: thetad,xa,epsdisp,epsforce ,rmtmax,arltv1,arltv2,arltv3
REAL :: s,r,d ,idsprs,scale
REAL :: s,r,d ,idsprs
INTEGER :: ok,ilo,n,nstate,i,j,na,n1,n2,jrc,nopd,symfh
INTEGER :: nmopq(3)
......@@ -116,7 +116,7 @@
CALL rw_inp('r',&
& atoms,obsolete,vacuum,input,stars,sliceplot,banddos,&
& cell,sym,xcpot,noco,jij,oneD,hybrid,kpts,&
& noel,namex,relcor,a1,a2,a3,scale)
& noel,namex,relcor,a1,a2,a3)
!---> pk non-collinear
!---> read the angle and spin-spiral information from nocoinp
......@@ -191,9 +191,9 @@
!
! ---> now, set the lattice harmonics, determine nlhd
!
cell%amat(:,1) = a1(:)*scale
cell%amat(:,2) = a2(:)*scale
cell%amat(:,3) = a3(:)*scale
cell%amat(:,1) = a1(:)*input%scaleCell
cell%amat(:,2) = a2(:)*input%scaleCell
cell%amat(:,3) = a3(:)*input%scaleCell
CALL inv3(cell%amat,cell%bmat,cell%omtil)
IF (input%film) cell%omtil = cell%omtil/cell%amat(3,3)*vacuum%dvac
!-odim
......@@ -259,17 +259,14 @@
CALL soc_sym(sym%nop,sym%mrot,noco%theta,noco%phi,cell%amat,error)
IF ( ANY(error(:)) ) THEN
WRITE(*,fmt='(1x)')
WRITE(*,fmt='(A)')&
& 'Symmetry incompatible with SOC spin-quantization axis ,'
WRITE(*,fmt='(A)')&
& 'do not perform self-consistent calculations !'
WRITE(*,fmt='(A)') 'Symmetry incompatible with SOC spin-quantization axis ,'
WRITE(*,fmt='(A)') 'do not perform self-consistent calculations !'
WRITE(*,fmt='(1x)')
IF ( input%eonly .or. (noco%l_soc.and.noco%l_ss) .or. input%gw.ne.0 ) THEN ! .or. .
CONTINUE
ELSE
IF (input%itmax>1) THEN
CALL juDFT_error("symmetry & SOC",calledby&
& ="dimen7")
CALL juDFT_error("symmetry & SOC",calledby ="dimen7")
ENDIF
ENDIF
ENDIF
......@@ -281,8 +278,7 @@
IF (noco%l_ss) THEN ! test symmetry for spin-spiral
ALLOCATE ( error(sym%nop) )
CALL ss_sym(sym%nop,sym%mrot,noco%qss,error)
IF ( ANY(error(:)) ) CALL juDFT_error("symmetry & SSDW",&
& calledby="dimen7")
IF ( ANY(error(:)) ) CALL juDFT_error("symmetry & SSDW", calledby="dimen7")
DEALLOCATE ( error )
ENDIF
!--- J<
......@@ -306,10 +302,8 @@
ENDIF
IF ( xcpot%gmaxxc .le. 10.0**(-6) ) THEN
WRITE (6,'(" xcpot%gmaxxc=0 : xcpot%gmaxxc=stars%gmax choosen as default",&
& " value")')
WRITE (6,'(" concerning memory, you may want to choose",&
& " a smaller value for stars%gmax")')
WRITE (6,'(" xcpot%gmaxxc=0 : xcpot%gmaxxc=stars%gmax choosen as default value")')
WRITE (6,'(" concerning memory, you may want to choose a smaller value for stars%gmax")')
xcpot%gmaxxc=stars%gmax
END IF
......@@ -324,17 +318,13 @@
n2=sym%nop2
sym%nop=1
sym%nop2=1
CALL julia(&
& sym,cell,input,noco,banddos,&
& kpts,.false.,.FALSE.)
CALL julia(sym,cell,input,noco,banddos,kpts,.false.,.FALSE.)
sym%nop=n1
sym%nop2=n2
ELSE IF(l_gamma .and. banddos%ndir .eq. 0) THEN
call judft_error("gamma swtich not supported in old inp file anymore",calledby="dimen7")
ELSE
CALL julia(&
& sym,cell,input,noco,banddos,&
& kpts,.false.,.FALSE.)
CALL julia(sym,cell,input,noco,banddos,kpts,.false.,.FALSE.)
ENDIF
ELSE
CALL od_kptsgen (kpts%nkpt)
......@@ -343,17 +333,15 @@
IF(input%gw.eq.2) THEN
INQUIRE(file='QGpsi',exist=l_kpts) ! Use QGpsi if it exists ot
IF(l_kpts) THEN
WRITE(6,*)&
& 'QGpsi exists and will be used to generate kpts-file'
OPEN (15,file='QGpsi',form='unformatted',status='old',&
& action='read')
WRITE(6,*) 'QGpsi exists and will be used to generate kpts-file'
OPEN (15,file='QGpsi',form='unformatted',status='old',action='read')
OPEN (41,file='kpts',form='formatted',status='unknown')
REWIND(41)
READ (15) kpts%nkpt
WRITE (41,'(i5,f20.10)') kpts%nkpt,1.0
DO n = 1, kpts%nkpt
READ (15) q
WRITE (41,'(4f10.5)') MATMUL(TRANSPOSE(cell%amat),q)/scale,1.0
WRITE (41,'(4f10.5)') MATMUL(TRANSPOSE(cell%amat),q)/input%scaleCell,1.0
READ (15)
ENDDO
CLOSE (15)
......@@ -372,17 +360,14 @@
l_tmp=(/noco%l_ss,noco%l_soc/)
noco%l_ss=.false.
noco%l_soc=.false.
CALL julia(&
& sym,cell,input,noco,banddos,&
& kpts,.true.,.FALSE.)
CALL julia(sym,cell,input,noco,banddos,kpts,.true.,.FALSE.)
noco%l_ss=l_tmp(1); noco%l_soc=l_tmp(2)
ENDIF
!
! now proceed as usual
!
CALL inpeig_dim(input,obsolete,cell,noco,oneD,jij,&
& kpts,dimension,stars)
CALL inpeig_dim(input,obsolete,cell,noco,oneD,jij,kpts,dimension,stars)
vacuum%layerd = max(vacuum%layerd,1)
dimension%nstd = max(dimension%nstd,30)
atoms%ntype = atoms%ntype
......@@ -390,18 +375,15 @@
atoms%nlod = max(atoms%nlod,2) ! for chkmt
dimension%jspd=input%jspins
CALL parawrite(&
& sym,stars,atoms,sphhar,dimension,vacuum,obsolete,&
& kpts,oneD)
CALL parawrite(sym,stars,atoms,sphhar,dimension,vacuum,obsolete,kpts,oneD)
!
DEALLOCATE( sym%mrot,sym%tau,&
& atoms%lmax,atoms%ntypsy,atoms%neq,atoms%nlhtyp,atoms%rmt,atoms%zatom,atoms%jri,atoms%dx,atoms%nlo,atoms%llo,atoms%nflip,atoms%bmu,noel,&
& vacuum%izlay,atoms%ncst,atoms%lnonsph,atoms%taual,atoms%pos,atoms%nz,atoms%relax,&
& atoms%l_geo,noco%soc_opt,noco%alph,noco%beta,atoms%lda_u,noco%l_relax,jij%l_magn,jij%M,noco%b_con,sphhar%clnu,sphhar%nlh,&
& sphhar%llh,sphhar%nmem,sphhar%mlh,jij%magtype,jij%nmagtype,hybrid%select1,hybrid%lcutm1,&
& hybrid%lcutwf)
!
RETURN
END SUBROUTINE dimen7
END MODULE m_dimen7
......@@ -194,14 +194,10 @@ CONTAINS
IF (l_kpts) WRITE (6,*) ' No fl7para-file found, '
WRITE (6,*) ' invoking dimen7... '
!call first_glance to generate k-points
CALL first_glance(&
& n1,n2,n3,n5,n6,input%itmax,&
& l_kpts,l_qpts,ldum,n7,n8,n9,n10)
CALL dimen7(&
& input,sym,stars,atoms,sphhar,&
& dimension,vacuum,obsolete,kpts,&
& oneD,hybrid,Jij,cell)
CALL first_glance(n1,n2,n3,n5,n6,input%itmax,l_kpts,l_qpts,ldum,n7,n8,n9,n10)
CALL dimen7(input,sym,stars,atoms,sphhar,dimension,vacuum,obsolete,kpts,&
oneD,hybrid,Jij,cell)
ENDIF
! in case of a parallel calculation we have to broadcast
#ifdef CPP_MPI
......
......@@ -26,11 +26,9 @@
! *******************************************************
!
CONTAINS
SUBROUTINE inped( &
& atoms,obsolete,vacuum,&
& input,banddos,xcpot,sym,&
& cell,sliceplot,noco,&
& stars,oneD,jij,hybrid,kpts,scale,a1,a2,a3,namex,relcor)
SUBROUTINE inped(atoms,obsolete,vacuum,input,banddos,xcpot,sym,&
cell,sliceplot,noco,&
stars,oneD,jij,hybrid,kpts,a1,a2,a3,namex,relcor)
USE m_rwinp
USE m_chkmt
USE m_inpnoco
......@@ -56,7 +54,6 @@
TYPE(t_jij), INTENT(INOUT) :: jij
TYPE(t_hybrid), INTENT(INOUT) :: hybrid
TYPE(t_kpts), INTENT(INOUT) :: kpts
REAL, INTENT(OUT) :: scale
REAL, INTENT(OUT) :: a1(3)
REAL, INTENT(OUT) :: a2(3)
REAL, INTENT(OUT) :: a3(3)
......@@ -88,7 +85,7 @@
na = 0
CALL rw_inp('r',atoms,obsolete,vacuum,input,stars,sliceplot,banddos,&
cell,sym,xcpot,noco,jij,oneD,hybrid,kpts, noel,namex,relcor,a1,a2,a3,scale)
cell,sym,xcpot,noco,jij,oneD,hybrid,kpts, noel,namex,relcor,a1,a2,a3)
input%l_core_confpot=.TRUE. !this is the former CPP_CORE switch!
input%l_useapw=.FALSE. !this is the former CPP_APW switch!
......@@ -139,9 +136,9 @@
CALL juDFT_error("latnam",calledby ="inped")
ENDIF
dtild=a3(3)
IF (scale.EQ.0.) scale = 1.
vacuum%dvac = scale*vacuum%dvac
dtild = scale*dtild
IF (input%scaleCell.EQ.0.0) input%scaleCell = 1.0
vacuum%dvac = input%scaleCell*vacuum%dvac
dtild = input%scaleCell*dtild
!+odim
IF (.NOT.oneD%odd%d1) THEN
IF ((dtild-vacuum%dvac.LT.0.0).AND.input%film) THEN
......@@ -164,11 +161,11 @@
IF (vacuum%nmz>vacuum%nmzd) CALL juDFT_error("nmzd",calledby ="inped")
vacuum%nmzxy = vacuum%nmzxyd
IF (vacuum%nmzxy>vacuum%nmzxyd) CALL juDFT_error("nmzxyd",calledby ="inped")
a1(:) = scale*a1(:)
a2(:) = scale*a2(:)
a3(:) = scale*a3(:)
WRITE (6,FMT=8050) scale
WRITE (16,FMT=8050) scale
a1(:) = input%scaleCell*a1(:)
a2(:) = input%scaleCell*a2(:)
a3(:) = input%scaleCell*a3(:)
WRITE (6,FMT=8050) input%scaleCell
WRITE (16,FMT=8050) input%scaleCell
8050 FORMAT (' unit cell scaled by ',f10.6)
WRITE (6,FMT=8060) cell%z1
WRITE (16,FMT=8060) cell%z1
......@@ -349,7 +346,7 @@
!
!---> for films, the z-coordinates are given in absolute values:
!
IF (input%film) atoms%taual(3,na) = scale*atoms%taual(3,na)/a3(3)
IF (input%film) atoms%taual(3,na) = input%scaleCell*atoms%taual(3,na)/a3(3)
!
! Transform intern coordinates to cartesian:
!
......
......@@ -98,14 +98,14 @@ SUBROUTINE postprocessInput(mpi,input,sym,stars,atoms,vacuum,obsolete,kpts,&
DO iType = 1, atoms%ntype
IF (atoms%nlo(iType).GE.1) THEN
IF (input%secvar) THEN
CALL juDFT_error("LO + sevcar not implemented",calledby ="r_inpXML")
CALL juDFT_error("LO + sevcar not implemented",calledby ="postprocessInput")
END IF
IF (input%isec1<input%itmax) THEN
CALL juDFT_error("LO + Wu not implemented",calledby ="r_inpXML")
CALL juDFT_error("LO + Wu not implemented",calledby ="postprocessInput")
END IF
IF (atoms%nlo(iType).GT.atoms%nlod) THEN
WRITE (6,*) 'nlo(n) =',atoms%nlo(iType),' > nlod =',atoms%nlod
CALL juDFT_error("nlo(n)>nlod",calledby ="r_inpXML")
CALL juDFT_error("nlo(n)>nlod",calledby ="postprocessInput")
END IF
DO j=1,atoms%nlo(iType)
IF (.NOT.input%l_useapw) THEN
......@@ -116,7 +116,7 @@ SUBROUTINE postprocessInput(mpi,input,sym,stars,atoms,vacuum,obsolete,kpts,&
ENDIF
IF ( (atoms%llo(j,iType).GT.atoms%llod).OR.(mod(-atoms%llod,10)-1).GT.atoms%llod ) THEN
WRITE (6,*) 'llo(j,n) =',atoms%llo(j,iType),' > llod =',atoms%llod
CALL juDFT_error("llo(j,n)>llod",calledby ="r_inpXML")
CALL juDFT_error("llo(j,n)>llod",calledby ="postprocessInput")
END IF
END DO
......@@ -138,7 +138,7 @@ SUBROUTINE postprocessInput(mpi,input,sym,stars,atoms,vacuum,obsolete,kpts,&
END IF
endif
WRITE(6,'(A,I2,A,I2)') 'I use',atoms%ulo_der(ilo,iType),'. derivative of l =',atoms%llo(ilo,iType)
IF (atoms%llo(ilo,iType)>atoms%llod) CALL juDFT_error(" l > llod!!!",calledby="r_inpXML")
IF (atoms%llo(ilo,iType)>atoms%llod) CALL juDFT_error(" l > llod!!!",calledby="postprocessInput")
l = atoms%llo(ilo,iType)
IF (ilo.EQ.1) THEN
atoms%lo1l(l,iType) = ilo
......@@ -171,42 +171,42 @@ SUBROUTINE postprocessInput(mpi,input,sym,stars,atoms,vacuum,obsolete,kpts,&
END DO
IF (atoms%n_u.GT.0) THEN
IF (input%secvar) CALL juDFT_error("LDA+U and sevcar not implemented",calledby ="r_inpXML")
IF (input%isec1<input%itmax) CALL juDFT_error("LDA+U and Wu not implemented",calledby ="r_inpXML")
IF (noco%l_mperp) CALL juDFT_error("LDA+U and l_mperp not implemented",calledby ="r_inpXML")
IF (input%secvar) CALL juDFT_error("LDA+U and sevcar not implemented",calledby ="postprocessInput")
IF (input%isec1<input%itmax) CALL juDFT_error("LDA+U and Wu not implemented",calledby ="postprocessInput")
IF (noco%l_mperp) CALL juDFT_error("LDA+U and l_mperp not implemented",calledby ="postprocessInput")
END IF
! Check DOS related stuff (from inped)
IF ((banddos%ndir.LT.0).AND..NOT.banddos%dos) THEN
CALL juDFT_error('STOP banddos: the inbuild dos-program <0'//&
' can only be used if dos = true',calledby ="r_inpXML")
' can only be used if dos = true',calledby ="postprocessInput")
END IF
IF ((banddos%ndir.LT.0).AND.banddos%dos) THEN
IF (banddos%e1_dos-banddos%e2_dos.LT.1e-3) THEN
CALL juDFT_error("STOP banddos: no valid energy window for "//&
"internal dos-program",calledby ="r_inpXML")
"internal dos-program",calledby ="postprocessInput")
END IF
IF (banddos%sig_dos.LT.0) THEN
CALL juDFT_error("STOP DOS: no valid broadening (sig_dos) for "//&
"internal dos-PROGRAM",calledby ="r_inpXML")
"internal dos-PROGRAM",calledby ="postprocessInput")
END IF
END IF
IF (banddos%vacdos) THEN
IF (.NOT.banddos%dos) THEN
CALL juDFT_error("STOP DOS: only set vacdos = .true. if dos = .true.",calledby ="r_inpXML")
CALL juDFT_error("STOP DOS: only set vacdos = .true. if dos = .true.",calledby ="postprocessInput")
END IF
IF (.NOT.vacuum%starcoeff.AND.(vacuum%nstars.NE.1))THEN
CALL juDFT_error("STOP banddos: if stars = f set vacuum=1",calledby ="r_inpXML")
CALL juDFT_error("STOP banddos: if stars = f set vacuum=1",calledby ="postprocessInput")
END IF
IF (vacuum%layers.LT.1) THEN
CALL juDFT_error("STOP DOS: specify layers if vacdos = true",calledby ="r_inpXML")
CALL juDFT_error("STOP DOS: specify layers if vacdos = true",calledby ="postprocessInput")
END IF
DO i=1,vacuum%layers
IF (vacuum%izlay(i,1).LT.1) THEN
CALL juDFT_error("STOP DOS: all layers must be at z>0",calledby ="r_inpXML")
CALL juDFT_error("STOP DOS: all layers must be at z>0",calledby ="postprocessInput")
END IF
END DO
END IF
......@@ -275,7 +275,7 @@ SUBROUTINE postprocessInput(mpi,input,sym,stars,atoms,vacuum,obsolete,kpts,&
END DO
!IF (input%film .OR.oneD%odd%d1) THEN
! WRITE(*,*) 'There might be additional work required for the k points here!'
! WRITE(*,*) '...in r_inpXML. See inpeig_dim for comparison!'
! WRITE(*,*) '...in postprocessInput. See inpeig_dim for comparison!'
!END IF
CALL apws_dim(bk(:),cell,input,noco,oneD,nv,nv2,kq1,kq2,kq3)
stars%kq1_fft = max(kq1,stars%kq1_fft)
......@@ -309,7 +309,7 @@ SUBROUTINE postprocessInput(mpi,input,sym,stars,atoms,vacuum,obsolete,kpts,&
l_vca = .FALSE.
INQUIRE (file="vca.in", exist=l_vca)
IF (l_vca) THEN
WRITE(*,*) 'Note: Implementation for virtual crystal approximation should be changed in r_inpXML!'
WRITE(*,*) 'Note: Implementation for virtual crystal approximation should be changed in postprocessInput!'
WRITE(*,*) 'I am not sure whether the implementation actually makes any sense. It is from inped.'
WRITE(*,*) 'We have to get rid of the file vca.in!'
OPEN (17,file='vca.in',form='formatted')
......
......@@ -66,7 +66,7 @@
INTEGER nu,iofile
INTEGER iggachk
INTEGER n ,iostat, errorStatus
REAL scale,scpos ,zc
REAL scpos ,zc
TYPE(t_banddos)::banddos
TYPE(t_obsolete)::obsolete
......@@ -160,7 +160,8 @@
atoms%lda_u%l = -1 ; atoms%relax(1:2,:) = 1 ; atoms%relax(:,:) = 1
input%epsdisp = 0.00001 ; input%epsforce = 0.00001 ; input%xa = 2.0 ; input%thetad = 330.0
sliceplot%e1s = 0.0 ; sliceplot%e2s = 0.0 ; banddos%e1_dos = 0.5 ; banddos%e2_dos = -0.5 ; input%tkb = 0.001
banddos%sig_dos = 0.015 ; vacuum%tworkf = 0.0 ; scale = 1.0 ; scpos = 1.0
banddos%sig_dos = 0.015 ; vacuum%tworkf = 0.0 ; input%scaleCell = 1.0 ; scpos = 1.0
input%scaleA1 = 1.0 ; input%scaleA2 = 1.0 ; input%scaleC = 1.0
zc = 0.0 ; vacuum%locx(:) = 0.0 ; vacuum%locy(:) = 0.0
kpts%numSpecialPoints = 0
input%ldauLinMix = .FALSE. ; input%ldauMixParam = 0.05 ; input%ldauSpinf = 1.0
......@@ -459,7 +460,7 @@
CALL w_inpXML(&
& atoms,obsolete,vacuum,input,stars,sliceplot,banddos,&
& cell,sym,xcpot,noco,jij,oneD,hybrid,kpts,div,l_gamma,&
& noel,namex,relcor,a1Temp,a2Temp,a3Temp,scale,dtild,input%comment,&
& noel,namex,relcor,a1Temp,a2Temp,a3Temp,dtild,input%comment,&
& xmlElectronStates,xmlPrintCoreStates,xmlCoreOccs,&
& atomTypeSpecies,speciesRepAtomType,.FALSE.,filename,&
& l_explicit,numSpecies,enpara)
......@@ -497,7 +498,7 @@
CALL rw_inp(&
& ch_rw,atoms,obsolete,vacuum,input,stars,sliceplot,banddos,&
& cell,sym,xcpot,noco,jij,oneD,hybrid,kpts,&
& noel,namex,relcor,a1,a2,a3,scale,dtild,input%comment)
& noel,namex,relcor,a1,a2,a3,dtild,input%comment)
iofile = 6
......@@ -534,7 +535,7 @@
CALL rw_inp(&
& ch_rw,atoms,obsolete,vacuum,input,stars,sliceplot,banddos,&
& cell,sym,xcpot,noco,jij,oneD,hybrid,kpts,&
& noel,namex,relcor,a1,a2,a3,scale,dtild,input%comment)
& noel,namex,relcor,a1,a2,a3,dtild,input%comment)
IF ( ALL(div /= 0) ) nkpt3 = div
WRITE (iofile,FMT=9999) product(nkpt3),nkpt3,l_gamma
......
......@@ -16,7 +16,7 @@ CONTAINS
SUBROUTINE r_inpXML(&
atoms,obsolete,vacuum,input,stars,sliceplot,banddos,dimension,&
cell,sym,xcpot,noco,jij,oneD,hybrid,kpts,enpara,coreSpecInput,wann,&
noel,namex,relcor,a1,a2,a3,scale,dtild,xmlElectronStates,&
noel,namex,relcor,a1,a2,a3,dtild,xmlElectronStates,&
xmlPrintCoreStates,xmlCoreOccs,atomTypeSpecies,speciesRepAtomType,&
l_kpts)
......@@ -67,7 +67,7 @@ SUBROUTINE r_inpXML(&
CHARACTER(len=4), INTENT(OUT) :: namex
CHARACTER(len=12), INTENT(OUT) :: relcor
REAL, INTENT(OUT) :: a1(3),a2(3),a3(3)
REAL, INTENT(OUT) :: scale, dtild
REAL, INTENT(OUT) :: dtild
CHARACTER(len=8) :: name(10)
......@@ -739,7 +739,7 @@ SUBROUTINE r_inpXML(&
IF (numberNodes.EQ.1) THEN
latticeScale = evaluateFirstOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@scale'))
scale = latticeScale
input%scaleCell = latticeScale
valueString = TRIM(ADJUSTL(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@latnam')))
READ(valueString,*) cell%latnam
......@@ -774,14 +774,20 @@ SUBROUTINE r_inpXML(&
numberNodes = xmlGetNumberOfNodes(TRIM(ADJUSTL(xPathA))//'/a1')
IF (numberNodes.EQ.1) THEN
latticeDef = 1
input%scaleA1 = evaluateFirstOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/a1/@scale'))
a1(1) = evaluateFirstOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/a1'))
a1(1) = a1(1) * input%scaleA1
numberNodes