FMS  2024.03
Flexible Modeling System
mpp.F90
1 !***********************************************************************
2 !* GNU Lesser General Public License
3 !*
4 !* This file is part of the GFDL Flexible Modeling System (FMS).
5 !*
6 !* FMS is free software: you can redistribute it and/or modify it under
7 !* the terms of the GNU Lesser General Public License as published by
8 !* the Free Software Foundation, either version 3 of the License, or (at
9 !* your option) any later version.
10 !*
11 !* FMS is distributed in the hope that it will be useful, but WITHOUT
12 !* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
13 !* FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
14 !* for more details.
15 !*
16 !* You should have received a copy of the GNU Lesser General Public
17 !* License along with FMS. If not, see <http://www.gnu.org/licenses/>.
18 !***********************************************************************
19 !-----------------------------------------------------------------------
20 ! Communication for message-passing codes
21 !
22 ! AUTHOR: V. Balaji (V.Balaji@noaa.gov)
23 ! SGI/GFDL Princeton University
24 !
25 !-----------------------------------------------------------------------
26 
27 !> @defgroup mpp_mod mpp_mod
28 !> @ingroup mpp
29 !> @brief This module defines interfaces for common operations using message-passing libraries.
30 !! Any type-less arguments in the documentation are MPP_TYPE_ which is defined by the pre-processor
31 !! to create multiple subroutines out of one implementation for use in an interface. See the note
32 !! below for more information
33 !!
34 !> @author V. Balaji <"V.Balaji@noaa.gov">
35 !!
36 !! A set of simple calls to provide a uniform interface
37 !! to different message-passing libraries. It currently can be
38 !! implemented either in the SGI/Cray native SHMEM library or in the MPI
39 !! standard. Other libraries (e.g MPI-2, Co-Array Fortran) can be
40 !! incorporated as the need arises.
41 !!
42 !! The data transfer between a processor and its own memory is based
43 !! on <TT>load</TT> and <TT>store</TT> operations upon
44 !! memory. Shared-memory systems (including distributed shared memory
45 !! systems) have a single address space and any processor can acquire any
46 !! data within the memory by <TT>load</TT> and
47 !! <TT>store</TT>. The situation is different for distributed
48 !! parallel systems. Specialized MPP systems such as the T3E can simulate
49 !! shared-memory by direct data acquisition from remote memory. But if
50 !! the parallel code is distributed across a cluster, or across the Net,
51 !! messages must be sent and received using the protocols for
52 !! long-distance communication, such as TCP/IP. This requires a
53 !! ``handshaking'' between nodes of the distributed system. One can think
54 !! of the two different methods as involving <TT>put</TT>s or
55 !! <TT>get</TT>s (e.g the SHMEM library), or in the case of
56 !! negotiated communication (e.g MPI), <TT>send</TT>s and
57 !! <TT>recv</TT>s.
58 !!
59 !! The difference between SHMEM and MPI is that SHMEM uses one-sided
60 !! communication, which can have very low-latency high-bandwidth
61 !! implementations on tightly coupled systems. MPI is a standard
62 !! developed for distributed computing across loosely-coupled systems,
63 !! and therefore incurs a software penalty for negotiating the
64 !! communication. It is however an open industry standard whereas SHMEM
65 !! is a proprietary interface. Besides, the <TT>put</TT>s or
66 !! <TT>get</TT>s on which it is based cannot currently be implemented in
67 !! a cluster environment (there are recent announcements from Compaq that
68 !! occasion hope).
69 !!
70 !! The message-passing requirements of climate and weather codes can be
71 !! reduced to a fairly simple minimal set, which is easily implemented in
72 !! any message-passing API. <TT>mpp_mod</TT> provides this API.
73 !!
74 !! Features of <TT>mpp_mod</TT> include:
75 !! <ol>
76 !! <li> Simple, minimal API, with free access to underlying API for </li>
77 !! more complicated stuff.<BR/>
78 !! <li> Design toward typical use in climate/weather CFD codes. </li>
79 !! <li> Performance to be not significantly lower than any native API. </li>
80 !! </ol>
81 !!
82 !! This module is used to develop higher-level calls for
83 !! domain decomposition (@ref mpp_domains) and parallel I/O (@ref fms2_io)
84 !! <br/>
85 !! Parallel computing is initially daunting, but it soon becomes
86 !! second nature, much the way many of us can now write vector code
87 !! without much effort. The key insight required while reading and
88 !! writing parallel code is in arriving at a mental grasp of several
89 !! independent parallel execution streams through the same code (the SPMD
90 !! model). Each variable you examine may have different values for each
91 !! stream, the processor ID being an obvious example. Subroutines and
92 !! function calls are particularly subtle, since it is not always obvious
93 !! from looking at a call what synchronization between execution streams
94 !! it implies. An example of erroneous code would be a global barrier
95 !! call (see @ref mpp_sync below) placed
96 !! within a code block that not all PEs will execute, e.g:
97 !!
98 !! <PRE>
99 !! if( pe.EQ.0 )call mpp_sync()
100 !! </PRE>
101 !!
102 !! Here only PE 0 reaches the barrier, where it will wait
103 !! indefinitely. While this is a particularly egregious example to
104 !! illustrate the coding flaw, more subtle versions of the same are
105 !! among the most common errors in parallel code.
106 !! <br/>
107 !! It is therefore important to be conscious of the context of a
108 !! subroutine or function call, and the implied synchronization. There
109 !! are certain calls here (e.g <TT>mpp_declare_pelist, mpp_init,
110 !! mpp_set_stack_size</TT>) which must be called by all
111 !! PEs. There are others which must be called by a subset of PEs (here
112 !! called a <TT>pelist</TT>) which must be called by all the PEs in the
113 !! <TT>pelist</TT> (e.g <TT>mpp_max, mpp_sum, mpp_sync</TT>). Still
114 !! others imply no synchronization at all. I will make every effort to
115 !! highlight the context of each call in the MPP modules, so that the
116 !! implicit synchronization is spelt out.
117 !! <br/>
118 !! For performance it is necessary to keep synchronization as limited
119 !! as the algorithm being implemented will allow. For instance, a single
120 !! message between two PEs should only imply synchronization across the
121 !! PEs in question. A <I>global</I> synchronization (or <I>barrier</I>)
122 !! is likely to be slow, and is best avoided. But codes first
123 !! parallelized on a Cray T3E tend to have many global syncs, as very
124 !! fast barriers were implemented there in hardware.
125 !! <br/>
126 !! Another reason to use pelists is to run a single program in MPMD
127 !! mode, where different PE subsets work on different portions of the
128 !! code. A typical example is to assign an ocean model and atmosphere
129 !! model to different PE subsets, and couple them concurrently instead of
130 !! running them serially. The MPP module provides the notion of a
131 !! <I>current pelist</I>, which is set when a group of PEs branch off
132 !! into a subset. Subsequent calls that omit the <TT>pelist</TT> optional
133 !! argument (seen below in many of the individual calls) assume that the
134 !! implied synchronization is across the current pelist. The calls
135 !! <TT>mpp_root_pe</TT> and <TT>mpp_npes</TT> also return the values
136 !! appropriate to the current pelist. The <TT>mpp_set_current_pelist</TT>
137 !! call is provided to set the current pelist.
138 !! </DESCRIPTION>
139 !! <br/>
140 !!
141 !! @note F90 is a strictly-typed language, and the syntax pass of the
142 !! compiler requires matching of type, kind and rank (TKR). Most calls
143 !! listed here use a generic type, shown here as <TT>MPP_TYPE_</TT>. This
144 !! is resolved in the pre-processor stage to any of a variety of
145 !! types. In general the MPP operations work on 4-byte and 8-byte
146 !! variants of <TT>integer, real, complex, logical</TT> variables, of
147 !! rank 0 to 5, leading to 48 specific module procedures under the same
148 !! generic interface. Any of the variables below shown as
149 !! <TT>MPP_TYPE_</TT> is treated in this way.
150 
151 module mpp_mod
152 
153 ! Define rank(X) for PGI compiler
154 #if defined( __PGI) || defined (__FLANG)
155 #define rank(X) size(shape(X))
156 #endif
157 
158 
159 #if defined(use_libMPI)
160  use mpi
161 #endif
162 
163  use iso_fortran_env, only : input_unit, output_unit, error_unit
164  use mpp_parameter_mod, only : mpp_verbose, mpp_debug, all_pes, any_pe, null_pe
165  use mpp_parameter_mod, only : note, warning, fatal, mpp_clock_detailed,mpp_clock_sync
166  use mpp_parameter_mod, only : clock_component, clock_subcomponent, clock_module_driver
167  use mpp_parameter_mod, only : clock_module, clock_routine, clock_loop, clock_infra
168  use mpp_parameter_mod, only : max_events, max_bins, max_event_types, max_clocks
169  use mpp_parameter_mod, only : maxpes, event_wait, event_allreduce, event_broadcast
170  use mpp_parameter_mod, only : event_alltoall
171  use mpp_parameter_mod, only : event_type_create, event_type_free
172  use mpp_parameter_mod, only : event_recv, event_send, mpp_ready, mpp_wait
173  use mpp_parameter_mod, only : mpp_parameter_version=>version
174  use mpp_parameter_mod, only : default_tag
175  use mpp_parameter_mod, only : comm_tag_1, comm_tag_2, comm_tag_3, comm_tag_4
176  use mpp_parameter_mod, only : comm_tag_5, comm_tag_6, comm_tag_7, comm_tag_8
177  use mpp_parameter_mod, only : comm_tag_9, comm_tag_10, comm_tag_11, comm_tag_12
178  use mpp_parameter_mod, only : comm_tag_13, comm_tag_14, comm_tag_15, comm_tag_16
179  use mpp_parameter_mod, only : comm_tag_17, comm_tag_18, comm_tag_19, comm_tag_20
180  use mpp_parameter_mod, only : mpp_fill_int,mpp_fill_double
181  use mpp_data_mod, only : stat, mpp_stack, ptr_stack, status, ptr_status, sync, ptr_sync
182  use mpp_data_mod, only : mpp_from_pe, ptr_from, remote_data_loc, ptr_remote
183  use mpp_data_mod, only : mpp_data_version=>version
184  use platform_mod
185 
186 implicit none
187 private
188 
189  !--- public parameters -----------------------------------------------
190  public :: mpp_verbose, mpp_debug, all_pes, any_pe, null_pe, note, warning, fatal
191  public :: mpp_clock_sync, mpp_clock_detailed, clock_component, clock_subcomponent
192  public :: clock_module_driver, clock_module, clock_routine, clock_loop, clock_infra
193  public :: maxpes, event_recv, event_send
194  public :: comm_tag_1, comm_tag_2, comm_tag_3, comm_tag_4
195  public :: comm_tag_5, comm_tag_6, comm_tag_7, comm_tag_8
196  public :: comm_tag_9, comm_tag_10, comm_tag_11, comm_tag_12
197  public :: comm_tag_13, comm_tag_14, comm_tag_15, comm_tag_16
198  public :: comm_tag_17, comm_tag_18, comm_tag_19, comm_tag_20
199  public :: mpp_fill_int,mpp_fill_double,mpp_info_null,mpp_comm_null
200  public :: mpp_init_test_full_init, mpp_init_test_init_true_only, mpp_init_test_peset_allocated
201  public :: mpp_init_test_clocks_init, mpp_init_test_datatype_list_init, mpp_init_test_logfile_init
202  public :: mpp_init_test_read_namelist, mpp_init_test_etc_unit, mpp_init_test_requests_allocated
203 
204  !--- public interface from mpp_util.h ------------------------------
205  public :: stdin, stdout, stderr, stdlog, warnlog, lowercase, uppercase, mpp_error, mpp_error_state
206  public :: mpp_set_warn_level, mpp_sync, mpp_sync_self, mpp_pe
207  public :: mpp_npes, mpp_root_pe, mpp_set_root_pe, mpp_declare_pelist
208  public :: mpp_get_current_pelist, mpp_set_current_pelist, mpp_get_current_pelist_name
209  public :: mpp_clock_id, mpp_clock_set_grain, mpp_record_timing_data, get_unit
210  public :: read_ascii_file, read_input_nml, mpp_clock_begin, mpp_clock_end
211  public :: get_ascii_file_num_lines, get_ascii_file_num_lines_and_length
212  public :: mpp_record_time_start, mpp_record_time_end
213 
214  !--- public interface from mpp_comm.h ------------------------------
216  public :: mpp_sum_ad
217  public :: mpp_broadcast, mpp_init, mpp_exit
219  public :: mpp_type, mpp_byte, mpp_type_create, mpp_type_free
220 
221  !*********************************************************************
222  !
223  ! public data type
224  !
225  !*********************************************************************
226  !> Communication information for message passing libraries
227  !!
228  !> peset hold communicators as SHMEM-compatible triads (start, log2(stride), num)
229  !> @ingroup mpp_mod
230  type :: communicator
231  private
232  character(len=32) :: name
233  integer, pointer :: list(:) =>null()
234  integer :: count
235  integer :: start, log2stride !< dummy variables when libMPI is defined.
236  integer :: id, group !< MPI communicator and group id for this PE set.
237  end type communicator
238 
239  !> Communication event profile
240  !> @ingroup mpp_mod
241  type :: event
242  private
243  character(len=16) :: name
244  integer(i8_kind), dimension(MAX_EVENTS) :: ticks, bytes
245  integer :: calls
246  end type event
247 
248  !> a clock contains an array of event profiles for a region
249  !> @ingroup mpp_mod
250  type :: clock
251  private
252  character(len=32) :: name
253  integer(i8_kind) :: hits
254  integer(i8_kind) :: tick
255  integer(i8_kind) :: total_ticks
256  integer :: peset_num
257  logical :: sync_on_begin, detailed
258  integer :: grain
259  type(event), pointer :: events(:) =>null() !> if needed, allocate to MAX_EVENT_TYPES
260  logical :: is_on !> initialize to false. set true when calling mpp_clock_begin
261  !! set false when calling mpp_clock_end
262  end type clock
263 
264  !> Summary of information from a clock run
265  !> @ingroup mpp_mod
267  private
268  character(len=16) :: name
269  real(r8_kind) :: msg_size_sums(MAX_BINS)
270  real(r8_kind) :: msg_time_sums(MAX_BINS)
271  real(r8_kind) :: total_data
272  real(r8_kind) :: total_time
273  integer(i8_kind) :: msg_size_cnts(MAX_BINS)
274  integer(i8_kind) :: total_cnts
275  end type clock_data_summary
276 
277  !> holds name and clock data for use in @ref mpp_util.h
278  !> @ingroup mpp_mod
280  private
281  character(len=16) :: name
282  type (Clock_Data_Summary) :: event(MAX_EVENT_TYPES)
283  end type summary_struct
284 
285  !> Data types for generalized data transfer (e.g. MPI_Type)
286  !> @ingroup mpp_mod
287  type :: mpp_type
288  private
289  integer :: counter !> Number of instances of this type
290  integer :: ndims
291  integer, allocatable :: sizes(:)
292  integer, allocatable :: subsizes(:)
293  integer, allocatable :: starts(:)
294  integer :: etype !> Elementary data type (e.g. MPI_BYTE)
295  integer :: id !> Identifier within message passing library (e.g. MPI)
296 
297  type(mpp_type), pointer :: prev => null()
298  type(mpp_type), pointer :: next => null()
299  end type mpp_type
300 
301  !> Persisent elements for linked list interaction
302  !> @ingroup mpp_mod
304  private
305  type(mpp_type), pointer :: head => null()
306  type(mpp_type), pointer :: tail => null()
307  integer :: length
308  end type mpp_type_list
309 
310 !***********************************************************************
311 !
312 ! public interface from mpp_util.h
313 !
314 !***********************************************************************
315  !> @brief Error handler.
316  !!
317  !> It is strongly recommended that all error exits pass through
318  !! <TT>mpp_error</TT> to assure the program fails cleanly. An individual
319  !! PE encountering a <TT>STOP</TT> statement, for instance, can cause the
320  !! program to hang. The use of the <TT>STOP</TT> statement is strongly
321  !! discouraged.
322  !!
323  !! Calling mpp_error with no arguments produces an immediate error
324  !! exit, i.e:
325  !! <PRE>
326  !! call mpp_error
327  !! call mpp_error()
328  !! </PRE>
329  !! are equivalent.
330  !!
331  !! The argument order
332  !! <PRE>
333  !! call mpp_error( routine, errormsg, errortype )
334  !! </PRE>
335  !! is also provided to support legacy code. In this version of the
336  !! call, none of the arguments may be omitted.
337  !!
338  !! The behaviour of <TT>mpp_error</TT> for a <TT>WARNING</TT> can be
339  !! controlled with an additional call <TT>mpp_set_warn_level</TT>.
340  !! <PRE>
341  !! call mpp_set_warn_level(ERROR)
342  !! </PRE>
343  !! causes <TT>mpp_error</TT> to treat <TT>WARNING</TT>
344  !! exactly like <TT>FATAL</TT>.
345  !! <PRE>
346  !! call mpp_set_warn_level(WARNING)
347  !! </PRE>
348  !! resets to the default behaviour described above.
349  !!
350  !! <TT>mpp_error</TT> also has an internal error state which
351  !! maintains knowledge of whether a warning has been issued. This can be
352  !! used at startup in a subroutine that checks if the model has been
353  !! properly configured. You can generate a series of warnings using
354  !! <TT>mpp_error</TT>, and then check at the end if any warnings has been
355  !! issued using the function <TT>mpp_error_state()</TT>. If the value of
356  !! this is <TT>WARNING</TT>, at least one warning has been issued, and
357  !! the user can take appropriate action:
358  !!
359  !! <PRE>
360  !! if( ... )call mpp_error( WARNING, '...' )
361  !! if( ... )call mpp_error( WARNING, '...' )
362  !! if( ... )call mpp_error( WARNING, '...' )
363  !! ...
364  !! if( mpp_error_state().EQ.WARNING )call mpp_error( FATAL, '...' )
365  !! </PRE>
366  !! </DESCRIPTION>
367  !! <br> Example usage:
368  !! @code{.F90}
369  !! call mpp_error( errortype, routine, errormsg )
370  !! @endcode
371  !! @param errortype
372  !! One of <TT>NOTE</TT>, <TT>WARNING</TT> or <TT>FATAL</TT>
373  !! (these definitions are acquired by use association).
374  !! <TT>NOTE</TT> writes <TT>errormsg</TT> to <TT>STDOUT</TT>.
375  !! <TT>WARNING</TT> writes <TT>errormsg</TT> to <TT>STDERR</TT>.
376  !! <TT>FATAL</TT> writes <TT>errormsg</TT> to <TT>STDERR</TT>,
377  !! and induces a clean error exit with a call stack traceback.
378  !! @param routine Calling routine name
379  !! @param errmsg Message to output
380  !! </IN>
381  !> @ingroup mpp_mod
382  interface mpp_error
383  module procedure mpp_error_basic
384  module procedure mpp_error_mesg
385  module procedure mpp_error_noargs
386  module procedure mpp_error_is
387  module procedure mpp_error_rs
388  module procedure mpp_error_ia
389  module procedure mpp_error_ra
390  module procedure mpp_error_ia_ia
391  module procedure mpp_error_ia_ra
392  module procedure mpp_error_ra_ia
393  module procedure mpp_error_ra_ra
394  module procedure mpp_error_ia_is
395  module procedure mpp_error_ia_rs
396  module procedure mpp_error_ra_is
397  module procedure mpp_error_ra_rs
398  module procedure mpp_error_is_ia
399  module procedure mpp_error_is_ra
400  module procedure mpp_error_rs_ia
401  module procedure mpp_error_rs_ra
402  module procedure mpp_error_is_is
403  module procedure mpp_error_is_rs
404  module procedure mpp_error_rs_is
405  module procedure mpp_error_rs_rs
406  end interface
407  !> Takes a given integer or real array and returns it as a string
408  !> @param[in] array An array of integers or reals
409  !> @returns string equivalent of given array
410  !> @ingroup mpp_mod
411  interface array_to_char
412  module procedure iarray_to_char
413  module procedure rarray_to_char
414  end interface
415 
416 !***********************************************************************
417 !
418 ! public interface from mpp_comm.h
419 !
420 !***********************************************************************
421 
422 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
423  ! !
424  ! ROUTINES TO INITIALIZE/FINALIZE MPP MODULE: mpp_init, mpp_exit !
425  ! !
426 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
427 
428 !> @fn mpp_mod::mpp_init::mpp_init( flags, localcomm, test_level)
429 !> @ingroup mpp_mod
430 !> @brief Initialize @ref mpp_mod
431 !!
432 !> Called to initialize the <TT>mpp_mod</TT> package. It is recommended
433 !! that this call be the first executed line in your program. It sets the
434 !! number of PEs assigned to this run (acquired from the command line, or
435 !! through the environment variable <TT>NPES</TT>), and associates an ID
436 !! number to each PE. These can be accessed by calling @ref mpp_npes and
437 !! @ref mpp_pe.
438 !! <br> Example usage:
439 !!
440 !! call mpp_init( flags )
441 !!
442 !! @param flags
443 !! <TT>flags</TT> can be set to <TT>MPP_VERBOSE</TT> to
444 !! have <TT>mpp_mod</TT> keep you informed of what it's up to.
445 !! @param test_level
446 !! Debugging flag to set amount of initialization tasks performed
447 
448 !> @fn mpp_mod::mpp_exit()
449 !> @brief Exit <TT>@ref mpp_mod</TT>.
450 !!
451 !> Called at the end of the run, or to re-initialize <TT>mpp_mod</TT>,
452 !! should you require that for some odd reason.
453 !!
454 !! This call implies synchronization across all PEs.
455 !!
456 !! <br>Example usage:
457 !!
458 !! call mpp_exit()
459 !> @ingroup mpp_mod
460 
461  !#####################################################################
462 
463  !> @fn subroutine mpp_set_stack_size(n)
464  !> @brief Allocate module internal workspace.
465  !> @param Integer to set stack size to(in words)
466  !> <TT>mpp_mod</TT> maintains a private internal array called
467  !! <TT>mpp_stack</TT> for private workspace. This call sets the length,
468  !! in words, of this array.
469  !!
470  !! The <TT>mpp_init</TT> call sets this
471  !! workspace length to a default of 32768, and this call may be used if a
472  !! longer workspace is needed.
473  !!
474  !! This call implies synchronization across all PEs.
475  !!
476  !! This workspace is symmetrically allocated, as required for
477  !! efficient communication on SGI and Cray MPP systems. Since symmetric
478  !! allocation must be performed by <I>all</I> PEs in a job, this call
479  !! must also be called by all PEs, using the same value of
480  !! <TT>n</TT>. Calling <TT>mpp_set_stack_size</TT> from a subset of PEs,
481  !! or with unequal argument <TT>n</TT>, may cause the program to hang.
482  !!
483  !! If any MPP call using <TT>mpp_stack</TT> overflows the declared
484  !! stack array, the program will abort with a message specifying the
485  !! stack length that is required. Many users wonder why, if the required
486  !! stack length can be computed, it cannot also be specified at that
487  !! point. This cannot be automated because there is no way for the
488  !! program to know if all PEs are present at that call, and with equal
489  !! values of <TT>n</TT>. The program must be rerun by the user with the
490  !! correct argument to <TT>mpp_set_stack_size</TT>, called at an
491  !! appropriate point in the code where all PEs are known to be present.
492  !! @verbose call mpp_set_stack_size(n)
493  !!
494  !> @ingroup mpp_mod
495  public :: mpp_set_stack_size
496  ! from mpp_util.h
497 
498 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
499 ! !
500 ! DATA TRANSFER TYPES: mpp_type_create !
501 ! !
502 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
503 
504  !> @brief Create a mpp_type variable
505  !> @param[in] field A field of any numerical or logical type
506  !> @param[in] array_of_subsizes Integer array of subsizes
507  !> @param[in] array_of_starts Integer array of starts
508  !> @param[out] dtype_out Output variable for created @ref mpp_type
509  !> @ingroup mpp_mod
510  interface mpp_type_create
511  module procedure mpp_type_create_int4
512  module procedure mpp_type_create_int8
513  module procedure mpp_type_create_real4
514  module procedure mpp_type_create_real8
515  module procedure mpp_type_create_cmplx4
516  module procedure mpp_type_create_cmplx8
517  module procedure mpp_type_create_logical4
518  module procedure mpp_type_create_logical8
519  end interface mpp_type_create
520 
521 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
522  ! !
523  ! GLOBAL REDUCTION ROUTINES: mpp_max, mpp_sum, mpp_min !
524  ! !
525 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
526 
527  !> @brief Reduction operations.
528  !> Find the max of scalar a from the PEs in pelist
529  !! result is also automatically broadcast to all PEs
530  !! @code{.F90}
531  !! call mpp_max( a, pelist )
532  !! @endcode
533  !> @param a <TT>real</TT> or <TT>integer</TT>, of 4-byte of 8-byte kind.
534  !> @param pelist If <TT>pelist</TT> is omitted, the context is assumed to be the
535  !! current pelist. This call implies synchronization across the PEs in
536  !! <TT>pelist</TT>, or the current pelist if <TT>pelist</TT> is absent.
537  !> @ingroup mpp_mod
538  interface mpp_max
539  module procedure mpp_max_real8_0d
540  module procedure mpp_max_real8_1d
541  module procedure mpp_max_int8_0d
542  module procedure mpp_max_int8_1d
543  module procedure mpp_max_real4_0d
544  module procedure mpp_max_real4_1d
545  module procedure mpp_max_int4_0d
546  module procedure mpp_max_int4_1d
547  end interface
548 
549  !> @brief Reduction operations.
550  !> Find the min of scalar a from the PEs in pelist
551  !! result is also automatically broadcast to all PEs
552  !! @code{.F90}
553  !! call mpp_min( a, pelist )
554  !! @endcode
555  !> @param a <TT>real</TT> or <TT>integer</TT>, of 4-byte of 8-byte kind.
556  !> @param pelist If <TT>pelist</TT> is omitted, the context is assumed to be the
557  !! current pelist. This call implies synchronization across the PEs in
558  !! <TT>pelist</TT>, or the current pelist if <TT>pelist</TT> is absent.
559  !> @ingroup mpp_mod
560  interface mpp_min
561  module procedure mpp_min_real8_0d
562  module procedure mpp_min_real8_1d
563  module procedure mpp_min_int8_0d
564  module procedure mpp_min_int8_1d
565  module procedure mpp_min_real4_0d
566  module procedure mpp_min_real4_1d
567  module procedure mpp_min_int4_0d
568  module procedure mpp_min_int4_1d
569  end interface
570 
571 
572  !> @brief Reduction operation.
573  !!
574  !> <TT>MPP_TYPE_</TT> corresponds to any 4-byte and 8-byte variant of
575  !! <TT>integer, real, complex</TT> variables, of rank 0 or 1. A
576  !! contiguous block from a multi-dimensional array may be passed by its
577  !! starting address and its length, as in <TT>f77</TT>.
578  !!
579  !! Library reduction operators are not required or guaranteed to be
580  !! bit-reproducible. In any case, changing the processor count changes
581  !! the data layout, and thus very likely the order of operations. For
582  !! bit-reproducible sums of distributed arrays, consider using the
583  !! <TT>mpp_global_sum</TT> routine provided by the
584  !! @ref mpp_domains module.
585  !!
586  !! The <TT>bit_reproducible</TT> flag provided in earlier versions of
587  !! this routine has been removed.
588  !!
589  !!
590  !! If <TT>pelist</TT> is omitted, the context is assumed to be the
591  !! current pelist. This call implies synchronization across the PEs in
592  !! <TT>pelist</TT>, or the current pelist if <TT>pelist</TT> is absent.
593  !! Example usage:
594  !! call mpp_sum( a, length, pelist )
595  !!
596  !> @ingroup mpp_mod
597  interface mpp_sum
598  module procedure mpp_sum_int8
599  module procedure mpp_sum_int8_scalar
600  module procedure mpp_sum_int8_2d
601  module procedure mpp_sum_int8_3d
602  module procedure mpp_sum_int8_4d
603  module procedure mpp_sum_int8_5d
604  module procedure mpp_sum_real8
605  module procedure mpp_sum_real8_scalar
606  module procedure mpp_sum_real8_2d
607  module procedure mpp_sum_real8_3d
608  module procedure mpp_sum_real8_4d
609  module procedure mpp_sum_real8_5d
610 #ifdef OVERLOAD_C8
611  module procedure mpp_sum_cmplx8
612  module procedure mpp_sum_cmplx8_scalar
613  module procedure mpp_sum_cmplx8_2d
614  module procedure mpp_sum_cmplx8_3d
615  module procedure mpp_sum_cmplx8_4d
616  module procedure mpp_sum_cmplx8_5d
617 #endif
618  module procedure mpp_sum_int4
619  module procedure mpp_sum_int4_scalar
620  module procedure mpp_sum_int4_2d
621  module procedure mpp_sum_int4_3d
622  module procedure mpp_sum_int4_4d
623  module procedure mpp_sum_int4_5d
624  module procedure mpp_sum_real4
625  module procedure mpp_sum_real4_scalar
626  module procedure mpp_sum_real4_2d
627  module procedure mpp_sum_real4_3d
628  module procedure mpp_sum_real4_4d
629  module procedure mpp_sum_real4_5d
630 #ifdef OVERLOAD_C4
631  module procedure mpp_sum_cmplx4
632  module procedure mpp_sum_cmplx4_scalar
633  module procedure mpp_sum_cmplx4_2d
634  module procedure mpp_sum_cmplx4_3d
635  module procedure mpp_sum_cmplx4_4d
636  module procedure mpp_sum_cmplx4_5d
637 #endif
638  end interface
639 
640  !> Calculates sum of a given numerical array across pe's for adjoint domains
641  !> @ingroup mpp_mod
642  interface mpp_sum_ad
643  module procedure mpp_sum_int8_ad
644  module procedure mpp_sum_int8_scalar_ad
645  module procedure mpp_sum_int8_2d_ad
646  module procedure mpp_sum_int8_3d_ad
647  module procedure mpp_sum_int8_4d_ad
648  module procedure mpp_sum_int8_5d_ad
649  module procedure mpp_sum_real8_ad
650  module procedure mpp_sum_real8_scalar_ad
651  module procedure mpp_sum_real8_2d_ad
652  module procedure mpp_sum_real8_3d_ad
653  module procedure mpp_sum_real8_4d_ad
654  module procedure mpp_sum_real8_5d_ad
655 #ifdef OVERLOAD_C8
656  module procedure mpp_sum_cmplx8_ad
657  module procedure mpp_sum_cmplx8_scalar_ad
658  module procedure mpp_sum_cmplx8_2d_ad
659  module procedure mpp_sum_cmplx8_3d_ad
660  module procedure mpp_sum_cmplx8_4d_ad
661  module procedure mpp_sum_cmplx8_5d_ad
662 #endif
663  module procedure mpp_sum_int4_ad
664  module procedure mpp_sum_int4_scalar_ad
665  module procedure mpp_sum_int4_2d_ad
666  module procedure mpp_sum_int4_3d_ad
667  module procedure mpp_sum_int4_4d_ad
668  module procedure mpp_sum_int4_5d_ad
669  module procedure mpp_sum_real4_ad
670  module procedure mpp_sum_real4_scalar_ad
671  module procedure mpp_sum_real4_2d_ad
672  module procedure mpp_sum_real4_3d_ad
673  module procedure mpp_sum_real4_4d_ad
674  module procedure mpp_sum_real4_5d_ad
675 #ifdef OVERLOAD_C4
676  module procedure mpp_sum_cmplx4_ad
677  module procedure mpp_sum_cmplx4_scalar_ad
678  module procedure mpp_sum_cmplx4_2d_ad
679  module procedure mpp_sum_cmplx4_3d_ad
680  module procedure mpp_sum_cmplx4_4d_ad
681  module procedure mpp_sum_cmplx4_5d_ad
682 #endif
683  end interface
684 
685  !> @brief Gather data sent from pelist onto the root pe
686  !! Wrapper for MPI_gather, can be used with and without indices
687  !> @ingroup mpp_mod
688  !!
689  !> @param sbuf MPP_TYPE_ data buffer to send
690  !> @param rbuf MPP_TYPE_ data buffer to receive
691  !> @param pelist integer(:) optional pelist to gather from, defaults to current
692  !>
693  !> <BR> Example usage:
694  !!
695  !! call mpp_gather(send_buffer,recv_buffer, pelist)
696  !! call mpp_gather(is, ie, js, je, pelist, array_seg, data, is_root_pe)
697  !!
698  interface mpp_gather
699  module procedure mpp_gather_logical_1d
700  module procedure mpp_gather_int4_1d
701  module procedure mpp_gather_int8_1d
702  module procedure mpp_gather_real4_1d
703  module procedure mpp_gather_real8_1d
704  module procedure mpp_gather_logical_1dv
705  module procedure mpp_gather_int4_1dv
706  module procedure mpp_gather_int8_1dv
707  module procedure mpp_gather_real4_1dv
708  module procedure mpp_gather_real8_1dv
709  module procedure mpp_gather_pelist_logical_2d
710  module procedure mpp_gather_pelist_logical_3d
711  module procedure mpp_gather_pelist_int4_2d
712  module procedure mpp_gather_pelist_int4_3d
713  module procedure mpp_gather_pelist_int8_2d
714  module procedure mpp_gather_pelist_int8_3d
715  module procedure mpp_gather_pelist_real4_2d
716  module procedure mpp_gather_pelist_real4_3d
717  module procedure mpp_gather_pelist_real8_2d
718  module procedure mpp_gather_pelist_real8_3d
719  end interface
720 
721  !> @brief Scatter (ie - is) * (je - js) contiguous elements of array data from the designated root pe
722  !! into contigous members of array segment in each pe that is included in the pelist argument.
723  !> @ingroup mpp_mod
724  !!
725  !> @param is, ie integer start and end index of the first dimension of the segment array
726  !> @param je, js integer start and end index of the second dimension of the segment array
727  !> @param pelist integer(:) the PE list of target pes, needs to be monotonically increasing
728  !> @param array_seg MPP_TYPE_ 2D array that the data is to be copied into
729  !> @param data MPP_TYPE_ the source array
730  !> @param is_root_pe logical true if calling from root pe
731  !> @param ishift integer offsets specifying the first elelement in the data array
732  !> @param nk integer size of third dimension for 3D calls
733  !!
734  !> <BR> Example usage:
735  !!
736  !! call mpp_scatter(is, ie, js, je, pelist, segment, data, .true.)
737  !!
738  interface mpp_scatter
739  module procedure mpp_scatter_pelist_int4_2d
740  module procedure mpp_scatter_pelist_int4_3d
741  module procedure mpp_scatter_pelist_int8_2d
742  module procedure mpp_scatter_pelist_int8_3d
743  module procedure mpp_scatter_pelist_real4_2d
744  module procedure mpp_scatter_pelist_real4_3d
745  module procedure mpp_scatter_pelist_real8_2d
746  module procedure mpp_scatter_pelist_real8_3d
747  end interface
748 
749  !#####################################################################
750  !> @brief Scatter a vector across all PEs
751  !!
752  !> Transpose the vector and PE index
753  !! Wrapper for the MPI_alltoall function, includes more generic _V and _W
754  !! versions if given displacements/data types
755  !!
756  !! Generic MPP_TYPE_ implentations:
757  !! <li> @ref mpp_alltoall_ </li>
758  !! <li> @ref mpp_alltoallv_ </li>
759  !! <li> @ref mpp_alltoallw_ </li>
760  !!
761  !> @ingroup mpp_mod
762  interface mpp_alltoall
763  module procedure mpp_alltoall_int4
764  module procedure mpp_alltoall_int8
765  module procedure mpp_alltoall_real4
766  module procedure mpp_alltoall_real8
767 #ifdef OVERLOAD_C4
768  module procedure mpp_alltoall_cmplx4
769 #endif
770 #ifdef OVERLOAD_C8
771  module procedure mpp_alltoall_cmplx8
772 #endif
773  module procedure mpp_alltoall_logical4
774  module procedure mpp_alltoall_logical8
775  module procedure mpp_alltoall_int4_v
776  module procedure mpp_alltoall_int8_v
777  module procedure mpp_alltoall_real4_v
778  module procedure mpp_alltoall_real8_v
779 #ifdef OVERLOAD_C4
780  module procedure mpp_alltoall_cmplx4_v
781 #endif
782 #ifdef OVERLOAD_C8
783  module procedure mpp_alltoall_cmplx8_v
784 #endif
785  module procedure mpp_alltoall_logical4_v
786  module procedure mpp_alltoall_logical8_v
787  module procedure mpp_alltoall_int4_w
788  module procedure mpp_alltoall_int8_w
789  module procedure mpp_alltoall_real4_w
790  module procedure mpp_alltoall_real8_w
791 #ifdef OVERLOAD_C4
792  module procedure mpp_alltoall_cmplx4_w
793 #endif
794 #ifdef OVERLOAD_C8
795  module procedure mpp_alltoall_cmplx8_w
796 #endif
797  module procedure mpp_alltoall_logical4_w
798  module procedure mpp_alltoall_logical8_w
799  end interface
800 
801 
802  !#####################################################################
803  !> @brief Basic message-passing call.
804  !!
805  !> <TT>MPP_TYPE_</TT> corresponds to any 4-byte and 8-byte variant of
806  !! <TT>integer, real, complex, logical</TT> variables, of rank 0 or 1. A
807  !! contiguous block from a multi-dimensional array may be passed by its
808  !! starting address and its length, as in <TT>f77</TT>.
809  !!
810  !! <TT>mpp_transmit</TT> is currently implemented as asynchronous
811  !! outward transmission and synchronous inward transmission. This follows
812  !! the behaviour of <TT>shmem_put</TT> and <TT>shmem_get</TT>. In MPI, it
813  !! is implemented as <TT>mpi_isend</TT> and <TT>mpi_recv</TT>. For most
814  !! applications, transmissions occur in pairs, and are here accomplished
815  !! in a single call.
816  !!
817  !! The special PE designations <TT>NULL_PE</TT>,
818  !! <TT>ANY_PE</TT> and <TT>ALL_PES</TT> are provided by use
819  !! association.
820  !!
821  !! <TT>NULL_PE</TT>: is used to disable one of the pair of
822  !! transmissions.<BR/>
823  !! <TT>ANY_PE</TT>: is used for unspecific remote
824  !! destination. (Please note that <TT>put_pe=ANY_PE</TT> has no meaning
825  !! in the MPI context, though it is available in the SHMEM invocation. If
826  !! portability is a concern, it is best avoided).<BR/>
827  !! <TT>ALL_PES</TT>: is used for broadcast operations.
828  !!
829  !! It is recommended that
830  !! @ref mpp_broadcast be used for
831  !! broadcasts.
832  !!
833  !! The following example illustrates the use of
834  !! <TT>NULL_PE</TT> and <TT>ALL_PES</TT>:
835  !!
836  !! <PRE>
837  !! real, dimension(n) :: a
838  !! if( pe.EQ.0 )then
839  !! do p = 1,npes-1
840  !! call mpp_transmit( a, n, p, a, n, NULL_PE )
841  !! end do
842  !! else
843  !! call mpp_transmit( a, n, NULL_PE, a, n, 0 )
844  !! end if
845  !!
846  !! call mpp_transmit( a, n, ALL_PES, a, n, 0 )
847  !! </PRE>
848  !!
849  !! The do loop and the broadcast operation above are equivalent.
850  !!
851  !! Two overloaded calls <TT>mpp_send</TT> and
852  !! <TT>mpp_recv</TT> have also been
853  !! provided. <TT>mpp_send</TT> calls <TT>mpp_transmit</TT>
854  !! with <TT>get_pe=NULL_PE</TT>. <TT>mpp_recv</TT> calls
855  !! <TT>mpp_transmit</TT> with <TT>put_pe=NULL_PE</TT>. Thus
856  !! the do loop above could be written more succinctly:
857  !!
858  !! <PRE>
859  !! if( pe.EQ.0 )then
860  !! do p = 1,npes-1
861  !! call mpp_send( a, n, p )
862  !! end do
863  !! else
864  !! call mpp_recv( a, n, 0 )
865  !! end if
866  !! </PRE>
867  !! <br>Example call:
868  !! @code{.F90}
869  !! call mpp_transmit( put_data, put_len, put_pe, get_data, get_len, get_pe )
870  !! @endcode
871  !> @ingroup mpp_mod
872  interface mpp_transmit
873  module procedure mpp_transmit_real8
874  module procedure mpp_transmit_real8_scalar
875  module procedure mpp_transmit_real8_2d
876  module procedure mpp_transmit_real8_3d
877  module procedure mpp_transmit_real8_4d
878  module procedure mpp_transmit_real8_5d
879 #ifdef OVERLOAD_C8
880  module procedure mpp_transmit_cmplx8
881  module procedure mpp_transmit_cmplx8_scalar
882  module procedure mpp_transmit_cmplx8_2d
883  module procedure mpp_transmit_cmplx8_3d
884  module procedure mpp_transmit_cmplx8_4d
885  module procedure mpp_transmit_cmplx8_5d
886 #endif
887  module procedure mpp_transmit_int8
888  module procedure mpp_transmit_int8_scalar
889  module procedure mpp_transmit_int8_2d
890  module procedure mpp_transmit_int8_3d
891  module procedure mpp_transmit_int8_4d
892  module procedure mpp_transmit_int8_5d
893  module procedure mpp_transmit_logical8
894  module procedure mpp_transmit_logical8_scalar
895  module procedure mpp_transmit_logical8_2d
896  module procedure mpp_transmit_logical8_3d
897  module procedure mpp_transmit_logical8_4d
898  module procedure mpp_transmit_logical8_5d
899 
900  module procedure mpp_transmit_real4
901  module procedure mpp_transmit_real4_scalar
902  module procedure mpp_transmit_real4_2d
903  module procedure mpp_transmit_real4_3d
904  module procedure mpp_transmit_real4_4d
905  module procedure mpp_transmit_real4_5d
906 
907 #ifdef OVERLOAD_C4
908  module procedure mpp_transmit_cmplx4
909  module procedure mpp_transmit_cmplx4_scalar
910  module procedure mpp_transmit_cmplx4_2d
911  module procedure mpp_transmit_cmplx4_3d
912  module procedure mpp_transmit_cmplx4_4d
913  module procedure mpp_transmit_cmplx4_5d
914 #endif
915  module procedure mpp_transmit_int4
916  module procedure mpp_transmit_int4_scalar
917  module procedure mpp_transmit_int4_2d
918  module procedure mpp_transmit_int4_3d
919  module procedure mpp_transmit_int4_4d
920  module procedure mpp_transmit_int4_5d
921  module procedure mpp_transmit_logical4
922  module procedure mpp_transmit_logical4_scalar
923  module procedure mpp_transmit_logical4_2d
924  module procedure mpp_transmit_logical4_3d
925  module procedure mpp_transmit_logical4_4d
926  module procedure mpp_transmit_logical4_5d
927  end interface
928  !> @brief Recieve data from another PE
929  !!
930  !> @param[out] get_data scalar or array to get written with received data
931  !> @param get_len size of array to recv from get_data
932  !> @param from_pe PE number to receive from
933  !> @param block true for blocking, false for non-blocking. Defaults to true
934  !> @param tag communication tag
935  !> @param[out] request MPI request handle
936  !> @ingroup mpp_mod
937  interface mpp_recv
938  module procedure mpp_recv_real8
939  module procedure mpp_recv_real8_scalar
940  module procedure mpp_recv_real8_2d
941  module procedure mpp_recv_real8_3d
942  module procedure mpp_recv_real8_4d
943  module procedure mpp_recv_real8_5d
944 #ifdef OVERLOAD_C8
945  module procedure mpp_recv_cmplx8
946  module procedure mpp_recv_cmplx8_scalar
947  module procedure mpp_recv_cmplx8_2d
948  module procedure mpp_recv_cmplx8_3d
949  module procedure mpp_recv_cmplx8_4d
950  module procedure mpp_recv_cmplx8_5d
951 #endif
952  module procedure mpp_recv_int8
953  module procedure mpp_recv_int8_scalar
954  module procedure mpp_recv_int8_2d
955  module procedure mpp_recv_int8_3d
956  module procedure mpp_recv_int8_4d
957  module procedure mpp_recv_int8_5d
958  module procedure mpp_recv_logical8
959  module procedure mpp_recv_logical8_scalar
960  module procedure mpp_recv_logical8_2d
961  module procedure mpp_recv_logical8_3d
962  module procedure mpp_recv_logical8_4d
963  module procedure mpp_recv_logical8_5d
964 
965  module procedure mpp_recv_real4
966  module procedure mpp_recv_real4_scalar
967  module procedure mpp_recv_real4_2d
968  module procedure mpp_recv_real4_3d
969  module procedure mpp_recv_real4_4d
970  module procedure mpp_recv_real4_5d
971 
972 #ifdef OVERLOAD_C4
973  module procedure mpp_recv_cmplx4
974  module procedure mpp_recv_cmplx4_scalar
975  module procedure mpp_recv_cmplx4_2d
976  module procedure mpp_recv_cmplx4_3d
977  module procedure mpp_recv_cmplx4_4d
978  module procedure mpp_recv_cmplx4_5d
979 #endif
980  module procedure mpp_recv_int4
981  module procedure mpp_recv_int4_scalar
982  module procedure mpp_recv_int4_2d
983  module procedure mpp_recv_int4_3d
984  module procedure mpp_recv_int4_4d
985  module procedure mpp_recv_int4_5d
986  module procedure mpp_recv_logical4
987  module procedure mpp_recv_logical4_scalar
988  module procedure mpp_recv_logical4_2d
989  module procedure mpp_recv_logical4_3d
990  module procedure mpp_recv_logical4_4d
991  module procedure mpp_recv_logical4_5d
992  end interface
993  !> Send data to a receiving PE.
994  !!
995  !> @param put_data scalar or array to get sent to a receiving PE
996  !> @param put_len size of data to send from put_data
997  !> @param to_pe PE number to send to
998  !> @param block true for blocking, false for non-blocking. Defaults to true
999  !> @param tag communication tag
1000  !> @param[out] request MPI request handle
1001  !! <br> Example usage:
1002  !! @code{.F90} call mpp_send(data, ie, pe) @endcode
1003  !> @ingroup mpp_mod
1004  interface mpp_send
1005  module procedure mpp_send_real8
1006  module procedure mpp_send_real8_scalar
1007  module procedure mpp_send_real8_2d
1008  module procedure mpp_send_real8_3d
1009  module procedure mpp_send_real8_4d
1010  module procedure mpp_send_real8_5d
1011 #ifdef OVERLOAD_C8
1012  module procedure mpp_send_cmplx8
1013  module procedure mpp_send_cmplx8_scalar
1014  module procedure mpp_send_cmplx8_2d
1015  module procedure mpp_send_cmplx8_3d
1016  module procedure mpp_send_cmplx8_4d
1017  module procedure mpp_send_cmplx8_5d
1018 #endif
1019  module procedure mpp_send_int8
1020  module procedure mpp_send_int8_scalar
1021  module procedure mpp_send_int8_2d
1022  module procedure mpp_send_int8_3d
1023  module procedure mpp_send_int8_4d
1024  module procedure mpp_send_int8_5d
1025  module procedure mpp_send_logical8
1026  module procedure mpp_send_logical8_scalar
1027  module procedure mpp_send_logical8_2d
1028  module procedure mpp_send_logical8_3d
1029  module procedure mpp_send_logical8_4d
1030  module procedure mpp_send_logical8_5d
1031 
1032  module procedure mpp_send_real4
1033  module procedure mpp_send_real4_scalar
1034  module procedure mpp_send_real4_2d
1035  module procedure mpp_send_real4_3d
1036  module procedure mpp_send_real4_4d
1037  module procedure mpp_send_real4_5d
1038 
1039 #ifdef OVERLOAD_C4
1040  module procedure mpp_send_cmplx4
1041  module procedure mpp_send_cmplx4_scalar
1042  module procedure mpp_send_cmplx4_2d
1043  module procedure mpp_send_cmplx4_3d
1044  module procedure mpp_send_cmplx4_4d
1045  module procedure mpp_send_cmplx4_5d
1046 #endif
1047  module procedure mpp_send_int4
1048  module procedure mpp_send_int4_scalar
1049  module procedure mpp_send_int4_2d
1050  module procedure mpp_send_int4_3d
1051  module procedure mpp_send_int4_4d
1052  module procedure mpp_send_int4_5d
1053  module procedure mpp_send_logical4
1054  module procedure mpp_send_logical4_scalar
1055  module procedure mpp_send_logical4_2d
1056  module procedure mpp_send_logical4_3d
1057  module procedure mpp_send_logical4_4d
1058  module procedure mpp_send_logical4_5d
1059  end interface
1060 
1061 
1062  !> @brief Perform parallel broadcasts
1063  !!
1064  !> The <TT>mpp_broadcast</TT> call has been added because the original
1065  !! syntax (using <TT>ALL_PES</TT> in <TT>mpp_transmit</TT>) did not
1066  !! support a broadcast across a pelist.
1067  !!
1068  !! <TT>MPP_TYPE_</TT> corresponds to any 4-byte and 8-byte variant of
1069  !! <TT>integer, real, complex, logical</TT> variables, of rank 0 or 1. A
1070  !! contiguous block from a multi-dimensional array may be passed by its
1071  !! starting address and its length, as in <TT>f77</TT>.
1072  !!
1073  !! Global broadcasts through the <TT>ALL_PES</TT> argument to
1074  !! @ref mpp_transmit are still provided for
1075  !! backward-compatibility.
1076  !!
1077  !! If <TT>pelist</TT> is omitted, the context is assumed to be the
1078  !! current pelist. <TT>from_pe</TT> must belong to the current
1079  !! pelist. This call implies synchronization across the PEs in
1080  !! <TT>pelist</TT>, or the current pelist if <TT>pelist</TT> is absent.
1081  !!
1082  !! <br>Example usage:
1083  !!
1084  !! call mpp_broadcast( data, length, from_pe, pelist )
1085  !!
1086  !> @param[inout] data Data to broadcast
1087  !> @param length Length of data to broadcast
1088  !> @param from_pe PE to send the data from
1089  !> @param pelist List of PE's to broadcast across, if not provided uses current list
1090  !> @ingroup mpp_mod
1091  interface mpp_broadcast
1092  module procedure mpp_broadcast_char
1093  module procedure mpp_broadcast_real8
1094  module procedure mpp_broadcast_real8_scalar
1095  module procedure mpp_broadcast_real8_2d
1096  module procedure mpp_broadcast_real8_3d
1097  module procedure mpp_broadcast_real8_4d
1098  module procedure mpp_broadcast_real8_5d
1099 #ifdef OVERLOAD_C8
1100  module procedure mpp_broadcast_cmplx8
1101  module procedure mpp_broadcast_cmplx8_scalar
1102  module procedure mpp_broadcast_cmplx8_2d
1103  module procedure mpp_broadcast_cmplx8_3d
1104  module procedure mpp_broadcast_cmplx8_4d
1105  module procedure mpp_broadcast_cmplx8_5d
1106 #endif
1107  module procedure mpp_broadcast_int8
1108  module procedure mpp_broadcast_int8_scalar
1109  module procedure mpp_broadcast_int8_2d
1110  module procedure mpp_broadcast_int8_3d
1111  module procedure mpp_broadcast_int8_4d
1112  module procedure mpp_broadcast_int8_5d
1113  module procedure mpp_broadcast_logical8
1114  module procedure mpp_broadcast_logical8_scalar
1115  module procedure mpp_broadcast_logical8_2d
1116  module procedure mpp_broadcast_logical8_3d
1117  module procedure mpp_broadcast_logical8_4d
1118  module procedure mpp_broadcast_logical8_5d
1119 
1120  module procedure mpp_broadcast_real4
1121  module procedure mpp_broadcast_real4_scalar
1122  module procedure mpp_broadcast_real4_2d
1123  module procedure mpp_broadcast_real4_3d
1124  module procedure mpp_broadcast_real4_4d
1125  module procedure mpp_broadcast_real4_5d
1126 
1127 #ifdef OVERLOAD_C4
1128  module procedure mpp_broadcast_cmplx4
1129  module procedure mpp_broadcast_cmplx4_scalar
1130  module procedure mpp_broadcast_cmplx4_2d
1131  module procedure mpp_broadcast_cmplx4_3d
1132  module procedure mpp_broadcast_cmplx4_4d
1133  module procedure mpp_broadcast_cmplx4_5d
1134 #endif
1135  module procedure mpp_broadcast_int4
1136  module procedure mpp_broadcast_int4_scalar
1137  module procedure mpp_broadcast_int4_2d
1138  module procedure mpp_broadcast_int4_3d
1139  module procedure mpp_broadcast_int4_4d
1140  module procedure mpp_broadcast_int4_5d
1141  module procedure mpp_broadcast_logical4
1142  module procedure mpp_broadcast_logical4_scalar
1143  module procedure mpp_broadcast_logical4_2d
1144  module procedure mpp_broadcast_logical4_3d
1145  module procedure mpp_broadcast_logical4_4d
1146  module procedure mpp_broadcast_logical4_5d
1147  end interface
1148 
1149  !#####################################################################
1150 
1151  !> @brief Calculate parallel checksums
1152  !!
1153  !> \e mpp_chksum is a parallel checksum routine that returns an
1154  !! identical answer for the same array irrespective of how it has been
1155  !! partitioned across processors. \e int_kind is the KIND
1156  !! parameter corresponding to long integers (see discussion on
1157  !! OS-dependent preprocessor directives) defined in
1158  !! the file platform.F90. \e MPP_TYPE_ corresponds to any
1159  !! 4-byte and 8-byte variant of \e integer, \e real, \e complex, \e logical
1160  !! variables, of rank 0 to 5.
1161  !!
1162  !! Integer checksums on FP data use the F90 <TT>TRANSFER()</TT>
1163  !! intrinsic.
1164  !!
1165  !! This provides identical results on a single-processor job, and to perform
1166  !! serial checksums on a single processor of a parallel job, you only
1167  !! need to use the optional <TT>pelist</TT> argument.
1168  !! <PRE>
1169  !! use mpp_mod
1170  !! integer :: pe, chksum
1171  !! real :: a(:)
1172  !! pe = mpp_pe()
1173  !! chksum = mpp_chksum( a, (/pe/) )
1174  !! </PRE>
1175  !!
1176  !! The additional functionality of <TT>mpp_chksum</TT> over
1177  !! serial checksums is to compute the checksum across the PEs in
1178  !! <TT>pelist</TT>. The answer is guaranteed to be the same for
1179  !! the same distributed array irrespective of how it has been
1180  !! partitioned.
1181  !!
1182  !! If <TT>pelist</TT> is omitted, the context is assumed to be the
1183  !! current pelist. This call implies synchronization across the PEs in
1184  !! <TT>pelist</TT>, or the current pelist if <TT>pelist</TT> is absent.
1185  !! <br> Example usage:
1186  !!
1187  !! mpp_chksum( var, pelist )
1188  !!
1189  !! @param var Data to calculate checksum of
1190  !! @param pelist Optional list of PE's to include in checksum calculation if not using
1191  !! current pelist
1192  !! @return Parallel checksum of var across given or implicit pelist
1193  !!
1194  !! Generic MPP_TYPE_ implentations:
1195  !! <li> @ref mpp_chksum_</li>
1196  !! <li> @ref mpp_chksum_int_</li>
1197  !! <li> @ref mpp_chksum_int_rmask_</li>
1198  !!
1199  !> @ingroup mpp_mod
1200  interface mpp_chksum
1201  module procedure mpp_chksum_i8_1d
1202  module procedure mpp_chksum_i8_2d
1203  module procedure mpp_chksum_i8_3d
1204  module procedure mpp_chksum_i8_4d
1205  module procedure mpp_chksum_i8_5d
1206  module procedure mpp_chksum_i8_1d_rmask
1207  module procedure mpp_chksum_i8_2d_rmask
1208  module procedure mpp_chksum_i8_3d_rmask
1209  module procedure mpp_chksum_i8_4d_rmask
1210  module procedure mpp_chksum_i8_5d_rmask
1211 
1212  module procedure mpp_chksum_i4_1d
1213  module procedure mpp_chksum_i4_2d
1214  module procedure mpp_chksum_i4_3d
1215  module procedure mpp_chksum_i4_4d
1216  module procedure mpp_chksum_i4_5d
1217  module procedure mpp_chksum_i4_1d_rmask
1218  module procedure mpp_chksum_i4_2d_rmask
1219  module procedure mpp_chksum_i4_3d_rmask
1220  module procedure mpp_chksum_i4_4d_rmask
1221  module procedure mpp_chksum_i4_5d_rmask
1222 
1223  module procedure mpp_chksum_r8_0d
1224  module procedure mpp_chksum_r8_1d
1225  module procedure mpp_chksum_r8_2d
1226  module procedure mpp_chksum_r8_3d
1227  module procedure mpp_chksum_r8_4d
1228  module procedure mpp_chksum_r8_5d
1229 
1230  module procedure mpp_chksum_r4_0d
1231  module procedure mpp_chksum_r4_1d
1232  module procedure mpp_chksum_r4_2d
1233  module procedure mpp_chksum_r4_3d
1234  module procedure mpp_chksum_r4_4d
1235  module procedure mpp_chksum_r4_5d
1236 #ifdef OVERLOAD_C8
1237  module procedure mpp_chksum_c8_0d
1238  module procedure mpp_chksum_c8_1d
1239  module procedure mpp_chksum_c8_2d
1240  module procedure mpp_chksum_c8_3d
1241  module procedure mpp_chksum_c8_4d
1242  module procedure mpp_chksum_c8_5d
1243 #endif
1244 #ifdef OVERLOAD_C4
1245  module procedure mpp_chksum_c4_0d
1246  module procedure mpp_chksum_c4_1d
1247  module procedure mpp_chksum_c4_2d
1248  module procedure mpp_chksum_c4_3d
1249  module procedure mpp_chksum_c4_4d
1250  module procedure mpp_chksum_c4_5d
1251 #endif
1252  end interface
1253 
1254 !> @addtogroup mpp_mod
1255 !> @{
1256 !***********************************************************************
1257 !
1258 ! module variables
1259 !
1260 !***********************************************************************
1261  integer, parameter :: PESET_MAX = 10000
1262  integer :: current_peset_max = 32
1263  type(communicator), allocatable :: peset(:) !< Will be allocated starting from 0, 0 is a dummy used
1264  !! to hold single-PE "self" communicator
1265  logical :: module_is_initialized = .false.
1266  logical :: debug = .false.
1267  integer :: npes=1, root_pe=0, pe=0
1268  integer(i8_kind) :: tick, ticks_per_sec, max_ticks, start_tick, end_tick, tick0=0
1269  integer :: mpp_comm_private
1270  logical :: first_call_system_clock_mpi=.true.
1271  real(r8_kind) :: mpi_count0=0 !< use to prevent integer overflow
1272  real(r8_kind) :: mpi_tick_rate=0.d0 !< clock rate for mpi_wtick()
1273  logical :: mpp_record_timing_data=.true.
1274  type(clock),save :: clocks(max_clocks)
1275  integer :: log_unit, etc_unit
1276  integer :: warn_unit !< unit number of the warning log
1277  character(len=32), parameter :: configfile='logfile'
1278  character(len=32), parameter :: warnfile='warnfile' !< base name for warninglog (appends ".<PE>.out")
1279  integer :: peset_num=0, current_peset_num=0
1280  integer :: world_peset_num !<the world communicator
1281  integer :: error
1282  integer :: clock_num=0, num_clock_ids=0,current_clock=0, previous_clock(max_clocks)=0
1283  real :: tick_rate
1284 
1285  type(mpp_type_list) :: datatypes
1286  type(mpp_type), target :: mpp_byte
1287 
1288  integer :: cur_send_request = 0
1289  integer :: cur_recv_request = 0
1290  integer, allocatable :: request_send(:)
1291  integer, allocatable :: request_recv(:)
1292  integer, allocatable :: size_recv(:)
1293  integer, allocatable :: type_recv(:)
1294 ! if you want to save the non-root PE information uncomment out the following line
1295 ! and comment out the assigment of etcfile to '/dev/null'
1296 #ifdef NO_DEV_NULL
1297  character(len=32) :: etcfile='._mpp.nonrootpe.msgs'
1298 #else
1299  character(len=32) :: etcfile='/dev/null'
1300 #endif
1301 
1302 !> Use the intrinsics in iso_fortran_env
1303  integer :: in_unit=input_unit, out_unit=output_unit, err_unit=error_unit
1304  integer :: stdout_unit
1305 
1306  !--- variables used in mpp_util.h
1307  type(summary_struct) :: clock_summary(max_clocks)
1308  logical :: warnings_are_fatal = .false.
1309  integer :: error_state=0
1310  integer :: clock_grain=clock_loop-1
1311 
1312  !--- variables used in mpp_comm.h
1313  integer :: clock0 !<measures total runtime from mpp_init to mpp_exit
1314  integer :: mpp_stack_size=0, mpp_stack_hwm=0
1315  logical :: verbose=.false.
1316 
1317  integer :: get_len_nocomm = 0 !< needed for mpp_transmit_nocomm.h
1318 
1319  !--- variables used in mpp_comm_mpi.inc
1320  integer, parameter :: mpp_init_test_full_init = -1
1321  integer, parameter :: mpp_init_test_init_true_only = 0
1322  integer, parameter :: mpp_init_test_peset_allocated = 1
1323  integer, parameter :: mpp_init_test_clocks_init = 2
1324  integer, parameter :: mpp_init_test_datatype_list_init = 3
1325  integer, parameter :: mpp_init_test_logfile_init = 4
1326  integer, parameter :: mpp_init_test_read_namelist = 5
1327  integer, parameter :: mpp_init_test_etc_unit = 6
1328  integer, parameter :: mpp_init_test_requests_allocated = 7
1329 
1330 !> MPP_INFO_NULL acts as an analagous mpp-macro for MPI_INFO_NULL to share with fms2_io NetCDF4
1331 !! mpi-io. The default value for the no-mpi case comes from Intel MPI and MPICH. OpenMPI sets
1332 !! a default value of '0'
1333 #if defined(use_libMPI)
1334  integer, parameter :: mpp_info_null = mpi_info_null
1335 #else
1336  integer, parameter :: mpp_info_null = 469762048
1337 #endif
1338 
1339 !> MPP_COMM_NULL acts as an analagous mpp-macro for MPI_COMM_NULL to share with fms2_io NetCDF4
1340 !! mpi-io. The default value for the no-mpi case comes from Intel MPI and MPICH. OpenMPI sets
1341 !! a default value of '2'
1342 #if defined(use_libMPI)
1343  integer, parameter :: mpp_comm_null = mpi_comm_null
1344 #else
1345  integer, parameter :: mpp_comm_null = 67108864
1346 #endif
1347 
1348 !***********************************************************************
1349 ! variables needed for subroutine read_input_nml (include/mpp_util.inc)
1350 !
1351 ! public variable needed for reading input nml file from an internal file
1352  character(len=:), dimension(:), allocatable, target, public :: input_nml_file
1353  logical :: read_ascii_file_on = .false.
1354 !***********************************************************************
1355 
1356 ! Include variable "version" to be written to log file.
1357 #include<file_version.h>
1358  public version
1359 
1360  integer, parameter :: max_request_min = 10000
1361  integer :: request_multiply = 20
1362 
1363  logical :: etc_unit_is_stderr = .false.
1364  integer :: max_request = 0
1365  logical :: sync_all_clocks = .false.
1366  namelist /mpp_nml/ etc_unit_is_stderr, request_multiply, mpp_record_timing_data, sync_all_clocks
1367 
1368  contains
1369 #include <system_clock.fh>
1370 #include <mpp_util.inc>
1371 #include <mpp_comm.inc>
1372 
1373  end module mpp_mod
1374 !> @}
1375 ! close documentation grouping
subroutine mpp_sync_self(pelist, check, request, msg_size, msg_type)
This is to check if current PE's outstanding puts are complete but we can't use shmem_fence because w...
integer warn_unit
unit number of the warning log
Definition: mpp.F90:1276
subroutine mpp_error_basic(errortype, errormsg)
A very basic error handler uses ABORT and FLUSH calls, may need to use cpp to rename.
integer function stdout()
This function returns the current standard fortran unit numbers for output.
Definition: mpp_util.inc:43
subroutine read_ascii_file(FILENAME, LENGTH, Content, PELIST)
Reads any ascii file into a character array and broadcasts it to the non-root mpi-tasks....
Definition: mpp_util.inc:1438
subroutine mpp_error_mesg(routine, errormsg, errortype)
overloads to mpp_error_basic, support for error_mesg routine in FMS
Definition: mpp_util.inc:175
subroutine mpp_set_current_pelist(pelist, no_sync)
Set context pelist.
Definition: mpp_util.inc:490
integer, parameter, public mpp_comm_null
MPP_COMM_NULL acts as an analagous mpp-macro for MPI_COMM_NULL to share with fms2_io NetCDF4 mpi-io....
Definition: mpp.F90:1345
subroutine mpp_init(flags, localcomm, test_level, alt_input_nml_path)
Initialize the mpp_mod module. Must be called before any usage.
integer get_len_nocomm
needed for mpp_transmit_nocomm.h
Definition: mpp.F90:1317
integer function stderr()
This function returns the current standard fortran unit numbers for error messages.
Definition: mpp_util.inc:51
subroutine read_input_nml(pelist_name_in, alt_input_nml_path)
Reads an existing input nml file into a character array and broadcasts it to the non-root mpi-tasks....
Definition: mpp_util.inc:1219
character(len=32), parameter warnfile
base name for warninglog (appends ".<PE>.out")
Definition: mpp.F90:1278
type(communicator), dimension(:), allocatable peset
Will be allocated starting from 0, 0 is a dummy used to hold single-PE "self" communicator.
Definition: mpp.F90:1263
subroutine mpp_type_free(dtype)
Deallocates memory for mpp_type objects @TODO This should probably not take a pointer,...
integer, parameter, public mpp_info_null
MPP_INFO_NULL acts as an analagous mpp-macro for MPI_INFO_NULL to share with fms2_io NetCDF4 mpi-io....
Definition: mpp.F90:1336
integer clock0
measures total runtime from mpp_init to mpp_exit
Definition: mpp.F90:1313
subroutine mpp_clock_set_grain(grain)
Set the level of granularity of timing measurements.
Definition: mpp_util.inc:641
real(r8_kind) mpi_tick_rate
clock rate for mpi_wtick()
Definition: mpp.F90:1272
subroutine mpp_declare_pelist(pelist, name, commID)
Declare a pelist.
Definition: mpp_util.inc:461
integer world_peset_num
the world communicator
Definition: mpp.F90:1280
subroutine mpp_exit()
Finalizes process termination. To be called at the end of a run. Certain mpi implementations(openmpi)...
integer function stdlog()
This function returns the current standard fortran unit numbers for log messages. Log messages,...
Definition: mpp_util.inc:59
integer in_unit
Use the intrinsics in iso_fortran_env.
Definition: mpp.F90:1303
integer function mpp_npes()
Returns processor count for current pelist.
Definition: mpp_util.inc:421
subroutine mpp_set_stack_size(n)
Set the mpp_stack variable to be at least n LONG words long.
integer function, dimension(2) get_ascii_file_num_lines_and_length(FILENAME, PELIST)
Function to determine the maximum line length and number of lines from an ascii file.
Definition: mpp_util.inc:1345
real(r8_kind) mpi_count0
use to prevent integer overflow
Definition: mpp.F90:1271
integer function mpp_pe()
Returns processor ID.
Definition: mpp_util.inc:407
subroutine mpp_sync(pelist, do_self)
Synchronize PEs in list.
integer function mpp_clock_id(name, flags, grain)
Return an ID for a new or existing clock.
Definition: mpp_util.inc:705
integer function warnlog()
This function returns unit number for the warning log if on the root pe, otherwise returns the etc_un...
Definition: mpp_util.inc:141
subroutine mpp_broadcast_char(char_data, length, from_pe, pelist)
Broadcasts a character string from the given pe to it's pelist.
integer function stdin()
This function returns the current standard fortran unit numbers for input.
Definition: mpp_util.inc:36
Takes a given integer or real array and returns it as a string.
Definition: mpp.F90:411
Scatter a vector across all PEs.
Definition: mpp.F90:762
Perform parallel broadcasts.
Definition: mpp.F90:1091
Calculate parallel checksums.
Definition: mpp.F90:1200
Error handler.
Definition: mpp.F90:382
Gather data sent from pelist onto the root pe Wrapper for MPI_gather, can be used with and without in...
Definition: mpp.F90:698
Reduction operations. Find the max of scalar a from the PEs in pelist result is also automatically br...
Definition: mpp.F90:538
Reduction operations. Find the min of scalar a from the PEs in pelist result is also automatically br...
Definition: mpp.F90:560
Recieve data from another PE.
Definition: mpp.F90:937
Scatter (ie - is) * (je - js) contiguous elements of array data from the designated root pe into cont...
Definition: mpp.F90:738
Send data to a receiving PE.
Definition: mpp.F90:1004
Reduction operation.
Definition: mpp.F90:597
Calculates sum of a given numerical array across pe's for adjoint domains.
Definition: mpp.F90:642
Basic message-passing call.
Definition: mpp.F90:872
Create a mpp_type variable.
Definition: mpp.F90:510
a clock contains an array of event profiles for a region
Definition: mpp.F90:250
Summary of information from a clock run.
Definition: mpp.F90:266
Communication information for message passing libraries.
Definition: mpp.F90:230
Communication event profile.
Definition: mpp.F90:241
Data types for generalized data transfer (e.g. MPI_Type)
Definition: mpp.F90:287
Persisent elements for linked list interaction.
Definition: mpp.F90:303
holds name and clock data for use in mpp_util.h
Definition: mpp.F90:279