Commit 45716040 authored by Daniel Wortmann's avatar Daniel Wortmann

Bugfixes for parallel case, reshuffling of init routines to separate stuff according to MPI usage

parent b4e8f6e1
This diff is collapsed.
......@@ -113,7 +113,7 @@ MODULE m_types_atoms
class(t_atoms),INTENT(INOUT)::this
integer,INTENT(IN):: mpi_comm
INTEGER,INTENT(IN),OPTIONAL::irank
INTEGER ::rank
INTEGER ::rank,myrank,ierr,n
if (present(irank)) THEN
rank=irank
else
......@@ -160,11 +160,27 @@ MODULE m_types_atoms
call mpi_bc(this%relax,rank,mpi_comm)
call mpi_bc(this%nflip,rank,mpi_comm)
!this needs work
!TYPE(t_econfig),ALLOCATABLE::econf(:)
!TYPE(t_utype), ALLOCATABLE::lda_u(:)
#ifdef CPP_MPI
CALL mpi_COMM_RANK(mpi_comm,myrank,ierr)
IF (myrank.ne.rank) Then
if (allocated(this%econf)) DEALLOCATE(this%econf)
if (allocated(this%lda_u)) DEALLOCATE(this%lda_u)
ALLOCATE(this%econf(this%ntype))
ALLOCATE(this%lda_u(4*this%ntype))
ENDIF
DO n=1,this%ntype
call this%econf(n)%broadcast(rank,mpi_comm)
endDO
DO n=1,this%n_u
call mpi_bc(this%lda_u(n)%j,irank,mpi_comm)
call mpi_bc(this%lda_u(n)%u,irank,mpi_comm)
call mpi_bc(this%lda_u(n)%theta,irank,mpi_comm)
call mpi_bc(this%lda_u(n)%phi,irank,mpi_comm)
call mpi_bc(this%lda_u(n)%l,irank,mpi_comm)
call mpi_bc(this%lda_u(n)%atomType,irank,mpi_comm)
call mpi_bc(this%lda_u(n)%l_amf,irank,mpi_comm)
ENDDO
#endif
end subroutine mpi_bc_atoms
LOGICAL FUNCTION same_species(atoms,n,nn)
......
......@@ -80,21 +80,18 @@ CONTAINS
END FUNCTION get_state_string
SUBROUTINE broadcast(econf,mpi_comm)
SUBROUTINE broadcast(econf,irank,mpi_comm)
USE m_mpi_bc_tool
CLASS(t_econfig),INTENT(INOUT):: econf
INTEGER,INTENT(in) :: mpi_comm
INTEGER,INTENT(in) :: irank,mpi_comm
#ifdef CPP_MPI
INCLUDE 'mpif.h'
INTEGER :: ierr,irank
CALL mpi_bc(econf%num_core_states,0,mpi_comm)
CALL mpi_bc(econf%num_states,0,mpi_comm)
CALL mpi_bc(econf%nprnc,0,mpi_comm)
CALL mpi_bc(econf%kappa,0,mpi_comm)
CALL mpi_bc(econf%occupation,0,mpi_comm)
CALL mpi_bc(econf%core_electrons,0,mpi_comm)
CALL mpi_bc(econf%valence_electrons,0,mpi_comm)
CALL mpi_bc(econf%num_core_states,irank,mpi_comm)
CALL mpi_bc(econf%num_states,irank,mpi_comm)
CALL mpi_bc(econf%nprnc,irank,mpi_comm)
CALL mpi_bc(econf%kappa,irank,mpi_comm)
CALL mpi_bc(econf%occupation,Irank,mpi_comm)
CALL mpi_bc(econf%core_electrons,irank,mpi_comm)
CALL mpi_bc(econf%valence_electrons,irank,mpi_comm)
#endif
END SUBROUTINE broadcast
......
......@@ -33,17 +33,19 @@ MODULE m_types_xcpot
REAL,ALLOCATABLE :: gr(:,:,:)
REAL,ALLOCATABLE :: laplace(:,:)
END TYPE t_gradients
TYPE,ABSTRACT,EXTENDS(t_fleurinput_base) :: t_xcpot
TYPE,EXTENDS(t_fleurinput_base) :: t_xcpot
REAL :: gmaxxc
!Data for libxc
LOGICAL :: l_libxc=.FALSE.
INTEGER :: func_vxc_id_c, func_vxc_id_x !> functionals to be used for potential & density convergence
INTEGER :: func_exc_id_c, func_exc_id_x !> functionals to be used in exc- & totale-calculations
!For inbuild
LOGICAL :: l_inbuild=.FALSE.
CHARACTER(len=10):: inbuild_name="vwn"
LOGICAL :: l_relativistic=.FALSE.
CONTAINS
PROCEDURE :: vxc_is_LDA => xcpot_vxc_is_LDA
PROCEDURE :: vxc_is_GGA => xcpot_vxc_is_GGA
......@@ -73,18 +75,18 @@ MODULE m_types_xcpot
CONTAINS
SUBROUTINE mpi_bc_xcpot(this,mpi_comm,irank)
USE m_mpi_bc_tool
CLASS(t_xcpot),INTENT(INOUT)::this
INTEGER,INTENT(IN):: mpi_comm
INTEGER,INTENT(IN),OPTIONAL::irank
INTEGER ::rank
IF (PRESENT(irank)) THEN
rank=irank
ELSE
rank=0
END IF
Subroutine Mpi_bc_xcpot(This,Mpi_comm,Irank)
Use M_mpi_bc_tool
Class(T_xcpot),Intent(Inout)::This
Integer,Intent(In):: Mpi_comm
Integer,Intent(In),Optional::Irank
Integer ::Rank
If (Present(Irank)) Then
Rank=Irank
Else
Rank=0
End If
CALL mpi_bc(this%l_libxc,rank,mpi_comm)
CALL mpi_bc(this%func_vxc_id_c,rank,mpi_comm)
CALL mpi_bc(this%func_vxc_id_x ,rank,mpi_comm)
......@@ -93,7 +95,6 @@ MODULE m_types_xcpot
CALL mpi_bc(this%l_inbuild,rank,mpi_comm)
CALL mpi_bc(rank,mpi_comm,this%inbuild_name)
CALL mpi_bc(this%l_relativistic,rank,mpi_comm)
END SUBROUTINE mpi_bc_xcpot
......@@ -101,7 +102,7 @@ MODULE m_types_xcpot
USE m_types_xml
CLASS(t_xcpot),INTENT(INOUT):: this
TYPE(t_xml),INTENT(in) :: xml
CHARACTER(len=10)::xpathA,xpathB
INTEGER :: vxc_id_x,vxc_id_c, exc_id_x, exc_id_c,jspins
LOGICAL :: l_libxc_names
......@@ -114,14 +115,14 @@ MODULE m_types_xcpot
this%inbuild_name=TRIM(ADJUSTL(xml%GetAttributeValue(TRIM(ADJUSTL('/fleurInput/xcFunctional/@name')))))
this%l_relativistic=evaluateFirstBoolOnly(xml%GetAttributeValue('/fleurInput/xcFunctional/@relativisticCorrections'))
ENDIF
!Input for libxc
! Read in xc functional parameters
!Read in libxc parameters if present
xPathA = '/fleurInput/xcFunctional/LibXCID'
xPathB = '/fleurInput/xcFunctional/LibXCName'
! LibXCID
! LibXCID
IF (xml%GetNumberOfNodes(xPathA) == 1) THEN
this%l_libxc=.TRUE.
this%func_vxc_id_x=evaluateFirstOnly(xml%GetAttributeValue(xPathA // '/@exchange'))
......@@ -131,29 +132,29 @@ MODULE m_types_xcpot
ELSE
this%func_exc_id_x = vxc_id_x
ENDIF
IF(xml%GetNumberOfNodes(TRIM(xPathA) // '/@exc_correlation') == 1) THEN
this%func_exc_id_c = evaluateFirstOnly(xml%GetAttributeValue(xPathA // '/@exc_correlation'))
ELSE
this%func_exc_id_c = this%func_vxc_id_c
ENDIF
! LibXCName
! LibXCName
ELSEIF (xml%GetNumberOfNodes(TRIM(xPathB)) == 1) THEN
l_libxc_names=.TRUE.
#ifdef CPP_LIBXC
valueString = TRIM(ADJUSTL(xml%GetAttributeValue(TRIM(xPathB) // '/@exchange')))
this%func_vxc_id_x = xc_f03_functional_get_number(TRIM(valueString))
valueString = TRIM(ADJUSTL(xml%GetAttributeValue(TRIM(xPathB) // '/@correlation')))
this%func_vxc_id_c = xc_f03_functional_get_number(TRIM(valueString))
IF(xml%GetNumberOfNodes(TRIM(xPathB) // '/@etot_exchange') == 1) THEN
valueString = TRIM(ADJUSTL(xml%GetAttributeValue(TRIM(xPathB) // '/@etot_exchange')))
this%func_exc_id_x = xc_f03_functional_get_number(TRIM(valueString))
ELSE
this%func_exc_id_x = this%func_vxc_id_x
ENDIF
IF(xml%GetNumberOfNodes(TRIM(xPathB) // '/@etot_correlation') == 1) THEN
valueString = TRIM(ADJUSTL(xml%GetAttributeValue(TRIM(xPathB) // '/@etot_correlation')))
this%func_exc_id_c = xc_f03_functional_get_number(TRIM(valueString))
......@@ -164,12 +165,12 @@ MODULE m_types_xcpot
CALL judft_error("To use libxc functionals you have to compile with libXC support")
#endif
ENDIF
IF (this%l_libxc.AND.l_libxc_names) CALL judft_error("You specified libxc by name and id, please choose only one option")
this%l_libxc=this%l_libxc.OR.l_libxc_names
IF (this%l_inbuild.AND.this%l_libxc) CALL judft_error("You specified libxc and an inbuild xc-pot, please choose only one option")
IF (.NOT.(this%l_inbuild.OR.this%l_libxc)) CALL judft_error("You specified no xc-pot")
END SUBROUTINE read_xml_xcpot
! LDA
......@@ -184,7 +185,7 @@ MODULE m_types_xcpot
CLASS(t_xcpot),INTENT(IN):: xcpot
xcpot_vx_is_LDA=.FALSE.
END FUNCTION xcpot_vx_is_LDA
LOGICAL FUNCTION xcpot_vxc_is_LDA(xcpot)
IMPLICIT NONE
CLASS(t_xcpot),INTENT(IN):: xcpot
......@@ -209,7 +210,7 @@ MODULE m_types_xcpot
CLASS(t_xcpot),INTENT(IN):: xcpot
xcpot_vx_is_GGA=.FALSE.
END FUNCTION xcpot_vx_is_GGA
LOGICAL FUNCTION xcpot_vxc_is_gga(xcpot)
IMPLICIT NONE
CLASS(t_xcpot),INTENT(IN):: xcpot
......@@ -286,7 +287,7 @@ MODULE m_types_xcpot
!---> xc energy density
REAL, INTENT (OUT) :: exc (:)
TYPE(t_gradients),OPTIONAL,INTENT(IN) :: grad
LOGICAL, OPTIONAL, INTENT(IN) :: mt_call
LOGICAL, OPTIONAL, INTENT(IN) :: mt_call
REAL, INTENT(IN), OPTIONAL :: kinEnergyDen_KS(:,:)
exc = 0.0
......
......@@ -14,6 +14,7 @@ init/spgrot.f
init/strgn_dim.F
)
set(fleur_F90 ${fleur_F90}
init/fleurinput_postprocess.f90
init/compile_descr.F90
init/checks.F90
init/efield.f90
......@@ -32,6 +33,5 @@ init/prp_xcfft.f90
init/stepf.F90
init/strgn.f90
init/postprocessInput.F90
init/initParallelProcesses.F90
init/lapw_dim.F90
)
......@@ -5,7 +5,7 @@
PRIVATE
PUBLIC :: e_field
CONTAINS
SUBROUTINE e_field(atoms, DIMENSION, stars, sym, vacuum, cell, input,efield)
SUBROUTINE e_field(atoms, stars, sym, vacuum, cell, input,efield)
!
!*********************************************************************
! sets the values of the sheets of charge for external electric
......@@ -23,7 +23,6 @@
! ..
! .. Scalar Arguments ..
TYPE(t_atoms), INTENT (IN) :: atoms
TYPE(t_dimension),INTENT(IN) :: dimension
Type(t_stars),INTENT(IN) :: stars
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_vacuum),INTENT(IN) :: vacuum
......@@ -253,7 +252,7 @@
REAL :: tmp
INTEGER :: i
! New format
ALLOCATE(E%sigEF(3*k1d, 3*k2d, nvac))
E%sigEF = 0.0
......@@ -753,7 +752,7 @@
END DO
END IF
END SUBROUTINE print_efield
SUBROUTINE V_seg_EF(&
& efield,&
& vacuum, stars)
......
MODULE m_fleurinput_postprocess
USE m_types_fleurinput
IMPLICIT NONE
CONTAINS
SUBROUTINE fleurinput_postprocess(Cell,Sym,Atoms,Input,Noco,Vacuum,&
Banddos,Oned,Wann,Xcpot,Kpts)
USE m_juDFT
USE m_types
use m_make_sym
USE m_chkmt
use m_make_xcpot
use m_lapwdim
use m_checks
USE m_relaxio
TYPE(t_cell),INTENT(INOUT) ::cell
TYPE(t_sym),INTENT(INOUT) ::sym
TYPE(t_atoms),INTENT(INOUT) ::atoms
TYPE(t_input),INTENT(INOUT) ::input
TYPE(t_noco),INTENT(INOUT) ::noco
TYPE(t_vacuum),INTENT(INOUT)::vacuum
TYPE(t_banddos),INTENT(IN) ::banddos
TYPE(t_oneD),INTENT(INOUT) ::oneD
TYPE(t_wann),INTENT(OUT) ::wann
CLASS(t_xcpot),ALLOCATABLE,INTENT(INOUT)::xcpot
TYPE(t_kpts),INTENT(IN)::kpts
call cell%init(DOT_PRODUCT(atoms%volmts(:),atoms%neq(:)))
call atoms%init(cell)
CALL sym%init(cell,input%film)
call vacuum%init(sym)
CALL make_sym(sym,cell,atoms,noco,oneD,input)
call make_xcpot(xcpot,atoms,input)
call oneD%init(atoms)
call check_input_switches(banddos,vacuum,noco,atoms,input)
! Check muffin tin radii, only checking, dont use new parameters
CALL chkmt(atoms,input,vacuum,cell,oneD,.TRUE.)
!adjust positions by displacements
CALL apply_displacements(cell,input,vacuum,oneD,sym,noco,atoms)
END SUBROUTINE fleurinput_postprocess
END MODULE m_fleurinput_postprocess
......@@ -49,7 +49,7 @@ contains
atoms%nat,atoms%nat,nq1,cell%amat,cell%bmat,atoms%taual,&
sphhar%nlhd,sphhar%memd,sphhar%ntypsd,.true.,nlhtp1,&
sphhar%nlh,sphhar%llh,sphhar%nmem,&
sphhar%mlh,sphhar%clnu)
sphhar%mlh,sphhar%clnu)
ii = 1
DO i = 1,atoms%ntype
atoms%nlhtyp(i) = nlhtp1(ii)
......@@ -58,7 +58,7 @@ contains
DEALLOCATE (nq1,lmx1,nlhtp1)
END IF
DEALLOCATE(sphhar%clnu,sphhar%nlh,sphhar%llh,sphhar%nmem,sphhar%mlh)
ALLOCATE(sphhar%clnu(sphhar%memd,0:sphhar%nlhd,sphhar%ntypsd))
ALLOCATE(sphhar%llh(0:sphhar%nlhd,sphhar%ntypsd))
ALLOCATE(sphhar%mlh(sphhar%memd,0:sphhar%nlhd,sphhar%ntypsd))
......@@ -71,8 +71,8 @@ contains
sphhar%nlhd,sphhar%memd,sphhar%ntypsd,.FALSE.,&
atoms%nlhtyp,sphhar%nlh,sphhar%llh,sphhar%nmem,sphhar%mlh,sphhar%clnu)
sym%nsymt = sphhar%ntypsd
oneD%mrot1(:,:,:) = sym%mrot(:,:,:)
oneD%tau1(:,:) = sym%tau(:,:)
! oneD%mrot1(:,:,:) = sym%mrot(:,:,:)
! oneD%tau1(:,:) = sym%tau(:,:)
ELSE IF (oneD%odd%d1) THEN
WRITE(*,*) 'Note: I would be surprised if lattice harmonics generation works'
WRITE(*,*) 'Dimensioning of local arrays seems to be inconsistent with routine local_sym'
......@@ -98,5 +98,5 @@ contains
END DO
DEALLOCATE (lmx1,nlhtp1)
END IF
end
end
end
......@@ -28,7 +28,7 @@ MODULE m_make_stars
use m_types_oned
USE m_types_mpi
use m_types_noco
use m_mpi_bc_tool
class(t_stars),intent(INOUT) :: stars
type(t_sym),intent(in)::sym
......@@ -44,12 +44,12 @@ MODULE m_make_stars
! Generate stars
! Dimensioning of stars
IF (input%film) THEN
CALL strgn1_dim(input%gmax,cell%bmat,sym%invs,sym%zrfs,sym%mrot,&
sym%tau,sym%nop,sym%nop2,stars%mx1,stars%mx2,stars%mx3,&
stars%ng3,stars%ng2,oneD%odd)
ELSE
CALL strgn2_dim(input%gmax,cell%bmat,sym%invs,sym%zrfs,sym%mrot,&
sym%tau,sym%nop,stars%mx1,stars%mx2,stars%mx3,&
......@@ -79,14 +79,14 @@ MODULE m_make_stars
ALLOCATE (stars%rgphs(-stars%mx1:stars%mx1,-stars%mx2:stars%mx2,-stars%mx3:stars%mx3))
ALLOCATE (stars%pgfft(0:stars%kimax),stars%pgfft2(0:stars%kimax2))
ALLOCATE (stars%ufft(0:27*stars%mx1*stars%mx2*stars%mx3-1),stars%ustep(stars%ng3))
stars%sk2(:) = 0.0
stars%phi2(:) = 0.0
! Initialize xc fft box
CALL prp_xcfft_box(xcpot%gmaxxc,cell%bmat,stars%kxc1_fft,stars%kxc2_fft,stars%kxc3_fft)
! Missing xc functionals initializations
IF (xcpot%needs_grad()) THEN
ALLOCATE (stars%ft2_gfx(0:stars%kimax2),stars%ft2_gfy(0:stars%kimax2))
......@@ -102,7 +102,7 @@ MODULE m_make_stars
oneD%odi%nq2 = oneD%odd%nq2
CALL timestart("strgn")
CALL timestart("strgn")
IF (input%film) THEN
CALL strgn1(stars,sym,atoms,vacuum,sphhar,input,cell,xcpot)
IF (oneD%odd%d1) THEN
......@@ -114,21 +114,23 @@ MODULE m_make_stars
CALL lapw_fft_dim(cell,input,noco,stars)
ALLOCATE (stars%igq_fft(0:stars%kq1_fft*stars%kq2_fft*stars%kq3_fft-1))
ALLOCATE (stars%igq2_fft(0:stars%kq1_fft*stars%kq2_fft-1))
! Set up pointer for backtransformation from g-vector in positive
! Set up pointer for backtransformation from g-vector in positive
! domain of carge density fftibox into stars
CALL prp_qfft(stars,cell,noco,input)
CALL prp_qfft_map(stars,sym,input,stars%igq2_fft,stars%igq_fft)
CALL timestop("strgn")
CALL timestart("stepf")
CALL timestop("strgn")
CALL timestart("stepf")
CALL stepf(sym,stars,atoms,oneD,input,cell,vacuum,mpi)
CALL timestop("stepf")
call mpi_bc(stars%ustep,0,mpi%mpi_comm)
call mpi_bc(stars%ufft,0,mpi%mpi_comm)
CALL timestop("stepf")
END SUBROUTINE make_stars
......
......@@ -10,29 +10,28 @@ 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_kpts)
noco,DIMENSION,sphhar,l_kpts)
USE m_juDFT
USE m_types
USE m_constants
USE m_ylm
USE m_chkmt
USE m_dwigner
USE m_cdn_io
USE m_prpxcfft
use m_checks
use m_lapwdim
use m_make_stars
use m_make_sphhar
use m_make_forcetheo
use m_make_xcpot
use m_make_sym
USE m_convn
USE m_efield
USE m_od_kptsgen
USE m_relaxio
USE m_fleurinput_postprocess
USE m_fleurinput_mpi_bc
IMPLICIT NONE
TYPE(t_mpi) ,INTENT (IN) :: mpi
......@@ -52,120 +51,13 @@ SUBROUTINE postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,kpts,&
CLASS(t_xcpot),ALLOCATABLE,INTENT(INOUT) :: xcpot
TYPE(t_noco), INTENT(INOUT) :: noco
TYPE(t_dimension),INTENT(INOUT) :: dimension
TYPE(t_enparaXML) ,INTENT(IN):: enparaXML
TYPE(t_enpara) ,INTENT(OUT) :: enpara
TYPE(t_sphhar) ,INTENT (OUT) :: sphhar
TYPE(t_field), INTENT(INOUT) :: field
LOGICAL, INTENT (IN) :: l_kpts
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
REAL :: rmtmax, zp, radius, dr
LOGICAL :: l_vca, l_test
INTEGER, ALLOCATABLE :: jri1(:), lmax1(:)
REAL, ALLOCATABLE :: rmt1(:), dx1(:)
#ifdef CPP_MPI
INCLUDE 'mpif.h'
#endif
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!! Start of input postprocessing (calculate missing parameters)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
call cell%init(DOT_PRODUCT(atoms%volmts(:),atoms%neq(:)))
call atoms%init(cell)
CALL sym%init(cell,input%film)
call vacuum%init(sym)
CALL enpara%init_enpara(atoms,input%jspins,input%film,enparaXML)
CALL make_sym(sym,cell,atoms,noco,oneD,input)
call make_forcetheo(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)
! Generate missing general parameters
minNeigd = MAX(5,NINT(0.75*input%zelec) + 1)
IF (noco%l_soc.and.(.not.noco%l_noco)) minNeigd = 2 * minNeigd
IF (noco%l_soc.and.noco%l_ss) minNeigd=(3*minNeigd)/2
IF ((dimension%neigd.NE.-1).AND.(dimension%neigd.LT.minNeigd)) THEN
IF (dimension%neigd>0) THEN
WRITE(*,*) 'numbands is too small. Setting parameter to default value.'
WRITE(*,*) 'changed numbands (dimension%neigd) to ',minNeigd
ENDIF
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
CALL ylmnorm_init(atoms%lmaxd)
call oneD%init(atoms)
! 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
IF ( banddos%dos .AND. banddos%ndir == -3 ) THEN
WRITE(*,*) 'Recalculating k point grid to cover the full BZ.'
!CALL gen_bz(kpts,sym)
kpts%nkpt = kpts%nkptf
DEALLOCATE(kpts%bk,kpts%wtkpt)
ALLOCATE(kpts%bk(3,kpts%nkptf),kpts%wtkpt(kpts%nkptf))
kpts%bk(:,:) = kpts%bkf(:,:)
kpts%wtkpt = 1.0 / kpts%nkptf
END IF
CALL prp_xcfft(stars,input,cell,xcpot)
IF (.NOT.sliceplot%iplot) THEN
IF (mpi%irank.EQ.0) THEN
CALL convn(atoms,stars)
CALL e_field(atoms,DIMENSION,stars,sym,vacuum,cell,input,field%efield)
END IF !(mpi%irank.EQ.0)
END IF
!At some point this should be enabled for noco as well
#ifdef CPP_MPI
CALL MPI_BCAST(atoms%nat,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
#endif
IF (.not.noco%l_noco) &
CALL transform_by_moving_atoms(mpi,stars,atoms,vacuum, cell, sym, sphhar,input,oned,noco)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!! End of input postprocessing (calculate missing parameters)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
call oneD%init(atoms)
END SUBROUTINE postprocessInput
END MODULE m_postprocessInput
......@@ -107,7 +107,7 @@ CONTAINS
REAL :: fix
#ifdef CPP_MPI
INCLUDE 'mpif.h'
INTEGER :: ierr(2),n
INTEGER :: ierr(2)
#endif
mpi%mpi_comm = mpi_comm
......
......@@ -21,7 +21,7 @@ CONTAINS
USE m_dwigner
!USE m_gen_bz