FMS  2025.02.01
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_commid, 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_logical4
700  module procedure mpp_gatherv_logical4
701  module procedure mpp_gather_logical_1d
702  module procedure mpp_gather_int4
703  module procedure mpp_gather_int8
704  module procedure mpp_gatherv_int4
705  module procedure mpp_gatherv_int8
706  module procedure mpp_gather_int4_1d
707  module procedure mpp_gather_int8_1d
708  module procedure mpp_gather_real4
709  module procedure mpp_gather_real8
710  module procedure mpp_gatherv_real4
711  module procedure mpp_gatherv_real8
712  module procedure mpp_gather_real4_1d
713  module procedure mpp_gather_real8_1d
714  module procedure mpp_gather_logical_1dv
715  module procedure mpp_gather_int4_1dv
716  module procedure mpp_gather_int8_1dv
717  module procedure mpp_gather_real4_1dv
718  module procedure mpp_gather_real8_1dv
719  module procedure mpp_gather_pelist_logical_2d
720  module procedure mpp_gather_pelist_logical_3d
721  module procedure mpp_gather_pelist_int4_2d
722  module procedure mpp_gather_pelist_int4_3d
723  module procedure mpp_gather_pelist_int8_2d
724  module procedure mpp_gather_pelist_int8_3d
725  module procedure mpp_gather_pelist_real4_2d
726  module procedure mpp_gather_pelist_real4_3d
727  module procedure mpp_gather_pelist_real8_2d
728  module procedure mpp_gather_pelist_real8_3d
729  end interface
730 
731  !> @brief Scatter (ie - is) * (je - js) contiguous elements of array data from the designated root pe
732  !! into contigous members of array segment in each pe that is included in the pelist argument.
733  !> @ingroup mpp_mod
734  !!
735  !> @param is, ie integer start and end index of the first dimension of the segment array
736  !> @param je, js integer start and end index of the second dimension of the segment array
737  !> @param pelist integer(:) the PE list of target pes, needs to be monotonically increasing
738  !> @param array_seg MPP_TYPE_ 2D array that the data is to be copied into
739  !> @param data MPP_TYPE_ the source array
740  !> @param is_root_pe logical true if calling from root pe
741  !> @param ishift integer offsets specifying the first elelement in the data array
742  !> @param nk integer size of third dimension for 3D calls
743  !!
744  !> <BR> Example usage:
745  !!
746  !! call mpp_scatter(is, ie, js, je, pelist, segment, data, .true.)
747  !!
748  interface mpp_scatter
749  module procedure mpp_scatterv_int4
750  module procedure mpp_scatter_pelist_int4_2d
751  module procedure mpp_scatter_pelist_int4_3d
752  module procedure mpp_scatterv_int8
753  module procedure mpp_scatter_pelist_int8_2d
754  module procedure mpp_scatter_pelist_int8_3d
755  module procedure mpp_scatterv_real4
756  module procedure mpp_scatter_pelist_real4_2d
757  module procedure mpp_scatter_pelist_real4_3d
758  module procedure mpp_scatterv_real8
759  module procedure mpp_scatter_pelist_real8_2d
760  module procedure mpp_scatter_pelist_real8_3d
761  end interface
762 
763  !#####################################################################
764  !> @brief Scatter a vector across all PEs
765  !!
766  !> Transpose the vector and PE index
767  !! Wrapper for the MPI_alltoall function, includes more generic _V and _W
768  !! versions if given displacements/data types
769  !!
770  !! Generic MPP_TYPE_ implentations:
771  !! <li> @ref mpp_alltoall_ </li>
772  !! <li> @ref mpp_alltoallv_ </li>
773  !! <li> @ref mpp_alltoallw_ </li>
774  !!
775  !> @ingroup mpp_mod
776  interface mpp_alltoall
777  module procedure mpp_alltoall_int4
778  module procedure mpp_alltoall_int8
779  module procedure mpp_alltoall_real4
780  module procedure mpp_alltoall_real8
781 #ifdef OVERLOAD_C4
782  module procedure mpp_alltoall_cmplx4
783 #endif
784 #ifdef OVERLOAD_C8
785  module procedure mpp_alltoall_cmplx8
786 #endif
787  module procedure mpp_alltoall_logical4
788  module procedure mpp_alltoall_logical8
789  module procedure mpp_alltoall_int4_v
790  module procedure mpp_alltoall_int8_v
791  module procedure mpp_alltoall_real4_v
792  module procedure mpp_alltoall_real8_v
793 #ifdef OVERLOAD_C4
794  module procedure mpp_alltoall_cmplx4_v
795 #endif
796 #ifdef OVERLOAD_C8
797  module procedure mpp_alltoall_cmplx8_v
798 #endif
799  module procedure mpp_alltoall_logical4_v
800  module procedure mpp_alltoall_logical8_v
801  module procedure mpp_alltoall_int4_w
802  module procedure mpp_alltoall_int8_w
803  module procedure mpp_alltoall_real4_w
804  module procedure mpp_alltoall_real8_w
805 #ifdef OVERLOAD_C4
806  module procedure mpp_alltoall_cmplx4_w
807 #endif
808 #ifdef OVERLOAD_C8
809  module procedure mpp_alltoall_cmplx8_w
810 #endif
811  module procedure mpp_alltoall_logical4_w
812  module procedure mpp_alltoall_logical8_w
813  end interface
814 
815 
816  !#####################################################################
817  !> @brief Basic message-passing call.
818  !!
819  !> <TT>MPP_TYPE_</TT> corresponds to any 4-byte and 8-byte variant of
820  !! <TT>integer, real, complex, logical</TT> variables, of rank 0 or 1. A
821  !! contiguous block from a multi-dimensional array may be passed by its
822  !! starting address and its length, as in <TT>f77</TT>.
823  !!
824  !! <TT>mpp_transmit</TT> is currently implemented as asynchronous
825  !! outward transmission and synchronous inward transmission. This follows
826  !! the behaviour of <TT>shmem_put</TT> and <TT>shmem_get</TT>. In MPI, it
827  !! is implemented as <TT>mpi_isend</TT> and <TT>mpi_recv</TT>. For most
828  !! applications, transmissions occur in pairs, and are here accomplished
829  !! in a single call.
830  !!
831  !! The special PE designations <TT>NULL_PE</TT>,
832  !! <TT>ANY_PE</TT> and <TT>ALL_PES</TT> are provided by use
833  !! association.
834  !!
835  !! <TT>NULL_PE</TT>: is used to disable one of the pair of
836  !! transmissions.<BR/>
837  !! <TT>ANY_PE</TT>: is used for unspecific remote
838  !! destination. (Please note that <TT>put_pe=ANY_PE</TT> has no meaning
839  !! in the MPI context, though it is available in the SHMEM invocation. If
840  !! portability is a concern, it is best avoided).<BR/>
841  !! <TT>ALL_PES</TT>: is used for broadcast operations.
842  !!
843  !! It is recommended that
844  !! @ref mpp_broadcast be used for
845  !! broadcasts.
846  !!
847  !! The following example illustrates the use of
848  !! <TT>NULL_PE</TT> and <TT>ALL_PES</TT>:
849  !!
850  !! <PRE>
851  !! real, dimension(n) :: a
852  !! if( pe.EQ.0 )then
853  !! do p = 1,npes-1
854  !! call mpp_transmit( a, n, p, a, n, NULL_PE )
855  !! end do
856  !! else
857  !! call mpp_transmit( a, n, NULL_PE, a, n, 0 )
858  !! end if
859  !!
860  !! call mpp_transmit( a, n, ALL_PES, a, n, 0 )
861  !! </PRE>
862  !!
863  !! The do loop and the broadcast operation above are equivalent.
864  !!
865  !! Two overloaded calls <TT>mpp_send</TT> and
866  !! <TT>mpp_recv</TT> have also been
867  !! provided. <TT>mpp_send</TT> calls <TT>mpp_transmit</TT>
868  !! with <TT>get_pe=NULL_PE</TT>. <TT>mpp_recv</TT> calls
869  !! <TT>mpp_transmit</TT> with <TT>put_pe=NULL_PE</TT>. Thus
870  !! the do loop above could be written more succinctly:
871  !!
872  !! <PRE>
873  !! if( pe.EQ.0 )then
874  !! do p = 1,npes-1
875  !! call mpp_send( a, n, p )
876  !! end do
877  !! else
878  !! call mpp_recv( a, n, 0 )
879  !! end if
880  !! </PRE>
881  !! <br>Example call:
882  !! @code{.F90}
883  !! call mpp_transmit( put_data, put_len, put_pe, get_data, get_len, get_pe )
884  !! @endcode
885  !> @ingroup mpp_mod
886  interface mpp_transmit
887  module procedure mpp_transmit_real8
888  module procedure mpp_transmit_real8_scalar
889  module procedure mpp_transmit_real8_2d
890  module procedure mpp_transmit_real8_3d
891  module procedure mpp_transmit_real8_4d
892  module procedure mpp_transmit_real8_5d
893 #ifdef OVERLOAD_C8
894  module procedure mpp_transmit_cmplx8
895  module procedure mpp_transmit_cmplx8_scalar
896  module procedure mpp_transmit_cmplx8_2d
897  module procedure mpp_transmit_cmplx8_3d
898  module procedure mpp_transmit_cmplx8_4d
899  module procedure mpp_transmit_cmplx8_5d
900 #endif
901  module procedure mpp_transmit_int8
902  module procedure mpp_transmit_int8_scalar
903  module procedure mpp_transmit_int8_2d
904  module procedure mpp_transmit_int8_3d
905  module procedure mpp_transmit_int8_4d
906  module procedure mpp_transmit_int8_5d
907  module procedure mpp_transmit_logical8
908  module procedure mpp_transmit_logical8_scalar
909  module procedure mpp_transmit_logical8_2d
910  module procedure mpp_transmit_logical8_3d
911  module procedure mpp_transmit_logical8_4d
912  module procedure mpp_transmit_logical8_5d
913 
914  module procedure mpp_transmit_real4
915  module procedure mpp_transmit_real4_scalar
916  module procedure mpp_transmit_real4_2d
917  module procedure mpp_transmit_real4_3d
918  module procedure mpp_transmit_real4_4d
919  module procedure mpp_transmit_real4_5d
920 
921 #ifdef OVERLOAD_C4
922  module procedure mpp_transmit_cmplx4
923  module procedure mpp_transmit_cmplx4_scalar
924  module procedure mpp_transmit_cmplx4_2d
925  module procedure mpp_transmit_cmplx4_3d
926  module procedure mpp_transmit_cmplx4_4d
927  module procedure mpp_transmit_cmplx4_5d
928 #endif
929  module procedure mpp_transmit_int4
930  module procedure mpp_transmit_int4_scalar
931  module procedure mpp_transmit_int4_2d
932  module procedure mpp_transmit_int4_3d
933  module procedure mpp_transmit_int4_4d
934  module procedure mpp_transmit_int4_5d
935  module procedure mpp_transmit_logical4
936  module procedure mpp_transmit_logical4_scalar
937  module procedure mpp_transmit_logical4_2d
938  module procedure mpp_transmit_logical4_3d
939  module procedure mpp_transmit_logical4_4d
940  module procedure mpp_transmit_logical4_5d
941  end interface
942  !> @brief Recieve data from another PE
943  !!
944  !> @param[out] get_data scalar or array to get written with received data
945  !> @param get_len size of array to recv from get_data
946  !> @param from_pe PE number to receive from
947  !> @param block true for blocking, false for non-blocking. Defaults to true
948  !> @param tag communication tag
949  !> @param[out] request MPI request handle
950  !> @ingroup mpp_mod
951  interface mpp_recv
952  module procedure mpp_recv_real8
953  module procedure mpp_recv_real8_scalar
954  module procedure mpp_recv_real8_2d
955  module procedure mpp_recv_real8_3d
956  module procedure mpp_recv_real8_4d
957  module procedure mpp_recv_real8_5d
958 #ifdef OVERLOAD_C8
959  module procedure mpp_recv_cmplx8
960  module procedure mpp_recv_cmplx8_scalar
961  module procedure mpp_recv_cmplx8_2d
962  module procedure mpp_recv_cmplx8_3d
963  module procedure mpp_recv_cmplx8_4d
964  module procedure mpp_recv_cmplx8_5d
965 #endif
966  module procedure mpp_recv_int8
967  module procedure mpp_recv_int8_scalar
968  module procedure mpp_recv_int8_2d
969  module procedure mpp_recv_int8_3d
970  module procedure mpp_recv_int8_4d
971  module procedure mpp_recv_int8_5d
972  module procedure mpp_recv_logical8
973  module procedure mpp_recv_logical8_scalar
974  module procedure mpp_recv_logical8_2d
975  module procedure mpp_recv_logical8_3d
976  module procedure mpp_recv_logical8_4d
977  module procedure mpp_recv_logical8_5d
978 
979  module procedure mpp_recv_real4
980  module procedure mpp_recv_real4_scalar
981  module procedure mpp_recv_real4_2d
982  module procedure mpp_recv_real4_3d
983  module procedure mpp_recv_real4_4d
984  module procedure mpp_recv_real4_5d
985 
986 #ifdef OVERLOAD_C4
987  module procedure mpp_recv_cmplx4
988  module procedure mpp_recv_cmplx4_scalar
989  module procedure mpp_recv_cmplx4_2d
990  module procedure mpp_recv_cmplx4_3d
991  module procedure mpp_recv_cmplx4_4d
992  module procedure mpp_recv_cmplx4_5d
993 #endif
994  module procedure mpp_recv_int4
995  module procedure mpp_recv_int4_scalar
996  module procedure mpp_recv_int4_2d
997  module procedure mpp_recv_int4_3d
998  module procedure mpp_recv_int4_4d
999  module procedure mpp_recv_int4_5d
1000  module procedure mpp_recv_logical4
1001  module procedure mpp_recv_logical4_scalar
1002  module procedure mpp_recv_logical4_2d
1003  module procedure mpp_recv_logical4_3d
1004  module procedure mpp_recv_logical4_4d
1005  module procedure mpp_recv_logical4_5d
1006  end interface
1007  !> Send data to a receiving PE.
1008  !!
1009  !> @param put_data scalar or array to get sent to a receiving PE
1010  !> @param put_len size of data to send from put_data
1011  !> @param to_pe PE number to send to
1012  !> @param block true for blocking, false for non-blocking. Defaults to true
1013  !> @param tag communication tag
1014  !> @param[out] request MPI request handle
1015  !! <br> Example usage:
1016  !! @code{.F90} call mpp_send(data, ie, pe) @endcode
1017  !> @ingroup mpp_mod
1018  interface mpp_send
1019  module procedure mpp_send_real8
1020  module procedure mpp_send_real8_scalar
1021  module procedure mpp_send_real8_2d
1022  module procedure mpp_send_real8_3d
1023  module procedure mpp_send_real8_4d
1024  module procedure mpp_send_real8_5d
1025 #ifdef OVERLOAD_C8
1026  module procedure mpp_send_cmplx8
1027  module procedure mpp_send_cmplx8_scalar
1028  module procedure mpp_send_cmplx8_2d
1029  module procedure mpp_send_cmplx8_3d
1030  module procedure mpp_send_cmplx8_4d
1031  module procedure mpp_send_cmplx8_5d
1032 #endif
1033  module procedure mpp_send_int8
1034  module procedure mpp_send_int8_scalar
1035  module procedure mpp_send_int8_2d
1036  module procedure mpp_send_int8_3d
1037  module procedure mpp_send_int8_4d
1038  module procedure mpp_send_int8_5d
1039  module procedure mpp_send_logical8
1040  module procedure mpp_send_logical8_scalar
1041  module procedure mpp_send_logical8_2d
1042  module procedure mpp_send_logical8_3d
1043  module procedure mpp_send_logical8_4d
1044  module procedure mpp_send_logical8_5d
1045 
1046  module procedure mpp_send_real4
1047  module procedure mpp_send_real4_scalar
1048  module procedure mpp_send_real4_2d
1049  module procedure mpp_send_real4_3d
1050  module procedure mpp_send_real4_4d
1051  module procedure mpp_send_real4_5d
1052 
1053 #ifdef OVERLOAD_C4
1054  module procedure mpp_send_cmplx4
1055  module procedure mpp_send_cmplx4_scalar
1056  module procedure mpp_send_cmplx4_2d
1057  module procedure mpp_send_cmplx4_3d
1058  module procedure mpp_send_cmplx4_4d
1059  module procedure mpp_send_cmplx4_5d
1060 #endif
1061  module procedure mpp_send_int4
1062  module procedure mpp_send_int4_scalar
1063  module procedure mpp_send_int4_2d
1064  module procedure mpp_send_int4_3d
1065  module procedure mpp_send_int4_4d
1066  module procedure mpp_send_int4_5d
1067  module procedure mpp_send_logical4
1068  module procedure mpp_send_logical4_scalar
1069  module procedure mpp_send_logical4_2d
1070  module procedure mpp_send_logical4_3d
1071  module procedure mpp_send_logical4_4d
1072  module procedure mpp_send_logical4_5d
1073  end interface
1074 
1075 
1076  !> @brief Perform parallel broadcasts
1077  !!
1078  !> The <TT>mpp_broadcast</TT> call has been added because the original
1079  !! syntax (using <TT>ALL_PES</TT> in <TT>mpp_transmit</TT>) did not
1080  !! support a broadcast across a pelist.
1081  !!
1082  !! <TT>MPP_TYPE_</TT> corresponds to any 4-byte and 8-byte variant of
1083  !! <TT>integer, real, complex, logical</TT> variables, of rank 0 or 1. A
1084  !! contiguous block from a multi-dimensional array may be passed by its
1085  !! starting address and its length, as in <TT>f77</TT>.
1086  !!
1087  !! Global broadcasts through the <TT>ALL_PES</TT> argument to
1088  !! @ref mpp_transmit are still provided for
1089  !! backward-compatibility.
1090  !!
1091  !! If <TT>pelist</TT> is omitted, the context is assumed to be the
1092  !! current pelist. <TT>from_pe</TT> must belong to the current
1093  !! pelist. This call implies synchronization across the PEs in
1094  !! <TT>pelist</TT>, or the current pelist if <TT>pelist</TT> is absent.
1095  !!
1096  !! <br>Example usage:
1097  !!
1098  !! call mpp_broadcast( data, length, from_pe, pelist )
1099  !!
1100  !> @param[inout] data Data to broadcast
1101  !> @param length Length of data to broadcast
1102  !> @param from_pe PE to send the data from
1103  !> @param pelist List of PE's to broadcast across, if not provided uses current list
1104  !> @ingroup mpp_mod
1105  interface mpp_broadcast
1106  module procedure mpp_broadcast_char
1107  module procedure mpp_broadcast_real8
1108  module procedure mpp_broadcast_real8_scalar
1109  module procedure mpp_broadcast_real8_2d
1110  module procedure mpp_broadcast_real8_3d
1111  module procedure mpp_broadcast_real8_4d
1112  module procedure mpp_broadcast_real8_5d
1113 #ifdef OVERLOAD_C8
1114  module procedure mpp_broadcast_cmplx8
1115  module procedure mpp_broadcast_cmplx8_scalar
1116  module procedure mpp_broadcast_cmplx8_2d
1117  module procedure mpp_broadcast_cmplx8_3d
1118  module procedure mpp_broadcast_cmplx8_4d
1119  module procedure mpp_broadcast_cmplx8_5d
1120 #endif
1121  module procedure mpp_broadcast_int8
1122  module procedure mpp_broadcast_int8_scalar
1123  module procedure mpp_broadcast_int8_2d
1124  module procedure mpp_broadcast_int8_3d
1125  module procedure mpp_broadcast_int8_4d
1126  module procedure mpp_broadcast_int8_5d
1127  module procedure mpp_broadcast_logical8
1128  module procedure mpp_broadcast_logical8_scalar
1129  module procedure mpp_broadcast_logical8_2d
1130  module procedure mpp_broadcast_logical8_3d
1131  module procedure mpp_broadcast_logical8_4d
1132  module procedure mpp_broadcast_logical8_5d
1133 
1134  module procedure mpp_broadcast_real4
1135  module procedure mpp_broadcast_real4_scalar
1136  module procedure mpp_broadcast_real4_2d
1137  module procedure mpp_broadcast_real4_3d
1138  module procedure mpp_broadcast_real4_4d
1139  module procedure mpp_broadcast_real4_5d
1140 
1141 #ifdef OVERLOAD_C4
1142  module procedure mpp_broadcast_cmplx4
1143  module procedure mpp_broadcast_cmplx4_scalar
1144  module procedure mpp_broadcast_cmplx4_2d
1145  module procedure mpp_broadcast_cmplx4_3d
1146  module procedure mpp_broadcast_cmplx4_4d
1147  module procedure mpp_broadcast_cmplx4_5d
1148 #endif
1149  module procedure mpp_broadcast_int4
1150  module procedure mpp_broadcast_int4_scalar
1151  module procedure mpp_broadcast_int4_2d
1152  module procedure mpp_broadcast_int4_3d
1153  module procedure mpp_broadcast_int4_4d
1154  module procedure mpp_broadcast_int4_5d
1155  module procedure mpp_broadcast_logical4
1156  module procedure mpp_broadcast_logical4_scalar
1157  module procedure mpp_broadcast_logical4_2d
1158  module procedure mpp_broadcast_logical4_3d
1159  module procedure mpp_broadcast_logical4_4d
1160  module procedure mpp_broadcast_logical4_5d
1161  end interface
1162 
1163  !#####################################################################
1164 
1165  !> @brief Calculate parallel checksums
1166  !!
1167  !> \e mpp_chksum is a parallel checksum routine that returns an
1168  !! identical answer for the same array irrespective of how it has been
1169  !! partitioned across processors. \e int_kind is the KIND
1170  !! parameter corresponding to long integers (see discussion on
1171  !! OS-dependent preprocessor directives) defined in
1172  !! the file platform.F90. \e MPP_TYPE_ corresponds to any
1173  !! 4-byte and 8-byte variant of \e integer, \e real, \e complex, \e logical
1174  !! variables, of rank 0 to 5.
1175  !!
1176  !! Integer checksums on FP data use the F90 <TT>TRANSFER()</TT>
1177  !! intrinsic.
1178  !!
1179  !! This provides identical results on a single-processor job, and to perform
1180  !! serial checksums on a single processor of a parallel job, you only
1181  !! need to use the optional <TT>pelist</TT> argument.
1182  !! <PRE>
1183  !! use mpp_mod
1184  !! integer :: pe, chksum
1185  !! real :: a(:)
1186  !! pe = mpp_pe()
1187  !! chksum = mpp_chksum( a, (/pe/) )
1188  !! </PRE>
1189  !!
1190  !! The additional functionality of <TT>mpp_chksum</TT> over
1191  !! serial checksums is to compute the checksum across the PEs in
1192  !! <TT>pelist</TT>. The answer is guaranteed to be the same for
1193  !! the same distributed array irrespective of how it has been
1194  !! partitioned.
1195  !!
1196  !! If <TT>pelist</TT> is omitted, the context is assumed to be the
1197  !! current pelist. This call implies synchronization across the PEs in
1198  !! <TT>pelist</TT>, or the current pelist if <TT>pelist</TT> is absent.
1199  !! <br> Example usage:
1200  !!
1201  !! mpp_chksum( var, pelist )
1202  !!
1203  !! @param var Data to calculate checksum of
1204  !! @param pelist Optional list of PE's to include in checksum calculation if not using
1205  !! current pelist
1206  !! @return Parallel checksum of var across given or implicit pelist
1207  !!
1208  !! Generic MPP_TYPE_ implentations:
1209  !! <li> @ref mpp_chksum_</li>
1210  !! <li> @ref mpp_chksum_int_</li>
1211  !! <li> @ref mpp_chksum_int_rmask_</li>
1212  !!
1213  !> @ingroup mpp_mod
1214  interface mpp_chksum
1215  module procedure mpp_chksum_i8_1d
1216  module procedure mpp_chksum_i8_2d
1217  module procedure mpp_chksum_i8_3d
1218  module procedure mpp_chksum_i8_4d
1219  module procedure mpp_chksum_i8_5d
1220  module procedure mpp_chksum_i8_1d_rmask
1221  module procedure mpp_chksum_i8_2d_rmask
1222  module procedure mpp_chksum_i8_3d_rmask
1223  module procedure mpp_chksum_i8_4d_rmask
1224  module procedure mpp_chksum_i8_5d_rmask
1225 
1226  module procedure mpp_chksum_i4_1d
1227  module procedure mpp_chksum_i4_2d
1228  module procedure mpp_chksum_i4_3d
1229  module procedure mpp_chksum_i4_4d
1230  module procedure mpp_chksum_i4_5d
1231  module procedure mpp_chksum_i4_1d_rmask
1232  module procedure mpp_chksum_i4_2d_rmask
1233  module procedure mpp_chksum_i4_3d_rmask
1234  module procedure mpp_chksum_i4_4d_rmask
1235  module procedure mpp_chksum_i4_5d_rmask
1236 
1237  module procedure mpp_chksum_r8_0d
1238  module procedure mpp_chksum_r8_1d
1239  module procedure mpp_chksum_r8_2d
1240  module procedure mpp_chksum_r8_3d
1241  module procedure mpp_chksum_r8_4d
1242  module procedure mpp_chksum_r8_5d
1243 
1244  module procedure mpp_chksum_r4_0d
1245  module procedure mpp_chksum_r4_1d
1246  module procedure mpp_chksum_r4_2d
1247  module procedure mpp_chksum_r4_3d
1248  module procedure mpp_chksum_r4_4d
1249  module procedure mpp_chksum_r4_5d
1250 #ifdef OVERLOAD_C8
1251  module procedure mpp_chksum_c8_0d
1252  module procedure mpp_chksum_c8_1d
1253  module procedure mpp_chksum_c8_2d
1254  module procedure mpp_chksum_c8_3d
1255  module procedure mpp_chksum_c8_4d
1256  module procedure mpp_chksum_c8_5d
1257 #endif
1258 #ifdef OVERLOAD_C4
1259  module procedure mpp_chksum_c4_0d
1260  module procedure mpp_chksum_c4_1d
1261  module procedure mpp_chksum_c4_2d
1262  module procedure mpp_chksum_c4_3d
1263  module procedure mpp_chksum_c4_4d
1264  module procedure mpp_chksum_c4_5d
1265 #endif
1266  end interface
1267 
1268 !> @addtogroup mpp_mod
1269 !> @{
1270 !***********************************************************************
1271 !
1272 ! module variables
1273 !
1274 !***********************************************************************
1275  integer, parameter :: PESET_MAX = 10000
1276  integer :: current_peset_max = 32
1277  type(communicator), allocatable :: peset(:) !< Will be allocated starting from 0, 0 is a dummy used
1278  !! to hold single-PE "self" communicator
1279  logical :: module_is_initialized = .false.
1280  logical :: debug = .false.
1281  integer :: npes=1, root_pe=0, pe=0
1282  integer(i8_kind) :: tick, ticks_per_sec, max_ticks, start_tick, end_tick, tick0=0
1283  integer :: mpp_comm_private
1284  logical :: first_call_system_clock_mpi=.true.
1285  real(r8_kind) :: mpi_count0=0 !< use to prevent integer overflow
1286  real(r8_kind) :: mpi_tick_rate=0.d0 !< clock rate for mpi_wtick()
1287  logical :: mpp_record_timing_data=.true.
1288  type(clock),save :: clocks(max_clocks)
1289  integer :: log_unit, etc_unit
1290  integer :: warn_unit !< unit number of the warning log
1291  character(len=32), parameter :: configfile='logfile'
1292  character(len=32), parameter :: warnfile='warnfile' !< base name for warninglog (appends ".<PE>.out")
1293  integer :: peset_num=0, current_peset_num=0
1294  integer :: world_peset_num !<the world communicator
1295  integer :: error
1296  integer :: clock_num=0, num_clock_ids=0,current_clock=0, previous_clock(max_clocks)=0
1297  real :: tick_rate
1298 
1299  type(mpp_type_list) :: datatypes
1300  type(mpp_type), target :: mpp_byte
1301 
1302  integer :: cur_send_request = 0
1303  integer :: cur_recv_request = 0
1304  integer, allocatable :: request_send(:)
1305  integer, allocatable :: request_recv(:)
1306  integer, allocatable :: size_recv(:)
1307  integer, allocatable :: type_recv(:)
1308 ! if you want to save the non-root PE information uncomment out the following line
1309 ! and comment out the assigment of etcfile to '/dev/null'
1310 #ifdef NO_DEV_NULL
1311  character(len=32) :: etcfile='._mpp.nonrootpe.msgs'
1312 #else
1313  character(len=32) :: etcfile='/dev/null'
1314 #endif
1315 
1316 !> Use the intrinsics in iso_fortran_env
1317  integer :: in_unit=input_unit, out_unit=output_unit, err_unit=error_unit
1318  integer :: stdout_unit
1319 
1320  !--- variables used in mpp_util.h
1321  type(summary_struct) :: clock_summary(max_clocks)
1322  logical :: warnings_are_fatal = .false.
1323  integer :: error_state=0
1324  integer :: clock_grain=clock_loop-1
1325 
1326  !--- variables used in mpp_comm.h
1327  integer :: clock0 !<measures total runtime from mpp_init to mpp_exit
1328  integer :: mpp_stack_size=0, mpp_stack_hwm=0
1329  logical :: verbose=.false.
1330 
1331  integer :: get_len_nocomm = 0 !< needed for mpp_transmit_nocomm.h
1332 
1333  !--- variables used in mpp_comm_mpi.inc
1334  integer, parameter :: mpp_init_test_full_init = -1
1335  integer, parameter :: mpp_init_test_init_true_only = 0
1336  integer, parameter :: mpp_init_test_peset_allocated = 1
1337  integer, parameter :: mpp_init_test_clocks_init = 2
1338  integer, parameter :: mpp_init_test_datatype_list_init = 3
1339  integer, parameter :: mpp_init_test_logfile_init = 4
1340  integer, parameter :: mpp_init_test_read_namelist = 5
1341  integer, parameter :: mpp_init_test_etc_unit = 6
1342  integer, parameter :: mpp_init_test_requests_allocated = 7
1343 
1344 !> MPP_INFO_NULL acts as an analagous mpp-macro for MPI_INFO_NULL to share with fms2_io NetCDF4
1345 !! mpi-io. The default value for the no-mpi case comes from Intel MPI and MPICH. OpenMPI sets
1346 !! a default value of '0'
1347 #if defined(use_libMPI)
1348  integer, parameter :: mpp_info_null = mpi_info_null
1349 #else
1350  integer, parameter :: mpp_info_null = 469762048
1351 #endif
1352 
1353 !> MPP_COMM_NULL acts as an analagous mpp-macro for MPI_COMM_NULL to share with fms2_io NetCDF4
1354 !! mpi-io. The default value for the no-mpi case comes from Intel MPI and MPICH. OpenMPI sets
1355 !! a default value of '2'
1356 #if defined(use_libMPI)
1357  integer, parameter :: mpp_comm_null = mpi_comm_null
1358 #else
1359  integer, parameter :: mpp_comm_null = 67108864
1360 #endif
1361 
1362 !***********************************************************************
1363 ! variables needed for subroutine read_input_nml (include/mpp_util.inc)
1364 !
1365 ! public variable needed for reading input nml file from an internal file
1366  character(len=:), dimension(:), allocatable, target, public :: input_nml_file
1367  logical :: read_ascii_file_on = .false.
1368 !***********************************************************************
1369 
1370 ! Include variable "version" to be written to log file.
1371 #include<file_version.h>
1372  public version
1373 
1374  integer, parameter :: max_request_min = 10000
1375  integer :: request_multiply = 20
1376 
1377  logical :: etc_unit_is_stderr = .false.
1378  integer :: max_request = 0
1379  logical :: sync_all_clocks = .false.
1380  namelist /mpp_nml/ etc_unit_is_stderr, request_multiply, mpp_record_timing_data, sync_all_clocks
1381 
1382  contains
1383 #include <system_clock.fh>
1384 #include <mpp_util.inc>
1385 #include <mpp_comm.inc>
1386 
1387  end module mpp_mod
1388 !> @}
1389 ! 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:1290
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:1447
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:499
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:1359
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:1331
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:1228
character(len=32), parameter warnfile
base name for warninglog (appends ".<PE>.out")
Definition: mpp.F90:1292
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:1277
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:1350
integer clock0
measures total runtime from mpp_init to mpp_exit
Definition: mpp.F90:1327
subroutine mpp_clock_set_grain(grain)
Set the level of granularity of timing measurements.
Definition: mpp_util.inc:650
real(r8_kind) mpi_tick_rate
clock rate for mpi_wtick()
Definition: mpp.F90:1286
subroutine mpp_declare_pelist(pelist, name, commID)
Declare a pelist.
Definition: mpp_util.inc:470
integer world_peset_num
the world communicator
Definition: mpp.F90:1294
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:1317
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:1354
real(r8_kind) mpi_count0
use to prevent integer overflow
Definition: mpp.F90:1285
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:714
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:776
Perform parallel broadcasts.
Definition: mpp.F90:1105
Calculate parallel checksums.
Definition: mpp.F90:1214
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:951
Scatter (ie - is) * (je - js) contiguous elements of array data from the designated root pe into cont...
Definition: mpp.F90:748
Send data to a receiving PE.
Definition: mpp.F90:1018
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:886
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