Commit 56418866 authored by Daniel Wortmann's avatar Daniel Wortmann

Added IO, added kpoint-generation

parent ebed47a4
......@@ -43,7 +43,7 @@ PROGRAM inpgen
REAL, ALLOCATABLE :: atompos(:, :),atomid(:)
CHARACTER(len=20), ALLOCATABLE :: atomLabel(:)
LOGICAL :: l_fullinput,l_explicit,l_inpxml
LOGICAL :: l_fullinput,l_explicit,l_inpxml,l_include
TYPE(t_input) :: input
TYPE(t_atoms) :: atoms
......@@ -62,9 +62,12 @@ PROGRAM inpgen
TYPE(t_stars) :: stars
CHARACTER(len=40):: kpts_str
kpts_str=""
!Start program and greet user
CALL inpgen_help()
l_explicit=judft_was_argument("-explicit")
l_include=judft_was_argument("-singlefile")
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")
......@@ -102,25 +105,21 @@ PROGRAM inpgen
!
! k-points can also be modified here
!
!call make_kpoints()
call make_kpoints(kpts,cell,sym,input%film,noco%l_ss.or.noco%l_soc,kpts_str)
!
!Now the IO-section
!
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,&
.false.,"inp.xml",&
l_explicit,enpara)
!the sym.xml file
PRINT *,"sym->XML missing"
!CALL sym%writeXML(0,"sym.xml")
l_explicit,l_include,enpara)
if (.not.l_include) CALL sym%print_XML(99,"sym.xml")
ENDIF
PRINT *,"kpts->XML missing"
!CALL kpts%writeXML(0,"kpts.xml")
if (.not.l_include) CALL kpts%print_XML(99,kpts_str,"kpts.xml")
! Structure in xsf-format
OPEN (55,file="struct.xsf")
......
......@@ -27,6 +27,7 @@ CONTAINS
CALL new_argument(0,"-inp","convert old inp file to inp.xml file","")
CALL new_argument(1,"-f","filename to process","")
CALL new_argument(0,"-warn_only","do not stop for warnings","")
CALL new_argument(0,"-singlefile","include all data in inp.xml, do not create files for kpoints and symmetry","")
CALL new_argument(0,"-h","Print this help message","")
......
!--------------------------------------------------------------------------------
! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
! This file is part of FLEUR and available as free software under the conditions
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------
module m_make_kpoints
use m_juDFT
implicit none
contains
subroutine make_kpoints(kpts,cell,sym,film,l_socorss,str)
use m_types_kpts
use m_types_cell
use m_types_sym
type(t_kpts),intent(out)::kpts
type(t_cell),intent(in) ::cell
type(t_sym),intent(in) ::sym
logical,intent(in)::l_socorss
character(len=*),intent(inout)::str
logical::tria,l_gamma,l_soc_or_ss
l_soc_or_ss=l_socorss
if (judft_was_argument("-k")) then
if (len_trim(str)>1) call judft_error("Do not specify k-points in file and on command line")
str=judft_string_for_argument("-k")
end if
str=adjustl(str)
do while(index(str,'@')>0)
if (index(str,'tria@')==1) then
tria=.true.
str=str(6:)
endif
if (index(str,'gamma@')==1) then
l_gamma=.true.
str=str(7:)
endif
if (index(str,'soc@')==1) then
l_soc_or_ss=.true.
str=str(5:)
endif
end do
if (index(str,'den=')==1) THEN
str=str(5:)
read(str,*) den
call kpts%init_by_density(den,cell,sym,film,tria,l_soc_or_ss,l_gamma)
elseif(index(str,'nk=')==1) then
str=str(4:)
read(str,*) nk
call kpts%init_by_number(nk,cell,sym,film,tria,l_soc_or_ss,l_gamma)
elseif(index(str,'grid=')==1) then
str=str(6:)
read(str,*) grid
call kpts%init_by_grid(grid,cell,sym,film,tria,l_soc_or_ss,l_gamma)
elseif(index(str,'file')==1) then
call kpts%init_by_kptsfile(cell,sym,film,tria,l_soc_or_ss,l_gamma)
elseif(index(str,'special')==1) then
call kpts%init_by_kptsfile(cell,sym,film,tria,l_soc_or_ss,l_gamma)
elseif(len_trim(str)<1.or.index(adjustl(str),'#')==1) then
call kpts%init_defaults(cell,sym,film,tria,l_soc_or_ss,l_gamma)
else
call judft_error(("Could not process -k argument:"//str))
endif
!set name
if (index(str,"#")>0) then
str=str(index(str,"#")+1:)
else
str='default'
end if
end subroutine make_kpoints
......@@ -190,7 +190,7 @@ CONTAINS
elseif(nkpt>0) then
write(kpts_str,"(a,i0)") "nk=",nkpt
elseif(all([div1,div2,div3]>0)) then
write(kpts_str,"(a,i0,a,i0,a,i0)") "grid=",div1,"x",div2,"x",div3
write(kpts_str,"(a,i0,a,i0,a,i0)") "grid=",div1,",",div2,",",div3
end if
end SUBROUTINE process_kpts
......
......@@ -20,7 +20,7 @@ SUBROUTINE w_inpXML(&
& atoms,vacuum,input,stars,sliceplot,forcetheo,banddos,&
& cell,sym,xcpot,noco,oneD,hybrid,kpts,&
& l_outFile,filename,&
& l_explicitIn,enpara)
& l_explicitIn,l_includeIn,enpara)
use m_types_input
......@@ -63,7 +63,7 @@ SUBROUTINE w_inpXML(&
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_enpara),INTENT(IN) :: enpara
CLASS(t_forcetheo),INTENT(IN):: forcetheo !nothing is done here so far....
LOGICAL, INTENT (IN) :: l_outFile, l_explicitIn
LOGICAL, INTENT (IN) :: l_outFile, l_explicitIn,l_includeIn
CHARACTER(LEN=*),INTENT(IN) :: filename
......@@ -97,7 +97,7 @@ SUBROUTINE w_inpXML(&
INTEGER ::nw,idsprs, n1, n2
INTEGER ieq,i,k,na,n,ilo
REAL s3,ah,a,hs2,rest
LOGICAL l_hyb,l_sym,ldum
LOGICAL l_hyb,ldum
INTEGER :: ierr
! ..
!... Local Arrays
......@@ -116,19 +116,17 @@ SUBROUTINE w_inpXML(&
CHARACTER(len=20) :: mixingScheme
CHARACTER(len=10) :: loType
CHARACTER(len=10) :: bzIntMode
CHARACTER(len=200) :: symFilename
LOGICAL :: l_explicit, l_nocoOpt
LOGICAL :: l_explicit, l_nocoOpt,l_include
INTEGER :: iAtomType, startCoreStates, endCoreStates
CHARACTER(len=100) :: posString(3)
CHARACTER(len=7) :: str
REAL :: tempTaual(3,atoms%nat), scpos(3)
REAL :: amatTemp(3,3), bmatTemp(3,3)
l_include=l_inclueIn.or.l_outfile
l_explicit = l_explicitIn.OR.l_outFile
l_nocoOpt = noco%l_noco.OR.juDFT_was_argument("-noco")
symFilename = 'sym.out'
band = .false.
nw=1
......@@ -231,52 +229,11 @@ SUBROUTINE w_inpXML(&
200 FORMAT(' <bzIntegration valenceElectrons="',f0.8,'" mode="',a,'" fermiSmearingEnergy="',f0.8,'">')
WRITE (fileNum,200) input%zelec,TRIM(ADJUSTL(bzIntMode)),input%tkb
PRINT *,"KPTS->XML broken"
!!$ IF(kpts%specificationType.EQ.3) THEN
!!$ sumWeight = 0.0
!!$ DO i = 1, kpts%nkpt
!!$ sumWeight = sumWeight + kpts%wtkpt(i)
!!$ END DO
!!$ 205 FORMAT(' <kPointList posScale="',f0.8,'" weightScale="',f0.8,'" count="',i0,'">')
!!$ WRITE (fileNum,205) kpts%posScale, sumWeight, kpts%nkpt
!!$ DO i = 1, kpts%nkpt
!!$ 206 FORMAT(' <kPoint weight="',f12.6,'">',f12.6,' ',f12.6,' ',f12.6,'</kPoint>')
!!$ WRITE (fileNum,206) kpts%wtkpt(i), kpts%bk(1,i), kpts%bk(2,i), kpts%bk(3,i)
!!$ END DO
!!$ WRITE (fileNum,'(a)')(' </kPointList>')
!!$ ELSE IF(kpts%specificationType.EQ.1) THEN
!!$
!!$ IF (kpts%numSpecialPoints.GE.2) THEN
!!$ 207 FORMAT(' <kPointCount count="',i0,'" gamma="',l1,'">')
!!$ WRITE (fileNum,207) kpts%nkpt,kptGamma
!!$ 209 FORMAT(' <specialPoint name="',a,'">', f10.6,' ',f10.6,' ',f10.6,'</specialPoint>')
!!$ DO i = 1, kpts%numSpecialPoints
!!$ WRITE(fileNum,209) TRIM(ADJUSTL(kpts%specialPointNames(i))),&
!!$ kpts%specialPoints(1,i),kpts%specialPoints(2,i),kpts%specialPoints(3,i)
!!$ END DO
!!$ WRITE (fileNum,'(a)') ' </kPointCount>'
!!$ ELSE
!!$! <kPointCount count="100" gamma="F"/>
!!$ 208 FORMAT(' <kPointCount count="',i0,'" gamma="',l1,'"/>')
!!$ WRITE (fileNum,208) kpts%nkpt,kptGamma
!!$ END IF
!!$
!!$ ELSE IF (kpts%specificationType.EQ.2) THEN
!!$! <kPointMesh nx="10" ny="10" nz="10" gamma="F"/>
!!$ 210 FORMAT(' <kPointMesh nx="',i0,'" ny="',i0,'" nz="',i0,'" gamma="',l1,'"/>')
!!$ WRITE (fileNum,210) div(1),div(2),div(3),kptGamma
!!$ ELSE !(kpts%specificationType.EQ.4)
!!$ 212 FORMAT(' <kPointDensity denX="',f0.6,'" denY="',f0.6,'" denZ="',f0.6,'" gamma="',l1,'"/>')
!!$ WRITE (fileNum,212) kpts%kPointDensity(1),kpts%kPointDensity(2),kpts%kPointDensity(3),kptGamma
!!$ END IF
!!$
!!$ IF(juDFT_was_argument("-kpts_gw")) THEN
!!$ WRITE(fileNum,'(a)') ' <altKPointSet purpose="GW">'
!!$ WRITE(fileNum,'(a)') ' <kPointListFile filename="kpts_gw"/>'
!!$ WRITE(fileNum,'(a)') ' </altKPointSet>'
!!$ END IF
if (l_include) THEN
call kpts%print_xml(fileNum,"default")
else
WRITE (fileNum,'(a)')' <xi:include xmlns:xi="http://www.w3.org/2001/XInclude" href="kpts.xml"> </xi:include>'
end if
WRITE (fileNum,'(a)') ' </bzIntegration>'
! <energyParameterLimits ellow="-2.00000" elup="2.00000"/>
......@@ -285,29 +242,11 @@ SUBROUTINE w_inpXML(&
WRITE (fileNum,'(a)') ' </calculationSetup>'
WRITE (fileNum,'(a)') ' <cell>'
IF(sym%symSpecType.EQ.3) THEN
WRITE(fileNum,'(a)') ' <symmetryOperations>'
DO i = 1, sym%nop
WRITE(fileNum,'(a)') ' <symOp>'
224 FORMAT(' <row-1>',i0,' ',i0,' ',i0,' ',f0.10,'</row-1>')
WRITE(fileNum,224) sym%mrot(1,1,i), sym%mrot(1,2,i), sym%mrot(1,3,i), sym%tau(1,i)
225 FORMAT(' <row-2>',i0,' ',i0,' ',i0,' ',f0.10,'</row-2>')
WRITE(fileNum,225) sym%mrot(2,1,i), sym%mrot(2,2,i), sym%mrot(2,3,i), sym%tau(2,i)
226 FORMAT(' <row-3>',i0,' ',i0,' ',i0,' ',f0.10,'</row-3>')
WRITE(fileNum,226) sym%mrot(3,1,i), sym%mrot(3,2,i), sym%mrot(3,3,i), sym%tau(3,i)
WRITE(fileNum,'(a)') ' </symOp>'
END DO
WRITE(fileNum,'(a)') ' </symmetryOperations>'
ELSE IF(sym%symSpecType.EQ.1) THEN
228 FORMAT(' <symmetryFile filename="',a,'"/>')
WRITE(fileNum,228) TRIM(ADJUSTL(symFilename))
ELSE !(sym%symSpecType.EQ.2)
! <symmetry spgrp="any" invs="T" zrfs="F"/>
230 FORMAT(' <symmetry spgrp="',a,'" invs="',l1,'" zrfs="',l1,'"/>')
WRITE (fileNum,230) TRIM(ADJUSTL(sym%namgrp)),sym%invs,sym%zrfs
END IF
if (l_include) THEN
call sym%print_xml(fileNum)
else
WRITE (fileNum,'(a)')' <xi:include xmlns:xi="http://www.w3.org/2001/XInclude" href="sym.xml"> </xi:include>'
end if
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!! Note: Different options for the cell definition!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
......
......@@ -37,13 +37,59 @@ MODULE m_types_kpts
procedure :: init_special
!procedure :: read_xml
procedure :: add_special_line
procedure :: print_xml
ENDTYPE t_kpts
public :: t_kpts
CONTAINS
SUBROUTINE add_special_line(kpts,point,name)
subroutine print_xml(fh,name,filename)
CLASS(t_kpts),INTENT(in ):: kpts
integer,intent(in) :: fh
CHARACTER(len=*),INTENT(in):: name
character(len=*),intent(in),optional::filename
integer :: n
logical :: l_exist
if (present(filename)) Then
inquire(file=filename,exist=l_exist)
if (l_exist) THEN
open(fh,file=filename,action="write",position="append")
else
open(fh,file=filename,action="write")
end if
endif
205 FORMAT(' <kPointList name="',a,'" count="',i0,'">')
if (kpts%numSpecialPoints<2) THEN
write(fh,205) name,kpts%nkpt
206 FORMAT(' <kPoint weight="',f12.6,'">',f12.6,' ',f12.6,' ',f12.6,'</kPoint>')
do n=1,kpts%nkpt
WRITE (fh,206) kpts%wtkpt(n), kpts%bk(:,n)
end do
if (kpts%ntet>0) then
write(fh,207) kpts%ntet
207 format(' <tetraeder ntet="',i0,'">')
DO n=1,kpts%ntet
208 format(' <tet vol="',f12.6,'">',i0,' ',i0,' ',i0,' ',i0,'</tet>')
write(fh,208) kpts%voltet(n),kpts%ntetra(:,n)
end DO
write(fh,'(a)') ' </tetraeder>'
else
WRITE (fh,205) name,nkpts%numSpecialPoints
209 FORMAT(' <specialPoint name="',a,'">', f10.6,' ',f10.6,' ',f10.6,'</specialPoint>')
DO n = 1, kpts%numSpecialPoints
WRITE(fh,209) TRIM(ADJUSTL(kpts%specialPointNames(i))),kpts%specialPoints(:,n)
END DO
end if
end if
WRITE (fh,'(a)')(' </kPointList>')
if (present(filename)) close(fh)
end subroutine print_xml
SUBROUTINE add_special_line(kpts,point,name)
CLASS(t_kpts),INTENT(inout):: kpts
CHARACTER(len=*),INTENT(in):: name
REAL,INTENT(in) :: point(3)
......
......@@ -55,9 +55,34 @@ MODULE m_types_sym
CONTAINS
PROCEDURE :: init
procedure :: print_xml
END TYPE t_sym
PUBLIC t_sym
CONTAINS
SUBROUTINE print_xml(sym,fh,filename)
CLASS(t_sym),INTENT(INOUT):: sym
integer,intent(in) ::fh
character(len=*),intent(in),optional::filename
integer::i
if (present(filename)) open(fh,file=filename,status='replace',action='write')
WRITE(fh,'(a)') ' <symmetryOperations>'
DO i = 1, sym%nop
WRITE(fileNum,'(a)') ' <symOp>'
224 FORMAT(' <row-1>',i0,' ',i0,' ',i0,' ',f0.10,'</row-1>')
WRITE(fh,224) sym%mrot(1,1,i), sym%mrot(1,2,i), sym%mrot(1,3,i), sym%tau(1,i)
225 FORMAT(' <row-2>',i0,' ',i0,' ',i0,' ',f0.10,'</row-2>')
WRITE(fh,225) sym%mrot(2,1,i), sym%mrot(2,2,i), sym%mrot(2,3,i), sym%tau(2,i)
226 FORMAT(' <row-3>',i0,' ',i0,' ',i0,' ',f0.10,'</row-3>')
WRITE(fh,226) sym%mrot(3,1,i), sym%mrot(3,2,i), sym%mrot(3,3,i), sym%tau(3,i)
WRITE(fileNum,'(a)') ' </symOp>'
END DO
WRITE(fileNum,'(a)') ' </symmetryOperations>'
if (present(filename)) close(fh)
end SUBROUTINE print_xml
SUBROUTINE init(sym,cell,film)
!Generates missing symmetry info.
!tau,mrot and nop have to be specified already
......
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