Bugfixes for MPI codepath

init/old_inp/fleur_init_old.F90

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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

+!--------------------------------------------------------------------------------
+! 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

@@ -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

@@ -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

@@ -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

@@ -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