LCOV - code coverage report
Current view: top level - mpi - mpi_bc_tool.F90 (source / functions) Hit Total Coverage
Test: combined.info Lines: 134 207 64.7 %
Date: 2019-09-08 04:53:50 Functions: 11 18 61.1 %

          Line data    Source code
       1             : !--------------------------------------------------------------------------------
       2             : ! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
       3             : ! This file is part of FLEUR and available as free software under the conditions
       4             : ! of the MIT license as expressed in the LICENSE file in more detail.
       5             : !--------------------------------------------------------------------------------
       6             : 
       7             : MODULE m_mpi_bc_tool
       8             :   USE m_judft
       9             :   IMPLICIT NONE
      10             :   PRIVATE
      11             : #ifdef CPP_MPI  
      12             :   INCLUDE 'mpif.h'
      13             : #endif
      14             :   !This interface is used to broadcast data. On the recieving PE the data-array is first allocated to
      15             :   !have the same shape as the one on irank
      16             :   INTERFACE mpi_bc
      17             :      MODULE PROCEDURE  mpi_bc_int,mpi_bc_int1,mpi_bc_int2,mpi_bc_int3,mpi_bc_int4,mpi_bc_int5
      18             :      MODULE PROCEDURE  mpi_bc_real,mpi_bc_real1,mpi_bc_real2,mpi_bc_real3,mpi_bc_real4,mpi_bc_real5
      19             :      MODULE PROCEDURE  mpi_bc_complex,mpi_bc_complex1,mpi_bc_complex2,mpi_bc_complex3,mpi_bc_complex4,mpi_bc_complex5
      20             :   END INTERFACE mpi_bc
      21             :   PUBLIC :: mpi_bc
      22             : CONTAINS
      23        2364 :   SUBROUTINE mpi_bc_int(i,irank,mpi_comm)
      24             :     IMPLICIT NONE
      25             :     INTEGER,INTENT(INOUT):: i
      26             :     INTEGER,INTENT(IN)   :: mpi_comm,irank
      27             : 
      28             :     INTEGER:: ierr
      29             : 
      30             : #ifdef CPP_MPI  
      31        2364 :     CALL MPI_BCAST(i,1,MPI_INTEGER,irank,mpi_comm,ierr)
      32             : #endif
      33        2364 :     IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
      34        2364 :   END SUBROUTINE mpi_bc_int
      35             : 
      36         380 :   SUBROUTINE mpi_bc_int1(i,irank,mpi_comm)
      37             :     IMPLICIT NONE
      38             :     INTEGER,ALLOCATABLE,INTENT(INOUT) :: i(:)
      39             :     INTEGER,INTENT(IN)                :: irank,mpi_comm
      40             : 
      41             :     INTEGER:: ierr,ilow(1),iup(1),myrank
      42             : 
      43             : #ifdef CPP_MPI  
      44             : 
      45         380 :     CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
      46         380 :     IF (myrank==irank) THEN
      47         380 :        ilow=LBOUND(i)
      48         380 :        iup=UBOUND(i)
      49             :     END IF
      50         380 :     CALL MPI_BCAST(ilow,1,MPI_INTEGER,0,mpi_comm,ierr)
      51         380 :     CALL MPI_BCAST(iup,1,MPI_INTEGER,0,mpi_comm,ierr)
      52         380 :     IF (myrank.NE.irank) THEN
      53         190 :        IF (ALLOCATED(i)) DEALLOCATE(i)
      54         190 :        ALLOCATE(i(ilow(1):iup(1)))
      55             :     ENDIF
      56             : 
      57         380 :     CALL MPI_BCAST(i,SIZE(i),MPI_INTEGER,irank,mpi_comm,ierr)
      58             : 
      59         380 :     IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
      60             : #endif
      61         380 :   END SUBROUTINE mpi_bc_int1
      62             : 
      63         304 :   SUBROUTINE mpi_bc_int2(i,irank,mpi_comm)
      64             :     IMPLICIT NONE
      65             :     INTEGER,ALLOCATABLE,INTENT(INOUT) :: i(:,:)
      66             :     INTEGER,INTENT(IN)                :: irank,mpi_comm
      67             : 
      68             :     INTEGER:: ierr,ilow(2),iup(2),myrank
      69             : 
      70             : #ifdef CPP_MPI  
      71             : 
      72         304 :     CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
      73         304 :     IF (myrank==irank) THEN
      74         456 :        ilow=LBOUND(i)
      75         456 :        iup=UBOUND(i)
      76             :     END IF
      77         304 :     CALL MPI_BCAST(ilow,2,MPI_INTEGER,0,mpi_comm,ierr)
      78         304 :     CALL MPI_BCAST(iup,2,MPI_INTEGER,0,mpi_comm,ierr)
      79         304 :     IF (myrank.NE.irank) THEN
      80         152 :        IF (ALLOCATED(i)) DEALLOCATE(i)
      81         152 :        ALLOCATE(i(ilow(1):iup(1),ilow(2):iup(2)))
      82             :     ENDIF
      83             : 
      84         304 :     CALL MPI_BCAST(i,SIZE(i),MPI_INTEGER,irank,mpi_comm,ierr)
      85             : #endif
      86         304 :     IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
      87         304 :   END SUBROUTINE mpi_bc_int2
      88             : 
      89          76 :   SUBROUTINE mpi_bc_int3(i,irank,mpi_comm)
      90             :     IMPLICIT NONE
      91             :     INTEGER,ALLOCATABLE,INTENT(INOUT) :: i(:,:,:)
      92             :     INTEGER,INTENT(IN)                :: irank,mpi_comm
      93             : 
      94             :     INTEGER:: ierr,ilow(3),iup(3),myrank
      95             : 
      96             : #ifdef CPP_MPI  
      97             : 
      98          76 :     CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
      99          76 :     IF (myrank==irank) THEN
     100         152 :        ilow=LBOUND(i)
     101         152 :        iup=UBOUND(i)
     102             :     END IF
     103          76 :     CALL MPI_BCAST(ilow,3,MPI_INTEGER,0,mpi_comm,ierr)
     104          76 :     CALL MPI_BCAST(iup,3,MPI_INTEGER,0,mpi_comm,ierr)
     105          76 :     IF (myrank.NE.irank) THEN
     106          38 :        IF (ALLOCATED(i)) DEALLOCATE(i)
     107          38 :        ALLOCATE(i(ilow(1):iup(1),ilow(2):iup(2),ilow(3):iup(3)))
     108             :     ENDIF
     109             : 
     110          76 :     CALL MPI_BCAST(i,SIZE(i),MPI_INTEGER,irank,mpi_comm,ierr)
     111             : #endif
     112          76 :     IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
     113          76 :   END SUBROUTINE mpi_bc_int3
     114             : 
     115           0 :   SUBROUTINE mpi_bc_int4(i,irank,mpi_comm)
     116             :     IMPLICIT NONE
     117             :     INTEGER,ALLOCATABLE,INTENT(INOUT) :: i(:,:,:,:)
     118             :     INTEGER,INTENT(IN)                :: irank,mpi_comm
     119             : 
     120             :     INTEGER:: ierr,ilow(4),iup(4),myrank
     121             : 
     122             : #ifdef CPP_MPI  
     123             : 
     124           0 :     CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
     125           0 :     IF (myrank==irank) THEN
     126           0 :        ilow=LBOUND(i)
     127           0 :        iup=UBOUND(i)
     128             :     END IF
     129           0 :     CALL MPI_BCAST(ilow,4,MPI_INTEGER,0,mpi_comm,ierr)
     130           0 :     CALL MPI_BCAST(iup,4,MPI_INTEGER,0,mpi_comm,ierr)
     131           0 :     IF (myrank.NE.irank) THEN
     132           0 :        IF (ALLOCATED(i)) DEALLOCATE(i)
     133           0 :        ALLOCATE(i(ilow(1):iup(1),ilow(2):iup(2),ilow(3):iup(3),ilow(4):iup(4)))
     134             :     ENDIF
     135             : 
     136           0 :     CALL MPI_BCAST(i,SIZE(i),MPI_INTEGER,irank,mpi_comm,ierr)
     137             : #endif
     138           0 :     IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
     139           0 :   END SUBROUTINE mpi_bc_int4
     140             : 
     141           0 :   SUBROUTINE mpi_bc_int5(i,irank,mpi_comm)
     142             :     IMPLICIT NONE
     143             :     INTEGER,ALLOCATABLE,INTENT(INOUT) :: i(:,:,:,:,:)
     144             :     INTEGER,INTENT(IN)                :: irank,mpi_comm
     145             : 
     146             :     INTEGER:: ierr,ilow(5),iup(5),myrank
     147             : 
     148             : #ifdef CPP_MPI  
     149             : 
     150           0 :     CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
     151           0 :     IF (myrank==irank) THEN
     152           0 :        ilow=LBOUND(i)
     153           0 :        iup=UBOUND(i)
     154             :     END IF
     155           0 :     CALL MPI_BCAST(ilow,5,MPI_INTEGER,0,mpi_comm,ierr)
     156           0 :     CALL MPI_BCAST(iup,5,MPI_INTEGER,0,mpi_comm,ierr)
     157           0 :     IF (myrank.NE.irank) THEN
     158           0 :        IF (ALLOCATED(i)) DEALLOCATE(i)
     159           0 :        ALLOCATE(i(ilow(1):iup(1),ilow(2):iup(2),ilow(3):iup(3),ilow(4):iup(4),ilow(5):iup(5)))
     160             :     ENDIF
     161             : 
     162           0 :     CALL MPI_BCAST(i,SIZE(i),MPI_INTEGER,irank,mpi_comm,ierr)
     163             : #endif
     164           0 :     IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
     165           0 :   END SUBROUTINE mpi_bc_int5
     166             : 
     167             :   !
     168             :   ! now the same for reals
     169             :   !
     170             : 
     171             : 
     172           0 :   SUBROUTINE mpi_bc_real(r,irank,mpi_comm)
     173             :     IMPLICIT NONE
     174             :     REAL,INTENT(INOUT)   :: r
     175             :     INTEGER,INTENT(IN)   :: mpi_comm,irank
     176             : 
     177             :     INTEGER:: ierr
     178             : #ifdef CPP_MPI  
     179             : 
     180           0 :     CALL MPI_BCAST(r,1,MPI_DOUBLE_PRECISION,irank,mpi_comm,ierr)
     181             : #endif
     182           0 :     IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
     183           0 :   END SUBROUTINE mpi_bc_real
     184             : 
     185         456 :   SUBROUTINE mpi_bc_real1(r,irank,mpi_comm)
     186             :     IMPLICIT NONE
     187             :     REAL   ,ALLOCATABLE,INTENT(INOUT) :: r(:)
     188             :     INTEGER,INTENT(IN)                :: irank,mpi_comm
     189             : 
     190             :     INTEGER:: ierr,ilow(1),iup(1),myrank
     191             : 
     192             : #ifdef CPP_MPI
     193         456 :     CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
     194         456 :     IF (myrank==irank) THEN
     195         456 :        ilow=LBOUND(r)
     196         456 :        iup=UBOUND(r)
     197             :     END IF
     198         456 :     CALL MPI_BCAST(ilow,1,MPI_INTEGER,0,mpi_comm,ierr)
     199         456 :     CALL MPI_BCAST(iup,1,MPI_INTEGER,0,mpi_comm,ierr)
     200         456 :     IF (myrank.NE.irank) THEN
     201         228 :        IF (ALLOCATED(r)) DEALLOCATE(r)
     202         228 :        ALLOCATE(r(ilow(1):iup(1)))
     203             :     ENDIF
     204             : 
     205         456 :     CALL MPI_BCAST(r,SIZE(r),MPI_DOUBLE_PRECISION,irank,mpi_comm,ierr)
     206             : #endif
     207         456 :     IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
     208         456 :   END SUBROUTINE mpi_bc_real1
     209             : 
     210           0 :   SUBROUTINE mpi_bc_real2(r,irank,mpi_comm)
     211             :     IMPLICIT NONE
     212             :     REAL   ,ALLOCATABLE,INTENT(INOUT) :: r(:,:)
     213             :     INTEGER,INTENT(IN)                :: irank,mpi_comm
     214             : 
     215             :     INTEGER:: ierr,ilow(2),iup(2),myrank
     216             : 
     217             : #ifdef CPP_MPI  
     218             : 
     219           0 :     CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
     220           0 :     IF (myrank==irank) THEN
     221           0 :        ilow=LBOUND(r)
     222           0 :        iup=UBOUND(r)
     223             :     END IF
     224           0 :     CALL MPI_BCAST(ilow,2,MPI_INTEGER,0,mpi_comm,ierr)
     225           0 :     CALL MPI_BCAST(iup,2,MPI_INTEGER,0,mpi_comm,ierr)
     226           0 :     IF (myrank.NE.irank) THEN
     227           0 :        IF (ALLOCATED(r)) DEALLOCATE(r)
     228           0 :        ALLOCATE(r(ilow(1):iup(1),ilow(2):iup(2)))
     229             :     ENDIF
     230             : 
     231           0 :     CALL MPI_BCAST(r,SIZE(r),MPI_DOUBLE_PRECISION,irank,mpi_comm,ierr)
     232             : #endif  
     233             : 
     234           0 :     IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
     235           0 :   END SUBROUTINE mpi_bc_real2
     236             : 
     237        1182 :   SUBROUTINE mpi_bc_real3(r,irank,mpi_comm)
     238             :     IMPLICIT NONE
     239             :     REAL   ,ALLOCATABLE,INTENT(INOUT) :: r(:,:,:)
     240             :     INTEGER,INTENT(IN)                :: irank,mpi_comm
     241             : 
     242             :     INTEGER:: ierr,ilow(3),iup(3),myrank
     243             : 
     244             : #ifdef CPP_MPI  
     245             : 
     246        1182 :     CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
     247        1182 :     IF (myrank==irank) THEN
     248        2364 :        ilow=LBOUND(r)
     249        2364 :        iup=UBOUND(r)
     250             :     END IF
     251        1182 :     CALL MPI_BCAST(ilow,3,MPI_INTEGER,0,mpi_comm,ierr)
     252        1182 :     CALL MPI_BCAST(iup,3,MPI_INTEGER,0,mpi_comm,ierr)
     253        1182 :     IF (myrank.NE.irank) THEN
     254         591 :        IF (ALLOCATED(r)) DEALLOCATE(r)
     255         591 :        ALLOCATE(r(ilow(1):iup(1),ilow(2):iup(2),ilow(3):iup(3)))
     256             :     ENDIF
     257             : 
     258        1182 :     CALL MPI_BCAST(r,SIZE(r),MPI_DOUBLE_PRECISION,irank,mpi_comm,ierr)
     259             : #endif  
     260             : 
     261        1182 :     IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
     262        1182 :   END SUBROUTINE mpi_bc_real3
     263             : 
     264        1182 :   SUBROUTINE mpi_bc_real4(r,irank,mpi_comm)
     265             :     IMPLICIT NONE
     266             :     REAL   ,ALLOCATABLE,INTENT(INOUT) :: r(:,:,:,:)
     267             :     INTEGER,INTENT(IN)                :: irank,mpi_comm
     268             : 
     269             :     INTEGER:: ierr,ilow(4),iup(4),myrank
     270             : #ifdef CPP_MPI  
     271             : 
     272             : 
     273        1182 :     CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
     274        1182 :     IF (myrank==irank) THEN
     275        2955 :        ilow=LBOUND(r)
     276        2955 :        iup=UBOUND(r)
     277             :     END IF
     278        1182 :     CALL MPI_BCAST(ilow,4,MPI_INTEGER,0,mpi_comm,ierr)
     279        1182 :     CALL MPI_BCAST(iup,4,MPI_INTEGER,0,mpi_comm,ierr)
     280        1182 :     IF (myrank.NE.irank) THEN
     281         591 :        IF (ALLOCATED(r)) DEALLOCATE(r)
     282         591 :        ALLOCATE(r(ilow(1):iup(1),ilow(2):iup(2),ilow(3):iup(3),ilow(4):iup(4)))
     283             :     ENDIF
     284             : 
     285        1182 :     CALL MPI_BCAST(r,SIZE(r),MPI_DOUBLE_PRECISION,irank,mpi_comm,ierr)
     286             : 
     287             : #endif  
     288        1182 :     IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
     289        1182 :   END SUBROUTINE mpi_bc_real4
     290             : 
     291           0 :   SUBROUTINE mpi_bc_real5(r,irank,mpi_comm)
     292             :     IMPLICIT NONE
     293             :     REAL   ,ALLOCATABLE,INTENT(INOUT) :: r(:,:,:,:,:)
     294             :     INTEGER,INTENT(IN)                :: irank,mpi_comm
     295             : 
     296             :     INTEGER:: ierr,ilow(5),iup(5),myrank
     297             : #ifdef CPP_MPI  
     298             : 
     299             : 
     300           0 :     CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
     301           0 :     IF (myrank==irank) THEN
     302           0 :        ilow=LBOUND(r)
     303           0 :        iup=UBOUND(r)
     304             :     END IF
     305           0 :     CALL MPI_BCAST(ilow,5,MPI_INTEGER,0,mpi_comm,ierr)
     306           0 :     CALL MPI_BCAST(iup,5,MPI_INTEGER,0,mpi_comm,ierr)
     307           0 :     IF (myrank.NE.irank) THEN
     308           0 :        IF (ALLOCATED(r)) DEALLOCATE(r)
     309           0 :        ALLOCATE(r(ilow(1):iup(1),ilow(2):iup(2),ilow(3):iup(3),ilow(4):iup(4),ilow(5):iup(5)))
     310             :     ENDIF
     311             : 
     312           0 :     CALL MPI_BCAST(r,SIZE(r),MPI_DOUBLE_PRECISION,irank,mpi_comm,ierr)
     313             : #endif  
     314             : 
     315           0 :     IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
     316           0 :   END SUBROUTINE mpi_bc_real5
     317             : 
     318             :   !
     319             :   ! And Complex!!
     320             :   !
     321             : 
     322           0 :   SUBROUTINE mpi_bc_complex(c,irank,mpi_comm)
     323             :     IMPLICIT NONE
     324             :     COMPLEX,INTENT(INOUT)   :: c
     325             :     INTEGER,INTENT(IN)   :: mpi_comm,irank
     326             : 
     327             :     INTEGER:: ierr
     328             : #ifdef CPP_MPI  
     329             : 
     330           0 :     CALL MPI_BCAST(c,1,MPI_DOUBLE_COMPLEX,irank,mpi_comm,ierr)
     331             : #endif  
     332             : 
     333           0 :     IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
     334           0 :   END SUBROUTINE mpi_bc_complex
     335             : 
     336         228 :   SUBROUTINE mpi_bc_complex1(c,irank,mpi_comm)
     337             :     IMPLICIT NONE
     338             :     COMPLEX,ALLOCATABLE,INTENT(INOUT) :: c(:)
     339             :     INTEGER,INTENT(IN)                :: irank,mpi_comm
     340             : 
     341             :     INTEGER:: ierr,ilow(1),iup(1),myrank
     342             : 
     343             : #ifdef CPP_MPI  
     344             : 
     345         228 :     CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
     346         228 :     IF (myrank==irank) THEN
     347         228 :        ilow=LBOUND(c)
     348         228 :        iup=UBOUND(c)
     349             :     END IF
     350         228 :     CALL MPI_BCAST(ilow,1,MPI_INTEGER,0,mpi_comm,ierr)
     351         228 :     CALL MPI_BCAST(iup,1,MPI_INTEGER,0,mpi_comm,ierr)
     352         228 :     IF (myrank.NE.irank) THEN
     353         114 :        IF (ALLOCATED(c)) DEALLOCATE(c)
     354         114 :        ALLOCATE(c(ilow(1):iup(1)))
     355             :     ENDIF
     356             : 
     357         228 :     CALL MPI_BCAST(c,SIZE(c),MPI_DOUBLE_COMPLEX,irank,mpi_comm,ierr)
     358             : #endif  
     359             : 
     360         228 :     IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
     361         228 :   END SUBROUTINE mpi_bc_complex1
     362             : 
     363        1182 :   SUBROUTINE mpi_bc_complex2(c,irank,mpi_comm)
     364             :     IMPLICIT NONE
     365             :     COMPLEX,ALLOCATABLE,INTENT(INOUT) :: c(:,:)
     366             :     INTEGER,INTENT(IN)                :: irank,mpi_comm
     367             : 
     368             :     INTEGER:: ierr,ilow(2),iup(2),myrank
     369             : #ifdef CPP_MPI  
     370             : 
     371             : 
     372        1182 :     CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
     373        1182 :     IF (myrank==irank) THEN
     374        1773 :        ilow=LBOUND(c)
     375        1773 :        iup=UBOUND(c)
     376             :     END IF
     377        1182 :     CALL MPI_BCAST(ilow,2,MPI_INTEGER,0,mpi_comm,ierr)
     378        1182 :     CALL MPI_BCAST(iup,2,MPI_INTEGER,0,mpi_comm,ierr)
     379        1182 :     IF (myrank.NE.irank) THEN
     380         591 :        IF (ALLOCATED(c)) DEALLOCATE(c)
     381         591 :        ALLOCATE(c(ilow(1):iup(1),ilow(2):iup(2)))
     382             :     ENDIF
     383             : 
     384        1182 :     CALL MPI_BCAST(c,SIZE(c),MPI_DOUBLE_COMPLEX,irank,mpi_comm,ierr)
     385             : #endif  
     386             : 
     387        1182 :     IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
     388        1182 :   END SUBROUTINE mpi_bc_complex2
     389             : 
     390          76 :   SUBROUTINE mpi_bc_complex3(c,irank,mpi_comm)
     391             :     IMPLICIT NONE
     392             :     COMPLEX,ALLOCATABLE,INTENT(INOUT) :: c(:,:,:)
     393             :     INTEGER,INTENT(IN)                :: irank,mpi_comm
     394             : 
     395             :     INTEGER:: ierr,ilow(3),iup(3),myrank
     396             : #ifdef CPP_MPI  
     397             : 
     398             : 
     399          76 :     CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
     400          76 :     IF (myrank==irank) THEN
     401         152 :        ilow=LBOUND(c)
     402         152 :        iup=UBOUND(c)
     403             :     END IF
     404          76 :     CALL MPI_BCAST(ilow,3,MPI_INTEGER,0,mpi_comm,ierr)
     405          76 :     CALL MPI_BCAST(iup,3,MPI_INTEGER,0,mpi_comm,ierr)
     406          76 :     IF (myrank.NE.irank) THEN
     407          38 :        IF (ALLOCATED(c)) DEALLOCATE(c)
     408          38 :        ALLOCATE(c(ilow(1):iup(1),ilow(2):iup(2),ilow(3):iup(3)))
     409             :     ENDIF
     410             : 
     411          76 :     CALL MPI_BCAST(c,SIZE(c),MPI_DOUBLE_COMPLEX,irank,mpi_comm,ierr)
     412             : #endif  
     413             : 
     414          76 :     IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
     415          76 :   END SUBROUTINE mpi_bc_complex3
     416             : 
     417        2364 :   SUBROUTINE mpi_bc_complex4(c,irank,mpi_comm)
     418             :     IMPLICIT NONE
     419             :     COMPLEX,ALLOCATABLE,INTENT(INOUT) :: c(:,:,:,:)
     420             :     INTEGER,INTENT(IN)                :: irank,mpi_comm
     421             : 
     422             :     INTEGER:: ierr,ilow(4),iup(4),myrank
     423             : #ifdef CPP_MPI  
     424             : 
     425             : 
     426        2364 :     CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
     427        2364 :     IF (myrank==irank) THEN
     428        5910 :        ilow=LBOUND(c)
     429        5910 :        iup=UBOUND(c)
     430             :     END IF
     431        2364 :     CALL MPI_BCAST(ilow,4,MPI_INTEGER,0,mpi_comm,ierr)
     432        2364 :     CALL MPI_BCAST(iup,4,MPI_INTEGER,0,mpi_comm,ierr)
     433        2364 :     IF (myrank.NE.irank) THEN
     434        1182 :        IF (ALLOCATED(c)) DEALLOCATE(c)
     435        1182 :        ALLOCATE(c(ilow(1):iup(1),ilow(2):iup(2),ilow(3):iup(3),ilow(4):iup(4)))
     436             :     ENDIF
     437             : 
     438        2364 :     CALL MPI_BCAST(c,SIZE(c),MPI_DOUBLE_COMPLEX,irank,mpi_comm,ierr)
     439             : #endif  
     440             : 
     441        2364 :     IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
     442        2364 :   END SUBROUTINE mpi_bc_complex4
     443             : 
     444           0 :   SUBROUTINE mpi_bc_complex5(c,irank,mpi_comm)
     445             :     IMPLICIT NONE
     446             :     COMPLEX,ALLOCATABLE,INTENT(INOUT) :: c(:,:,:,:,:)
     447             :     INTEGER,INTENT(IN)                :: irank,mpi_comm
     448             : 
     449             :     INTEGER:: ierr,ilow(5),iup(5),myrank
     450             : #ifdef CPP_MPI  
     451             : 
     452             : 
     453           0 :     CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
     454           0 :     IF (myrank==irank) THEN
     455           0 :        ilow=LBOUND(c)
     456           0 :        iup=UBOUND(c)
     457             :     END IF
     458           0 :     CALL MPI_BCAST(ilow,5,MPI_INTEGER,0,mpi_comm,ierr)
     459           0 :     CALL MPI_BCAST(iup,5,MPI_INTEGER,0,mpi_comm,ierr)
     460           0 :     IF (myrank.NE.irank) THEN
     461           0 :        IF (ALLOCATED(c)) DEALLOCATE(c)
     462           0 :        ALLOCATE(c(ilow(1):iup(1),ilow(2):iup(2),ilow(3):iup(3),ilow(4):iup(4),ilow(5):iup(5)))
     463             :     ENDIF
     464             : 
     465           0 :     CALL MPI_BCAST(c,SIZE(c),MPI_DOUBLE_COMPLEX,irank,mpi_comm,ierr)
     466             : 
     467             : #endif  
     468           0 :     IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
     469           0 :   END SUBROUTINE mpi_bc_complex5
     470             : END MODULE m_mpi_bc_tool

Generated by: LCOV version 1.13