mpi_bc_xcpot.F90 2.58 KB
Newer Older
Daniel Wortmann's avatar
Daniel Wortmann committed
1 2 3 4 5 6 7 8 9
!--------------------------------------------------------------------------------
! 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
10
    USE m_types_xcpot_libxc
Daniel Wortmann's avatar
Daniel Wortmann committed
11 12 13 14 15
    IMPLICIT NONE
    CLASS(t_xcpot),ALLOCATABLE,INTENT(INOUT):: xcpot
    TYPE(t_mpi),INTENT(IN)                  :: mpi

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

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