mpi_bc_xcpot.F90 2.59 KB
Newer Older
1 2 3 4 5 6
!--------------------------------------------------------------------------------
! 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
7
  use m_judft
8 9 10
CONTAINS
  SUBROUTINE mpi_bc_xcpot(xcpot,mpi)
    USE m_types
11
    USE m_types_xcpot_libxc
12 13 14 15 16
    IMPLICIT NONE
    CLASS(t_xcpot),ALLOCATABLE,INTENT(INOUT):: xcpot
    TYPE(t_mpi),INTENT(IN)                  :: mpi

#ifdef CPP_MPI
17 18
    LOGICAL           :: l_relcor
    CHARACTER(len=100):: namex
19
    INTEGER           :: ierr,n,i(5)
20
    INCLUDE 'mpif.h'
Daniel Wortmann's avatar
Daniel Wortmann committed
21

22 23 24 25 26 27
    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
28 29
       TYPE IS (t_xcpot_libxc)
          n=2
30 31 32 33 34
       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)
35
    IF (mpi%irank /= 0) THEN
36 37 38 39 40
       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)
41 42
       CASE(2)
          ALLOCATE(t_xcpot_libxc::xcpot)
43 44 45 46 47 48 49
       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)
Daniel Wortmann's avatar
Daniel Wortmann committed
50 51 52 53 54
       IF (mpi%irank==0) THEN
          namex=xcpot%get_name()
          l_relcor=xcpot%DATA%krla==1
          n=SIZE(xcpot%lda_atom)
       ENDIF
55 56 57
       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)
58
       IF (mpi%irank /= 0)  CALL xcpot%init(namex(1:4),l_relcor,n)
59
       CALL MPI_BCAST(xcpot%lda_atom,n,MPI_LOGICAL,0,mpi%mpi_comm,ierr)
60 61
    TYPE IS (t_xcpot_libxc)
       IF (mpi%irank==0) THEN
62 63 64 65 66
          i(1) = xcpot%jspins
          i(2) = xcpot%func_vxc_id_x
          i(3) = xcpot%func_vxc_id_c
          i(4) = xcpot%func_exc_id_x
          i(5) = xcpot%func_exc_id_c
67
       ENDIF
68 69
       CALL MPI_BCAST(i,size(i),MPI_INTEGER,0,mpi%mpi_comm,ierr)
        IF (mpi%irank /= 0)  CALL xcpot%init(i(1),i(2),i(3),i(4),i(5)) 
70 71 72 73
    END SELECT
#endif
  END SUBROUTINE mpi_bc_xcpot
END MODULE m_mpi_bc_xcpot