mpi_bc_potden.F90 2.82 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26
!--------------------------------------------------------------------------------
! Copyright (c) 2017 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_potden
CONTAINS
   SUBROUTINE mpi_bc_potden(mpi,stars,sphhar,atoms,input,vacuum,oneD,noco,potden)

   USE m_types
   USE m_constants
   IMPLICIT NONE
   INCLUDE 'mpif.h'

   TYPE(t_mpi),INTENT(IN)        :: mpi
   TYPE(t_input),INTENT(IN)      :: input
   TYPE(t_vacuum),INTENT(IN)     :: vacuum
   TYPE(t_stars),INTENT(IN)      :: stars
   TYPE(t_sphhar),INTENT(IN)     :: sphhar
   TYPE(t_atoms),INTENT(IN)      :: atoms
   TYPE(t_noco),INTENT(IN)       :: noco
   TYPE(t_oneD),INTENT(IN)       :: oneD
   TYPE(t_potden),INTENT(INOUT)  :: potden

   INTEGER :: n, ierr(3)
27
   LOGICAL :: l_nocoAlloc, l_denMatAlloc, l_vaczAlloc, l_pw_wAlloc
28 29 30 31 32

   CALL MPI_BCAST(potden%iter,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)

   l_nocoAlloc = .FALSE.
   l_denMatAlloc = .FALSE.
33
   l_vaczAlloc = .FALSE.
34
   l_pw_wAlloc = .FALSE.
35 36
   IF(mpi%irank.EQ.0) THEN
      IF (ALLOCATED(potden%mmpMat)) l_denMatAlloc = .TRUE.
37
      IF (ALLOCATED(potden%vacz)) l_vaczAlloc = .TRUE.
38
      IF (ALLOCATED(potden%pw_w)) l_pw_wAlloc = .TRUE.
39 40 41
   END IF
   CALL MPI_BCAST(l_nocoAlloc,1,MPI_LOGICAL,0,mpi%mpi_comm,ierr)
   CALL MPI_BCAST(l_denMatAlloc,1,MPI_LOGICAL,0,mpi%mpi_comm,ierr)
42
   CALL MPI_BCAST(l_vaczAlloc,1,MPI_LOGICAL,0,mpi%mpi_comm,ierr)
43
   CALL MPI_BCAST(l_pw_wAlloc,1,MPI_LOGICAL,0,mpi%mpi_comm,ierr)
44
   IF((mpi%irank.NE.0).AND.l_denMatAlloc) THEN
45 46 47
      IF(.NOT.ALLOCATED(potden%mmpMat)) THEN
         ALLOCATE(potDen%mmpMat(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,MAX(1,atoms%n_u),input%jspins))
      END IF
48 49
   END IF

50
   n = stars%ng3 * SIZE(potden%pw,2)
51 52 53 54 55
   CALL MPI_BCAST(potden%pw,n,MPI_DOUBLE_COMPLEX,0,mpi%mpi_comm,ierr)

   n = atoms%jmtd * (sphhar%nlhd+1) * atoms%ntype * input%jspins
   CALL MPI_BCAST(potden%mt,n,MPI_DOUBLE,0,mpi%mpi_comm,ierr)

56 57 58 59 60
   IF (l_pw_wAlloc) THEN
      n = stars%ng3 * SIZE(potden%pw_w,2)
      CALL MPI_BCAST(potden%pw_w,n,MPI_DOUBLE_COMPLEX,0,mpi%mpi_comm,ierr)
   END IF

61 62 63
   IF (l_vaczAlloc) THEN
      n = vacuum%nmzd * 2 * SIZE(potden%vacz,3)
      CALL MPI_BCAST(potden%vacz,n,MPI_DOUBLE,0,mpi%mpi_comm,ierr)
64

65
      n = vacuum%nmzxyd * (stars%ng2-1) * 2 * SIZE(potden%vacxy,4)
66 67
      CALL MPI_BCAST(potden%vacxy,n,MPI_DOUBLE_COMPLEX,0,mpi%mpi_comm,ierr)
   END IF
68 69 70 71 72 73 74 75

   IF (l_denMatAlloc) THEN
      n = SIZE(potden%mmpMat,1) * SIZE(potden%mmpMat,2) * SIZE(potden%mmpMat,3) * SIZE(potden%mmpMat,4)
      CALL MPI_BCAST(potden%mmpMat,n,MPI_DOUBLE_COMPLEX,0,mpi%mpi_comm,ierr)
   END IF

   END SUBROUTINE mpi_bc_potden
END MODULE m_mpi_bc_potden