Commit 6ae2e892 authored by Daniel Wortmann's avatar Daniel Wortmann

more types :-)

parent 0e6ba4e0
......@@ -12,77 +12,41 @@ MODULE m_make_defaults
! help in the out-file. gb`02
!---------------------------------------------------------------------
CONTAINS
subroutine make_FleurInputSchema()
USE iso_c_binding
implicit none
integer :: errorStatus
logical :: l_exist
interface
function dropInputSchema() bind(C, name="dropInputSchema")
use iso_c_binding
INTEGER(c_int) dropInputSchema
end function dropInputSchema
end interface
inquire(file="FleurInputSchema",exist=l_exist)
if (l_exist) return
errorStatus = 0
errorStatus = dropInputSchema()
IF(errorStatus.NE.0) THEN
call judft_error('Error: Cannot print out FleurInputSchema.xsd')
END IF
end subroutine make_FleurInputSchema
SUBROUTINE make_defaults(atoms,vacuum,input,stars,&
& cell,sym,xcpot,noco,hybrid,kpts)
& title
USE m_types
USE iso_c_binding
USE m_chkmt
USE m_constants
USE m_atominput
USE m_lapwinput
USE m_rwinp
USE m_winpXML
USE m_juDFT_init
USE m_kpoints
USE m_inv3
USE m_types_xcpot_inbuild
IMPLICIT NONE
!-odim
!+odim
! REAL, PARAMETER :: eps=0.00000001
! ..
!HF added for HF and hybrid functionals
INTEGER :: bands
INTEGER :: nkpt3(3)
!HF
INTEGER :: xmlElectronStates(29,atoms%ntype)
LOGICAL :: xmlPrintCoreStates(29,atoms%ntype)
REAL :: xmlCoreOccs(2,29,atoms%ntype)
REAL :: xmlCoreRefOccs(29)
interface
function dropInputSchema() bind(C, name="dropInputSchema")
use iso_c_binding
INTEGER(c_int) dropInputSchema
end function dropInputSchema
end interface
l_test = .false.
l_gga = .true.
! Set parameters to defaults that can not be given to inpgen
ch_rw = 'w'
sym%namgrp= 'any '
vacuum%nstars = 0 ; vacuum%nstm = 0
nu = 5 ; vacuum%layerd = 1 ; iofile = 6
ALLOCATE(vacuum%izlay(vacuum%layerd,2))
vacuum%layers = 0 ; vacuum%izlay(:,:) = 0
vacuum%tworkf = 0.0 ; scpos = 1.0
zc = 0.0 ; vacuum%locx(:) = 0.0 ; vacuum%locy(:) = 0.0
kpts%numSpecialPoints = 0
!Set some more input switches
input%delgau = input%tkb
input%comment = title
IF (noco%l_noco) input%jspins = 2
!defaults ...
stars%gmax=merge(stars%gmax,3.0*input%rkmax,stars%gmax>0)
xcpot%gmaxxc=merge(xcpot%gmaxxc,3.0*input%rkmax,xcpot%gmaxxc>0)
IF ( ANY(atoms%nlo(:).NE.0) ) THEN
input%ellow = -1.8
ELSE
......@@ -93,11 +57,37 @@ CONTAINS
ELSE
input%elup = 1.0
ENDIF
IF (l_hyb) THEN
input%ellow = input%ellow - 2.0
input%elup = input%elup + 10.0
input%gw_neigd = max( nint(input%zelec)*10, 60 )
input%minDistance = 1.0e-5
input%ctail = .false.
ELSE
input%gw_neigd = 0
END IF
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%gmaxInit = stars%gmax
xcpot%gmaxxc=merge(xcpot%gmaxxc,3.0*input%rkmax,xcpot%gmaxxc>0)
xcpot%gmaxxc = real(NINT(xcpot%gmaxxc * 10 ) / 10.)
IF (.not.input%film) THEN
vacuum%dvac = a3(3) ; dtild = vacuum%dvac
vacuum%dvac = a3(3)
Else
vacuum%dvac = real(NINT(vacuum%dvac*100)/100.)
ENDIF
!
!HF added for HF and hybrid functionals
hybrid%gcutm1 = input%rkmax - 0.5
ALLOCATE(hybrid%lcutwf(atoms%ntype))
......@@ -109,83 +99,14 @@ CONTAINS
hybrid%select1(2,:) = 0
hybrid%select1(3,:) = 4
hybrid%select1(4,:) = 2
bands = max( nint(input%zelec)*10, 60 )
hybrid%l_hybrid = l_hyb
IF (l_hyb) THEN
input%ellow = input%ellow - 2.0
input%elup = input%elup + 10.0
input%gw_neigd = bands
kpts%l_gamma = .true.
input%minDistance = 1.0e-5
ELSE
input%gw_neigd = 0
END IF
!HF
! rounding
stars%gmax = real(NINT(stars%gmax * 10 ) / 10.)
input%rkmax = real(NINT(input%rkmax * 10 ) / 10.)
xcpot%gmaxxc = real(NINT(xcpot%gmaxxc * 10 ) / 10.)
hybrid%gcutm1 = real(NINT(hybrid%gcutm1 * 10 ) / 10.)
IF (input%film) THEN
vacuum%dvac = real(NINT(vacuum%dvac*100)/100.)
dtild = real(NINT(dtild*100)/100.)
ENDIF
!
! read some lapw input
!
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)
stars%gmaxInit = stars%gmax
!
nu = 8
IF (kpts%nkpt == 0) THEN ! set some defaults for the k-points
IF (input%film) THEN
cell%area = cell%omtil / vacuum%dvac
kpts%nkpt = MAX(nint((3600/cell%area)/sym%nop2),1)
ELSE
kpts%nkpt = MAX(nint((216000/cell%omtil)/sym%nop),1)
ENDIF
ENDIF
kpts%specificationType = 0
IF((ANY(div(:).NE.0)).AND.(ANY(kpts%kPointDensity(:).NE.0.0))) THEN
CALL juDFT_error('Double specification of k point set', calledby = 'set_inp')
END IF
IF (ANY(div(:).NE.0)) THEN
kpts%specificationType = 2
ELSE IF (ANY(kpts%kPointDensity(:).NE.0.0)) THEN
kpts%specificationType = 4
ELSE
kpts%specificationType = 1
END IF
l_kpts = .FALSE.
IF(TRIM(ADJUSTL(sym%namgrp)).EQ.'any') THEN
sym%symSpecType = 1
ELSE
sym%symSpecType = 2
END IF
! set vacuum%nvac
vacuum%nvac = 2
IF (sym%zrfs.OR.sym%invs) vacuum%nvac = 1
IF (oneD%odd%d1) vacuum%nvac = 1
! 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))
IF (noco%l_ss) input%ctail = .FALSE.
noco%qss = merge(noco%qss,[0.0,0.0,0.0],noco%l_ss)
noco%l_relax(:) = .FALSE.
......@@ -194,30 +115,24 @@ CONTAINS
noco%beta(:) = 0.0
noco%b_con(:,:) = 0.0
kpts%nkpt3(:) = div(:)
IF (kpts%specificationType.EQ.4) THEN
DO i = 1, 3
IF (kpts%kPointDensity(i).LE.0.0) THEN
CALL juDFT_error('Error: Nonpositive kpointDensity provided', calledby = 'set_inp')
END IF
recVecLength = SQRT(cell%bmat(i,1)**2 + cell%bmat(i,2)**2 + cell%bmat(i,3)**2)
kpts%nkpt3(i) = CEILING(kpts%kPointDensity(i) * recVecLength)
END DO
kpts%nkpt = kpts%nkpt3(1) * kpts%nkpt3(2) * kpts%nkpt3(3)
END IF
! 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'
input%ctail = .false. ; atoms%l_geo = .false.! ; input%frcor = .true.
input%itmax = 15 ; input%maxiter = 25!; input%imix = 17
IF (ANY(kpts%nkpt3(:).EQ.0)) kpts%nkpt3(:) = 4
div(:) = kpts%nkpt3(:)
kpts%specificationType = 2
atoms%l_geo = .false.! ; input%frcor = .true.
END IF
latnamTemp = cell%latnam
l_explicit = juDFT_was_argument("-explicit")
......@@ -227,16 +142,12 @@ latnamTemp = cell%latnam
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
errorStatus = 0
errorStatus = dropInputSchema()
IF(errorStatus.NE.0) THEN
STOP 'Error: Cannot print out FleurInputSchema.xsd'
END IF
......
......@@ -5,36 +5,67 @@
!--------------------------------------------------------------------------------
MODULE m_types_kpts
INTEGER,PARAMETER:: kpts_by_number=1
INTEGER,PARAMETER:: kpts_by_mesh =2
INTEGER,PARAMETER:: kpts_by_list =3
TYPE t_kpts
INTEGER :: specificationType
!no
INTEGER :: nkpt
INTEGER :: ntet
REAL :: posScale
LOGICAL :: l_gamma
INTEGER :: nkpt=0
INTEGER :: ntet=0
LOGICAL :: l_gamma=.false.
!(3,nkpt) k-vectors internal units
REAL,ALLOCATABLE :: bk(:,:)
!(nkpts) weights
REAL,ALLOCATABLE :: wtkpt(:)
INTEGER :: nkptf !<k-vectors in full BZ
INTEGER :: nkpt3(3)
REAL :: kPointDensity(3) ! only used if k point set is defined as density
INTEGER :: nkptf=0 !<k-vectors in full BZ
INTEGER :: nkpt3(3)=[0,0,0]
REAL ,ALLOCATABLE :: bkf(:,:)
INTEGER,ALLOCATABLE :: bkp(:)
INTEGER,ALLOCATABLE :: bksym(:)
INTEGER :: numSpecialPoints
INTEGER :: numSpecialPoints=0
INTEGER, ALLOCATABLE :: specialPointIndices(:)
CHARACTER(LEN=50),ALLOCATABLE :: specialPointNames(:)
REAL ,ALLOCATABLE :: specialPoints(:,:)
INTEGER,ALLOCATABLE :: ntetra(:,:)
REAL ,ALLOCATABLE :: voltet(:)
REAL ,ALLOCATABLE :: sc_list(:,:) !list for all information about folding of bandstructure (need for unfoldBandKPTS)((k(x,y,z),K(x,y,z),m(g1,g2,g3)),(nkpt),k_original(x,y,z))
contains
procedure :: init_defaults
procedure :: init_by_density
procedure :: init_by_number
procedure :: init_by_grid
procedure :: init_special
procedure :: read_xml
procedure :: add_special_line
ENDTYPE t_kpts
contains
subroutine init_defaults(kpts,film,area,omtil,nop2,nop)
class(t_kpts),intent(out):: kpts
logical,intent(in) :: film
real,intent(in) :: area,omtil
integer,intent(in) :: nop2,nop
integer:: nkpt
IF (film) THEN
nkpt = MAX(nint((3600/area)/nop2),1)
ELSE
nkpt = MAX(nint((216000/omtil)/nop),1)
ENDIF
call kpts%init_by_number(nkpt)
end subroutine init_defaults
subroutine init_by_density(kpts,density,bmat)
class(t_kpts),intent(out):: kpts
real,intent(in) :: density,bmat(3,3)
real :: length
integer :: n,grid(3)
do n=1,3
length=sqrt(dot_product(bmat(n,:),bmat(n,:))) !TODO why not bmat(:,n)???
grid(n)=ceiling(density*length)
end do
call kpts%init_by_grid(grid)
call kpts%init_grid(kpts
end subroutine init_by_density
END MODULE m_types_kpts
......@@ -213,27 +213,6 @@ MODULE m_types_setup
LOGICAL :: lwb !remove
END TYPE t_obsolete
TYPE t_vacuum
!Stuff for the vacuum
INTEGER ::nmz
INTEGER ::nmzd
INTEGER ::nmzxy
INTEGER ::nmzxyd
INTEGER :: layerd
INTEGER :: layers
INTEGER :: nvac
INTEGER :: nvacd
REAL :: delz
REAL :: dvac
INTEGER::nstars
INTEGER:: nstm
REAL :: tworkf
REAL :: locx(2)
REAL :: locy(2)
LOGICAL ::starcoeff
INTEGER, ALLOCATABLE :: izlay(:, :)
END TYPE t_vacuum
!Data for the spherical harmonics
TYPE t_sphhar
!No of symmetry types (must
......
!--------------------------------------------------------------------------------
! 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_types_vacuum
TYPE t_vacuum
!Stuff for the vacuum
INTEGER ::nmz=250
INTEGER ::nmzd=250
INTEGER ::nmzxy=100
INTEGER ::nmzxyd=100
INTEGER :: layerd=1
INTEGER :: layers=0
INTEGER :: nvac=2
INTEGER :: nvacd=2
REAL :: delz=0.1
REAL :: dvac=0.0
INTEGER::nstars=0
INTEGER:: nstm=0
REAL :: tworkf=0.0
REAL :: locx(2)=[0.,0.]
REAL :: locy(2)=[0.,0.]
LOGICAL ::starcoeff=.false.
INTEGER, ALLOCATABLE :: izlay(:, :)= reshape([0.,0.],[1,2])
END TYPE t_vacuum
end MODULE m_types_vacuum
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