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