Commit 1cde15db authored by Daniel Wortmann's avatar Daniel Wortmann

Bugfixes

parent ff0cec65
......@@ -237,7 +237,6 @@
write(*,*) as,sym%nop2,l_tria
! l_tria=.true.
ELSE
IF (input%l_inpXML) THEN
IF (input%tria) THEN
ntetra = kpts%ntet
DO i = 1, ntetra
......@@ -249,15 +248,6 @@
ELSE
GOTO 66
END IF
END IF
OPEN (41,file='kpts',FORM='formatted',STATUS='old')
DO i = 1, kpts%nkpt+1
READ (41,*,END=66,ERR=66)
ENDDO
READ (41,'(i5)',END=66,ERR=66) ntetra
READ (41,'(4(4i6,4x))') ((itetra(i,k),i=1,4),k=1,ntetra)
READ (41,'(4f20.13)') (voltet(k),k=1,ntetra)
CLOSE(41)
voltet(1:ntetra) = voltet(1:ntetra) / ntetra
l_tria=.true.
GOTO 67
......
......@@ -208,7 +208,7 @@ CONTAINS
IF ( mpi%irank == 0 ) THEN
WRITE (6,FMT=8010) n,ws,weight
END IF
CALL juDFT_error("Not enough eavefunctions",calledby="fermie")
CALL juDFT_error("Not enough weavefunctions",calledby="fermie")
8010 FORMAT (/,10x,'error: not enough wavefunctions.',i10,2d20.10)
END IF
ws = ws + we(INDEX(l))
......
......@@ -86,35 +86,11 @@ c
c---> write results of triang
IF (.not.film) THEN
IF(input%l_inpXML) THEN
ntetra = kpts%ntet
DO j = 1, ntetra
itetra(1:4,j) = kpts%ntetra(1:4,j)
voltet(j) = kpts%voltet(j) / ntetra
END DO
ELSE
IF ( irank == 0 ) THEN
WRITE (6,*) 'reading tetrahedrons from file kpts'
END IF
OPEN (41,file='kpts',FORM='formatted',STATUS='old')
DO i = 1, nkpt+1
READ (41,*)
ENDDO
READ (41,'(i5)',ERR=66,END=66) ntetra
IF (ntetra>6*nkpt) CALL juDFT_error("ntetra > 6 nkpt"
+ ,calledby ="fertri")
READ (41,'(4(4i6,4x))') ((itetra(i,j),i=1,4),j=1,ntetra)
READ (41,'(4f20.13)') (voltet(j),j=1,ntetra)
voltet(1:ntetra) = voltet(1:ntetra) / ntetra
GOTO 67
66 CONTINUE ! no tetrahedron-information of file
CALL make_tetra(
> nkpt,bk,ntria,itria,atr,
< ntetra,itetra,voltet)!keep
67 CONTINUE ! tetrahedron-information read or created
CLOSE(41)
END IF
lb = MINVAL(eig(:,:,:)) - 0.01
ub = ef + 0.2
CALL tetra_ef(
......
......@@ -278,9 +278,10 @@ MODULE m_types_atoms
!force type
xpath=''
IF(xml%getNumberOfNodes(TRIM(ADJUSTL(xPaths))//'/force')==1) xpath=xpaths
IF(xml%getNumberOfNodes(TRIM(ADJUSTL(xPathg))//'/force')==1) xpath=xpathg
IF (xpath.NE.'') THEN
this%l_geo(n) = evaluateFirstBoolOnly(xml%getAttributeValue(TRIM(ADJUSTL(xPathg))//'/force/@calculate'))
valueString = xml%getAttributeValue(TRIM(ADJUSTL(xPathg))//'force/@relaxXYZ')
this%l_geo(n) = evaluateFirstBoolOnly(xml%getAttributeValue(TRIM(ADJUSTL(xPath))//'/force/@calculate'))
valueString = xml%getAttributeValue(TRIM(ADJUSTL(xPath))//'/force/@relaxXYZ')
READ(valueString,'(3l1)') relaxX, relaxY, relaxZ
IF (relaxX) this%relax(1,n) = 1
IF (relaxY) this%relax(2,n) = 1
......
......@@ -9,7 +9,7 @@ MODULE m_types_econfig
PRIVATE
!This is used by t_atoms and does not extend t_fleurinput_base by itself
TYPE:: t_econfig
CHARACTER(len=100) :: coreconfig
CHARACTER(len=200) :: coreconfig
CHARACTER(len=100) :: valenceconfig
INTEGER :: num_core_states
INTEGER :: num_states
......@@ -209,13 +209,13 @@ CONTAINS
ENDDO
econf%num_states=econf%num_core_states
!valence charge
charge=nz-SUM(ABS(kap(:econf%num_core_states)))*2
charge=nz-SUM(ABS(kap(:econf%num_core_states))**2)*2
DO WHILE(charge>0) !Add valence
str=coreStateList_const(econf%num_states+1)
PRINT*,econf%num_states,str,charge
CALL extract_next(str,np(econf%num_states+1),kap(econf%num_states+1))
econf%num_states=econf%num_states+1
charge=charge-ABS(kap(econf%num_states))
charge=charge-ABS(kap(econf%num_states)**2)*2
ENDDO
ALLOCATE(econf%nprnc(econf%num_states),econf%kappa(econf%num_states))
......@@ -345,13 +345,13 @@ CONTAINS
CASE ("Ne","ne","NE")
str="(1s1/2) (2s1/2) (2p1/2) "//str
CASE ("Ar","ar","AR")
str="(1s1/2) (2s1/2) (2p1/2) (3s1/2) (3p1/2) (3p3/2) "//str
str="(1s1/2) (2s1/2) (2p1/2) (2p3/2) (3s1/2) (3p1/2) (3p3/2) "//str
CASE ("Kr","kr","KR")
str="(1s1/2) (2s1/2) (2p1/2) (3s1/2) (3p1/2) (3p3/2) (4s1/2) (3d3/2) (3d5/2) (4p1/2) (4p3/2)"//str
str="(1s1/2) (2s1/2) (2p1/2) (2p3/2) (3s1/2) (3p1/2) (3p3/2) (4s1/2) (3d3/2) (3d5/2) (4p1/2) (4p3/2)"//str
CASE ("Xe","xe","XE")
str="(1s1/2) (2s1/2) (2p1/2) (3s1/2) (3p1/2) (3p3/2) (4s1/2) (3d3/2) (3d5/2) (4p1/2) (4p3/2) (5s1/2) (4d3/2) (4d5/2) (5p1/2) (5p3/2) "//str
str="(1s1/2) (2s1/2) (2p1/2) (2p3/2) (3s1/2) (3p1/2) (3p3/2) (4s1/2) (3d3/2) (3d5/2) (4p1/2) (4p3/2) (5s1/2) (4d3/2) (4d5/2) (5p1/2) (5p3/2) "//str
CASE ("Rn","rn","RN")
str="(1s1/2) (2s1/2) (2p1/2) (3s1/2) (3p1/2) (3p3/2) (4s1/2) (3d3/2) (3d5/2) (4p1/2) (4p3/2) (5s1/2) (4d3/2) (4d5/2) (5p1/2) (5p3/2) (6s1/2) (4f5/2) (4f7/2) (5d3/2) (5d5/2) (6p1/2) (6p3/2) "//str
str="(1s1/2) (2s1/2) (2p1/2) (2p3/2) (3s1/2) (3p1/2) (3p3/2) (4s1/2) (3d3/2) (3d5/2) (4p1/2) (4p3/2) (5s1/2) (4d3/2) (4d5/2) (5p1/2) (5p3/2) (6s1/2) (4f5/2) (4f7/2) (5d3/2) (5d5/2) (6p1/2) (6p3/2) "//str
CASE default
call judft_error(("Invalid econfig:"//TRIM(str)))
END SELECT
......@@ -367,7 +367,7 @@ CONTAINS
REAL,ALLOCATABLE,INTENT(OUT) :: occupations(:)
CHARACTER(len=200)::conf
REAL :: occupation(100) !this is the tmp local variable (no 's')
REAL :: occupation(200) !this is the tmp local variable (no 's')
INTEGER:: n,nn,occ
CHARACTER:: n_ch,ch
extended=""
......
......@@ -131,7 +131,7 @@ CONTAINS
enpara%qn_el(:,ntype,:)=ABS(enpara%qn_el(:,ntype,:))
END SUBROUTINE set_quantum_numbers
SUBROUTINE init(this,ntype,nlod,jspins,l_defaults,nz)
SUBROUTINE Init(This,Ntype,Nlod,Jspins,L_defaults,Nz)
USE m_constants
CLASS(t_enparaXML),INTENT(inout):: this
INTEGER,INTENT(IN) :: jspins,nlod,ntype
......@@ -141,6 +141,9 @@ CONTAINS
INTEGER :: n,i,jsp,l
this%evac0=-1E99
if (allocated(this%qn_el)) deallocate(this%qn_el)
if (allocated(this%qn_ello)) deallocate(this%qn_ello)
ALLOCATE(this%qn_el(0:3,ntype,jspins))
ALLOCATE(this%qn_ello(nlod,ntype,jspins))
......
......@@ -57,7 +57,7 @@ MODULE m_types_input
LOGICAL:: l_wann=.FALSE.
LOGICAL:: secvar=.FALSE.
LOGICAL:: evonly=.FALSE.
LOGICAL:: l_inpXML=.TRUE.
! LOGICAL:: l_inpXML=.TRUE.
REAL :: ellow=-1.8
REAL :: elup=1.0
REAL :: fixed_moment = 0.0
......@@ -135,7 +135,7 @@ CONTAINS
call mpi_bc(this%l_wann,rank,mpi_comm)
call mpi_bc(this%secvar,rank,mpi_comm)
call mpi_bc(this%evonly,rank,mpi_comm)
call mpi_bc(this%l_inpXML,rank,mpi_comm)
! call mpi_bc(this%l_inpXML,rank,mpi_comm)
call mpi_bc(this%ellow,rank,mpi_comm)
call mpi_bc(this%elup,rank,mpi_comm)
call mpi_bc(this%fixed_moment ,rank,mpi_comm)
......
......@@ -115,8 +115,9 @@ MODULE m_types_noco
ALLOCATE(this%socscale(ntype))
DO itype=1,ntype
this%socscale(Itype)=1.0
IF (xml%GetNumberOfNodes(TRIM(ADJUSTL(xml%speciesPath(itype)))//'/special/@socscale')>0) &
this%socscale(iType)=evaluateFirstOnly(xml%GetAttributeValue(TRIM(ADJUSTL(xml%speciesPath(itype)))//'/special/@socscale'))
this%socscale(Itype)=evaluateFirstOnly(xml%GetAttributeValue(TRIM(ADJUSTL(xml%speciesPath(itype)))//'/special/@socscale'))
!Read in atom group specific noco parameters
xPathB = TRIM(ADJUSTL(xml%groupPath(itype)))//'/nocoParams'
numberNodes = xml%GetNumberOfNodes(TRIM(ADJUSTL(xPathB)))
......
......@@ -50,10 +50,10 @@
!
IF(PRESENT(enpara)) THEN
IF (.NOT.input%l_inpXML) THEN
!IF (.NOT.input%l_inpXML) THEN
!read enpara file if present!
CALL enpara%init_enpara(atoms,input%jspins,input%film)
END IF
!END IF
END IF
!
!---> read k-points from file 41='kpts'
......
......@@ -311,11 +311,10 @@
READ (UNIT=5,FMT=7182,END=77,ERR=77) ch_test
IF (ch_test.EQ.'igr') THEN ! GGA input
BACKSPACE (5)
call judft_error("Old input files with explicit GGA parameters no longer supported")
! READ (UNIT=5,FMT=7121,END=99,ERR=99)&
! & idum,obsolete%lwb,obsolete%ndvgrd,idsprs,obsolete%chng
! IF (idsprs.ne.0)&
! & CALL juDFT_warn("idsprs no longer supported in rw_inp")
READ (UNIT=5,FMT=7121,END=99,ERR=99)&
& idum,ldum,idum,idsprs
IF (idsprs.ne.0)&
& CALL juDFT_warn("idsprs no longer supported in rw_inp")
! WRITE (6,9121) idum,obsolete%lwb,obsolete%ndvgrd,idsprs,obsolete%chng
7121 FORMAT (5x,i1,5x,l1,8x,i1,8x,i1,6x,d10.3)
......
......@@ -47,6 +47,7 @@ CONTAINS
TYPE(t_sphhar) ::sphhar
TYPE(t_atompar) :: ap
INTEGER :: n,grid(3)
LOGICAL :: l_enparaok
CALL fleur_init_old(&
input,DIMENSION,atoms,sphhar,cell,stars,sym,noco,vacuum,&
......@@ -54,15 +55,35 @@ CONTAINS
oneD,grid) !kpt grid not used...
CALL sym%init(cell,input%film)
ALLOCATE(enpara%qn_el(0:3,atoms%ntype,2),enpara%qn_ello(size(enpara%ello0),atoms%ntype,2))
enpara%qn_el=0.0
enpara%qn_ello=0.0
ALLOCATE(atoms%label(atoms%nat)); atoms%label=""
!Generate speciesnames
ALLOCATE(atoms%speciesname(atoms%ntype))
DO n=1,atoms%ntype
WRITE(atoms%speciesname(n),"(a,a,i0)") ADJUSTL(TRIM(namat_const(atoms%nz(n)))),"-",n
END DO
write(atoms%speciesname(n),"(a,a,i0)") namat_const(atoms%nz(n)),"-",n
ENDDO
IF (.not.allocated(atoms%label)) THEN
allocate(atoms%label(atoms%nat))
atoms%label=""
ENDIF
!convert enpara
l_enparaok=.false.
If (all(abs(enpara%el0)<1E10))THEN
IF (All(Abs(Enpara%El0-Nint(Enpara%El0))<1e-9)) Then
Enpara%Qn_el=Nint(Enpara%El0)
l_enparaok=.true.
if (atoms%nlotot>0) THEN
IF (all(abs(enpara%ello0-Nint(Enpara%ello0))<1e-9)) THEN
enpara%qn_ello=Nint(enpara%ello0)
ELSE
l_enparaok=.false.
ENDIF
ENDIF
ENDIF
ENDIF
IF (.NOT.l_enparaok) THEN
CALL enpara%init(atoms%ntype,atoms%nlod,input%jspins,.true.,atoms%nz)
call judft_warn("Enpara not found or not set to integer values. Using defaults")
ENDIF
DO n=1,atoms%ntype
ap=find_atompar(atoms%nz(n),atoms%rmt(n))
......
......@@ -99,8 +99,8 @@ CONTAINS
mpi%irank=0 ; mpi%isize=1; mpi%mpi_comm=1
#endif
!determine if we use an xml-input file
INQUIRE (file='inp.xml',exist=input%l_inpXML)
IF (.NOT.input%l_inpXML) THEN
INQUIRE (file='inp.xml',exist=l_found)
IF (.NOT.l_found) THEN
CALL judft_error("No input file found",calledby='fleur_init',hint="To use FLEUR, you have to provide an 'inp.xml' file in the working directory")
END IF
......
......@@ -57,8 +57,8 @@ SUBROUTINE stden(mpi,sphhar,stars,atoms,sym,DIMENSION,vacuum,&
REAL :: vacpar(2)
INTEGER lnum(29,atoms%ntype),nst(atoms%ntype)
INTEGER jrc(atoms%ntype)
LOGICAL l_found(0:3),llo_found(atoms%nlod),l_enpara,l_st
REAL :: occ(MAXVAL(atoms%econf%num_states),2)
LOGICAL l_found(0:3),llo_found(atoms%nlod),l_st
REAL,ALLOCATABLE :: occ(:,:)
! Data statements
DATA del/1.e-6/
PARAMETER (l_st=.true.)
......@@ -219,12 +219,8 @@ SUBROUTINE stden(mpi,sphhar,stars,atoms,sym,DIMENSION,vacuum,&
END DO ! ispin = 1, input%jspins
END IF ! input%vchk
l_enpara = .FALSE.
INQUIRE (file='enpara',exist=l_enpara)
l_enpara = l_enpara.OR.input%l_inpXML
! set up parameters for enpara-file
IF ((juDFT_was_argument("-genEnpara")).AND..NOT.l_enpara) THEN
IF ((juDFT_was_argument("-genEnpara"))) THEN
CALL enpara%init_enpara(atoms,input%jspins,input%film)
enpara%lchange = .TRUE.
......
......@@ -47,26 +47,6 @@ c********************************************************
endif
close(987)
else
IF(.NOT.input%l_inpXML) THEN
inquire(file='kpts',exist=l_file)
IF(.NOT.l_file) CALL juDFT_error("where is kpts?",calledby
+ ="wann_get_kpts")
open(987,file='kpts',status='old',form='formatted')
read(987,*)nkpts,scale
write(6,*)"wann_get_kpts: nkpts=",nkpts
if(l_readkpts)then
IF(SIZE(kpoints,1)/=3)
+ CALL juDFT_error("wann_get_kpts: 1",
+ calledby ="wann_get_kpts")
IF(SIZE(kpoints,2)/=nkpts)
+ CALL juDFT_error("wann_get_kpts:2",
+ calledby ="wann_get_kpts")
do iter=1,nkpts
read(987,*)kpoints(:,iter)
enddo
endif
close(987)
ELSE
nkpts = kpts%nkpt
write(6,*)"wann_get_kpts: nkpts=",nkpts
if(l_readkpts)then
......@@ -74,15 +54,8 @@ c********************************************************
kpoints(:,iter) = kpts%bk(:,iter)
enddo
endif
END IF
endif
if(l_readkpts.AND..NOT.input%l_inpXML)then
kpoints=kpoints/scale
if(film.and..not.l_onedimens)then
kpoints(3,:)=0.0
endif
endif
IF (l_readkpts) THEN
do iter=1,nkpts
write(6,*)kpoints(:,iter)
......
......@@ -244,19 +244,10 @@ c*****************************************************************
close(412)
else
IF(.not.l_q)THEN
IF(.NOT.input%l_inpXML) THEN
open(412,file='kpts',form='formatted')
read(412,*)fullnkpts_tmp,scale
do k=1,fullnkpts
read(412,*)kpoints(:,k)
enddo
kpoints(:,:)=kpoints/scale
ELSE
fullnkpts_tmp = kpts%nkpt
do k=1,fullnkpts
kpoints(:,k) = kpts%bk(:,k)
enddo
END IF
ELSE
open(412,file=param_file,form='formatted')
read(412,*)fullnkpts_tmp,scale
......
......@@ -133,7 +133,7 @@ subroutine wann_read_inp(input,l_p0,wann)
!-----read the input file 'wann_inp'
l_file=.false.
inquire(file='wann_inp',exist=l_file)
IF ((.not.l_file).AND.(.NOT.input%l_inpXML)) THEN
IF ((.not.l_file)) THEN
CALL juDFT_error ("wann_inp not found", calledby="wann_read_inp")
END IF
IF (l_file) THEN
......@@ -426,7 +426,7 @@ subroutine wann_read_inp(input,l_p0,wann)
if(l_p0.and.ios.lt.0)write(6,*)"end of wann_inp reached"
close(916)
ELSE IF (input%l_inpXML) THEN
ELSE
DO i = 1, SIZE(wann%jobList)
task = TRIM(ADJUSTL(wann%jobList(i)))
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment