Skip to content
GitLab
Commit 5ee63ee0 authored by Daniel Wortmann's avatar Daniel Wortmann
Browse files

Bugfixes for MPI codepath

parent 2ea30680
Hide whitespace changes
Inline Side-by-side
init/old_inp/fleur_init_old.F90
View file @ 5ee63ee0
......@@ -38,7 +38,7 @@ CONTAINS
TYPE(t_banddos) ,INTENT(OUT) :: banddos
TYPE(t_obsolete) ,INTENT(OUT) :: obsolete
TYPE(t_enpara) ,INTENT(OUT) :: enpara
TYPE(t_xcpot_inbuild) ,INTENT(OUT) :: xcpot
CLASS(t_xcpot),INTENT(OUT),ALLOCATABLE :: xcpot
TYPE(t_kpts) ,INTENT(INOUT):: kpts
TYPE(t_hybrid) ,INTENT(OUT) :: hybrid
TYPE(t_oneD) ,INTENT(OUT) :: oneD
......@@ -68,6 +68,10 @@ CONTAINS
#endif
ALLOCATE(t_forcetheo::forcetheo) !default no forcetheorem type
ALLOCATE(t_xcpot_inbuild::xcpot)
SELECT TYPE(xcpot)
TYPE IS (t_xcpot_inbuild)
namex = ' '
relcor = ' '
......@@ -186,12 +190,12 @@ CONTAINS
#ifdef CPP_MPI
CALL MPI_BCAST(namex,4,MPI_CHARACTER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(l_krla,1,MPI_LOGICAL,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(atoms%ntype,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL mpi_dist_forcetheorem(mpi,forcetheo)
#endif
IF (mpi%irank.NE.0) THEN
CALL xcpot%init(namex,l_krla)
CALL xcpot%init(namex,l_krla,atoms%ntype)
END IF
CALL setup(mpi,atoms,kpts,DIMENSION,sphhar,&
......@@ -259,5 +263,6 @@ CONTAINS
END IF
END IF ! mpi%irank.eq.0
CALL timestop("preparation:stars,lattice harmonics,+etc")
END SELECT
END SUBROUTINE fleur_init_old
END MODULE m_fleur_init_old
init/old_inp/inped.F90
View file @ 5ee63ee0
......@@ -211,7 +211,7 @@
WRITE (6,FMT=8120) namex,relcor
8120 FORMAT (1x,'exchange-correlation: ',a4,2x,a12,1x,'correction')
CALL xcpot%init(namex,relcor.EQ.'relativistic')
CALL xcpot%init(namex,relcor.EQ.'relativistic',atoms%ntype)
!!$ xcpot%icorr = -99
!!$
!!$ ! l91: lsd(igrd=0) with dsprs=1.d-19 in pw91.
......
init/postprocessInput.F90
View file @ 5ee63ee0
......@@ -40,7 +40,6 @@ SUBROUTINE postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,obsolete,kpts
USE m_gen_bz
USE m_nocoInputCheck
USE m_kpoints
IMPLICIT NONE
TYPE(t_mpi) ,INTENT (IN) :: mpi
......@@ -537,7 +536,6 @@ SUBROUTINE postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,obsolete,kpts
CALL prp_xcfft(stars,input,cell,xcpot)
END IF !(mpi%irank.EQ.0)
call xcpot%broadcast(mpi)
#ifdef CPP_MPI
CALL MPI_BCAST(sliceplot%iplot,1,MPI_LOGICAL,0,mpi%mpi_comm,ierr)
#endif
......
io/r_inpXML.F90
View file @ 5ee63ee0
......@@ -2027,8 +2027,7 @@ SUBROUTINE setXCParameters(atoms,namex,relcor,xcpot)
SELECT TYPE(xcpot)
TYPE IS(t_xcpot_inbuild)
CALL xcpot%init(namex(1:4),relcor)
ALLOCATE(xcpot%lda_atom(atoms%ntype))
CALL xcpot%init(namex(1:4),relcor,atoms%ntype)
! TYPE IS(t_xcpot_libxc)
! CALL xcpot%init(namex)
END SELECT
......
main/fleur_init.F90
View file @ 5ee63ee0
......@@ -33,6 +33,8 @@
USE m_writeOutHeader
USE m_fleur_init_old
USE m_types_xcpot_inbuild
USE m_mpi_bc_xcpot
#ifdef CPP_MPI
USE m_mpi_bc_all, ONLY : mpi_bc_all
USE m_mpi_dist_forcetheorem
......@@ -177,7 +179,7 @@
xmlPrintCoreStates,xmlCoreOccs,atomTypeSpecies,speciesRepAtomType,&
l_kpts)
END IF
CALL mpi_bc_xcpot(xcpot,mpi)
CALL postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,obsolete,kpts,&
oneD,hybrid,cell,banddos,sliceplot,xcpot,forcetheo,&
noco,dimension,enpara,sphhar,l_opti,noel,l_kpts)
......@@ -207,14 +209,10 @@
#endif
ELSE ! else branch of "IF (input%l_inpXML) THEN"
ALLOCATE(t_xcpot_inbuild::xcpot)
SELECT TYPE(xcpot)
TYPE IS(t_xcpot_inbuild)
CALL fleur_init_old(mpi,&
input,DIMENSION,atoms,sphhar,cell,stars,sym,noco,vacuum,forcetheo,&
sliceplot,banddos,obsolete,enpara,xcpot,kpts,hybrid,&
oneD,coreSpecInput,l_opti)
END SELECT
CALL fleur_init_old(mpi,&
input,DIMENSION,atoms,sphhar,cell,stars,sym,noco,vacuum,forcetheo,&
sliceplot,banddos,obsolete,enpara,xcpot,kpts,hybrid,&
oneD,coreSpecInput,l_opti)
END IF ! end of else branch of "IF (input%l_inpXML) THEN"
!
......
mpi/CMakeLists.txt
View file @ 5ee63ee0
......@@ -11,5 +11,6 @@ if (${FLEUR_USE_MPI})
mpi/mpi_col_den.F90
mpi/mpi_make_groups.F90
mpi/mpi_dist_forcetheorem.F90
mpi/mpi_bc_xcpot.F90
)
endif()
mpi/mpi_bc_xcpot.F90 0 → 100644
View file @ 5ee63ee0
!--------------------------------------------------------------------------------
! 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_mpi_bc_xcpot
CONTAINS
SUBROUTINE mpi_bc_xcpot(xcpot,mpi)
USE m_types
IMPLICIT NONE
CLASS(t_xcpot),ALLOCATABLE,INTENT(INOUT):: xcpot
TYPE(t_mpi),INTENT(IN) :: mpi
#ifdef CPP_MPI
LOGICAL :: l_relcor
CHARACTER(len=4):: namex
INTEGER :: ierr,n
INCLUDE 'mpif.h'
IF (mpi%isize==1) RETURN !nothing to be done with only one PE
!First determine type on pe0
IF (mpi%irank==0) THEN
SELECT TYPE(xcpot)
TYPE IS (t_xcpot_inbuild)
n=1
CLASS DEFAULT
CALL judft_error("Type could not be determined in mpi_bc_xcpot")
END SELECT
END IF
CALL MPI_BCAST(n,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
IF (mpi%irank.NE.0) THEN
IF (ALLOCATED(xcpot)) DEALLOCATE(xcpot)
!Now we know the types and can allocate on the other PE type dependend
SELECT CASE(n)
CASE(1)
ALLOCATE(t_xcpot_inbuild::xcpot)
CASE DEFAULT
CALL judft_error("Type bcast failed in mpi_bc_xcpot")
END SELECT
END IF
!Now we can do the the type dependend bc
SELECT TYPE(xcpot)
TYPE IS (t_xcpot_inbuild)
namex=xcpot%get_name()
l_relcor=xcpot%data%krla==1
n=SIZE(xcpot%lda_atom)
CALL MPI_BCAST(namex,4,MPI_CHARACTER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(l_relcor,1,MPI_LOGICAL,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(n,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
IF (mpi%irank.NE.0) CALL xcpot%init(namex,l_relcor,n)
CALL MPI_BCAST(xcpot%lda_atom,n,MPI_LOGICAL,0,mpi%mpi_comm,ierr)
END SELECT
#endif
END SUBROUTINE mpi_bc_xcpot
END MODULE m_mpi_bc_xcpot
optional/stden.f90
View file @ 5ee63ee0
......@@ -303,7 +303,7 @@ SUBROUTINE stden(mpi,sphhar,stars,atoms,sym,DIMENSION,vacuum,&
! generate coulomb potential by integrating inward to z1
DO ivac = 1, vacuum%nvac
CALL xcpot_dummy%init("vwn",.false.)
CALL xcpot_dummy%init("vwn",.FALSE.,atoms%ntype)
DO i=1,vacuum%nmz
sigm(i) = (i-1)*vacuum%delz*den%vacz(i,ivac,ispin)
END DO
......
types/types_xcpot.F90
View file @ 5ee63ee0
......@@ -3,7 +3,14 @@
! 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.
!--------------------------------------------------------------------------------
!> This module defines two data-types used in the calculation of xc-potentials
!! a) the abstract t_xcpot which should be overwritten for actual implementations
!! b) the t_gradients that collects the gradients needed in GGAs
!!
!! Currently t_xcpot_inbuild implements the XC-pots directly build into FLEUR
!! and t_xcpot_libxc provides and interface to libxc.
!! In addition to overloading the t_xcpot datatype also mpi_bc_xcpot must be adjusted
!! for additional implementations.
MODULE m_types_xcpot
IMPLICIT NONE
PRIVATE
......@@ -17,7 +24,6 @@ MODULE m_types_xcpot
PROCEDURE :: get_exchange_weight=>xcpot_get_exchange_weight
PROCEDURE :: get_vxc=>xcpot_get_vxc
PROCEDURE :: get_exc=>xcpot_get_exc
PROCEDURE :: broadcast=>xcpot_broadcast
PROCEDURE,NOPASS :: alloc_gradients=>xcpot_alloc_gradients
END TYPE t_xcpot
......@@ -88,12 +94,5 @@ CONTAINS
ALLOCATE(grad%gggru(ngrid),grad%gzgr(ngrid),grad%g2rt(ngrid))
ALLOCATE(grad%gggrd(ngrid),grad%grgru(ngrid),grad%grgrd(ngrid))
END SUBROUTINE xcpot_alloc_gradients
SUBROUTINE xcpot_broadcast(xcpot,mpi)
USE m_types_mpi
IMPLICIT NONE
CLASS(t_xcpot),INTENT(INOUT) :: xcpot
TYPE(t_mpi),INTENT(IN) :: mpi
END SUBROUTINE xcpot_broadcast
END MODULE m_types_xcpot
types/types_xcpot_inbuild.F90
View file @ 5ee63ee0
......@@ -37,7 +37,7 @@ MODULE m_types_xcpot_inbuild
INTEGER,PRIVATE :: icorr=0
#endif
TYPE(t_xcpot_data) :: data
TYPE(t_xcpot_data) :: DATA
LOGICAL,ALLOCATABLE :: lda_atom(:)
......@@ -63,14 +63,18 @@ CONTAINS
xcpot_get_name=xc_names(xcpot%icorr)
END FUNCTION xcpot_get_name
SUBROUTINE xcpot_init(xcpot,namex,relcor)
SUBROUTINE xcpot_init(xcpot,namex,relcor,ntype)
USE m_judft
IMPLICIT NONE
CLASS(t_xcpot_inbuild),INTENT(INOUT) :: xcpot
CHARACTER(len=*),INTENT(IN) :: namex
LOGICAL,INTENT(IN) :: relcor
INTEGER,INTENT(IN) :: ntype
INTEGER:: n
!Determine icorr from name
ALLOCATE(xcpot%lda_atom(ntype))
xcpot%lda_atom=.FALSE.
xcpot%icorr=0
DO n=1,SIZE(xc_names)
IF (TRIM(ADJUSTL(namex))==TRIM(xc_names(n))) THEN
......@@ -312,27 +316,6 @@ CONTAINS
xcpot_is_name=(TRIM(xc_names(xcpot%icorr))==TRIM((name)))
END FUNCTION xcpot_is_name
SUBROUTINE xcpot_broadcast(xcpot,mpi)
USE m_types_mpi
IMPLICIT NONE
CLASS(t_xcpot),INTENT(INOUT) :: xcpot
TYPE(t_mpi),INTENT(IN) :: mpi
LOGICAL :: l_relcor
CHARACTER(len=4):: namex
INTEGER :: ierr
#ifdef CPP_MPI
INCLUDE 'mpif.h'
IF (mpi%irank==0) THEN
namex=xcpot%get_name()
l_relcor=xcpot%krla==1
ENDIF
CALL MPI_BCAST(namex,4,MPI_CHARACTER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(l_relcor,1,MPI_LOGICAL,0,mpi%mpi_comm,ierr)
IF (mpi%irank.NE.0) CALL xcpot%init(namex,l_relcor)
#endif
END SUBROUTINE xcpot_broadcast
END MODULE m_types_xcpot_inbuild
vgen/vmtxcg.F90
View file @ 5ee63ee0
......@@ -134,7 +134,7 @@ CONTAINS
IF (xcpot%lda_atom(n))THEN
IF((.NOT.xcpot%is_name("pw91"))) &
CALL judft_warn("Using locally LDA only possible with pw91 functional")
CALL xcpot_tmp%init("l91",.FALSE.)
CALL xcpot_tmp%init("l91",.FALSE.,atoms%ntype)
ENDIF
END SELECT
......
Supports Markdown
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