Skip to content

GitLab

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

more modifications...

parent 6ae2e892
Expand all Hide whitespace changes
Inline Side-by-side
Showing with 1222 additions and 894 deletions
inpgen/new/inpgen.f90
View file @ b1dc7820
......@@ -62,36 +62,63 @@ PROGRAM inpgen
!Start program and greet user
CALL inpgen_help()
!read the input
CALL read_input(film,symor,atomid,atompos,atomlabel,amat,dvac,noco)
!First we determine the spacegoup and map the atoms to groups
CALL make_crystal(film,symor,atomid,atompos,atomlabel,amat,dvac,noco,&
cell,sym,atoms)
!All atom related parameters are set here. Note that some parameters might
!have been set in the read_input call before by adding defaults to the atompar module
CALL make_atomic_defaults(input,vacuum,cell,oneD,atoms)
INQUIRE(file='inp.xml',exist=l_inpxml)
IF (l_inpxml.AND..NOT.judft_was_argument("-inp.xml")) CALL judft_error("inp.xml exists and can not be overwritten")
IF (judft_was_argument("-inp")) THEN
STOP "not yet"
!CALL read_old_input()
full_input=.TRUE.
ELSEIF (judft_was_argument("-inp.xml")) THEN
STOP "not yet"
!CALL r_inpXML()
full_input=.TRUE.
ELSEIF(judft_was_argument("-f")) THEN
!read the input
CALL read_inpgen_input(atom_pos,atom_id,atom_label,amat,
!Set all defaults that have not been specified before or can not be specified in inpgen
call make_defaults(atoms,vacuum,input,stars,sliceplot,forcetheo,banddos,&
cell,sym,xcpot,noco,oneD,hybrid,kpts)
film,symor,atomid,atompos,atomlabel,amat,dvac,noco)
full_input=.FALSE.
ELSE
CALL judft_error("You should either specify -inp,-inp.xml or -f command line options. Check -h if unsure")
ENDIF
IF (.NOT.full_input) THEN
!First we determine the spacegoup and map the atoms to groups
CALL make_crystal(film,symor,atomid,atompos,atomlabel,amat,dvac,noco,&
cell,sym,atoms)
!All atom related parameters are set here. Note that some parameters might
!have been set in the read_input call before by adding defaults to the atompar module
CALL make_atomic_defaults(input,vacuum,cell,oneD,atoms)
!Set all defaults that have not been specified before or can not be specified in inpgen
CALL make_defaults(atoms,vacuum,input,stars,sliceplot,forcetheo,banddos,&
cell,sym,xcpot,noco,oneD,hybrid,kpts)
ENDIF
!
! k-points can also be modified here
!
call make_kpoints()
!
!Now the IO-section
!
!the inp.xml file
CALL w_inpxml(&
atoms,vacuum,input,stars,sliceplot,forcetheo,banddos,&
cell,sym,xcpot,noco,oneD,hybrid,kpts,&
div,l_gamma,& !should be in kpts!?
namex,relcor,dtild_opt,name_opt,&!?should be somewhere...
l_outFile,"inp.xml",&
l_explicit,enpara)
!the sym.xml file
CALL write_sym()
IF (.NOT.l_inpxml) THEN
!the inp.xml file
l_explicit=judft_was_argument("-explicit")
CALL dump_FleurInputSchema()
CALL w_inpxml(&
atoms,vacuum,input,stars,sliceplot,forcetheo,banddos,&
cell,sym,xcpot,noco,oneD,hybrid,kpts,&
div,l_gamma,& !should be in kpts!?
namex,relcor,dtild_opt,name_opt,&!?should be somewhere...
.false.,"inp.xml",&
l_explicit,enpara)
!the sym.xml file
CALL sym%writeXML(0,"sym.xml")
ENDIF
CALL kpts%writeXML(0,"kpts.xml")
! Structure in xsf-format
OPEN (55,file="struct.xsf")
......
inpgen/new/make_defaults.f90
View file @ b1dc7820
......@@ -36,14 +36,25 @@ CONTAINS
SUBROUTINE make_defaults(atoms,vacuum,input,stars,&
& cell,sym,xcpot,noco,hybrid,kpts)
SUBROUTINE make_defaults(atoms,sym,vacuum,input,stars,&
& xcpot,noco,hybrid)
USE m_types
TYPE(t_atoms),INTENT(IN) ::atoms
TYPE(t_sym),INTENT(IN) ::sym
TYPE(t_vacuum),INTENT(INOUT)::vacuum
TYPE(t_input),INTENT(INOUT) ::input
TYPE(t_stars),INTENT(INOUT) ::stars
TYPE(t_xcpot),INTENT(INOUT) ::xcpot
TYPE(t_noco),INTENT(INOUT) ::noco
TYPE(t_hybrid),INTENT(INOUT)::hybrid
IMPLICIT NONE
!Set some more input switches
!
!input
!
input%delgau = input%tkb
IF (noco%l_noco) input%jspins = 2
......@@ -70,25 +81,47 @@ CONTAINS
input%rkmax = real(NINT(input%rkmax * 10 ) / 10.)
IF (noco%l_ss) input%ctail = .FALSE.
stars%gmax=merge(stars%gmax,3.0*input%rkmax,stars%gmax>0)
stars%gmax = real(NINT(stars%gmax * 10 ) / 10.)
!
! stars
!
stars%gmax = merge(stars%gmax,3.0*input%rkmax,stars%gmax>0)
stars%gmax = real(NINT(stars%gmax * 10 ) / 10.)
stars%gmaxInit = stars%gmax
xcpot%gmaxxc=merge(xcpot%gmaxxc,3.0*input%rkmax,xcpot%gmaxxc>0)
!
!xcpot
!
xcpot%gmaxxc = merge(xcpot%gmaxxc,3.0*input%rkmax,xcpot%gmaxxc>0)
xcpot%gmaxxc = real(NINT(xcpot%gmaxxc * 10 ) / 10.)
!
!vacuum
!
IF (.not.input%film) THEN
vacuum%dvac = a3(3)
Else
vacuum%dvac = real(NINT(vacuum%dvac*100)/100.)
vacuum%dvac = REAL(NINT(vacuum%dvac*100)/100.)
ENDIF
!
!HF added for HF and hybrid functionals
vacuum%nvac = 2
IF (sym%zrfs.OR.sym%invs) vacuum%nvac = 1
IF (oneD%odd%d1) vacuum%nvac = 1
!
!noco
!
ALLOCATE(noco%l_relax(atoms%ntype),noco%b_con(2,atoms%ntype))
ALLOCATE(noco%alphInit(atoms%ntype),noco%alph(atoms%ntype),noco%beta(atoms%ntype))
noco%qss = MERGE(noco%qss,[0.0,0.0,0.0],noco%l_ss)
noco%l_relax(:) = .FALSE.
noco%alphInit(:) = 0.0
noco%alph(:) = 0.0
noco%beta(:) = 0.0
noco%b_con(:,:) = 0.0
!
!hybrid
!
hybrid%gcutm1 = input%rkmax - 0.5
ALLOCATE(hybrid%lcutwf(atoms%ntype))
ALLOCATE(hybrid%lcutm1(atoms%ntype))
......@@ -101,55 +134,7 @@ CONTAINS
hybrid%select1(4,:) = 2
hybrid%l_hybrid = l_hyb
hybrid%gcutm1 = real(NINT(hybrid%gcutm1 * 10 ) / 10.)
! Set defaults for noco types
ALLOCATE(noco%l_relax(atoms%ntype),noco%b_con(2,atoms%ntype))
ALLOCATE(noco%alphInit(atoms%ntype),noco%alph(atoms%ntype),noco%beta(atoms%ntype))
noco%qss = merge(noco%qss,[0.0,0.0,0.0],noco%l_ss)
noco%l_relax(:) = .FALSE.
noco%alphInit(:) = 0.0
noco%alph(:) = 0.0
noco%beta(:) = 0.0
noco%b_con(:,:) = 0.0
! set vacuum%nvac
vacuum%nvac = 2
IF (sym%zrfs.OR.sym%invs) vacuum%nvac = 1
IF (oneD%odd%d1) vacuum%nvac = 1
IF (l_hyb) THEN
! Changes for hybrid functionals
namex = 'pbe0'
atoms%l_geo = .false.! ; input%frcor = .true.
END IF
l_explicit = juDFT_was_argument("-explicit")
IF(l_explicit) THEN
! kpts generation
CALL kpoints(oneD,sym,cell,input,noco,banddos,kpts,l_kpts)
kpts%specificationType = 3
kpts%l_gamma = .true.
IF (l_hyb) kpts%specificationType = 2
END IF
END SUBROUTINE make_defaults
END MODULE m_make_defaults
END SUBROUTINE make_defaults
END MODULE m_make_defaults
inpgen/new/read_inpgen_input.f90
View file @ b1dc7820
......@@ -8,6 +8,7 @@ MODULE m_read_inpgen_input
USE m_judft
IMPLICIT NONE
CONTAINS
SUBROUTINE read_inpgen_input(atom_pos,atom_id,atom_label,amat,div,namex,relcor,dtild&
input,sym,noco,vacuum,stars,kpts,xcpot,&
filename)
......@@ -45,77 +46,245 @@ CONTAINS
REAL :: a1(3),a2(3),a3(3),SCALE(3),factor(3),aa !lattice definition
INTEGER:: infh,errfh,warnfh,dbgfh,outfh,symfh !file handles
filename=juDFT_string_for_argument("-f")
INQUIRE(file=filename,exist=l_exist)
IF (.NOT.l_exist) CALL judft_error("Input file specified is not readable")
ALLOCATE ( mmrot(3,3,48), ttr(3,48) )
ALLOCATE ( atompos(3,natmax),atomid(natmax) )
ALLOCATE (atomLabel(natmax))
atomLabel = ''
OPEN(97,file=filename)
OPEN(98,status='scratch')
OPEN (bfh,file='bfh.txt',form='formatted',status='unknown')
IF (PRESENT(filename)) OPEN(5,file=filename)
noco%l_ss = .FALSE.
vacuum%dvac=0.0
noco%l_soc=.FALSE.
CALL normalize_file(97,98)
!default file handlers
infh = 5
errfh = 6 ; warnfh = 6 ; dbgfh = 6 ; outfh = 6;symfh=97
REWIND(98)
READ(98,"(a)",iostat=ios) input%comment
namelist_ok=.TRUE.
DO WHILE(ios.NE.0)
READ(98,"(a)",iostat=ios) line
IF (ios.NE.0) EXIT
IF (line(1:1)=="&") THEN
!process the namelist
SELECT CASE(line(2:5)) !e.g. atom
CASE ('latt')
CALL process_lattice(line,cell)???
CASE('inpu')
CALL process_input(line,input%film,sym%symor)
CASE('qss ')
CALL process_qss(line,noco)
CASE('soc ')
CALL process_soc(line,noco)
CASE('shif')
CALL process_shift(line,atom_pos)
CASE('fact')
CALL process_factor(line,atom_pos)
CASE('exco')
CALL process_exco(line,xcpot)
CASE('comp')
CALL process_comp(line,input%jspins,input%frcor,input%ctail,input%kcrel,stars%gmax,xcpot%gmaxxc,input%rkmax)
CASE('kpt ')
CALL process_kpt(line,???)???
CASE('film')
CALL process_film(line,vacuum%dvac,vacuum%dtild)???
CASE('gen ','sym ')
CALL judft_error("Specifying the symmetries no longer supported in inpgen")
CASE default
CALL judft_error(("Unkown input in:"//line))
END SELECT
ELSE
IF (SUM(ABS(cell%amat))>0) THEN
!cell was set already, so list of atoms follow
READ(line,*,iostat=ios) n
IF (ios.NE.0) CALL judft_error(("Surprising error in reading input:"//line))
ALLOCATE(atom_pos(3,n),atom_label(n),atom_id(n))
DO i=1,n
READ(98,"(a)",iostat=ios) line
IF (ios.NE.0) CALL judft_error(("List of atoms not complete:"//line))
atom_id(i)=evaluatefirst(line)
atom_pos(1,i)=evaluatefirst(line)
atom_pos(2,i)=evaluatefirst(line)
atom_pos(3,i)=evaluatefirst(line)
IF(TRIM(ADJUSTL(line)).NE.'') THEN
atom_Label(i) = TRIM(ADJUSTL(line))
ELSE
WRITE(atom_Label(i),'(i0)') n
END IF
END DO
ELSE
!the bravais matrix has to follow
???
ENDIF
ENDIF
END DO
IF (.NOT.ALLOCATED(atompos).OR.SUM(ABS(cell%amat))==0.0) CALL judft_error("input not complete")
nline=0
CALL struct_input(&
infh,errfh,warnfh,symfh,'sym ',bfh,&
natmax,48,&
nline,size(buffer),buffer,&
title,input%film,cal_symm,checkinp,sym%symor,&
cartesian,oldfleur,a1,a2,a3,vacuum%dvac,aa,scale,i_c,&
factor,natin,atomid,atompos,ngen,mmrot,ttr,atomLabel,&
l_hyb,noco%l_soc,noco%l_ss,noco%theta,noco%phi,noco%qss,inistop)
!Check output
IF (.NOT.cal_symm) CALL judft_error("Reading of symmetry no longer supported")
IF (checkinp.OR.inistop) CALL judft_warn("checkinp and inistop no longer supported")
IF (cartesian) CALL judft_error("Scaled Cartesian coordinates no longer supported")
IF (l_hyb) CALL judft_warn("Hybrid option no longer supported")
if (oldfleur.and..not.input%film) CALL judft_warn("oldfleur only in film setups")
!Generate amat
amat(:,1)=aa*SCALE(:)*a1(:)
amat(:,2)=aa*SCALE(:)*a2(:)
amat(:,3)=aa*SCALE(:)*a3(:)
!Generate list of atoms
ALLOCATE(atom_pos(3,natin),atom_id(natin),atom_label(natin))
atom_pos=atompos(:,:natin)
atom_id=atomid(:,:natin)
atom_label=atomlabel(:,:natin)
!title
DO i = 1, 10
j = (i-1) * 8 + 1
input%comment(i) = title(j:j+7)
ENDDO
IF (.NOT.input%film) vacuum%dvac=a3(3)
dtild=0.0
input%l_inpXML = .TRUE.
END SUBROUTINE read_inpgen_input
SUBROUTINE process_input(line,film,symor,hybrid)
CHARACTER(len=*),INTENT(in)::line
LOGICAL,INTENT(out)::film,symor,hybrid
INTEGER :: ios
LOGICAL :: cartesian, cal_symm, checkinp,inistop,oldfleur
cartesian=.FALSE.
cal_sym=.FALSE.
oldfleur=.FALSE.
NAMELIST /input/ film, cartesian, cal_symm, checkinp, inistop,
& symor, oldfleur, hybrid
READ(line,input,iostat=ios)
IF (ios.NE.0) CALL judft_error(("Error reading:"//line))
IF (ANY([cal_symm, checkinp,oldfleur])) CALL judft_error("Switches cal_symm, checkinp,oldfleur no longer supported")
END SUBROUTINE process_input
SUBROUTINE process_qss(line,noco)
CHARACTER(len=*),INTENT(in)::line
TYPE(t_noco),INTENT(INOUT) :: noco
CHARACTER(len=1000) :: buf
buf=ADJUSTL(line(5:len_TRIM(line)-1)
READ(line,*,iostat=ios) noco%qss
noco%l_ss=.TRUE.
noco%l_noco=.TRUE.
IF (ios.NE.0) CALL judft_error(("Error reading:"//line))
END SUBROUTINE process_qss
SUBROUTINE process_soc(line,noco)
CHARACTER(len=*),INTENT(in)::line
TYPE(t_noco),INTENT(INOUT) :: noco
CHARACTER(len=1000) :: buf
buf=ADJUSTL(line(5:len_TRIM(line)-1)
READ(line,*,iostat=ios) noco%theta,noco%phi
noco%l_soc=.TRUE.
IF (ios.NE.0) CALL judft_error(("Error reading:"//line))
END SUBROUTINE process_soc
SUBROUTINE process_shift(line,atompos)
CHARACTER(len=*),INTENT(in)::line
REAL,INTENT(INOUT) :: atompos(:,:)
CHARACTER(len=1000) :: buf
REAL :: shift(3)
INTEGER :: ios,n
buf=ADJUSTL(line(7:len_TRIM(line)-1)
READ(line,*,iostat=ios) shift
IF (ios.NE.0) CALL judft_error(("Error reading:"//line))
DO n=1,SIZE(atompos,2)
atompos(:,n)=atompos(:,)+shift
ENDDO
END SUBROUTINE process_shift
SUBROUTINE process_factor(line,atompos)
CHARACTER(len=*),INTENT(in)::line
REAL,INTENT(INOUT) :: atompos(:,:)
CHARACTER(len=1000) :: buf
REAL :: factor(3)
INTEGER :: ios,n
buf=ADJUSTL(line(8:len_TRIM(line)-1)
READ(line,*,iostat=ios) factor
IF (ios.NE.0) CALL judft_error(("Error reading:"//line))
DO n=1,SIZE(atompos,2)
atompos(:,n)=atompos(:,)/factor
ENDDO
END SUBROUTINE process_factor
SUBROUTINE process_exco(line,xcpot)
CHARACTER(len=*),INTENT(in)::line
TYPE(t_xcpot),INTENT(INOUT) :: xcpot
LOGICAL::relxc
CHARACTER(len=4) :: xctyp
NAMELIST /exco/ xctyp, relxc
INTEGER :: ios
READ(line,exco,iostat=ios)
IF (ios.NE.0) CALL judft_error(("Error reading:"//line))
call xcpot???
END SUBROUTINE process_exco
SUBROUTINE process_comp(line,jspins,frcor,ctail,kcrel,gmax,gmaxxc,rkmax)
CHARACTER(len=*),INTENT(in)::line
INTEGER,INTENT(inout):: jspins,frcor,ctail,kcrel
REAL,intent(inout) :: gmax,gmaxxc,rkmax
INTEGER :: ios
NAMELIST /comp/ jspins, frcor, ctail, kcrel, gmax, gmaxxc, kmax
READ(line,comp,iostat=ios)
IF (ios.NE.0) CALL judft_error(("Error reading:"//line))
END SUBROUTINE process_comp
SUBROUTINE normalize_file(infh,outfh)
!***********************************************************************
! reads in the file from infh
! and:
! - deletes comments
! - deletes empty line
! - combines multiple line namelists into single line
!
! then the input is written to outfh
!
!***********************************************************************
CALL lapw_input(&
infh,nline,xl_buffer,bfh,buffer,&
input%jspins,input%kcrel,obsolete%ndvgrd,kpts%nkpt,div,kpts%kPointDensity,&
input%frcor,input%ctail,obsolete%chng,input%tria,input%rkmax,stars%gmax,xcpot%gmaxxc,&
vacuum%dvac,dtild,input%tkb,namex,relcor)
IMPLICIT NONE
CLOSE(bfh)
INTEGER, INTENT (IN) :: infh ! input filehandle (5)
INTEGER, INTENT (IN) :: outh ! Output filehandle
!Read the &atom namelists and put into atompar as defaults
CALL read_params("bfh.txt")
INTEGER :: n,ios
LOGICAL :: building, complete
CHARACTER(len=1000) :: line,buffer
OPEN(bfh,"bfh,txt")
CLOSE(bfh,status='delete')
IF (PRESENT(filename)) CLOSE(5)
END SUBROUTINE read_inpgen_input
!---> initialize some variables
building = .false.
complete = .false.
loop: DO
READ (infh,'(a)',IOSTAT=ios) line
IF (ios.NE.0) EXIT !done
LINE = ADJUSTL(line)
n = SCAN(line,'!') ! remove end of line comments
IF ( n>0 ) THEN
line = line(1:n-1)
ENDIF
n = LEN_TRIM( line ) ! length of line without trailing blanks
IF ( n == 0 ) CYCLE loop
IF ( line(1:1)=='&' ) THEN ! check if beginning of namelist
IF (building) CALL juDFT_error ("missing end of namelist marker / in or before line")
building = .TRUE.
buffer = line
IF( line(n:n)=='/' ) complete = .TRUE.
ELSEIF ( line(n:n)=='/' ) THEN ! check if end of namelist
IF (building) THEN
complete = .TRUE.
buffer = trim(buffer)//' '//line
ELSE
CALL juDFT_error ("out of place end of namelist marker / in line")
ENDIF
ELSEIF ( building ) THEN ! add line to buffer
buffer = trim(buffer)//' '//line
ELSEIF ( n > 0 ) THEN ! check for non empty lines outside of namelists
buffer = line
complete = .TRUE.
ENDIF
IF ( complete ) THEN
WRITE(outfh,"(a)") TRIM(buffer)
buffer=''
building=.FALSE.
complete=.FALSE.
END IF
END DO loop
END SUBROUTINE normalize_file
END MODULE m_read_inpgen_input
kpoints/kptgen_hybrid.f
View file @ b1dc7820
......@@ -16,17 +16,17 @@
!Modified for types D.W.
SUBROUTINE kptgen_hybrid(input,cell,sym,kpts,l_soc)
SUBROUTINE kptgen_hybrid(film,grid,cell,sym,kpts,l_soc)
USE m_types
USE m_divi
IMPLICIT NONE
TYPE(t_input), INTENT(IN) :: input
LOGICAL,INTENT(IN) :: film
INTEGER,INTENT(IN) :: grid(3)
TYPE(t_cell), INTENT(IN) :: cell
TYPE(t_sym), INTENT(IN) :: sym
TYPE(t_kpts), INTENT(INOUT) :: kpts
TYPE(t_kpts), INTENT(OUT) :: kpts
! - scalars -
LOGICAL, INTENT(IN) :: l_soc
! - local scalars -
......@@ -44,21 +44,17 @@
REAL,ALLOCATABLE :: rarr(:)
LOGICAL :: ldum
IF (sum(kpts%nkpt3).EQ.0) THEN
CALL divi(kpts%nkpt,cell%bmat,input%film,sym%nop,
& sym%nop2,kpts%nkpt3)
END IF
nkpt=kpts%nkpt3(1)*kpts%nkpt3(2)*kpts%nkpt3(3)
nkpt=grid(1)*grid(2)*grid(3)
ALLOCATE( bk(3,nkpt),bkhlp(3,nkpt) )
ikpt = 0
DO i=0,kpts%nkpt3(1)-1
DO j=0,kpts%nkpt3(2)-1
DO k=0,kpts%nkpt3(3)-1
DO i=0,grid(1)-1
DO j=0,grid(2)-1
DO k=0,grid(3)-1
ikpt = ikpt + 1
bk(:,ikpt) = (/ 1.0*i/kpts%nkpt3(1),1.0*j/kpts%nkpt3(2),
& 1.0*k/kpts%nkpt3(3) /)
bk(:,ikpt) = (/ 1.0*i/grid(1),1.0*j/grid(2),
& 1.0*k/grid(3) /)
END DO
END DO
END DO
......@@ -113,16 +109,16 @@