mpi_bc_tool.F90 13.4 KB
Newer Older
1 2 3 4 5 6 7 8 9 10
!--------------------------------------------------------------------------------
! 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_tool
  USE m_judft
  IMPLICIT NONE
  PRIVATE
11
#ifdef CPP_MPI  
12
  INCLUDE 'mpif.h'
Daniel Wortmann's avatar
Daniel Wortmann committed
13
#endif
14 15 16
  !This interface is used to broadcast data. On the recieving PE the data-array is first allocated to
  !have the same shape as the one on irank
  INTERFACE mpi_bc
17 18 19
     MODULE PROCEDURE  mpi_bc_int,mpi_bc_int1,mpi_bc_int2,mpi_bc_int3,mpi_bc_int4,mpi_bc_int5
     MODULE PROCEDURE  mpi_bc_real,mpi_bc_real1,mpi_bc_real2,mpi_bc_real3,mpi_bc_real4,mpi_bc_real5
     MODULE PROCEDURE  mpi_bc_complex,mpi_bc_complex1,mpi_bc_complex2,mpi_bc_complex3,mpi_bc_complex4,mpi_bc_complex5
Daniel Wortmann's avatar
Daniel Wortmann committed
20
  END INTERFACE mpi_bc
21 22 23 24 25 26 27 28 29
  PUBLIC :: mpi_bc
CONTAINS
  SUBROUTINE mpi_bc_int(i,irank,mpi_comm)
    IMPLICIT NONE
    INTEGER,INTENT(INOUT):: i
    INTEGER,INTENT(IN)   :: mpi_comm,irank

    INTEGER:: ierr

Daniel Wortmann's avatar
Daniel Wortmann committed
30
#ifdef CPP_MPI  
31
    CALL MPI_BCAST(i,1,MPI_INTEGER,irank,mpi_comm,ierr)
Daniel Wortmann's avatar
Daniel Wortmann committed
32
#endif
33 34 35 36 37 38 39
    IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
  END SUBROUTINE mpi_bc_int

  SUBROUTINE mpi_bc_int1(i,irank,mpi_comm)
    IMPLICIT NONE
    INTEGER,ALLOCATABLE,INTENT(INOUT) :: i(:)
    INTEGER,INTENT(IN)                :: irank,mpi_comm
Daniel Wortmann's avatar
Daniel Wortmann committed
40

41 42
    INTEGER:: ierr,ilow(1),iup(1),myrank

Daniel Wortmann's avatar
Daniel Wortmann committed
43
#ifdef CPP_MPI  
44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59

    CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
    IF (myrank==irank) THEN
       ilow=LBOUND(i)
       iup=UBOUND(i)
    END IF
    CALL MPI_BCAST(ilow,1,MPI_INTEGER,0,mpi_comm,ierr)
    CALL MPI_BCAST(iup,1,MPI_INTEGER,0,mpi_comm,ierr)
    IF (myrank.NE.irank) THEN
       IF (ALLOCATED(i)) DEALLOCATE(i)
       ALLOCATE(i(ilow(1):iup(1)))
    ENDIF

    CALL MPI_BCAST(i,SIZE(i),MPI_INTEGER,irank,mpi_comm,ierr)

    IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
Daniel Wortmann's avatar
Daniel Wortmann committed
60
#endif
61 62
  END SUBROUTINE mpi_bc_int1

Daniel Wortmann's avatar
Daniel Wortmann committed
63
  SUBROUTINE mpi_bc_int2(i,irank,mpi_comm)
64 65 66
    IMPLICIT NONE
    INTEGER,ALLOCATABLE,INTENT(INOUT) :: i(:,:)
    INTEGER,INTENT(IN)                :: irank,mpi_comm
Daniel Wortmann's avatar
Daniel Wortmann committed
67

68 69
    INTEGER:: ierr,ilow(2),iup(2),myrank

Daniel Wortmann's avatar
Daniel Wortmann committed
70
#ifdef CPP_MPI  
71 72 73 74 75 76 77 78 79 80 81 82 83 84

    CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
    IF (myrank==irank) THEN
       ilow=LBOUND(i)
       iup=UBOUND(i)
    END IF
    CALL MPI_BCAST(ilow,2,MPI_INTEGER,0,mpi_comm,ierr)
    CALL MPI_BCAST(iup,2,MPI_INTEGER,0,mpi_comm,ierr)
    IF (myrank.NE.irank) THEN
       IF (ALLOCATED(i)) DEALLOCATE(i)
       ALLOCATE(i(ilow(1):iup(1),ilow(2):iup(2)))
    ENDIF

    CALL MPI_BCAST(i,SIZE(i),MPI_INTEGER,irank,mpi_comm,ierr)
Daniel Wortmann's avatar
Daniel Wortmann committed
85
#endif
86 87 88 89 90 91 92
    IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
  END SUBROUTINE mpi_bc_int2

  SUBROUTINE mpi_bc_int3(i,irank,mpi_comm)
    IMPLICIT NONE
    INTEGER,ALLOCATABLE,INTENT(INOUT) :: i(:,:,:)
    INTEGER,INTENT(IN)                :: irank,mpi_comm
Daniel Wortmann's avatar
Daniel Wortmann committed
93

94 95
    INTEGER:: ierr,ilow(3),iup(3),myrank

Daniel Wortmann's avatar
Daniel Wortmann committed
96
#ifdef CPP_MPI  
97 98 99 100 101 102 103 104 105 106 107 108 109 110

    CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
    IF (myrank==irank) THEN
       ilow=LBOUND(i)
       iup=UBOUND(i)
    END IF
    CALL MPI_BCAST(ilow,3,MPI_INTEGER,0,mpi_comm,ierr)
    CALL MPI_BCAST(iup,3,MPI_INTEGER,0,mpi_comm,ierr)
    IF (myrank.NE.irank) THEN
       IF (ALLOCATED(i)) DEALLOCATE(i)
       ALLOCATE(i(ilow(1):iup(1),ilow(2):iup(2),ilow(3):iup(3)))
    ENDIF

    CALL MPI_BCAST(i,SIZE(i),MPI_INTEGER,irank,mpi_comm,ierr)
Daniel Wortmann's avatar
Daniel Wortmann committed
111
#endif
112 113 114
    IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
  END SUBROUTINE mpi_bc_int3

Daniel Wortmann's avatar
Daniel Wortmann committed
115
  SUBROUTINE mpi_bc_int4(i,irank,mpi_comm)
116 117 118
    IMPLICIT NONE
    INTEGER,ALLOCATABLE,INTENT(INOUT) :: i(:,:,:,:)
    INTEGER,INTENT(IN)                :: irank,mpi_comm
Daniel Wortmann's avatar
Daniel Wortmann committed
119

120 121
    INTEGER:: ierr,ilow(4),iup(4),myrank

Daniel Wortmann's avatar
Daniel Wortmann committed
122
#ifdef CPP_MPI  
123 124 125 126 127 128 129 130 131 132 133 134 135 136

    CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
    IF (myrank==irank) THEN
       ilow=LBOUND(i)
       iup=UBOUND(i)
    END IF
    CALL MPI_BCAST(ilow,4,MPI_INTEGER,0,mpi_comm,ierr)
    CALL MPI_BCAST(iup,4,MPI_INTEGER,0,mpi_comm,ierr)
    IF (myrank.NE.irank) THEN
       IF (ALLOCATED(i)) DEALLOCATE(i)
       ALLOCATE(i(ilow(1):iup(1),ilow(2):iup(2),ilow(3):iup(3),ilow(4):iup(4)))
    ENDIF

    CALL MPI_BCAST(i,SIZE(i),MPI_INTEGER,irank,mpi_comm,ierr)
Daniel Wortmann's avatar
Daniel Wortmann committed
137
#endif
138 139 140
    IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
  END SUBROUTINE mpi_bc_int4

Daniel Wortmann's avatar
Daniel Wortmann committed
141
  SUBROUTINE mpi_bc_int5(i,irank,mpi_comm)
142 143 144
    IMPLICIT NONE
    INTEGER,ALLOCATABLE,INTENT(INOUT) :: i(:,:,:,:,:)
    INTEGER,INTENT(IN)                :: irank,mpi_comm
Daniel Wortmann's avatar
Daniel Wortmann committed
145

146 147
    INTEGER:: ierr,ilow(5),iup(5),myrank

Daniel Wortmann's avatar
Daniel Wortmann committed
148
#ifdef CPP_MPI  
149 150 151 152 153 154 155 156 157 158 159 160 161 162

    CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
    IF (myrank==irank) THEN
       ilow=LBOUND(i)
       iup=UBOUND(i)
    END IF
    CALL MPI_BCAST(ilow,5,MPI_INTEGER,0,mpi_comm,ierr)
    CALL MPI_BCAST(iup,5,MPI_INTEGER,0,mpi_comm,ierr)
    IF (myrank.NE.irank) THEN
       IF (ALLOCATED(i)) DEALLOCATE(i)
       ALLOCATE(i(ilow(1):iup(1),ilow(2):iup(2),ilow(3):iup(3),ilow(4):iup(4),ilow(5):iup(5)))
    ENDIF

    CALL MPI_BCAST(i,SIZE(i),MPI_INTEGER,irank,mpi_comm,ierr)
Daniel Wortmann's avatar
Daniel Wortmann committed
163
#endif
164 165 166 167 168 169 170
    IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
  END SUBROUTINE mpi_bc_int5

  !
  ! now the same for reals
  !

Daniel Wortmann's avatar
Daniel Wortmann committed
171 172

  SUBROUTINE mpi_bc_real(r,irank,mpi_comm)
173 174 175 176 177
    IMPLICIT NONE
    REAL,INTENT(INOUT)   :: r
    INTEGER,INTENT(IN)   :: mpi_comm,irank

    INTEGER:: ierr
Daniel Wortmann's avatar
Daniel Wortmann committed
178
#ifdef CPP_MPI  
179 180

    CALL MPI_BCAST(r,1,MPI_DOUBLE_PRECISION,irank,mpi_comm,ierr)
Daniel Wortmann's avatar
Daniel Wortmann committed
181
#endif
182 183 184 185 186 187 188 189
    IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
  END SUBROUTINE mpi_bc_real

  SUBROUTINE mpi_bc_real1(r,irank,mpi_comm)
    IMPLICIT NONE
    REAL   ,ALLOCATABLE,INTENT(INOUT) :: r(:)
    INTEGER,INTENT(IN)                :: irank,mpi_comm

Daniel Wortmann's avatar
Daniel Wortmann committed
190
    INTEGER:: ierr,ilow(1),iup(1),myrank
191

Daniel Wortmann's avatar
Daniel Wortmann committed
192
#ifdef CPP_MPI
193 194 195 196 197 198 199 200 201 202 203 204 205
    CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
    IF (myrank==irank) THEN
       ilow=LBOUND(r)
       iup=UBOUND(r)
    END IF
    CALL MPI_BCAST(ilow,1,MPI_INTEGER,0,mpi_comm,ierr)
    CALL MPI_BCAST(iup,1,MPI_INTEGER,0,mpi_comm,ierr)
    IF (myrank.NE.irank) THEN
       IF (ALLOCATED(r)) DEALLOCATE(r)
       ALLOCATE(r(ilow(1):iup(1)))
    ENDIF

    CALL MPI_BCAST(r,SIZE(r),MPI_DOUBLE_PRECISION,irank,mpi_comm,ierr)
Daniel Wortmann's avatar
Daniel Wortmann committed
206
#endif
207 208 209
    IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
  END SUBROUTINE mpi_bc_real1

Daniel Wortmann's avatar
Daniel Wortmann committed
210
  SUBROUTINE mpi_bc_real2(r,irank,mpi_comm)
211 212 213
    IMPLICIT NONE
    REAL   ,ALLOCATABLE,INTENT(INOUT) :: r(:,:)
    INTEGER,INTENT(IN)                :: irank,mpi_comm
Daniel Wortmann's avatar
Daniel Wortmann committed
214

215 216
    INTEGER:: ierr,ilow(2),iup(2),myrank

Daniel Wortmann's avatar
Daniel Wortmann committed
217
#ifdef CPP_MPI  
218 219 220 221 222 223 224 225 226 227 228 229 230 231

    CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
    IF (myrank==irank) THEN
       ilow=LBOUND(r)
       iup=UBOUND(r)
    END IF
    CALL MPI_BCAST(ilow,2,MPI_INTEGER,0,mpi_comm,ierr)
    CALL MPI_BCAST(iup,2,MPI_INTEGER,0,mpi_comm,ierr)
    IF (myrank.NE.irank) THEN
       IF (ALLOCATED(r)) DEALLOCATE(r)
       ALLOCATE(r(ilow(1):iup(1),ilow(2):iup(2)))
    ENDIF

    CALL MPI_BCAST(r,SIZE(r),MPI_DOUBLE_PRECISION,irank,mpi_comm,ierr)
Daniel Wortmann's avatar
Daniel Wortmann committed
232
#endif  
233 234 235 236 237 238 239 240

    IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
  END SUBROUTINE mpi_bc_real2

  SUBROUTINE mpi_bc_real3(r,irank,mpi_comm)
    IMPLICIT NONE
    REAL   ,ALLOCATABLE,INTENT(INOUT) :: r(:,:,:)
    INTEGER,INTENT(IN)                :: irank,mpi_comm
Daniel Wortmann's avatar
Daniel Wortmann committed
241

242 243
    INTEGER:: ierr,ilow(3),iup(3),myrank

Daniel Wortmann's avatar
Daniel Wortmann committed
244
#ifdef CPP_MPI  
245 246 247 248 249 250 251 252 253 254 255 256 257 258

    CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
    IF (myrank==irank) THEN
       ilow=LBOUND(r)
       iup=UBOUND(r)
    END IF
    CALL MPI_BCAST(ilow,3,MPI_INTEGER,0,mpi_comm,ierr)
    CALL MPI_BCAST(iup,3,MPI_INTEGER,0,mpi_comm,ierr)
    IF (myrank.NE.irank) THEN
       IF (ALLOCATED(r)) DEALLOCATE(r)
       ALLOCATE(r(ilow(1):iup(1),ilow(2):iup(2),ilow(3):iup(3)))
    ENDIF

    CALL MPI_BCAST(r,SIZE(r),MPI_DOUBLE_PRECISION,irank,mpi_comm,ierr)
Daniel Wortmann's avatar
Daniel Wortmann committed
259
#endif  
260 261 262 263

    IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
  END SUBROUTINE mpi_bc_real3

Daniel Wortmann's avatar
Daniel Wortmann committed
264
  SUBROUTINE mpi_bc_real4(r,irank,mpi_comm)
265 266 267
    IMPLICIT NONE
    REAL   ,ALLOCATABLE,INTENT(INOUT) :: r(:,:,:,:)
    INTEGER,INTENT(IN)                :: irank,mpi_comm
Daniel Wortmann's avatar
Daniel Wortmann committed
268

269
    INTEGER:: ierr,ilow(4),iup(4),myrank
Daniel Wortmann's avatar
Daniel Wortmann committed
270
#ifdef CPP_MPI  
271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286


    CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
    IF (myrank==irank) THEN
       ilow=LBOUND(r)
       iup=UBOUND(r)
    END IF
    CALL MPI_BCAST(ilow,4,MPI_INTEGER,0,mpi_comm,ierr)
    CALL MPI_BCAST(iup,4,MPI_INTEGER,0,mpi_comm,ierr)
    IF (myrank.NE.irank) THEN
       IF (ALLOCATED(r)) DEALLOCATE(r)
       ALLOCATE(r(ilow(1):iup(1),ilow(2):iup(2),ilow(3):iup(3),ilow(4):iup(4)))
    ENDIF

    CALL MPI_BCAST(r,SIZE(r),MPI_DOUBLE_PRECISION,irank,mpi_comm,ierr)

Daniel Wortmann's avatar
Daniel Wortmann committed
287
#endif  
288 289 290
    IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
  END SUBROUTINE mpi_bc_real4

Daniel Wortmann's avatar
Daniel Wortmann committed
291
  SUBROUTINE mpi_bc_real5(r,irank,mpi_comm)
292 293 294
    IMPLICIT NONE
    REAL   ,ALLOCATABLE,INTENT(INOUT) :: r(:,:,:,:,:)
    INTEGER,INTENT(IN)                :: irank,mpi_comm
Daniel Wortmann's avatar
Daniel Wortmann committed
295

296
    INTEGER:: ierr,ilow(5),iup(5),myrank
Daniel Wortmann's avatar
Daniel Wortmann committed
297
#ifdef CPP_MPI  
298 299 300 301 302 303 304 305 306 307 308 309 310 311 312


    CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
    IF (myrank==irank) THEN
       ilow=LBOUND(r)
       iup=UBOUND(r)
    END IF
    CALL MPI_BCAST(ilow,5,MPI_INTEGER,0,mpi_comm,ierr)
    CALL MPI_BCAST(iup,5,MPI_INTEGER,0,mpi_comm,ierr)
    IF (myrank.NE.irank) THEN
       IF (ALLOCATED(r)) DEALLOCATE(r)
       ALLOCATE(r(ilow(1):iup(1),ilow(2):iup(2),ilow(3):iup(3),ilow(4):iup(4),ilow(5):iup(5)))
    ENDIF

    CALL MPI_BCAST(r,SIZE(r),MPI_DOUBLE_PRECISION,irank,mpi_comm,ierr)
Daniel Wortmann's avatar
Daniel Wortmann committed
313
#endif  
314 315 316 317 318 319 320 321 322 323 324 325 326 327

    IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
  END SUBROUTINE mpi_bc_real5

  !
  ! And Complex!!
  !

  SUBROUTINE mpi_bc_complex(c,irank,mpi_comm)
    IMPLICIT NONE
    COMPLEX,INTENT(INOUT)   :: c
    INTEGER,INTENT(IN)   :: mpi_comm,irank

    INTEGER:: ierr
Daniel Wortmann's avatar
Daniel Wortmann committed
328
#ifdef CPP_MPI  
329 330

    CALL MPI_BCAST(c,1,MPI_DOUBLE_COMPLEX,irank,mpi_comm,ierr)
Daniel Wortmann's avatar
Daniel Wortmann committed
331
#endif  
332 333 334 335 336 337 338 339

    IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
  END SUBROUTINE mpi_bc_complex

  SUBROUTINE mpi_bc_complex1(c,irank,mpi_comm)
    IMPLICIT NONE
    COMPLEX,ALLOCATABLE,INTENT(INOUT) :: c(:)
    INTEGER,INTENT(IN)                :: irank,mpi_comm
Daniel Wortmann's avatar
Daniel Wortmann committed
340

341 342
    INTEGER:: ierr,ilow(1),iup(1),myrank

Daniel Wortmann's avatar
Daniel Wortmann committed
343
#ifdef CPP_MPI  
344 345 346 347 348 349 350 351 352 353 354 355 356 357

    CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
    IF (myrank==irank) THEN
       ilow=LBOUND(c)
       iup=UBOUND(c)
    END IF
    CALL MPI_BCAST(ilow,1,MPI_INTEGER,0,mpi_comm,ierr)
    CALL MPI_BCAST(iup,1,MPI_INTEGER,0,mpi_comm,ierr)
    IF (myrank.NE.irank) THEN
       IF (ALLOCATED(c)) DEALLOCATE(c)
       ALLOCATE(c(ilow(1):iup(1)))
    ENDIF

    CALL MPI_BCAST(c,SIZE(c),MPI_DOUBLE_COMPLEX,irank,mpi_comm,ierr)
Daniel Wortmann's avatar
Daniel Wortmann committed
358
#endif  
359 360 361 362

    IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
  END SUBROUTINE mpi_bc_complex1

Daniel Wortmann's avatar
Daniel Wortmann committed
363
  SUBROUTINE mpi_bc_complex2(c,irank,mpi_comm)
364 365 366
    IMPLICIT NONE
    COMPLEX,ALLOCATABLE,INTENT(INOUT) :: c(:,:)
    INTEGER,INTENT(IN)                :: irank,mpi_comm
Daniel Wortmann's avatar
Daniel Wortmann committed
367

368
    INTEGER:: ierr,ilow(2),iup(2),myrank
Daniel Wortmann's avatar
Daniel Wortmann committed
369
#ifdef CPP_MPI  
370 371 372 373 374 375 376 377 378 379 380 381 382 383 384


    CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
    IF (myrank==irank) THEN
       ilow=LBOUND(c)
       iup=UBOUND(c)
    END IF
    CALL MPI_BCAST(ilow,2,MPI_INTEGER,0,mpi_comm,ierr)
    CALL MPI_BCAST(iup,2,MPI_INTEGER,0,mpi_comm,ierr)
    IF (myrank.NE.irank) THEN
       IF (ALLOCATED(c)) DEALLOCATE(c)
       ALLOCATE(c(ilow(1):iup(1),ilow(2):iup(2)))
    ENDIF

    CALL MPI_BCAST(c,SIZE(c),MPI_DOUBLE_COMPLEX,irank,mpi_comm,ierr)
Daniel Wortmann's avatar
Daniel Wortmann committed
385
#endif  
386 387 388 389 390 391 392 393

    IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
  END SUBROUTINE mpi_bc_complex2

  SUBROUTINE mpi_bc_complex3(c,irank,mpi_comm)
    IMPLICIT NONE
    COMPLEX,ALLOCATABLE,INTENT(INOUT) :: c(:,:,:)
    INTEGER,INTENT(IN)                :: irank,mpi_comm
Daniel Wortmann's avatar
Daniel Wortmann committed
394

395
    INTEGER:: ierr,ilow(3),iup(3),myrank
Daniel Wortmann's avatar
Daniel Wortmann committed
396
#ifdef CPP_MPI  
397 398 399 400 401 402 403 404 405 406 407 408 409 410 411


    CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
    IF (myrank==irank) THEN
       ilow=LBOUND(c)
       iup=UBOUND(c)
    END IF
    CALL MPI_BCAST(ilow,3,MPI_INTEGER,0,mpi_comm,ierr)
    CALL MPI_BCAST(iup,3,MPI_INTEGER,0,mpi_comm,ierr)
    IF (myrank.NE.irank) THEN
       IF (ALLOCATED(c)) DEALLOCATE(c)
       ALLOCATE(c(ilow(1):iup(1),ilow(2):iup(2),ilow(3):iup(3)))
    ENDIF

    CALL MPI_BCAST(c,SIZE(c),MPI_DOUBLE_COMPLEX,irank,mpi_comm,ierr)
Daniel Wortmann's avatar
Daniel Wortmann committed
412
#endif  
413 414 415 416

    IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
  END SUBROUTINE mpi_bc_complex3

Daniel Wortmann's avatar
Daniel Wortmann committed
417
  SUBROUTINE mpi_bc_complex4(c,irank,mpi_comm)
418 419 420
    IMPLICIT NONE
    COMPLEX,ALLOCATABLE,INTENT(INOUT) :: c(:,:,:,:)
    INTEGER,INTENT(IN)                :: irank,mpi_comm
Daniel Wortmann's avatar
Daniel Wortmann committed
421

422
    INTEGER:: ierr,ilow(4),iup(4),myrank
Daniel Wortmann's avatar
Daniel Wortmann committed
423
#ifdef CPP_MPI  
424 425 426 427 428 429 430 431 432 433 434 435 436 437 438


    CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
    IF (myrank==irank) THEN
       ilow=LBOUND(c)
       iup=UBOUND(c)
    END IF
    CALL MPI_BCAST(ilow,4,MPI_INTEGER,0,mpi_comm,ierr)
    CALL MPI_BCAST(iup,4,MPI_INTEGER,0,mpi_comm,ierr)
    IF (myrank.NE.irank) THEN
       IF (ALLOCATED(c)) DEALLOCATE(c)
       ALLOCATE(c(ilow(1):iup(1),ilow(2):iup(2),ilow(3):iup(3),ilow(4):iup(4)))
    ENDIF

    CALL MPI_BCAST(c,SIZE(c),MPI_DOUBLE_COMPLEX,irank,mpi_comm,ierr)
Daniel Wortmann's avatar
Daniel Wortmann committed
439
#endif  
440 441 442 443

    IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
  END SUBROUTINE mpi_bc_complex4

Daniel Wortmann's avatar
Daniel Wortmann committed
444
  SUBROUTINE mpi_bc_complex5(c,irank,mpi_comm)
445 446 447
    IMPLICIT NONE
    COMPLEX,ALLOCATABLE,INTENT(INOUT) :: c(:,:,:,:,:)
    INTEGER,INTENT(IN)                :: irank,mpi_comm
Daniel Wortmann's avatar
Daniel Wortmann committed
448

449
    INTEGER:: ierr,ilow(5),iup(5),myrank
Daniel Wortmann's avatar
Daniel Wortmann committed
450
#ifdef CPP_MPI  
451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466


    CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
    IF (myrank==irank) THEN
       ilow=LBOUND(c)
       iup=UBOUND(c)
    END IF
    CALL MPI_BCAST(ilow,5,MPI_INTEGER,0,mpi_comm,ierr)
    CALL MPI_BCAST(iup,5,MPI_INTEGER,0,mpi_comm,ierr)
    IF (myrank.NE.irank) THEN
       IF (ALLOCATED(c)) DEALLOCATE(c)
       ALLOCATE(c(ilow(1):iup(1),ilow(2):iup(2),ilow(3):iup(3),ilow(4):iup(4),ilow(5):iup(5)))
    ENDIF

    CALL MPI_BCAST(c,SIZE(c),MPI_DOUBLE_COMPLEX,irank,mpi_comm,ierr)

Daniel Wortmann's avatar
Daniel Wortmann committed
467
#endif  
468 469 470
    IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
  END SUBROUTINE mpi_bc_complex5
END MODULE m_mpi_bc_tool