Commit 12c8019f authored by Gregor Michalicek's avatar Gregor Michalicek

Initial commit of xml input file generator.

Besides the conventional input, the new inpgen now also generates an
inp.xml file containing all required data to start a calculation. The
commit also includes additional command line parameters for inpgen:

   "-explicit": This writes k-points, symmetry operations, and the Bravais
                matrix explicitly into the inp.xml file.
   "-noXML":    This switches of the generation of the inp.xml file.
parent 6b2d091c
......@@ -37,12 +37,14 @@ inpgen/atom_sym.f inpgen/generator.f inpgen/read_record.f inpgen/soc_or_ssdw.f i
inpgen/bravais_symm.f inpgen/set_atom_core.f inpgen/spg_gen.f global/triang.f
inpgen/closure.f inpgen/lapw_input.f inpgen/struct_input.f inpgen/write_struct.f
global/hybridmix.f io/calculator.f global/ss_sym.f global/soc_sym.f math/inv3.f io/rw_symfile.f
global/sort.f
global/sort.f init/kptgen_hybrid.f init/od_kptsgen.f init/bravais.f init/divi.f init/brzone.f
init/kptmop.f init/kpttet.f init/bandstr1.F init/ordstar.f init/fulstar.f init/kprep.f
init/tetcon.f init/kvecon.f
)
set(inpgen_F90 io/xsf_io.f90
global/types.F90 global/enpara.f90 global/chkmt.f90 inpgen/inpgen.f90 inpgen/set_inp.f90 io/rw_inp.f90 juDFT/juDFT.F90
juDFT/stop.F90 juDFT/time.F90 juDFT/init.F90)
juDFT/stop.F90 juDFT/time.F90 juDFT/init.F90 io/w_inpXML.f90 init/julia.f90)
set(fleur_SRC ${fleur_F90} ${fleur_F77})
......
......@@ -246,9 +246,10 @@
TYPE t_kpts
!no
INTEGER ::nkpts
INTEGER ::nkpt
INTEGER ::nkptd
INTEGER :: nkpts
INTEGER :: nkpt
INTEGER :: nkptd
LOGICAL :: l_gamma
INTEGER :: nmop(3) !<number of k-points in 3 directions
!(3,nkpts) k-vectors internal units
REAL,ALLOCATABLE ::bk(:,:)
......
......@@ -331,7 +331,7 @@
sym%nop2=1
CALL julia(&
& sym,cell,input,noco,banddos,&
& kpts,.false.)
& kpts,.false.,.FALSE.)
sym%nop=n1
sym%nop2=n2
ELSE IF(l_gamma .and. banddos%ndir .eq. 0) THEN
......@@ -341,7 +341,7 @@
ELSE
CALL julia(&
& sym,cell,input,noco,banddos,&
& kpts,.false.)
& kpts,.false.,.FALSE.)
ENDIF
ELSE
CALL od_kptsgen (kpts%nkpt)
......@@ -381,7 +381,7 @@
noco%l_soc=.false.
CALL julia(&
& sym,cell,input,noco,banddos,&
& kpts,.true.)
& kpts,.true.,.FALSE.)
noco%l_ss=l_tmp(1); noco%l_soc=l_tmp(2)
ENDIF
......
......@@ -3,7 +3,7 @@
CONTAINS
SUBROUTINE julia(&
& sym,cell,input,noco,banddos,&
& kpts,l_q)
& kpts,l_q,l_fillArrays)
!----------------------------------------------------------------------+
! Generate a k-point file with approx. nkpt k-pts or a Monkhorst-Pack |
! set with nmod(i) divisions in i=x,y,z direction. Interface to kptmop |
......@@ -27,7 +27,7 @@
TYPE(t_banddos),INTENT(IN) :: banddos
TYPE(t_kpts),INTENT(INOUT) :: kpts
LOGICAL, INTENT (IN) :: l_q
LOGICAL, INTENT (IN) :: l_q, l_fillArrays
INTEGER, PARAMETER :: nop48 = 48
INTEGER, PARAMETER :: mface = 51
......@@ -103,6 +103,7 @@
! oblique = p-monoclinic ( 1+2 axis ) 6/1
!
!------------------------------------------------------------
IF(l_q) THEN
trias=input%tria
input%tria=.false.
......@@ -246,6 +247,7 @@
ndiv3 = 6*(mkpt+1)
ALLOCATE (vkxyz(3,mkpt),wghtkp(mkpt) )
ALLOCATE ( voltet(ndiv3),vktet(3,mkpt),ntetra(4,ndiv3) )
vkxyz = 0.0
CALL kpttet(&
& iofile,ibfile,iokpt,&
& kpri,ktest,kmidtet,mkpt,ndiv3,&
......@@ -269,6 +271,7 @@
& kpts%nkpt,cell%bmat,input%film,sym%nop,sym%nop2,&
& kpts%nmop)
ENDIF
!
! Now calculate Monkhorst-Pack k-points:
!
......@@ -282,6 +285,7 @@
IF (.not.input%film) mkpt = mkpt*kpts%nmop(3)
ENDIF
ALLOCATE (vkxyz(3,mkpt),wghtkp(mkpt) )
vkxyz = 0.0
CALL kptmop(&
& iofile,iokpt,kpri,ktest,&
......@@ -292,6 +296,7 @@
& kpts%nkpt,divis,vkxyz,nkstar,wghtkp)
ENDIF
!
idivis(1) = int(divis(1))
idivis(2) = int(divis(2))
......@@ -332,30 +337,48 @@
8050 FORMAT (2(f14.10,1x),f14.10)
!
! write k-points file
! write k-points file or write data into arrays
!
IF (l_fillArrays) THEN
IF (ALLOCATED(kpts%bk)) THEN
DEALLOCATE(kpts%bk)
END IF
IF (ALLOCATED(kpts%weight)) THEN
DEALLOCATE(kpts%weight)
END IF
ALLOCATE(kpts%bk(3,kpts%nkpt),kpts%weight(kpts%nkpt))
DO j = 1, kpts%nkpt
kpts%bk(1,j) = vkxyz(1,j) / real(idiv)
kpts%bk(2,j) = vkxyz(2,j) / real(idiv)
kpts%bk(3,j) = vkxyz(3,j) / real(idiv)
kpts%weight(j) = wghtkp(j)
END DO
ELSE
OPEN (41,file='kpts',form='formatted',status='new')
IF (input%film) THEN
WRITE (41,FMT=8110) kpts%nkpt,real(idiv),.false.
DO j=kpts%nkpt,1,-1
WRITE (41,FMT=8040) (vkxyz(i,j),i=1,2),wghtkp(j)
ENDDO
END DO
ELSE
WRITE (41,FMT=8100) kpts%nkpt,real(idiv)
DO j = 1, kpts%nkpt
WRITE (41,FMT=8040) (vkxyz(i,j),i=1,3),wghtkp(j)
ENDDO
END DO
IF (input%tria.AND.random) THEN
WRITE (41,'(i5)') ntet
WRITE (41,'(4(4i6,4x))') ((ntetra(i,j),i=1,4),j=1,ntet)
WRITE (41,'(4f20.13)') (ABS(voltet(j)),j=1,ntet)
ENDIF
END IF
END IF
8100 FORMAT (i5,f20.10)
8110 FORMAT (i5,f20.10,3x,l1)
8040 FORMAT (4f10.5)
CLOSE (41)
END IF
DEALLOCATE ( vkxyz,wghtkp )
IF (input%tria.AND..not.input%film) DEALLOCATE ( voltet,vktet,ntetra )
RETURN
......
......@@ -20,9 +20,9 @@ PROGRAM inpgen
IMPLICIT NONE
INTEGER natmax,nop48,nline,natin,ngen,i,j
INTEGER nops,no3,no2,na
INTEGER nops,no3,no2,na,numSpecies
INTEGER infh,errfh,bfh,warnfh,symfh,dbgfh,outfh,dispfh
LOGICAL cal_symm,checkinp
LOGICAL cal_symm,checkinp,newSpecies
LOGICAL cartesian,oldfleur,l_hyb ,inistop
REAL aa
......@@ -32,6 +32,7 @@ PROGRAM inpgen
REAL, ALLOCATABLE :: idlist(:)
INTEGER, ALLOCATABLE :: ntyrep(:) ! these variables are allocated with
INTEGER, ALLOCATABLE :: natype(:),natrep(:),natmap(:) ! or 'nat'
INTEGER, ALLOCATABLE :: speciesRepAtomType(:),atomTypeSpecies(:)
INTEGER, PARAMETER :: xl_buffer=16384 ! maximum length of read record
CHARACTER(len=xl_buffer) :: buffer
......@@ -48,7 +49,7 @@ PROGRAM inpgen
TYPE(t_vacuum) :: vacuum
nop48 = 48
natmax = 5999
natmax = 9999
ngen = 0
infh = 5
errfh = 6 ; warnfh = 6 ; dbgfh = 6 ; outfh = 6
......@@ -146,7 +147,7 @@ PROGRAM inpgen
DO i=1,atoms%nat
atoms%pos(:,i) = matmul( cell%amat , atoms%taual(:,i) )
ENDDO
DEALLOCATE ( ntyrep, natype, natrep, atomid )
!
! --> write a file 'sym.out' with accepted symmetry operations
!
......@@ -157,15 +158,42 @@ PROGRAM inpgen
& 'W',symfh,symfn,nops,cell%bmat,&
& sym%mrot,sym%tau,sym%nop,sym%nop2,sym%symor)
ALLOCATE (atomTypeSpecies(atoms%ntype))
ALLOCATE (speciesRepAtomType(atoms%nat))
numSpecies = 0
speciesRepAtomType = -1
atomTypeSpecies = -1
DO i = 1, atoms%nat
newSpecies = .TRUE.
DO j = 1, i-1
IF(atomid(i).EQ.atomid(j)) THEN
newSpecies = .FALSE.
atomTypeSpecies(natype(i)) = atomTypeSpecies(natype(j))
EXIT
END IF
END DO
IF(newSpecies) THEN
numSpecies = numSpecies + 1
speciesRepAtomType(numSpecies) = natype(i)
atomTypeSpecies(natype(i)) = numSpecies
END IF
END DO
!
! --> set defaults for FLEUR inp-file
!
ALLOCATE ( atoms%rmt(atoms%ntype) )
atoms%nlod=9 ! This fixed dimensioning might have to be made more dynamical!
CALL set_inp(&
& infh,nline,xl_buffer,buffer,l_hyb,&
& atoms,sym,cell,title,idlist,&
& input,vacuum,noco,&
& atomTypeSpecies,speciesRepAtomType,&
& a1,a2,a3)
DEALLOCATE (atomTypeSpecies,speciesRepAtomType)
DEALLOCATE ( ntyrep, natype, natrep, atomid )
!
! --> Structure in povray or xsf-format
!
......
......@@ -10,14 +10,22 @@
& infh,nline,xl_buffer,buffer,l_hyb,&
& atoms,sym,cell,title,idlist,&
& input,vacuum,noco,&
& atomTypeSpecies,speciesRepAtomType,&
& a1,a2,a3)
USE m_chkmt
USE m_constants, ONLY : namat_const
USE m_constants
USE m_atominput
USE m_lapwinput
USE m_rwinp
USE m_winpXML
USE m_types
USE m_juDFT_init
USE m_julia
USE m_kptgen_hybrid
USE m_od_kptsgen
USE m_inv3
IMPLICIT NONE
TYPE(t_input),INTENT(INOUT) :: input
TYPE(t_vacuum),INTENT(INOUT) :: vacuum
......@@ -28,14 +36,16 @@
INTEGER, INTENT (IN) :: infh,xl_buffer
INTEGER, INTENT (INOUT) :: nline
INTEGER, INTENT (IN) :: atomTypeSpecies(atoms%ntype)
INTEGER, INTENT (IN) :: speciesRepAtomType(atoms%nat)
CHARACTER(len=xl_buffer) :: buffer
LOGICAL, INTENT (IN) :: l_hyb
REAL, INTENT (IN) :: idlist(:)
REAL, INTENT (INOUT) :: a1(3),a2(3),a3(3)
CHARACTER(len=80), INTENT (IN) :: title
INTEGER nel,i,j
REAL kmax,dtild,dvac1,n1,n2,gam,kmax0,dtild0,dvac0
INTEGER nel,i,j, nkptOld
REAL kmax,dtild,dvac1,n1,n2,gam,kmax0,dtild0,dvac0,sumWeight
LOGICAL l_test,l_gga,l_exists
REAL dx0(atoms%ntype), rmtTemp(atoms%ntype)
INTEGER div(3)
......@@ -45,6 +55,7 @@
CHARACTER(len=8) :: name(10)
CHARACTER(len=3) :: noel(atoms%ntype)
CHARACTER(len=12) :: relcor
CHARACTER(len=3) :: latnamTemp
INTEGER nu,iofile
INTEGER iggachk
INTEGER n ,iostat
......@@ -316,12 +327,6 @@
nu = 8
input%gw = 0
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,name)
iofile = 6
OPEN (iofile,file='inp',form='formatted',status='old',position='append')
IF (kpts%nkpt == 0) THEN ! set some defaults for the k-points
IF (input%film) THEN
......@@ -331,6 +336,76 @@
kpts%nkpt = nint((216000/cell%omtil)/sym%nop)
ENDIF
ENDIF
IF(.NOT.juDFT_was_argument("-noXML")) THEN
nkptOld = kpts%nkpt
latnamTemp = cell%latnam
IF(juDFT_was_argument("-explicit")) THEN
! kpts generation
CALL inv3(cell%amat,cell%bmat,cell%omtil)
cell%bmat=tpi_const*cell%bmat
kpts%nmop(:) = div(:)
kpts%l_gamma = l_gamma
IF (.NOT.oneD%odd%d1) THEN
IF (jij%l_J) THEN
n1=sym%nop
n2=sym%nop2
sym%nop=1
sym%nop2=1
CALL julia(sym,cell,input,noco,banddos,kpts,.FALSE.,.TRUE.)
sym%nop=n1
sym%nop2=n2
ELSE IF(kpts%l_gamma .and. banddos%ndir .eq. 0) THEN
STOP 'Error: No kpoint set generation for gamma=T yet!'
CALL kptgen_hybrid(kpts%nmop(1),kpts%nmop(2),kpts%nmop(3),&
kpts%nkpt,sym%invs,noco%l_soc,sym%nop,&
sym%mrot,sym%tau)
ELSE
CALL julia(sym,cell,input,noco,banddos,kpts,.FALSE.,.TRUE.)
END IF
ELSE
STOP 'Error: No kpoint set generation for 1D systems yet!'
CALL od_kptsgen (kpts%nkpt)
END IF
kpts%nkpts = kpts%nkpt
ALLOCATE(kpts%wtkpt(kpts%nkpt))
sumWeight = 0.0
WRITE(*,*) 'nkpt: ', kpts%nkpt
DO i = 1, kpts%nkpt
sumWeight = sumWeight + kpts%weight(i)
END DO
DO i = 1, kpts%nkpt
kpts%weight(i) = kpts%weight(i) / sumWeight
kpts%wtkpt(i) = kpts%weight(i)
END DO
kpts%nkptd = kpts%nkpt
!set latnam to any
cell%latnam = 'any'
END IF
CALL w_inpXML(&
& atoms,obsolete,vacuum,input,stars,sliceplot,banddos,&
& cell,sym,xcpot,noco,jij,oneD,hybrid,kpts,div,l_gamma,&
& noel,namex,relcor,a1,a2,a3,scale,dtild,name,&
& xmlCoreStates,xmlPrintCoreStates,xmlCoreOccs,&
& atomTypeSpecies,speciesRepAtomType,&
& el0,ello0,evac0)
kpts%nkpt = nkptOld
cell%latnam = latnamTemp
END IF !xml output
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,name)
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
......
This diff is collapsed.
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