Line data Source code
1 : !|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
2 :
3 : module ice_broadcast
4 :
5 : ! This module contains all the broadcast routines. This
6 : ! particular version contains MPI versions of these routines.
7 : !
8 : ! author: Phil Jones, LANL
9 : ! Oct. 2004: Adapted from POP version by William H. Lipscomb, LANL
10 :
11 : #ifndef SERIAL_REMOVE_MPI
12 : use mpi ! MPI Fortran module
13 : #endif
14 : use ice_kinds_mod
15 : #ifdef SERIAL_REMOVE_MPI
16 : use ice_communicate, only: MPI_COMM_ICE
17 : #else
18 : use ice_communicate, only: mpiR8, mpir4, MPI_COMM_ICE
19 : #endif
20 : use ice_exit, only: abort_ice
21 : use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted
22 :
23 : implicit none
24 : private
25 :
26 : public :: broadcast_scalar, &
27 : broadcast_array
28 :
29 : !-----------------------------------------------------------------------
30 : !
31 : ! generic interfaces for module procedures
32 : !
33 : !-----------------------------------------------------------------------
34 :
35 : interface broadcast_scalar
36 : module procedure broadcast_scalar_dbl, &
37 : broadcast_scalar_real, & ! LCOV_EXCL_LINE
38 : broadcast_scalar_int, & ! LCOV_EXCL_LINE
39 : broadcast_scalar_log, & ! LCOV_EXCL_LINE
40 : broadcast_scalar_char
41 : end interface
42 :
43 : interface broadcast_array
44 : module procedure broadcast_array_dbl_1d, &
45 : broadcast_array_real_1d, & ! LCOV_EXCL_LINE
46 : broadcast_array_int_1d, & ! LCOV_EXCL_LINE
47 : broadcast_array_log_1d, & ! LCOV_EXCL_LINE
48 : broadcast_array_dbl_2d, & ! LCOV_EXCL_LINE
49 : broadcast_array_real_2d, & ! LCOV_EXCL_LINE
50 : broadcast_array_int_2d, & ! LCOV_EXCL_LINE
51 : broadcast_array_log_2d, & ! LCOV_EXCL_LINE
52 : broadcast_array_dbl_3d, & ! LCOV_EXCL_LINE
53 : broadcast_array_real_3d, & ! LCOV_EXCL_LINE
54 : broadcast_array_int_3d, & ! LCOV_EXCL_LINE
55 : broadcast_array_log_3d
56 : end interface
57 :
58 : !***********************************************************************
59 :
60 : contains
61 :
62 : !***********************************************************************
63 :
64 456300 : subroutine broadcast_scalar_dbl(scalar, root_pe)
65 :
66 : ! Broadcasts a scalar dbl variable from one processor (root_pe)
67 : ! to all other processors. This is a specific instance of the generic
68 : ! broadcast\_scalar interface.
69 :
70 : integer (int_kind), intent(in) :: &
71 : root_pe ! processor number to broadcast from
72 :
73 : real (dbl_kind), intent(inout) :: &
74 : scalar ! scalar to be broadcast
75 :
76 : !-----------------------------------------------------------------------
77 : !
78 : ! local variables
79 : !
80 : !-----------------------------------------------------------------------
81 :
82 : integer (int_kind) :: ierr ! local MPI error flag
83 : character(len=*), parameter :: subname = '(broadcast_scalar_dbl)'
84 :
85 : !-----------------------------------------------------------------------
86 :
87 : #ifdef SERIAL_REMOVE_MPI
88 : ! nothing to do
89 : #else
90 456300 : call MPI_BCAST(scalar, 1, mpiR8, root_pe, MPI_COMM_ICE, ierr)
91 456300 : call MPI_BARRIER(MPI_COMM_ICE, ierr)
92 : #endif
93 :
94 : !-----------------------------------------------------------------------
95 :
96 456300 : end subroutine broadcast_scalar_dbl
97 :
98 : !***********************************************************************
99 :
100 0 : subroutine broadcast_scalar_real(scalar, root_pe)
101 :
102 : ! Broadcasts a scalar real variable from one processor (root_pe)
103 : ! to all other processors. This is a specific instance of the generic
104 : ! broadcast\_scalar interface.
105 :
106 : integer (int_kind), intent(in) :: &
107 : root_pe ! processor number to broadcast from
108 :
109 : real (real_kind), intent(inout) :: &
110 : scalar ! scalar to be broadcast
111 :
112 : !-----------------------------------------------------------------------
113 : !
114 : ! local variables
115 : !
116 : !-----------------------------------------------------------------------
117 :
118 : integer (int_kind) :: ierr ! local MPI error flag
119 : character(len=*), parameter :: subname = '(broadcast_scalar_real)'
120 :
121 : !-----------------------------------------------------------------------
122 :
123 : #ifdef SERIAL_REMOVE_MPI
124 : ! nothing to do
125 : #else
126 0 : call MPI_BCAST(scalar, 1, mpiR4, root_pe, MPI_COMM_ICE, ierr)
127 0 : call MPI_BARRIER(MPI_COMM_ICE, ierr)
128 : #endif
129 :
130 : !-----------------------------------------------------------------------
131 :
132 0 : end subroutine broadcast_scalar_real
133 :
134 : !***********************************************************************
135 :
136 2540 : subroutine broadcast_scalar_int(scalar, root_pe)
137 :
138 : ! Broadcasts a scalar integer variable from one processor (root_pe)
139 : ! to all other processors. This is a specific instance of the generic
140 : ! broadcast\_scalar interface.
141 :
142 : integer (int_kind), intent(in) :: &
143 : root_pe ! processor number to broadcast from
144 :
145 : integer (int_kind), intent(inout) :: &
146 : scalar ! scalar to be broadcast
147 :
148 : !-----------------------------------------------------------------------
149 : !
150 : ! local variables
151 : !
152 : !-----------------------------------------------------------------------
153 :
154 : integer (int_kind) :: ierr ! local MPI error flag
155 : character(len=*), parameter :: subname = '(broadcast_scalar_int)'
156 :
157 : !-----------------------------------------------------------------------
158 :
159 : #ifdef SERIAL_REMOVE_MPI
160 : ! nothing to do
161 : #else
162 2540 : call MPI_BCAST(scalar, 1, MPI_INTEGER, root_pe, MPI_COMM_ICE,ierr)
163 2540 : call MPI_BARRIER(MPI_COMM_ICE, ierr)
164 : #endif
165 :
166 : !-----------------------------------------------------------------------
167 :
168 2540 : end subroutine broadcast_scalar_int
169 :
170 : !***********************************************************************
171 :
172 4204 : subroutine broadcast_scalar_log(scalar, root_pe)
173 :
174 : ! Broadcasts a scalar logical variable from one processor (root_pe)
175 : ! to all other processors. This is a specific instance of the generic
176 : ! broadcast\_scalar interface.
177 :
178 : integer (int_kind), intent(in) :: &
179 : root_pe ! processor number to broadcast from
180 :
181 : logical (log_kind), intent(inout) :: &
182 : scalar ! scalar to be broadcast
183 :
184 : !-----------------------------------------------------------------------
185 : !
186 : ! local variables
187 : !
188 : !-----------------------------------------------------------------------
189 :
190 : integer (int_kind) :: &
191 : itmp, &! local temporary ! LCOV_EXCL_LINE
192 : ierr ! MPI error flag
193 : character(len=*), parameter :: subname = '(broadcast_scalar_log)'
194 :
195 : !-----------------------------------------------------------------------
196 :
197 : #ifdef SERIAL_REMOVE_MPI
198 : ! nothing to do
199 : #else
200 4204 : if (scalar) then
201 1169 : itmp = 1
202 : else
203 3035 : itmp = 0
204 : endif
205 :
206 4204 : call MPI_BCAST(itmp, 1, MPI_INTEGER, root_pe, MPI_COMM_ICE, ierr)
207 4204 : call MPI_BARRIER(MPI_COMM_ICE, ierr)
208 :
209 4204 : if (itmp == 1) then
210 1072 : scalar = .true.
211 : else
212 3132 : scalar = .false.
213 : endif
214 : #endif
215 :
216 : !-----------------------------------------------------------------------
217 :
218 4204 : end subroutine broadcast_scalar_log
219 :
220 : !***********************************************************************
221 :
222 20124 : subroutine broadcast_scalar_char(scalar, root_pe)
223 :
224 : ! Broadcasts a scalar character variable from one processor (root_pe)
225 : ! to all other processors. This is a specific instance of the generic
226 : ! broadcast\_scalar interface.
227 :
228 : integer (int_kind), intent(in) :: &
229 : root_pe ! processor number to broadcast from
230 :
231 : character (*), intent(inout) :: &
232 : scalar ! scalar to be broadcast
233 :
234 : !-----------------------------------------------------------------------
235 : !
236 : ! local variables
237 : !
238 : !-----------------------------------------------------------------------
239 :
240 : integer (int_kind) :: &
241 : clength, &! length of character ! LCOV_EXCL_LINE
242 : ierr ! MPI error flag
243 : character(len=*), parameter :: subname = '(broadcast_scalar_char)'
244 :
245 : !-----------------------------------------------------------------------
246 :
247 : #ifdef SERIAL_REMOVE_MPI
248 : ! nothing to do
249 : #else
250 20124 : clength = len(scalar)
251 :
252 20124 : call MPI_BCAST(scalar, clength, MPI_CHARACTER, root_pe, MPI_COMM_ICE, ierr)
253 20124 : call MPI_BARRIER(MPI_COMM_ICE, ierr)
254 : #endif
255 :
256 : !--------------------------------------------------------------------
257 :
258 20124 : end subroutine broadcast_scalar_char
259 :
260 : !***********************************************************************
261 :
262 72 : subroutine broadcast_array_dbl_1d(array, root_pe)
263 :
264 : ! Broadcasts a vector dbl variable from one processor (root_pe)
265 : ! to all other processors. This is a specific instance of the generic
266 : ! broadcast\_array interface.
267 :
268 : integer (int_kind), intent(in) :: &
269 : root_pe ! processor number to broadcast from
270 :
271 : real (dbl_kind), dimension(:), intent(inout) :: &
272 : array ! array to be broadcast
273 :
274 : !-----------------------------------------------------------------------
275 : !
276 : ! local variables
277 : !
278 : !-----------------------------------------------------------------------
279 :
280 : integer (int_kind) :: &
281 : nelements, &! size of array ! LCOV_EXCL_LINE
282 : ierr ! local MPI error flag
283 : character(len=*), parameter :: subname = '(broadcast_array_dbl_1d)'
284 :
285 : !-----------------------------------------------------------------------
286 :
287 : #ifdef SERIAL_REMOVE_MPI
288 : ! nothing to do
289 : #else
290 72 : nelements = size(array)
291 :
292 72 : call MPI_BCAST(array, nelements, mpiR8, root_pe, MPI_COMM_ICE, ierr)
293 72 : call MPI_BARRIER(MPI_COMM_ICE, ierr)
294 : #endif
295 :
296 : !-----------------------------------------------------------------------
297 :
298 72 : end subroutine broadcast_array_dbl_1d
299 :
300 : !***********************************************************************
301 :
302 0 : subroutine broadcast_array_real_1d(array, root_pe)
303 :
304 : ! Broadcasts a real vector from one processor (root_pe)
305 : ! to all other processors. This is a specific instance of the generic
306 : ! broadcast\_array interface.
307 :
308 : integer (int_kind), intent(in) :: &
309 : root_pe ! processor number to broadcast from
310 :
311 : real (real_kind), dimension(:), intent(inout) :: &
312 : array ! array to be broadcast
313 :
314 : !-----------------------------------------------------------------------
315 : !
316 : ! local variables
317 : !
318 : !-----------------------------------------------------------------------
319 :
320 : integer (int_kind) :: &
321 : nelements, &! size of array to be broadcast ! LCOV_EXCL_LINE
322 : ierr ! local MPI error flag
323 : character(len=*), parameter :: subname = '(broadcast_array_real_1d)'
324 :
325 : !-----------------------------------------------------------------------
326 :
327 : #ifdef SERIAL_REMOVE_MPI
328 : ! nothing to do
329 : #else
330 0 : nelements = size(array)
331 :
332 0 : call MPI_BCAST(array, nelements, mpiR4, root_pe, MPI_COMM_ICE, ierr)
333 0 : call MPI_BARRIER(MPI_COMM_ICE, ierr)
334 : #endif
335 :
336 : !-----------------------------------------------------------------------
337 :
338 0 : end subroutine broadcast_array_real_1d
339 :
340 : !***********************************************************************
341 :
342 108 : subroutine broadcast_array_int_1d(array, root_pe)
343 :
344 : ! Broadcasts an integer vector from one processor (root_pe)
345 : ! to all other processors. This is a specific instance of the generic
346 : ! broadcast\_array interface.
347 :
348 : integer (int_kind), intent(in) :: &
349 : root_pe ! processor number to broadcast from
350 :
351 : integer (int_kind), dimension(:), intent(inout) :: &
352 : array ! array to be broadcast
353 :
354 : !-----------------------------------------------------------------------
355 : !
356 : ! local variables
357 : !
358 : !-----------------------------------------------------------------------
359 :
360 : integer (int_kind) :: &
361 : nelements, &! size of array to be broadcast ! LCOV_EXCL_LINE
362 : ierr ! local MPI error flag
363 : character(len=*), parameter :: subname = '(broadcast_array_int_1d)'
364 :
365 : !-----------------------------------------------------------------------
366 :
367 : #ifdef SERIAL_REMOVE_MPI
368 : ! nothing to do
369 : #else
370 108 : nelements = size(array)
371 :
372 108 : call MPI_BCAST(array, nelements, MPI_INTEGER, root_pe, MPI_COMM_ICE, ierr)
373 108 : call MPI_BARRIER(MPI_COMM_ICE, ierr)
374 : #endif
375 :
376 : !-----------------------------------------------------------------------
377 :
378 108 : end subroutine broadcast_array_int_1d
379 :
380 : !***********************************************************************
381 :
382 36 : subroutine broadcast_array_log_1d(array, root_pe)
383 :
384 : ! Broadcasts a logical vector from one processor (root_pe)
385 : ! to all other processors. This is a specific instance of the generic
386 : ! broadcast\_array interface.
387 :
388 : integer (int_kind), intent(in) :: &
389 : root_pe ! processor number to broadcast from
390 :
391 : logical (log_kind), dimension(:), intent(inout) :: &
392 : array ! array to be broadcast
393 :
394 : !-----------------------------------------------------------------------
395 : !
396 : ! local variables
397 : !
398 : !-----------------------------------------------------------------------
399 :
400 : integer (int_kind), dimension(:), allocatable :: &
401 36 : array_int ! temporary array for MPI bcast
402 :
403 : integer (int_kind) :: &
404 : nelements, &! size of array to be broadcast ! LCOV_EXCL_LINE
405 : ierr ! local MPI error flag
406 :
407 : character(len=*), parameter :: subname = '(broadcast_array_log_1d)'
408 :
409 : !-----------------------------------------------------------------------
410 :
411 : #ifdef SERIAL_REMOVE_MPI
412 : ! nothing to do
413 : #else
414 36 : nelements = size(array)
415 36 : allocate(array_int(nelements))
416 :
417 216 : where (array)
418 8 : array_int = 1
419 : elsewhere
420 8 : array_int = 0
421 : end where
422 :
423 : call MPI_BCAST(array_int, nelements, MPI_INTEGER, root_pe, &
424 36 : MPI_COMM_ICE, ierr)
425 36 : call MPI_BARRIER(MPI_COMM_ICE, ierr)
426 :
427 216 : where (array_int == 1)
428 8 : array = .true.
429 : elsewhere
430 8 : array = .false.
431 : end where
432 :
433 36 : deallocate(array_int)
434 : #endif
435 :
436 : !-----------------------------------------------------------------------
437 :
438 72 : end subroutine broadcast_array_log_1d
439 :
440 : !***********************************************************************
441 :
442 72 : subroutine broadcast_array_dbl_2d(array, root_pe)
443 :
444 : ! Broadcasts a dbl 2d array from one processor (root_pe)
445 : ! to all other processors. This is a specific instance of the generic
446 : ! broadcast\_array interface.
447 :
448 : integer (int_kind), intent(in) :: &
449 : root_pe ! processor number to broadcast from
450 :
451 : real (dbl_kind), dimension(:,:), intent(inout) :: &
452 : array ! array to be broadcast
453 :
454 : !-----------------------------------------------------------------------
455 : !
456 : ! local variables
457 : !
458 : !-----------------------------------------------------------------------
459 :
460 : integer (int_kind) :: &
461 : nelements, &! size of array ! LCOV_EXCL_LINE
462 : ierr ! local MPI error flag
463 : character(len=*), parameter :: subname = '(broadcast_array_dbl_2d)'
464 :
465 : !-----------------------------------------------------------------------
466 :
467 : #ifdef SERIAL_REMOVE_MPI
468 : ! nothing to do
469 : #else
470 72 : nelements = size(array)
471 :
472 72 : call MPI_BCAST(array, nelements, mpiR8, root_pe, MPI_COMM_ICE, ierr)
473 72 : call MPI_BARRIER(MPI_COMM_ICE, ierr)
474 : #endif
475 :
476 : !-----------------------------------------------------------------------
477 :
478 72 : end subroutine broadcast_array_dbl_2d
479 :
480 : !***********************************************************************
481 :
482 0 : subroutine broadcast_array_real_2d(array, root_pe)
483 :
484 : ! Broadcasts a real 2d array from one processor (root_pe)
485 : ! to all other processors. This is a specific instance of the generic
486 : ! broadcast\_array interface.
487 :
488 : integer (int_kind), intent(in) :: &
489 : root_pe ! processor number to broadcast from
490 :
491 : real (real_kind), dimension(:,:), intent(inout) :: &
492 : array ! array to be broadcast
493 :
494 : !-----------------------------------------------------------------------
495 : !
496 : ! local variables
497 : !
498 : !-----------------------------------------------------------------------
499 :
500 : integer (int_kind) :: &
501 : nelements, &! size of array to be broadcast ! LCOV_EXCL_LINE
502 : ierr ! local MPI error flag
503 : character(len=*), parameter :: subname = '(broadcast_array_real_2d)'
504 :
505 : !-----------------------------------------------------------------------
506 :
507 : #ifdef SERIAL_REMOVE_MPI
508 : ! nothing to do
509 : #else
510 0 : nelements = size(array)
511 :
512 0 : call MPI_BCAST(array, nelements, mpiR4, root_pe, MPI_COMM_ICE, ierr)
513 0 : call MPI_BARRIER(MPI_COMM_ICE, ierr)
514 : #endif
515 :
516 : !-----------------------------------------------------------------------
517 :
518 0 : end subroutine broadcast_array_real_2d
519 :
520 : !***********************************************************************
521 :
522 0 : subroutine broadcast_array_int_2d(array, root_pe)
523 :
524 : ! Broadcasts a 2d integer array from one processor (root_pe)
525 : ! to all other processors. This is a specific instance of the generic
526 : ! broadcast\_array interface.
527 :
528 : integer (int_kind), intent(in) :: &
529 : root_pe ! processor number to broadcast from
530 :
531 : integer (int_kind), dimension(:,:), intent(inout) :: &
532 : array ! array to be broadcast
533 :
534 : !-----------------------------------------------------------------------
535 : !
536 : ! local variables
537 : !
538 : !-----------------------------------------------------------------------
539 :
540 : integer (int_kind) :: &
541 : nelements, &! size of array to be broadcast ! LCOV_EXCL_LINE
542 : ierr ! local MPI error flag
543 : character(len=*), parameter :: subname = '(broadcast_array_int_2d)'
544 :
545 : !-----------------------------------------------------------------------
546 :
547 : #ifdef SERIAL_REMOVE_MPI
548 : ! nothing to do
549 : #else
550 0 : nelements = size(array)
551 :
552 0 : call MPI_BCAST(array, nelements, MPI_INTEGER, root_pe, MPI_COMM_ICE, ierr)
553 0 : call MPI_BARRIER(MPI_COMM_ICE, ierr)
554 : #endif
555 :
556 : !-----------------------------------------------------------------------
557 :
558 0 : end subroutine broadcast_array_int_2d
559 :
560 : !***********************************************************************
561 :
562 0 : subroutine broadcast_array_log_2d(array, root_pe)
563 :
564 : ! Broadcasts a logical 2d array from one processor (root_pe)
565 : ! to all other processors. This is a specific instance of the generic
566 : ! broadcast\_array interface.
567 :
568 : integer (int_kind), intent(in) :: &
569 : root_pe ! processor number to broadcast from
570 :
571 : logical (log_kind), dimension(:,:), intent(inout) :: &
572 : array ! array to be broadcast
573 :
574 : !-----------------------------------------------------------------------
575 : !
576 : ! local variables
577 : !
578 : !-----------------------------------------------------------------------
579 :
580 : integer (int_kind), dimension(:,:), allocatable :: &
581 0 : array_int ! temporary array for MPI bcast
582 :
583 : integer (int_kind) :: &
584 : nelements, &! size of array to be broadcast ! LCOV_EXCL_LINE
585 : ierr ! local MPI error flag
586 :
587 : character(len=*), parameter :: subname = '(broadcast_array_log_2d)'
588 :
589 : !-----------------------------------------------------------------------
590 :
591 : #ifdef SERIAL_REMOVE_MPI
592 : ! nothing to do
593 : #else
594 0 : nelements = size(array)
595 0 : allocate(array_int(size(array,dim=1),size(array,dim=2)))
596 :
597 0 : where (array)
598 0 : array_int = 1
599 : elsewhere
600 0 : array_int = 0
601 : end where
602 :
603 : call MPI_BCAST(array_int, nelements, MPI_INTEGER, root_pe, &
604 0 : MPI_COMM_ICE, ierr)
605 0 : call MPI_BARRIER(MPI_COMM_ICE, ierr)
606 :
607 0 : where (array_int == 1)
608 0 : array = .true.
609 : elsewhere
610 0 : array = .false.
611 : end where
612 :
613 0 : deallocate(array_int)
614 : #endif
615 :
616 : !-----------------------------------------------------------------------
617 :
618 0 : end subroutine broadcast_array_log_2d
619 :
620 : !***********************************************************************
621 :
622 0 : subroutine broadcast_array_dbl_3d(array, root_pe)
623 :
624 : ! Broadcasts a double 3d array from one processor (root_pe)
625 : ! to all other processors. This is a specific instance of the generic
626 : ! broadcast\_array interface.
627 :
628 : integer (int_kind), intent(in) :: &
629 : root_pe ! processor number to broadcast from
630 :
631 : real (dbl_kind), dimension(:,:,:), intent(inout) :: &
632 : array ! array to be broadcast
633 :
634 : !-----------------------------------------------------------------------
635 : !
636 : ! local variables
637 : !
638 : !-----------------------------------------------------------------------
639 :
640 : integer (int_kind) :: &
641 : nelements, &! size of array ! LCOV_EXCL_LINE
642 : ierr ! local MPI error flag
643 : character(len=*), parameter :: subname = '(broadcast_array_dbl_3d)'
644 :
645 : !-----------------------------------------------------------------------
646 :
647 : #ifdef SERIAL_REMOVE_MPI
648 : ! nothing to do
649 : #else
650 0 : nelements = size(array)
651 :
652 0 : call MPI_BCAST(array, nelements, mpiR8, root_pe, MPI_COMM_ICE, ierr)
653 0 : call MPI_BARRIER(MPI_COMM_ICE, ierr)
654 : #endif
655 :
656 : !-----------------------------------------------------------------------
657 :
658 0 : end subroutine broadcast_array_dbl_3d
659 :
660 : !***********************************************************************
661 :
662 0 : subroutine broadcast_array_real_3d(array, root_pe)
663 :
664 : ! Broadcasts a real 3d array from one processor (root_pe)
665 : ! to all other processors. This is a specific instance of the generic
666 : ! broadcast\_array interface.
667 :
668 : integer (int_kind), intent(in) :: &
669 : root_pe ! processor number to broadcast from
670 :
671 : real (real_kind), dimension(:,:,:), intent(inout) :: &
672 : array ! array to be broadcast
673 :
674 : !-----------------------------------------------------------------------
675 : !
676 : ! local variables
677 : !
678 : !-----------------------------------------------------------------------
679 :
680 : integer (int_kind) :: &
681 : nelements, &! size of array to be broadcast ! LCOV_EXCL_LINE
682 : ierr ! local MPI error flag
683 : character(len=*), parameter :: subname = '(broadcast_array_real_3d)'
684 :
685 : !-----------------------------------------------------------------------
686 :
687 : #ifdef SERIAL_REMOVE_MPI
688 : ! nothing to do
689 : #else
690 0 : nelements = size(array)
691 :
692 0 : call MPI_BCAST(array, nelements, mpiR4, root_pe, MPI_COMM_ICE, ierr)
693 0 : call MPI_BARRIER(MPI_COMM_ICE, ierr)
694 : #endif
695 :
696 : !-----------------------------------------------------------------------
697 :
698 0 : end subroutine broadcast_array_real_3d
699 :
700 : !***********************************************************************
701 :
702 0 : subroutine broadcast_array_int_3d(array, root_pe)
703 :
704 : ! Broadcasts an integer 3d array from one processor (root_pe)
705 : ! to all other processors. This is a specific instance of the generic
706 : ! broadcast\_array interface.
707 :
708 : integer (int_kind), intent(in) :: &
709 : root_pe ! processor number to broadcast from
710 :
711 : integer (int_kind), dimension(:,:,:), intent(inout) :: &
712 : array ! array to be broadcast
713 :
714 : !-----------------------------------------------------------------------
715 : !
716 : ! local variables
717 : !
718 : !-----------------------------------------------------------------------
719 :
720 : integer (int_kind) :: &
721 : nelements, &! size of array to be broadcast ! LCOV_EXCL_LINE
722 : ierr ! local MPI error flag
723 : character(len=*), parameter :: subname = '(broadcast_array_int_3d)'
724 :
725 : !-----------------------------------------------------------------------
726 :
727 : #ifdef SERIAL_REMOVE_MPI
728 : ! nothing to do
729 : #else
730 0 : nelements = size(array)
731 :
732 0 : call MPI_BCAST(array, nelements, MPI_INTEGER, root_pe, MPI_COMM_ICE, ierr)
733 0 : call MPI_BARRIER(MPI_COMM_ICE, ierr)
734 : #endif
735 :
736 : !-----------------------------------------------------------------------
737 :
738 0 : end subroutine broadcast_array_int_3d
739 :
740 : !***********************************************************************
741 :
742 0 : subroutine broadcast_array_log_3d(array, root_pe)
743 :
744 : ! Broadcasts a logical 3d array from one processor (root_pe)
745 : ! to all other processors. This is a specific instance of the generic
746 : ! broadcast\_array interface.
747 :
748 : integer (int_kind), intent(in) :: &
749 : root_pe ! processor number to broadcast from
750 :
751 : logical (log_kind), dimension(:,:,:), intent(inout) :: &
752 : array ! array to be broadcast
753 :
754 : !-----------------------------------------------------------------------
755 : !
756 : ! local variables
757 : !
758 : !-----------------------------------------------------------------------
759 :
760 : integer (int_kind), dimension(:,:,:), allocatable :: &
761 0 : array_int ! temporary array for MPI bcast
762 :
763 : integer (int_kind) :: &
764 : nelements, &! size of array to be broadcast ! LCOV_EXCL_LINE
765 : ierr ! local MPI error flag
766 :
767 : character(len=*), parameter :: subname = '(broadcast_array_log_3d)'
768 :
769 : !-----------------------------------------------------------------------
770 :
771 : #ifdef SERIAL_REMOVE_MPI
772 : ! nothing to do
773 : #else
774 0 : nelements = size(array)
775 0 : allocate(array_int(size(array,dim=1), &
776 : size(array,dim=2), & ! LCOV_EXCL_LINE
777 0 : size(array,dim=3)))
778 :
779 0 : where (array)
780 0 : array_int = 1
781 : elsewhere
782 0 : array_int = 0
783 : end where
784 :
785 : call MPI_BCAST(array_int, nelements, MPI_INTEGER, root_pe, &
786 0 : MPI_COMM_ICE, ierr)
787 0 : call MPI_BARRIER(MPI_COMM_ICE, ierr)
788 :
789 0 : where (array_int == 1)
790 0 : array = .true.
791 : elsewhere
792 0 : array = .false.
793 : end where
794 :
795 0 : deallocate(array_int)
796 : #endif
797 :
798 : !-----------------------------------------------------------------------
799 :
800 0 : end subroutine broadcast_array_log_3d
801 :
802 : !***********************************************************************
803 :
804 : end module ice_broadcast
805 :
806 : !|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
|
