Commit c485ec4e authored by Daniel Wortmann's avatar Daniel Wortmann

Cleanup

parent 4116ecb8
!--------------------------------------------------------------------------------
! Copyright (c) 2017 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_forcetheo
implicit none
contains
subroutine make_forcetheo(forcetheo_data,cell,sym,atoms,forcetheo)
use m_types
USE m_types_forcetheo_extended
TYPE(t_sym), INTENT(IN) :: sym
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_cell), INTENT(IN) :: cell
TYPE(t_forcetheo_data),INTENT(IN):: forcetheo_data
CLASS(t_forcetheo),ALLOCATABLE,INTENT(OUT):: forcetheo
!Finish setup of forcetheorem
SELECT CASE (forcetheo_data%mode)
CASE(1)
ALLOCATE(t_forcetheo_mae::forcetheo)
CASE(2)
ALLOCATE(t_forcetheo_dmi::forcetheo)
CASE(3)
ALLOCATE(t_forcetheo_jij::forcetheo)
CASE(4)
ALLOCATE(t_forcetheo_ssdisp::forcetheo)
CASE default
ALLOCATE(t_forcetheo::forcetheo)
END SELECT
SELECT TYPE(forcetheo)
TYPE IS(t_forcetheo_mae)
CALL forcetheo%init(forcetheo_data%theta,forcetheo_data%phi,cell,sym)
TYPE IS(t_forcetheo_dmi)
CALL forcetheo%init(forcetheo_data%qvec,forcetheo_data%theta,forcetheo_data%phi)
TYPE IS(t_forcetheo_jij)
CALL forcetheo%init(forcetheo_data%qvec,forcetheo_data%theta(1),atoms)
TYPE IS(t_forcetheo_ssdisp)
CALL forcetheo%init(forcetheo_data%qvec)
END SELECT
end subroutine make_forcetheo
end MODULE m_make_forcetheo
!--------------------------------------------------------------------------------
! Copyright (c) 2017 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_xcpot
implicit none
use m_juDFT
private
public make_xcpot
contains
subroutine make_xcpot(xcpot,atoms,input)
use m_types
USE m_types_forcetheo_extended
USE m_types_xcpot_libxc
USE m_types_xcpot_inbuild
USE m_types_xcpot_inbuild_nofunction
TYPE(t_input), INTENT(IN) :: input
TYPE(t_atoms), INTENT(IN) :: atoms
CLASS(t_xcpot),ALLOCATABLE,INTENT(INOUT) :: xcpot
INTEGER ::func_vxc_id_c,func_vxc_id_x,func_exc_id_c,func_exc_id_x
!Finish setup of xcpot
IF (xcpot%l_libxc) THEN
func_vxc_id_c=xcpot%func_vxc_id_c
func_vxc_id_x=xcpot%func_vxc_id_x
func_exc_id_c=xcpot%func_exc_id_c
func_exc_id_x=xcpot%func_exc_id_x
DEALLOCATE(xcpot)
ALLOCATE(t_xcpot_libxc::xcpot)
SELECT TYPE(xcpot)
CLASS is (t_xcpot_libxc)!just allocated like this
CALL xcpot%init(func_vxc_id_x,func_vxc_id_c,func_exc_id_x,func_exc_id_c,input%jspins)
END SELECT
ELSE
SELECT TYPE(xcpot)
CLASS is (t_xcpot_inbuild_nf)
CALL xcpot%init(atoms%ntype)
CLASS DEFAULT
CALL judft_error("Error in setup xcpot")
END SELECT
END IF
end subroutine make_xcpot
end MODULE m_make_xcpot
......@@ -59,11 +59,11 @@ CONTAINS
call mpi_bc(this%volint,rank,mpi_comm)
end subroutine mpi_bc_cell
SUBROUTINE init(cell)
SUBROUTINE init(cell,volmts)
!initialize cell, only input is cell%amat and cell%z1 in case of a film
USE m_constants,ONLY:tpi_const
CLASS (t_cell),INTENT(INOUT):: cell
real,intent(in):: volmts !Volume of all MT-spheres
CALL inv3(cell%amat,cell%bmat,cell%omtil)
IF (cell%omtil<0) CALL judft_warn("Negative volume! You are using a left-handed coordinate system")
......@@ -84,6 +84,8 @@ CONTAINS
cell%bbmat=matmul(cell%bmat,transpose(cell%bmat))
cell%aamat=matmul(transpose(cell%amat),cell%amat)
cell%volint = cell%vol
cell%volint = cell%volint-volmts
CONTAINS
!This is a copy of the code in math/inv3
!Put here to make library independent
......
......@@ -126,6 +126,7 @@ CONTAINS
READ(str,*) this%ntetra(:,n)
ENDDO
END IF
kpts%wtkpt=kpts%wtkpt/sum(kpts%wtkpt) !Normalize k-point weight
END SUBROUTINE read_xml_kpts
SUBROUTINE print_xml(kpts,fh,filename)
......
......@@ -32,6 +32,7 @@ MODULE m_types_noco
CONTAINS
PROCEDURE :: read_xml=>read_xml_noco
PROCEDURE :: mpi_bc =>mpi_bc_noco
PROCEDURE :: init => init_noco
END TYPE t_noco
PUBLIC t_noco
......@@ -129,4 +130,41 @@ MODULE m_types_noco
END IF
ENDDO
END SUBROUTINE read_xml_noco
subroutine init_noco(this,atoms)
use m_types_atoms
use m_constants
CLASS(t_noco),INTENT(inout):: noco
types(t_atoms),INTENT(IN)::atoms
integer :: na,itype
! Check noco stuff and calculate missing noco parameters
IF (noco%l_noco) THEN
IF (noco%l_ss) THEN
!---> the angle beta is relative to the spiral in a spin-spiral
!---> calculation, i.e. if beta = 0 for all atoms in the unit cell
!---> that means that the moments are "in line" with the spin-spiral
!---> (beta = qss * taual). note: this means that only atoms within
!---> a plane perpendicular to qss can be equivalent!
na = 1
DO iType = 1,atoms%ntype
noco%alph(iType) = noco%alphInit(iType) + tpi_const*dot_product(noco%qss,atoms%taual(:,na))
na = na + atoms%neq(iType)
END DO
END IF
ELSE
IF (noco%l_ss) THEN
CALL judft_warn("l_noco=F and l_ss=T is meaningless. Setting l_ss to F.")
noco%l_ss = .FALSE.
END IF
END IF
end subroutine init_noco
END MODULE m_types_noco
......@@ -79,6 +79,7 @@ MODULE m_types_oneD
contains
procedure :: read_xml=>read_xml_oneD
PROCEDURE :: mpi_bc=>mpi_bc_oneD
procedure :: init=>init_oneD
END TYPE t_oneD
PUBLIC::t_oneD,od_dim,od_inp,od_gga,od_lda,od_sym
CONTAINS
......@@ -132,5 +133,17 @@ MODULE m_types_oneD
END IF
END SUBROUTINE read_xml_oneD
subroutine init_oneD(oneD)
class(t_oned),intent(inout)::this
! Initialize missing 1D code arrays
ALLOCATE (oneD%ig1(-oneD%odd%k3:oneD%odd%k3,-oneD%odd%M:oneD%odd%M))
ALLOCATE (oneD%kv1(2,oneD%odd%n2d),oneD%nstr1(oneD%odd%n2d))
ALLOCATE (oneD%ngopr1(atoms%nat),oneD%mrot1(3,3,oneD%odd%nop),oneD%tau1(3,oneD%odd%nop))
ALLOCATE (oneD%invtab1(oneD%odd%nop),oneD%multab1(oneD%odd%nop,oneD%odd%nop))
ALLOCATE (oneD%igfft1(0:oneD%odd%nn2d-1,2),oneD%pgfft1(0:oneD%odd%nn2d-1))
end subroutine init_oneD
END MODULE m_types_oneD
......@@ -21,6 +21,8 @@ init/gen_map.f90
init/make_stars.f90
init/make_sphhar.f90
init/make_sym.f90
init/make_forcetheo.f90
init/make_xcpot.f90
#init/inpeig.f90
init/mapatom.F90
init/od_mapatom.F90
......
......@@ -10,7 +10,7 @@ CONTAINS
SUBROUTINE postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,kpts,&
oneD,hybrid,cell,banddos,sliceplot,xcpot,forcetheo,forcetheo_data,&
noco,DIMENSION,enpara,enparaxml,sphhar,l_opti,noel,l_kpts)
noco,DIMENSION,enpara,enparaxml,sphhar,l_kpts)
USE m_juDFT
USE m_types
......@@ -24,16 +24,14 @@ SUBROUTINE postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,kpts,&
use m_lapwdim
use m_make_stars
use m_make_sphhar
use m_make_forectheo
use m_make_xcpot
use m_make_sym
USE m_convn
USE m_efield
USE m_od_kptsgen
USE m_types_forcetheo_extended
USE m_types_xcpot_libxc
USE m_types_xcpot_inbuild
USE m_types_xcpot_inbuild_nofunction
USE m_relaxio
IMPLICIT NONE
......@@ -60,8 +58,7 @@ SUBROUTINE postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,kpts,&
TYPE(t_field), INTENT(INOUT) :: field
LOGICAL, INTENT (OUT) :: l_opti
LOGICAL, INTENT (IN) :: l_kpts
CHARACTER(len=3), ALLOCATABLE, INTENT(IN) :: noel(:)
INTEGER :: i, j, n, na, n1, n2, iType, l, ilo, ikpt
INTEGER :: minNeigd, nv, nv2, kq1, kq2, kq3, jrc, jsp, ii
INTEGER :: ios, ntst, ierr
......@@ -73,8 +70,7 @@ SUBROUTINE postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,kpts,&
INTEGER, ALLOCATABLE :: jri1(:), lmax1(:)
REAL, ALLOCATABLE :: rmt1(:), dx1(:)
INTEGER ::func_vxc_id_c,func_vxc_id_x,func_exc_id_c,func_exc_id_x
#ifdef CPP_MPI
INCLUDE 'mpif.h'
#endif
......@@ -82,87 +78,18 @@ SUBROUTINE postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,kpts,&
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!! Start of input postprocessing (calculate missing parameters)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
call cell%init()
call cell%init(DOT_PRODUCT(atoms%volmts(:),atoms%neq(:))
call atoms%init(cell)
cell%volint = cell%vol
cell%volint = cell%volint - DOT_PRODUCT(atoms%volmts(:),atoms%neq(:))
CALL sym%init(cell,input%film)
CALL make_sym(sym,cell,atoms,noco,oneD,input)
!Finish setup of xcpot
IF (xcpot%l_libxc) THEN
func_vxc_id_c=xcpot%func_vxc_id_c
func_vxc_id_x=xcpot%func_vxc_id_x
func_exc_id_c=xcpot%func_exc_id_c
func_exc_id_x=xcpot%func_exc_id_x
DEALLOCATE(xcpot)
ALLOCATE(t_xcpot_libxc::xcpot)
SELECT TYPE(xcpot)
CLASS is (t_xcpot_libxc)!just allocated like this
CALL xcpot%init(func_vxc_id_x,func_vxc_id_c,func_exc_id_x,func_exc_id_c,input%jspins)
END SELECT
ELSE
SELECT TYPE(xcpot)
CLASS is (t_xcpot_inbuild_nf)
CALL xcpot%init(atoms%ntype)
CLASS DEFAULT
CALL judft_error("Error in setup xcpot")
END SELECT
END IF
!Finish setup of forcetheorem
SELECT CASE (forcetheo_data%mode)
CASE(1)
ALLOCATE(t_forcetheo_mae::forcetheo)
CASE(2)
ALLOCATE(t_forcetheo_dmi::forcetheo)
CASE(3)
ALLOCATE(t_forcetheo_jij::forcetheo)
CASE(4)
ALLOCATE(t_forcetheo_ssdisp::forcetheo)
CASE default
ALLOCATE(t_forcetheo::forcetheo)
END SELECT
SELECT TYPE(forcetheo)
TYPE IS(t_forcetheo_mae)
CALL forcetheo%init(forcetheo_data%theta,forcetheo_data%phi,cell,sym)
TYPE IS(t_forcetheo_dmi)
CALL forcetheo%init(forcetheo_data%qvec,forcetheo_data%theta,forcetheo_data%phi)
TYPE IS(t_forcetheo_jij)
CALL forcetheo%init(forcetheo_data%qvec,forcetheo_data%theta(1),atoms)
TYPE IS(t_forcetheo_ssdisp)
CALL forcetheo%init(forcetheo_data%qvec)
END SELECT
!Generate enpara datatype
CALL enpara%init_enpara(atoms,input%jspins,input%film,enparaXML)
CALL make_sym(sym,cell,atoms,noco,oneD,input)
call make_forectheo(forcetheo_data,cell,sym,atoms,forcetheo)
call make_xcpot(xcpot,atoms,input)
IF (mpi%irank.EQ.0) call check_input_switches(banddos,vacuum,noco,atoms,input)
! Check noco stuff and calculate missing noco parameters
IF (noco%l_noco) THEN
IF (noco%l_ss) THEN
!---> the angle beta is relative to the spiral in a spin-spiral
!---> calculation, i.e. if beta = 0 for all atoms in the unit cell
!---> that means that the moments are "in line" with the spin-spiral
!---> (beta = qss * taual). note: this means that only atoms within
!---> a plane perpendicular to qss can be equivalent!
na = 1
DO iType = 1,atoms%ntype
noco%alph(iType) = noco%alphInit(iType) + tpi_const*dot_product(noco%qss,atoms%taual(:,na))
na = na + atoms%neq(iType)
END DO
END IF
ELSE
IF (noco%l_ss) THEN
CALL judft_warn("l_noco=F and l_ss=T is meaningless. Setting l_ss to F.")
noco%l_ss = .FALSE.
END IF
END IF
! Generate missing general parameters
minNeigd = MAX(5,NINT(0.75*input%zelec) + 1)
......@@ -176,55 +103,33 @@ SUBROUTINE postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,kpts,&
dimension%neigd = minNeigd
END IF
CALL lapw_dim(kpts,cell,input,noco,oneD,forcetheo,DIMENSION)
IF(dimension%neigd.EQ.-1) THEN
dimension%neigd = dimension%nvd + atoms%nlotot
END IF
IF (noco%l_noco) dimension%neigd = 2*dimension%neigd
! Generate missing parameters for atoms and calculate volume of the different regions
CALL ylmnorm_init(atoms%lmaxd)
dimension%nspd=(atoms%lmaxd+1+mod(atoms%lmaxd+1,2))*(2*atoms%lmaxd+1)
! Initialize missing 1D code arrays
ALLOCATE (oneD%ig1(-oneD%odd%k3:oneD%odd%k3,-oneD%odd%M:oneD%odd%M))
ALLOCATE (oneD%kv1(2,oneD%odd%n2d),oneD%nstr1(oneD%odd%n2d))
ALLOCATE (oneD%ngopr1(atoms%nat),oneD%mrot1(3,3,oneD%odd%nop),oneD%tau1(3,oneD%odd%nop))
ALLOCATE (oneD%invtab1(oneD%odd%nop),oneD%multab1(oneD%odd%nop,oneD%odd%nop))
ALLOCATE (oneD%igfft1(0:oneD%odd%nn2d-1,2),oneD%pgfft1(0:oneD%odd%nn2d-1))
call oneD%init()
! Initialize missing hybrid functionals arrays
ALLOCATE (hybrid%nindx(0:atoms%lmaxd,atoms%ntype))
! Check muffin tin radii
l_test = .TRUE. ! only checking, dont use new parameters
CALL chkmt(atoms,input,vacuum,cell,oneD,l_test)
!adjust positions by displacements
CALL apply_displacements(cell,input,vacuum,oneD,sym,noco,atoms)
call make_sphhar(atoms,sphhar,sym,cell,oneD)
CALL make_stars(stars,sym,atoms,vacuum,sphhar,input,cell,xcpot,oneD,noco,mpi)
! Store structure data
CALL storeStructureIfNew(input,stars, atoms, cell, vacuum, oneD, sym, mpi,sphhar,noco)
!Adjust kpoints in case of DOS
......@@ -240,20 +145,6 @@ SUBROUTINE postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,kpts,&
END IF
! Other small stuff
input%strho = .FALSE.
INQUIRE(file="cdn1",exist=l_opti)
if (noco%l_noco) INQUIRE(file="rhomat_inp",exist=l_opti)
l_opti=.not.l_opti
IF ((sliceplot%iplot).OR.(input%strho).OR.(input%swsp).OR.&
(input%lflip).OR.(input%l_bmt)) l_opti = .TRUE.
kpts%wtkpt=kpts%wtkpt/sum(kpts%wtkpt) !Normalize k-point weight
CALL prp_xcfft(stars,input,cell,xcpot)
......
......@@ -102,7 +102,7 @@ CONTAINS
! local scalars
INTEGER :: eig_id,archiveType
INTEGER :: n,iter,iterHF
LOGICAL :: l_opti,l_cont,l_qfix,l_real
LOGICAL :: l_cont,l_qfix,l_real
REAL :: fix
#ifdef CPP_MPI
INCLUDE 'mpif.h'
......@@ -113,14 +113,14 @@ CONTAINS
CALL timestart("Initialization")
CALL fleur_init(mpi,input,field,DIMENSION,atoms,sphhar,cell,stars,sym,noco,vacuum,forcetheo,sliceplot,&
banddos,enpara,xcpot,results,kpts,hybrid,oneD,coreSpecInput,wann,l_opti)
banddos,enpara,xcpot,results,kpts,hybrid,oneD,coreSpecInput,wann)
CALL timestop("Initialization")
IF ( ( input%preconditioning_param /= 0 ) .AND. oneD%odi%d1 ) THEN
CALL juDFT_error('Currently no preconditioner for 1D calculations', calledby = 'fleur')
END IF
IF (l_opti) CALL optional(mpi,atoms,sphhar,vacuum,dimension,&
CALL optional(mpi,atoms,sphhar,vacuum,dimension,&
stars,input,sym,cell,sliceplot,xcpot,noco,oneD)
IF (input%l_wann.AND.(mpi%irank==0).AND.(.NOT.wann%l_bs_comf)) THEN
......
This diff is collapsed.
......@@ -114,8 +114,7 @@ CONTAINS
!
! --->generate starting charge density
!
strho=input%strho
IF (.NOT.(strho.OR.sliceplot%iplot)) THEN
IF (.NOT.(sliceplot%iplot)) THEN
archiveType = CDN_ARCHIVE_TYPE_CDN1_const
IF (noco%l_noco) THEN
archiveType = CDN_ARCHIVE_TYPE_NOCO_const
......@@ -168,7 +167,6 @@ CONTAINS
ENDIF ! mpi%irank == 0
IF (sliceplot%iplot) CALL juDFT_end("density plot o.k.",mpi%irank)
IF (input%strho) CALL juDFT_end("starting density generated",mpi%irank)
IF (input%swsp) CALL juDFT_end("spin polarised density generated",mpi%irank)
IF (input%lflip) CALL juDFT_end("magnetic moments flipped",mpi%irank)
IF (input%l_bmt) CALL juDFT_end('"cdnbmt" written',mpi%irank)
......
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