FMS  2025.04
Flexible Modeling System
mpp_comm_mpi.inc
1 ! -*-f90-*-
2 
3 !***********************************************************************
4 !* Apache License 2.0
5 !*
6 !* This file is part of the GFDL Flexible Modeling System (FMS).
7 !*
8 !* Licensed under the Apache License, Version 2.0 (the "License");
9 !* you may not use this file except in compliance with the License.
10 !* You may obtain a copy of the License at
11 !*
12 !* http://www.apache.org/licenses/LICENSE-2.0
13 !*
14 !* FMS is distributed in the hope that it will be useful, but WITHOUT
15 !* WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied;
16 !* without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
17 !* PARTICULAR PURPOSE. See the License for the specific language
18 !* governing permissions and limitations under the License.
19 !***********************************************************************
20 !> @file
21 !> @brief Routines to initialize and finalize @ref mpp_mod with mpi enabled.
22 
23 !> @addtogroup mpp_mod
24 !> @{
25 
26 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
27 ! !
28 ! ROUTINES TO INITIALIZE/FINALIZE MPP MODULE: mpp_init, mpp_exit !
29 ! !
30 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
31  !> @brief Initialize the @ref mpp_mod module. Must be called before any usage.
32  subroutine mpp_init( flags, localcomm, test_level, alt_input_nml_path )
33  integer, optional, intent(in) :: flags !< Flags for debug output, can be MPP_VERBOSE or MPP_DEBUG
34  integer, optional, intent(in) :: localcomm !< Id of MPI communicator used to initialize
35  integer, optional, intent(in) :: test_level !< Used to exit initialization at certain stages
36  !! before completion for testing purposes
37  character(len=*), optional, intent(in) :: alt_input_nml_path !< Input path for namelist
38  integer :: i, iunit
39  logical :: opened, existed
40  integer :: io_status
41  integer :: t_level
42 
43  if( module_is_initialized )return
44 
45  call mpi_initialized( opened, error ) !in case called from another MPI package
46  if(opened .and. .NOT. PRESENT(localcomm)) call mpp_error( fatal, 'MPP_INIT: communicator is required' )
47  if( .NOT.opened ) then
48  call mpi_init(error)
49  mpp_comm_private = mpi_comm_world
50  else
51  mpp_comm_private = localcomm
52  endif
53  call mpi_comm_rank( mpp_comm_private, pe, error )
54  call mpi_comm_size( mpp_comm_private, npes, error )
55 
56  module_is_initialized = .true.
57  if (present(test_level)) then
58  t_level = test_level
59  else
60  t_level = -1
61  endif
62  if (t_level == 0) return
63 
64  !PEsets: make defaults illegal
65  allocate(peset(0:current_peset_max))
66  peset(:)%count = -1
67  peset(:)%id = -1
68  peset(:)%group = -1
69  peset(:)%start = -1
70  peset(:)%log2stride = -1
71  peset(:)%name = " "
72  !0=single-PE, initialized so that count returns 1
73  peset(0)%count = 1
74  allocate( peset(0)%list(1) )
75  peset(0)%list = pe
76  current_peset_num = 0
77  peset(0)%id = mpp_comm_private
78  call mpi_comm_group( mpp_comm_private, peset(0)%group, error )
79  world_peset_num = get_peset( (/(i,i=0,npes-1)/) )
80  current_peset_num = world_peset_num !initialize current PEset to world
81  if (t_level == 1) return
82 
83  !initialize clocks
84  call system_clock( count=tick0, count_rate=ticks_per_sec, count_max=max_ticks )
85  tick_rate = 1./ticks_per_sec
86  clock0 = mpp_clock_id( 'Total runtime', flags=mpp_clock_sync )
87  if (t_level == 2) return
88 
89  ! Create the bytestream (default) mpp_datatype
90  mpp_byte%counter = 1
91  mpp_byte%ndims = 0
92  allocate(mpp_byte%sizes(0))
93  allocate(mpp_byte%subsizes(0))
94  allocate(mpp_byte%starts(0))
95  mpp_byte%etype = mpi_byte
96  mpp_byte%id = mpi_byte
97 
98  mpp_byte%prev => null()
99  mpp_byte%next => null()
100 
101  ! Initialize datatype list with mpp_byte
102  datatypes%head => mpp_byte
103  datatypes%tail => mpp_byte
104  datatypes%length = 0
105 
106  if( PRESENT(flags) )then
107  debug = flags.EQ.mpp_debug
108  verbose = flags.EQ.mpp_verbose .OR. debug
109  end if
110  if (t_level == 3) return
111 
112  call mpp_init_logfile()
113  call mpp_init_warninglog()
114  if (present(alt_input_nml_path)) then
115  call read_input_nml(alt_input_nml_path=alt_input_nml_path)
116  else
117  call read_input_nml
118  end if
119  if (t_level == 4) return
120 
121  !--- read namelist
122  read (input_nml_file, mpp_nml, iostat=io_status)
123  if (io_status > 0) then
124  call mpp_error(fatal,'=>mpp_init: Error reading mpp_nml')
125  endif
126  if (t_level == 5) return
127 
128  if(sync_all_clocks .AND. mpp_pe()==mpp_root_pe() ) call mpp_error(note, &
129  "mpp_mod: mpp_nml variable sync_all_clocks is set to .true., all clocks are synchronized in mpp_clock_begin.")
130 
131 ! non-root pe messages written to other location than stdout()
132 
133  if(etc_unit_is_stderr) then
134  etc_unit = stderr()
135  else
136  if (trim(etcfile) /= '/dev/null') then
137  write( etcfile,'(a,i6.6)' )trim(etcfile)//'.', pe
138  endif
139  inquire(file=etcfile, exist=existed)
140  if(existed) then
141  open( newunit=etc_unit, file=trim(etcfile), status='REPLACE' )
142  else
143  open( newunit=etc_unit, file=trim(etcfile) )
144  endif
145  endif
146 
147  if (t_level == 6) return
148 
149 ! max_request is set to maximum of npes * REQUEST_MULTIPLY ( default is 20) and MAX_REQUEST_MIN ( default 10000)
150  max_request = max(max_request_min, mpp_npes()*request_multiply)
151 
152  allocate( request_send(max_request) )
153  allocate( request_recv(max_request) )
154  allocate( size_recv(max_request) )
155  allocate( type_recv(max_request) )
156  request_send(:) = mpi_request_null
157  request_recv(:) = mpi_request_null
158  size_recv(:) = 0
159  type_recv(:) = 0
160 
161  if (t_level == 7) return
162 
163  !messages
164  iunit = stdlog() ! workaround for lf95.
165  if( verbose )call mpp_error( note, 'MPP_INIT: initializing MPP module...' )
166  if( pe.EQ.root_pe )then
167  write( iunit,'(/a)' )'MPP module '//trim(version)
168  write( iunit,'(a,i6)' )'MPP started with NPES=', npes
169  write( iunit,'(a)' )'Using MPI library for message passing...'
170  write( iunit, '(a,es12.4,a,i10,a)' ) &
171  'Realtime clock resolution=', tick_rate, ' sec (', ticks_per_sec, ' ticks/sec)'
172  write( iunit, '(a,es12.4,a,i20,a)' ) &
173  'Clock rolls over after ', max_ticks*tick_rate, ' sec (', max_ticks, ' ticks)'
174  write( iunit,'(/a)' )'MPP Parameter module '//trim(mpp_parameter_version)
175  write( iunit,'(/a)' )'MPP Data module '//trim(mpp_data_version)
176  end if
177 
178  stdout_unit = stdout()
179 
180  call mpp_clock_begin(clock0)
181 
182  return
183 end subroutine mpp_init
184 
185 !#######################################################################
186 !> Finalizes process termination. To be called at the end of a run.
187 !! Certain mpi implementations(openmpi) will fail if this is not called before program termination
188 subroutine mpp_exit()
189  integer :: i, j, n, nmax, out_unit, log_unit
190  real :: t, tmin, tmax, tavg, tstd
191  real :: m, mmin, mmax, mavg, mstd, t_total
192  logical :: opened
193  type(mpp_type), pointer :: dtype, next_dtype
194 
195  if( .NOT.module_is_initialized )return
197  call mpp_clock_end(clock0)
198  t_total = clocks(clock0)%total_ticks*tick_rate
199  out_unit = stdout()
200  log_unit = stdlog()
201  if( clock_num.GT.0 )then
202  if( any(clocks(1:clock_num)%detailed) )then
203  call sum_clock_data; call dump_clock_summary
204  end if
205 
206  call mpp_sync()
207  call flush( out_unit )
208  close(warn_unit)
209 
210  if( pe.EQ.root_pe )then
211  write( out_unit,'(/a,i6,a)' ) 'Tabulating mpp_clock statistics across ', npes, ' PEs...'
212  if( any(clocks(1:clock_num)%detailed) ) &
213  write( out_unit,'(a)' )' ... see mpp_clock.out.#### for details on individual PEs.'
214  write( out_unit,'(/32x,a)' ) &
215  & ' hits tmin tmax tavg tstd tfrac grain pemin pemax'
216  end if
217  write( log_unit,'(/37x,a)' ) 'time'
218 
219  call flush( out_unit )
220  call mpp_sync()
221  do i = 1,clock_num
222  if( .NOT.any(peset(clocks(i)%peset_num)%list(:).EQ.pe) )cycle
223  call mpp_set_current_pelist( peset(clocks(i)%peset_num)%list )
224  out_unit = stdout()
225  log_unit = stdlog()
226  !times between mpp_clock ticks
227  t = clocks(i)%total_ticks*tick_rate
228  tmin = t; call mpp_min(tmin)
229  tmax = t; call mpp_max(tmax)
230  tavg = t; call mpp_sum(tavg); tavg = tavg/mpp_npes()
231  tstd = (t-tavg)**2; call mpp_sum(tstd); tstd = sqrt( tstd/mpp_npes() )
232  if( pe.EQ.root_pe )write( out_unit,'(a32,i10,4f14.6,f7.3,3i6)' ) &
233  clocks(i)%name, clocks(i)%hits, tmin, tmax, tavg, tstd, tavg/t_total, &
234  clocks(i)%grain, minval(peset(clocks(i)%peset_num)%list), &
235  maxval(peset(clocks(i)%peset_num)%list)
236  write(log_unit,'(a32,f14.6)') clocks(i)%name, clocks(i)%total_ticks*tick_rate
237  end do
238 
239  if( any(clocks(1:clock_num)%detailed) .AND. pe.EQ.root_pe )write( out_unit,'(/32x,a)' ) &
240  ' tmin tmax tavg tstd mmin mmax mavg mstd mavg/tavg'
241 
242  do i = 1,clock_num
243  !messages: bytelengths and times
244  if( .NOT.clocks(i)%detailed )cycle
245  if( .NOT.any(peset(clocks(i)%peset_num)%list(:).EQ.pe) )cycle
246  call mpp_set_current_pelist( peset(clocks(i)%peset_num)%list )
247  out_unit = stdout()
248  do j = 1,max_event_types
249  n = clocks(i)%events(j)%calls; nmax = n
250  call mpp_max(nmax)
251  if( nmax.NE.0 )then
252  !don't divide by n because n might be 0
253  m = 0
254  if( n.GT.0 )m = sum(clocks(i)%events(j)%bytes(1:n))
255  mmin = m; call mpp_min(mmin)
256  mmax = m; call mpp_max(mmax)
257  mavg = m; call mpp_sum(mavg); mavg = mavg/mpp_npes()
258  mstd = (m-mavg)**2; call mpp_sum(mstd); mstd = sqrt( mstd/mpp_npes() )
259  t = 0
260  if( n.GT.0 )t = sum(clocks(i)%events(j)%ticks(1:n))*tick_rate
261  tmin = t; call mpp_min(tmin)
262  tmax = t; call mpp_max(tmax)
263  tavg = t; call mpp_sum(tavg); tavg = tavg/mpp_npes()
264  tstd = (t-tavg)**2; call mpp_sum(tstd); tstd = sqrt( tstd/mpp_npes() )
265  if( pe.EQ.root_pe )write( out_unit,'(a32,4f11.3,5es11.3)' ) &
266  trim(clocks(i)%name)//' '//trim(clocks(i)%events(j)%name), &
267  tmin, tmax, tavg, tstd, mmin, mmax, mavg, mstd, mavg/tavg
268  end if
269  end do
270  end do
271 
272  end if
273 
274  call flush( out_unit )
275 
276  inquire(unit=etc_unit, opened=opened)
277  if (opened) then
278  call flush (etc_unit)
279  close(etc_unit)
280  endif
281 
282  ! Clear derived data types
283  dtype => datatypes%head
284  do while (associated(dtype))
285  next_dtype => dtype%next
286  call mpp_type_free(dtype)
287  dtype => next_dtype
288  end do
289 
291  call mpp_sync()
292  call mpp_max(mpp_stack_hwm)
293  if( pe.EQ.root_pe )write( out_unit,* )'MPP_STACK high water mark=', mpp_stack_hwm
294  if(mpp_comm_private == mpi_comm_world ) call mpi_finalize(error)
295 
296  return
297 end subroutine mpp_exit
298 
299 !#######################################################################
300  !> Set the mpp_stack variable to be at least n LONG words long
301  subroutine mpp_set_stack_size(n)
302  integer, intent(in) :: n !< stack size to set
303  character(len=8) :: text
304 
305  if( n.GT.mpp_stack_size .AND. allocated(mpp_stack) )deallocate(mpp_stack)
306  if( .NOT.allocated(mpp_stack) )then
307  allocate( mpp_stack(n) )
308  mpp_stack_size = n
309  end if
310 
311  write( text,'(i8)' )n
312  if( pe.EQ.root_pe )call mpp_error( note, 'MPP_SET_STACK_SIZE: stack size set to '//text//'.' )
313 
314  return
315  end subroutine mpp_set_stack_size
316 
317 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
318 ! !
319 ! BASIC MESSAGE PASSING ROUTINE: mpp_transmit !
320 ! !
321 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
322  !> Broadcasts a character string from the given pe to it's pelist
323  subroutine mpp_broadcast_char(char_data, length, from_pe, pelist )
324  character(len=*), intent(inout) :: char_data(:) !< Character string to send
325  integer, intent(in) :: length !< length of given data to broadcast
326  integer, intent(in) :: from_pe !< pe to broadcast from
327  integer, intent(in), optional :: pelist(:) !< optional pelist to broadcast to
328  integer :: n, i, from_rank
329  character :: str1D(length*size(char_data(:)))
330  pointer(lptr, str1d)
331 
332  if( .NOT.module_is_initialized )call mpp_error( fatal, 'mpp_broadcast_text: You must first call mpp_init.' )
333  n = get_peset(pelist); if( peset(n)%count.EQ.1 )return
334 
335 
336  if( debug )then
337  call system_clock(tick)
338  if(mpp_pe() == mpp_root_pe()) then
339  write( stdout_unit,'(a,i18,a,i5,a,2i5,2i8)' )&
340  'T=',tick, ' PE=',pe, 'mpp_broadcast_text begin: from_pe, length=', from_pe, length
341  endif
342  end if
343 
344  if( .NOT.any(from_pe.EQ.peset(current_peset_num)%list) ) &
345  call mpp_error( fatal, 'mpp_broadcast_text: broadcasting from invalid PE.' )
346 
347  if( debug .and. (current_clock.NE.0) )call system_clock(start_tick)
348  ! find the rank of from_pe in the pelist.
349  do i = 1, mpp_npes()
350  if(peset(n)%list(i) == from_pe) then
351  from_rank = i - 1
352  exit
353  endif
354  enddo
355  lptr = loc(char_data)
356  if( mpp_npes().GT.1 ) call mpi_bcast( char_data, length*size(char_data(:)), &
357  mpi_character, from_rank, peset(n)%id, error )
358  if( debug .and. (current_clock.NE.0) )call increment_current_clock( event_broadcast, length )
359  return
360  end subroutine mpp_broadcast_char
361 
362 ! defines initialization value for mpp_type data
363 #define MPP_TYPE_INIT_VALUE 0.
364 
365 #undef MPP_TRANSMIT_
366 #define MPP_TRANSMIT_ mpp_transmit_real8
367 #undef MPP_TRANSMIT_SCALAR_
368 #define MPP_TRANSMIT_SCALAR_ mpp_transmit_real8_scalar
369 #undef MPP_TRANSMIT_2D_
370 #define MPP_TRANSMIT_2D_ mpp_transmit_real8_2d
371 #undef MPP_TRANSMIT_3D_
372 #define MPP_TRANSMIT_3D_ mpp_transmit_real8_3d
373 #undef MPP_TRANSMIT_4D_
374 #define MPP_TRANSMIT_4D_ mpp_transmit_real8_4d
375 #undef MPP_TRANSMIT_5D_
376 #define MPP_TRANSMIT_5D_ mpp_transmit_real8_5d
377 #undef MPP_RECV_
378 #define MPP_RECV_ mpp_recv_real8
379 #undef MPP_RECV_SCALAR_
380 #define MPP_RECV_SCALAR_ mpp_recv_real8_scalar
381 #undef MPP_RECV_2D_
382 #define MPP_RECV_2D_ mpp_recv_real8_2d
383 #undef MPP_RECV_3D_
384 #define MPP_RECV_3D_ mpp_recv_real8_3d
385 #undef MPP_RECV_4D_
386 #define MPP_RECV_4D_ mpp_recv_real8_4d
387 #undef MPP_RECV_5D_
388 #define MPP_RECV_5D_ mpp_recv_real8_5d
389 #undef MPP_SEND_
390 #define MPP_SEND_ mpp_send_real8
391 #undef MPP_SEND_SCALAR_
392 #define MPP_SEND_SCALAR_ mpp_send_real8_scalar
393 #undef MPP_SEND_2D_
394 #define MPP_SEND_2D_ mpp_send_real8_2d
395 #undef MPP_SEND_3D_
396 #define MPP_SEND_3D_ mpp_send_real8_3d
397 #undef MPP_SEND_4D_
398 #define MPP_SEND_4D_ mpp_send_real8_4d
399 #undef MPP_SEND_5D_
400 #define MPP_SEND_5D_ mpp_send_real8_5d
401 #undef MPP_BROADCAST_
402 #define MPP_BROADCAST_ mpp_broadcast_real8
403 #undef MPP_BROADCAST_SCALAR_
404 #define MPP_BROADCAST_SCALAR_ mpp_broadcast_real8_scalar
405 #undef MPP_BROADCAST_2D_
406 #define MPP_BROADCAST_2D_ mpp_broadcast_real8_2d
407 #undef MPP_BROADCAST_3D_
408 #define MPP_BROADCAST_3D_ mpp_broadcast_real8_3d
409 #undef MPP_BROADCAST_4D_
410 #define MPP_BROADCAST_4D_ mpp_broadcast_real8_4d
411 #undef MPP_BROADCAST_5D_
412 #define MPP_BROADCAST_5D_ mpp_broadcast_real8_5d
413 #undef MPP_SCATTERV_
414 #define MPP_SCATTERV_ mpp_scatterv_real8
415 #undef MPP_GATHER_
416 #define MPP_GATHER_ mpp_gather_real8
417 #undef MPP_GATHERV_
418 #define MPP_GATHERV_ mpp_gatherv_real8
419 #undef MPP_TYPE_
420 #define MPP_TYPE_ real(r8_kind)
421 #undef MPP_TYPE_BYTELEN_
422 #define MPP_TYPE_BYTELEN_ 8
423 #undef MPI_TYPE_
424 #define MPI_TYPE_ MPI_REAL8
425 
426 
427 
428 #include <mpp_transmit_mpi.fh>
429 
430 #ifdef OVERLOAD_C8
431 #undef MPP_TRANSMIT_
432 #define MPP_TRANSMIT_ mpp_transmit_cmplx8
433 #undef MPP_TRANSMIT_SCALAR_
434 #define MPP_TRANSMIT_SCALAR_ mpp_transmit_cmplx8_scalar
435 #undef MPP_TRANSMIT_2D_
436 #define MPP_TRANSMIT_2D_ mpp_transmit_cmplx8_2d
437 #undef MPP_TRANSMIT_3D_
438 #define MPP_TRANSMIT_3D_ mpp_transmit_cmplx8_3d
439 #undef MPP_TRANSMIT_4D_
440 #define MPP_TRANSMIT_4D_ mpp_transmit_cmplx8_4d
441 #undef MPP_TRANSMIT_5D_
442 #define MPP_TRANSMIT_5D_ mpp_transmit_cmplx8_5d
443 #undef MPP_RECV_
444 #define MPP_RECV_ mpp_recv_cmplx8
445 #undef MPP_RECV_SCALAR_
446 #define MPP_RECV_SCALAR_ mpp_recv_cmplx8_scalar
447 #undef MPP_RECV_2D_
448 #define MPP_RECV_2D_ mpp_recv_cmplx8_2d
449 #undef MPP_RECV_3D_
450 #define MPP_RECV_3D_ mpp_recv_cmplx8_3d
451 #undef MPP_RECV_4D_
452 #define MPP_RECV_4D_ mpp_recv_cmplx8_4d
453 #undef MPP_RECV_5D_
454 #define MPP_RECV_5D_ mpp_recv_cmplx8_5d
455 #undef MPP_SEND_
456 #define MPP_SEND_ mpp_send_cmplx8
457 #undef MPP_SEND_SCALAR_
458 #define MPP_SEND_SCALAR_ mpp_send_cmplx8_scalar
459 #undef MPP_SEND_2D_
460 #define MPP_SEND_2D_ mpp_send_cmplx8_2d
461 #undef MPP_SEND_3D_
462 #define MPP_SEND_3D_ mpp_send_cmplx8_3d
463 #undef MPP_SEND_4D_
464 #define MPP_SEND_4D_ mpp_send_cmplx8_4d
465 #undef MPP_SEND_5D_
466 #define MPP_SEND_5D_ mpp_send_cmplx8_5d
467 #undef MPP_BROADCAST_
468 #define MPP_BROADCAST_ mpp_broadcast_cmplx8
469 #undef MPP_BROADCAST_SCALAR_
470 #define MPP_BROADCAST_SCALAR_ mpp_broadcast_cmplx8_scalar
471 #undef MPP_BROADCAST_2D_
472 #define MPP_BROADCAST_2D_ mpp_broadcast_cmplx8_2d
473 #undef MPP_BROADCAST_3D_
474 #define MPP_BROADCAST_3D_ mpp_broadcast_cmplx8_3d
475 #undef MPP_BROADCAST_4D_
476 #define MPP_BROADCAST_4D_ mpp_broadcast_cmplx8_4d
477 #undef MPP_BROADCAST_5D_
478 #define MPP_BROADCAST_5D_ mpp_broadcast_cmplx8_5d
479 #undef MPP_SCATTERV_
480 #define MPP_SCATTERV_ mpp_scatterv_complx8
481 #undef MPP_GATHER_
482 #define MPP_GATHER_ mpp_gather_complx8
483 #undef MPP_GATHERV_
484 #define MPP_GATHERV_ mpp_gatherv_complx8
485 #undef MPP_TYPE_
486 #define MPP_TYPE_ complex(c8_kind)
487 #undef MPP_TYPE_BYTELEN_
488 #define MPP_TYPE_BYTELEN_ 16
489 #undef MPI_TYPE_
490 #define MPI_TYPE_ MPI_DOUBLE_COMPLEX
491 #include <mpp_transmit_mpi.fh>
492 #endif
493 
494 #undef MPP_TRANSMIT_
495 #define MPP_TRANSMIT_ mpp_transmit_real4
496 #undef MPP_TRANSMIT_SCALAR_
497 #define MPP_TRANSMIT_SCALAR_ mpp_transmit_real4_scalar
498 #undef MPP_TRANSMIT_2D_
499 #define MPP_TRANSMIT_2D_ mpp_transmit_real4_2d
500 #undef MPP_TRANSMIT_3D_
501 #define MPP_TRANSMIT_3D_ mpp_transmit_real4_3d
502 #undef MPP_TRANSMIT_4D_
503 #define MPP_TRANSMIT_4D_ mpp_transmit_real4_4d
504 #undef MPP_TRANSMIT_5D_
505 #define MPP_TRANSMIT_5D_ mpp_transmit_real4_5d
506 #undef MPP_RECV_
507 #define MPP_RECV_ mpp_recv_real4
508 #undef MPP_RECV_SCALAR_
509 #define MPP_RECV_SCALAR_ mpp_recv_real4_scalar
510 #undef MPP_RECV_2D_
511 #define MPP_RECV_2D_ mpp_recv_real4_2d
512 #undef MPP_RECV_3D_
513 #define MPP_RECV_3D_ mpp_recv_real4_3d
514 #undef MPP_RECV_4D_
515 #define MPP_RECV_4D_ mpp_recv_real4_4d
516 #undef MPP_RECV_5D_
517 #define MPP_RECV_5D_ mpp_recv_real4_5d
518 #undef MPP_SEND_
519 #define MPP_SEND_ mpp_send_real4
520 #undef MPP_SEND_SCALAR_
521 #define MPP_SEND_SCALAR_ mpp_send_real4_scalar
522 #undef MPP_SEND_2D_
523 #define MPP_SEND_2D_ mpp_send_real4_2d
524 #undef MPP_SEND_3D_
525 #define MPP_SEND_3D_ mpp_send_real4_3d
526 #undef MPP_SEND_4D_
527 #define MPP_SEND_4D_ mpp_send_real4_4d
528 #undef MPP_SEND_5D_
529 #define MPP_SEND_5D_ mpp_send_real4_5d
530 #undef MPP_BROADCAST_
531 #define MPP_BROADCAST_ mpp_broadcast_real4
532 #undef MPP_BROADCAST_SCALAR_
533 #define MPP_BROADCAST_SCALAR_ mpp_broadcast_real4_scalar
534 #undef MPP_BROADCAST_2D_
535 #define MPP_BROADCAST_2D_ mpp_broadcast_real4_2d
536 #undef MPP_BROADCAST_3D_
537 #define MPP_BROADCAST_3D_ mpp_broadcast_real4_3d
538 #undef MPP_BROADCAST_4D_
539 #define MPP_BROADCAST_4D_ mpp_broadcast_real4_4d
540 #undef MPP_BROADCAST_5D_
541 #define MPP_BROADCAST_5D_ mpp_broadcast_real4_5d
542 #undef MPP_SCATTERV_
543 #define MPP_SCATTERV_ mpp_scatterv_real4
544 #undef MPP_GATHER_
545 #define MPP_GATHER_ mpp_gather_real4
546 #undef MPP_GATHERV_
547 #define MPP_GATHERV_ mpp_gatherv_real4
548 #undef MPP_TYPE_
549 #define MPP_TYPE_ real(r4_kind)
550 #undef MPP_TYPE_BYTELEN_
551 #define MPP_TYPE_BYTELEN_ 4
552 #undef MPI_TYPE_
553 #define MPI_TYPE_ MPI_REAL4
554 #include <mpp_transmit_mpi.fh>
555 
556 #ifdef OVERLOAD_C4
557 #undef MPP_TRANSMIT_
558 #define MPP_TRANSMIT_ mpp_transmit_cmplx4
559 #undef MPP_TRANSMIT_SCALAR_
560 #define MPP_TRANSMIT_SCALAR_ mpp_transmit_cmplx4_scalar
561 #undef MPP_TRANSMIT_2D_
562 #define MPP_TRANSMIT_2D_ mpp_transmit_cmplx4_2d
563 #undef MPP_TRANSMIT_3D_
564 #define MPP_TRANSMIT_3D_ mpp_transmit_cmplx4_3d
565 #undef MPP_TRANSMIT_4D_
566 #define MPP_TRANSMIT_4D_ mpp_transmit_cmplx4_4d
567 #undef MPP_TRANSMIT_5D_
568 #define MPP_TRANSMIT_5D_ mpp_transmit_cmplx4_5d
569 #undef MPP_RECV_
570 #define MPP_RECV_ mpp_recv_cmplx4
571 #undef MPP_RECV_SCALAR_
572 #define MPP_RECV_SCALAR_ mpp_recv_cmplx4_scalar
573 #undef MPP_RECV_2D_
574 #define MPP_RECV_2D_ mpp_recv_cmplx4_2d
575 #undef MPP_RECV_3D_
576 #define MPP_RECV_3D_ mpp_recv_cmplx4_3d
577 #undef MPP_RECV_4D_
578 #define MPP_RECV_4D_ mpp_recv_cmplx4_4d
579 #undef MPP_RECV_5D_
580 #define MPP_RECV_5D_ mpp_recv_cmplx4_5d
581 #undef MPP_SEND_
582 #define MPP_SEND_ mpp_send_cmplx4
583 #undef MPP_SEND_SCALAR_
584 #define MPP_SEND_SCALAR_ mpp_send_cmplx4_scalar
585 #undef MPP_SEND_2D_
586 #define MPP_SEND_2D_ mpp_send_cmplx4_2d
587 #undef MPP_SEND_3D_
588 #define MPP_SEND_3D_ mpp_send_cmplx4_3d
589 #undef MPP_SEND_4D_
590 #define MPP_SEND_4D_ mpp_send_cmplx4_4d
591 #undef MPP_SEND_5D_
592 #define MPP_SEND_5D_ mpp_send_cmplx4_5d
593 #undef MPP_BROADCAST_
594 #define MPP_BROADCAST_ mpp_broadcast_cmplx4
595 #undef MPP_BROADCAST_SCALAR_
596 #define MPP_BROADCAST_SCALAR_ mpp_broadcast_cmplx4_scalar
597 #undef MPP_BROADCAST_2D_
598 #define MPP_BROADCAST_2D_ mpp_broadcast_cmplx4_2d
599 #undef MPP_BROADCAST_3D_
600 #define MPP_BROADCAST_3D_ mpp_broadcast_cmplx4_3d
601 #undef MPP_BROADCAST_4D_
602 #define MPP_BROADCAST_4D_ mpp_broadcast_cmplx4_4d
603 #undef MPP_BROADCAST_5D_
604 #define MPP_BROADCAST_5D_ mpp_broadcast_cmplx4_5d
605 #undef MPP_SCATTERV_
606 #define MPP_SCATTERV_ mpp_scatterv_cmplx4
607 #undef MPP_GATHER_
608 #define MPP_GATHER_ mpp_gather_cmplx4
609 #undef MPP_GATHERV_
610 #define MPP_GATHERV_ mpp_gatherv_cmplx4
611 #undef MPP_TYPE_
612 #define MPP_TYPE_ complex(c4_kind)
613 #undef MPP_TYPE_BYTELEN_
614 #define MPP_TYPE_BYTELEN_ 8
615 #undef MPI_TYPE_
616 #define MPI_TYPE_ MPI_COMPLEX
617 #include <mpp_transmit_mpi.fh>
618 #endif
619 
620 #undef MPP_TYPE_INIT_VALUE
621 #define MPP_TYPE_INIT_VALUE 0
622 #undef MPP_TRANSMIT_
623 #define MPP_TRANSMIT_ mpp_transmit_int8
624 #undef MPP_TRANSMIT_SCALAR_
625 #define MPP_TRANSMIT_SCALAR_ mpp_transmit_int8_scalar
626 #undef MPP_TRANSMIT_2D_
627 #define MPP_TRANSMIT_2D_ mpp_transmit_int8_2d
628 #undef MPP_TRANSMIT_3D_
629 #define MPP_TRANSMIT_3D_ mpp_transmit_int8_3d
630 #undef MPP_TRANSMIT_4D_
631 #define MPP_TRANSMIT_4D_ mpp_transmit_int8_4d
632 #undef MPP_TRANSMIT_5D_
633 #define MPP_TRANSMIT_5D_ mpp_transmit_int8_5d
634 #undef MPP_RECV_
635 #define MPP_RECV_ mpp_recv_int8
636 #undef MPP_RECV_SCALAR_
637 #define MPP_RECV_SCALAR_ mpp_recv_int8_scalar
638 #undef MPP_RECV_2D_
639 #define MPP_RECV_2D_ mpp_recv_int8_2d
640 #undef MPP_RECV_3D_
641 #define MPP_RECV_3D_ mpp_recv_int8_3d
642 #undef MPP_RECV_4D_
643 #define MPP_RECV_4D_ mpp_recv_int8_4d
644 #undef MPP_RECV_5D_
645 #define MPP_RECV_5D_ mpp_recv_int8_5d
646 #undef MPP_SEND_
647 #define MPP_SEND_ mpp_send_int8
648 #undef MPP_SEND_SCALAR_
649 #define MPP_SEND_SCALAR_ mpp_send_int8_scalar
650 #undef MPP_SEND_2D_
651 #define MPP_SEND_2D_ mpp_send_int8_2d
652 #undef MPP_SEND_3D_
653 #define MPP_SEND_3D_ mpp_send_int8_3d
654 #undef MPP_SEND_4D_
655 #define MPP_SEND_4D_ mpp_send_int8_4d
656 #undef MPP_SEND_5D_
657 #define MPP_SEND_5D_ mpp_send_int8_5d
658 #undef MPP_BROADCAST_
659 #define MPP_BROADCAST_ mpp_broadcast_int8
660 #undef MPP_BROADCAST_SCALAR_
661 #define MPP_BROADCAST_SCALAR_ mpp_broadcast_int8_scalar
662 #undef MPP_BROADCAST_2D_
663 #define MPP_BROADCAST_2D_ mpp_broadcast_int8_2d
664 #undef MPP_BROADCAST_3D_
665 #define MPP_BROADCAST_3D_ mpp_broadcast_int8_3d
666 #undef MPP_BROADCAST_4D_
667 #define MPP_BROADCAST_4D_ mpp_broadcast_int8_4d
668 #undef MPP_BROADCAST_5D_
669 #define MPP_BROADCAST_5D_ mpp_broadcast_int8_5d
670 #undef MPP_SCATTERV_
671 #define MPP_SCATTERV_ mpp_scatterv_int8
672 #undef MPP_GATHER_
673 #define MPP_GATHER_ mpp_gather_int8
674 #undef MPP_GATHERV_
675 #define MPP_GATHERV_ mpp_gatherv_int8
676 #undef MPP_TYPE_
677 #define MPP_TYPE_ integer(i8_kind)
678 #undef MPP_TYPE_BYTELEN_
679 #define MPP_TYPE_BYTELEN_ 8
680 #undef MPI_TYPE_
681 #define MPI_TYPE_ MPI_INTEGER8
682 #include <mpp_transmit_mpi.fh>
683 
684 #undef MPP_TRANSMIT_
685 #define MPP_TRANSMIT_ mpp_transmit_int4
686 #undef MPP_TRANSMIT_SCALAR_
687 #define MPP_TRANSMIT_SCALAR_ mpp_transmit_int4_scalar
688 #undef MPP_TRANSMIT_2D_
689 #define MPP_TRANSMIT_2D_ mpp_transmit_int4_2d
690 #undef MPP_TRANSMIT_3D_
691 #define MPP_TRANSMIT_3D_ mpp_transmit_int4_3d
692 #undef MPP_TRANSMIT_4D_
693 #define MPP_TRANSMIT_4D_ mpp_transmit_int4_4d
694 #undef MPP_TRANSMIT_5D_
695 #define MPP_TRANSMIT_5D_ mpp_transmit_int4_5d
696 #undef MPP_RECV_
697 #define MPP_RECV_ mpp_recv_int4
698 #undef MPP_RECV_SCALAR_
699 #define MPP_RECV_SCALAR_ mpp_recv_int4_scalar
700 #undef MPP_RECV_2D_
701 #define MPP_RECV_2D_ mpp_recv_int4_2d
702 #undef MPP_RECV_3D_
703 #define MPP_RECV_3D_ mpp_recv_int4_3d
704 #undef MPP_RECV_4D_
705 #define MPP_RECV_4D_ mpp_recv_int4_4d
706 #undef MPP_RECV_5D_
707 #define MPP_RECV_5D_ mpp_recv_int4_5d
708 #undef MPP_SEND_
709 #define MPP_SEND_ mpp_send_int4
710 #undef MPP_SEND_SCALAR_
711 #define MPP_SEND_SCALAR_ mpp_send_int4_scalar
712 #undef MPP_SEND_2D_
713 #define MPP_SEND_2D_ mpp_send_int4_2d
714 #undef MPP_SEND_3D_
715 #define MPP_SEND_3D_ mpp_send_int4_3d
716 #undef MPP_SEND_4D_
717 #define MPP_SEND_4D_ mpp_send_int4_4d
718 #undef MPP_SEND_5D_
719 #define MPP_SEND_5D_ mpp_send_int4_5d
720 #undef MPP_BROADCAST_
721 #define MPP_BROADCAST_ mpp_broadcast_int4
722 #undef MPP_BROADCAST_SCALAR_
723 #define MPP_BROADCAST_SCALAR_ mpp_broadcast_int4_scalar
724 #undef MPP_BROADCAST_2D_
725 #define MPP_BROADCAST_2D_ mpp_broadcast_int4_2d
726 #undef MPP_BROADCAST_3D_
727 #define MPP_BROADCAST_3D_ mpp_broadcast_int4_3d
728 #undef MPP_BROADCAST_4D_
729 #define MPP_BROADCAST_4D_ mpp_broadcast_int4_4d
730 #undef MPP_BROADCAST_5D_
731 #define MPP_BROADCAST_5D_ mpp_broadcast_int4_5d
732 #undef MPP_SCATTERV_
733 #define MPP_SCATTERV_ mpp_scatterv_int4
734 #undef MPP_GATHER_
735 #define MPP_GATHER_ mpp_gather_int4
736 #undef MPP_GATHERV_
737 #define MPP_GATHERV_ mpp_gatherv_int4
738 #undef MPP_TYPE_
739 #define MPP_TYPE_ integer(i4_kind)
740 #undef MPP_TYPE_BYTELEN_
741 #define MPP_TYPE_BYTELEN_ 4
742 #undef MPI_TYPE_
743 #define MPI_TYPE_ MPI_INTEGER4
744 #include <mpp_transmit_mpi.fh>
745 
746 #undef MPP_TYPE_INIT_VALUE
747 #define MPP_TYPE_INIT_VALUE .false.
748 #undef MPP_TRANSMIT_
749 #define MPP_TRANSMIT_ mpp_transmit_logical8
750 #undef MPP_TRANSMIT_SCALAR_
751 #define MPP_TRANSMIT_SCALAR_ mpp_transmit_logical8_scalar
752 #undef MPP_TRANSMIT_2D_
753 #define MPP_TRANSMIT_2D_ mpp_transmit_logical8_2d
754 #undef MPP_TRANSMIT_3D_
755 #define MPP_TRANSMIT_3D_ mpp_transmit_logical8_3d
756 #undef MPP_TRANSMIT_4D_
757 #define MPP_TRANSMIT_4D_ mpp_transmit_logical8_4d
758 #undef MPP_TRANSMIT_5D_
759 #define MPP_TRANSMIT_5D_ mpp_transmit_logical8_5d
760 #undef MPP_RECV_
761 #define MPP_RECV_ mpp_recv_logical8
762 #undef MPP_RECV_SCALAR_
763 #define MPP_RECV_SCALAR_ mpp_recv_logical8_scalar
764 #undef MPP_RECV_2D_
765 #define MPP_RECV_2D_ mpp_recv_logical8_2d
766 #undef MPP_RECV_3D_
767 #define MPP_RECV_3D_ mpp_recv_logical8_3d
768 #undef MPP_RECV_4D_
769 #define MPP_RECV_4D_ mpp_recv_logical8_4d
770 #undef MPP_RECV_5D_
771 #define MPP_RECV_5D_ mpp_recv_logical8_5d
772 #undef MPP_SEND_
773 #define MPP_SEND_ mpp_send_logical8
774 #undef MPP_SEND_SCALAR_
775 #define MPP_SEND_SCALAR_ mpp_send_logical8_scalar
776 #undef MPP_SEND_2D_
777 #define MPP_SEND_2D_ mpp_send_logical8_2d
778 #undef MPP_SEND_3D_
779 #define MPP_SEND_3D_ mpp_send_logical8_3d
780 #undef MPP_SEND_4D_
781 #define MPP_SEND_4D_ mpp_send_logical8_4d
782 #undef MPP_SEND_5D_
783 #define MPP_SEND_5D_ mpp_send_logical8_5d
784 #undef MPP_BROADCAST_
785 #define MPP_BROADCAST_ mpp_broadcast_logical8
786 #undef MPP_BROADCAST_SCALAR_
787 #define MPP_BROADCAST_SCALAR_ mpp_broadcast_logical8_scalar
788 #undef MPP_BROADCAST_2D_
789 #define MPP_BROADCAST_2D_ mpp_broadcast_logical8_2d
790 #undef MPP_BROADCAST_3D_
791 #define MPP_BROADCAST_3D_ mpp_broadcast_logical8_3d
792 #undef MPP_BROADCAST_4D_
793 #define MPP_BROADCAST_4D_ mpp_broadcast_logical8_4d
794 #undef MPP_BROADCAST_5D_
795 #define MPP_BROADCAST_5D_ mpp_broadcast_logical8_5d
796 #undef MPP_SCATTERV_
797 #define MPP_SCATTERV_ mpp_scatterv_logical8
798 #undef MPP_GATHER_
799 #define MPP_GATHER_ mpp_gather_logical8
800 #undef MPP_GATHERV_
801 #define MPP_GATHERV_ mpp_gatherv_logical8
802 #undef MPP_TYPE_
803 #define MPP_TYPE_ logical(l8_kind)
804 #undef MPP_TYPE_BYTELEN_
805 #define MPP_TYPE_BYTELEN_ 8
806 #undef MPI_TYPE_
807 #define MPI_TYPE_ MPI_INTEGER8
808 #include <mpp_transmit_mpi.fh>
809 
810 #undef MPP_TRANSMIT_
811 #define MPP_TRANSMIT_ mpp_transmit_logical4
812 #undef MPP_TRANSMIT_SCALAR_
813 #define MPP_TRANSMIT_SCALAR_ mpp_transmit_logical4_scalar
814 #undef MPP_TRANSMIT_2D_
815 #define MPP_TRANSMIT_2D_ mpp_transmit_logical4_2d
816 #undef MPP_TRANSMIT_3D_
817 #define MPP_TRANSMIT_3D_ mpp_transmit_logical4_3d
818 #undef MPP_TRANSMIT_4D_
819 #define MPP_TRANSMIT_4D_ mpp_transmit_logical4_4d
820 #undef MPP_TRANSMIT_5D_
821 #define MPP_TRANSMIT_5D_ mpp_transmit_logical4_5d
822 #undef MPP_RECV_
823 #define MPP_RECV_ mpp_recv_logical4
824 #undef MPP_RECV_SCALAR_
825 #define MPP_RECV_SCALAR_ mpp_recv_logical4_scalar
826 #undef MPP_RECV_2D_
827 #define MPP_RECV_2D_ mpp_recv_logical4_2d
828 #undef MPP_RECV_3D_
829 #define MPP_RECV_3D_ mpp_recv_logical4_3d
830 #undef MPP_RECV_4D_
831 #define MPP_RECV_4D_ mpp_recv_logical4_4d
832 #undef MPP_RECV_5D_
833 #define MPP_RECV_5D_ mpp_recv_logical4_5d
834 #undef MPP_SEND_
835 #define MPP_SEND_ mpp_send_logical4
836 #undef MPP_SEND_SCALAR_
837 #define MPP_SEND_SCALAR_ mpp_send_logical4_scalar
838 #undef MPP_SEND_2D_
839 #define MPP_SEND_2D_ mpp_send_logical4_2d
840 #undef MPP_SEND_3D_
841 #define MPP_SEND_3D_ mpp_send_logical4_3d
842 #undef MPP_SEND_4D_
843 #define MPP_SEND_4D_ mpp_send_logical4_4d
844 #undef MPP_SEND_5D_
845 #define MPP_SEND_5D_ mpp_send_logical4_5d
846 #undef MPP_BROADCAST_
847 #define MPP_BROADCAST_ mpp_broadcast_logical4
848 #undef MPP_BROADCAST_SCALAR_
849 #define MPP_BROADCAST_SCALAR_ mpp_broadcast_logical4_scalar
850 #undef MPP_BROADCAST_2D_
851 #define MPP_BROADCAST_2D_ mpp_broadcast_logical4_2d
852 #undef MPP_BROADCAST_3D_
853 #define MPP_BROADCAST_3D_ mpp_broadcast_logical4_3d
854 #undef MPP_BROADCAST_4D_
855 #define MPP_BROADCAST_4D_ mpp_broadcast_logical4_4d
856 #undef MPP_BROADCAST_5D_
857 #define MPP_BROADCAST_5D_ mpp_broadcast_logical4_5d
858 #undef MPP_SCATTERV_
859 #define MPP_SCATTERV_ mpp_scatterv_logical4
860 #undef MPP_GATHER_
861 #define MPP_GATHER_ mpp_gather_logical4
862 #undef MPP_GATHERV_
863 #define MPP_GATHERV_ mpp_gatherv_logical4
864 #undef MPP_TYPE_
865 #define MPP_TYPE_ logical(l4_kind)
866 #undef MPP_TYPE_BYTELEN_
867 #define MPP_TYPE_BYTELEN_ 4
868 #undef MPI_TYPE_
869 #define MPI_TYPE_ MPI_INTEGER4
870 #include <mpp_transmit_mpi.fh>
871 #undef MPP_TYPE_INIT_VALUE
872 
873 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
874 ! !
875 ! GLOBAL REDUCTION ROUTINES: mpp_max, mpp_sum, mpp_min !
876 ! !
877 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
878 #undef MPP_REDUCE_0D_
879 #define MPP_REDUCE_0D_ mpp_max_real8_0d
880 #undef MPP_REDUCE_1D_
881 #define MPP_REDUCE_1D_ mpp_max_real8_1d
882 #undef MPP_TYPE_
883 #define MPP_TYPE_ real(r8_kind)
884 #undef MPP_TYPE_BYTELEN_
885 #define MPP_TYPE_BYTELEN_ 8
886 #undef MPI_TYPE_
887 #define MPI_TYPE_ MPI_REAL8
888 #undef MPI_REDUCE_
889 #define MPI_REDUCE_ MPI_MAX
890 #include <mpp_reduce_mpi.fh>
891 
892 #undef MPP_REDUCE_0D_
893 #define MPP_REDUCE_0D_ mpp_max_real4_0d
894 #undef MPP_REDUCE_1D_
895 #define MPP_REDUCE_1D_ mpp_max_real4_1d
896 #undef MPP_TYPE_
897 #define MPP_TYPE_ real(r4_kind)
898 #undef MPP_TYPE_BYTELEN_
899 #define MPP_TYPE_BYTELEN_ 4
900 #undef MPI_TYPE_
901 #define MPI_TYPE_ MPI_REAL4
902 #undef MPI_REDUCE_
903 #define MPI_REDUCE_ MPI_MAX
904 #include <mpp_reduce_mpi.fh>
905 
906 #undef MPP_REDUCE_0D_
907 #define MPP_REDUCE_0D_ mpp_max_int8_0d
908 #undef MPP_REDUCE_1D_
909 #define MPP_REDUCE_1D_ mpp_max_int8_1d
910 #undef MPP_TYPE_
911 #define MPP_TYPE_ integer(i8_kind)
912 #undef MPP_TYPE_BYTELEN_
913 #define MPP_TYPE_BYTELEN_ 8
914 #undef MPI_TYPE_
915 #define MPI_TYPE_ MPI_INTEGER8
916 #undef MPI_REDUCE_
917 #define MPI_REDUCE_ MPI_MAX
918 #include <mpp_reduce_mpi.fh>
919 
920 #undef MPP_REDUCE_0D_
921 #define MPP_REDUCE_0D_ mpp_max_int4_0d
922 #undef MPP_REDUCE_1D_
923 #define MPP_REDUCE_1D_ mpp_max_int4_1d
924 #undef MPP_TYPE_
925 #define MPP_TYPE_ integer(i4_kind)
926 #undef MPP_TYPE_BYTELEN_
927 #define MPP_TYPE_BYTELEN_ 4
928 #undef MPI_TYPE_
929 #define MPI_TYPE_ MPI_INTEGER4
930 #undef MPI_REDUCE_
931 #define MPI_REDUCE_ MPI_MAX
932 #include <mpp_reduce_mpi.fh>
933 
934 #undef MPP_REDUCE_0D_
935 #define MPP_REDUCE_0D_ mpp_min_real8_0d
936 #undef MPP_REDUCE_1D_
937 #define MPP_REDUCE_1D_ mpp_min_real8_1d
938 #undef MPP_TYPE_
939 #define MPP_TYPE_ real(r8_kind)
940 #undef MPP_TYPE_BYTELEN_
941 #define MPP_TYPE_BYTELEN_ 8
942 #undef MPI_TYPE_
943 #define MPI_TYPE_ MPI_REAL8
944 #undef MPI_REDUCE_
945 #define MPI_REDUCE_ MPI_MIN
946 #include <mpp_reduce_mpi.fh>
947 
948 #undef MPP_REDUCE_0D_
949 #define MPP_REDUCE_0D_ mpp_min_real4_0d
950 #undef MPP_REDUCE_1D_
951 #define MPP_REDUCE_1D_ mpp_min_real4_1d
952 #undef MPP_TYPE_
953 #define MPP_TYPE_ real(r4_kind)
954 #undef MPP_TYPE_BYTELEN_
955 #define MPP_TYPE_BYTELEN_ 4
956 #undef MPI_TYPE_
957 #define MPI_TYPE_ MPI_REAL4
958 #undef MPI_REDUCE_
959 #define MPI_REDUCE_ MPI_MIN
960 #include <mpp_reduce_mpi.fh>
961 
962 #undef MPP_REDUCE_0D_
963 #define MPP_REDUCE_0D_ mpp_min_int8_0d
964 #undef MPP_REDUCE_1D_
965 #define MPP_REDUCE_1D_ mpp_min_int8_1d
966 #undef MPP_TYPE_
967 #define MPP_TYPE_ integer(i8_kind)
968 #undef MPP_TYPE_BYTELEN_
969 #define MPP_TYPE_BYTELEN_ 8
970 #undef MPI_TYPE_
971 #define MPI_TYPE_ MPI_INTEGER8
972 #undef MPI_REDUCE_
973 #define MPI_REDUCE_ MPI_MIN
974 #include <mpp_reduce_mpi.fh>
975 
976 #undef MPP_REDUCE_0D_
977 #define MPP_REDUCE_0D_ mpp_min_int4_0d
978 #undef MPP_REDUCE_1D_
979 #define MPP_REDUCE_1D_ mpp_min_int4_1d
980 #undef MPP_TYPE_
981 #define MPP_TYPE_ integer(i4_kind)
982 #undef MPP_TYPE_BYTELEN_
983 #define MPP_TYPE_BYTELEN_ 4
984 #undef MPI_TYPE_
985 #define MPI_TYPE_ MPI_INTEGER4
986 #undef MPI_REDUCE_
987 #define MPI_REDUCE_ MPI_MIN
988 #include <mpp_reduce_mpi.fh>
989 
990 #undef MPP_SUM_
991 #define MPP_SUM_ mpp_sum_real8
992 #undef MPP_SUM_SCALAR_
993 #define MPP_SUM_SCALAR_ mpp_sum_real8_scalar
994 #undef MPP_SUM_2D_
995 #define MPP_SUM_2D_ mpp_sum_real8_2d
996 #undef MPP_SUM_3D_
997 #define MPP_SUM_3D_ mpp_sum_real8_3d
998 #undef MPP_SUM_4D_
999 #define MPP_SUM_4D_ mpp_sum_real8_4d
1000 #undef MPP_SUM_5D_
1001 #define MPP_SUM_5D_ mpp_sum_real8_5d
1002 #undef MPP_TYPE_
1003 #define MPP_TYPE_ real(r8_kind)
1004 #undef MPI_TYPE_
1005 #define MPI_TYPE_ MPI_REAL8
1006 #undef MPP_TYPE_BYTELEN_
1007 #define MPP_TYPE_BYTELEN_ 8
1008 #include <mpp_sum_mpi.fh>
1009 
1010 #ifdef OVERLOAD_C8
1011 #undef MPP_SUM_
1012 #define MPP_SUM_ mpp_sum_cmplx8
1013 #undef MPP_SUM_SCALAR_
1014 #define MPP_SUM_SCALAR_ mpp_sum_cmplx8_scalar
1015 #undef MPP_SUM_2D_
1016 #define MPP_SUM_2D_ mpp_sum_cmplx8_2d
1017 #undef MPP_SUM_3D_
1018 #define MPP_SUM_3D_ mpp_sum_cmplx8_3d
1019 #undef MPP_SUM_4D_
1020 #define MPP_SUM_4D_ mpp_sum_cmplx8_4d
1021 #undef MPP_SUM_5D_
1022 #define MPP_SUM_5D_ mpp_sum_cmplx8_5d
1023 #undef MPP_TYPE_
1024 #define MPP_TYPE_ complex(c8_kind)
1025 #undef MPI_TYPE_
1026 #define MPI_TYPE_ MPI_DOUBLE_COMPLEX
1027 #undef MPP_TYPE_BYTELEN_
1028 #define MPP_TYPE_BYTELEN_ 16
1029 #include <mpp_sum_mpi.fh>
1030 #endif
1031 
1032 #undef MPP_SUM_
1033 #define MPP_SUM_ mpp_sum_real4
1034 #undef MPP_SUM_SCALAR_
1035 #define MPP_SUM_SCALAR_ mpp_sum_real4_scalar
1036 #undef MPP_SUM_2D_
1037 #define MPP_SUM_2D_ mpp_sum_real4_2d
1038 #undef MPP_SUM_3D_
1039 #define MPP_SUM_3D_ mpp_sum_real4_3d
1040 #undef MPP_SUM_4D_
1041 #define MPP_SUM_4D_ mpp_sum_real4_4d
1042 #undef MPP_SUM_5D_
1043 #define MPP_SUM_5D_ mpp_sum_real4_5d
1044 #undef MPP_TYPE_
1045 #define MPP_TYPE_ real(r4_kind)
1046 #undef MPI_TYPE_
1047 #define MPI_TYPE_ MPI_REAL4
1048 #undef MPP_TYPE_BYTELEN_
1049 #define MPP_TYPE_BYTELEN_ 4
1050 #include <mpp_sum_mpi.fh>
1051 
1052 #ifdef OVERLOAD_C4
1053 #undef MPP_SUM_
1054 #define MPP_SUM_ mpp_sum_cmplx4
1055 #undef MPP_SUM_SCALAR_
1056 #define MPP_SUM_SCALAR_ mpp_sum_cmplx4_scalar
1057 #undef MPP_SUM_2D_
1058 #define MPP_SUM_2D_ mpp_sum_cmplx4_2d
1059 #undef MPP_SUM_3D_
1060 #define MPP_SUM_3D_ mpp_sum_cmplx4_3d
1061 #undef MPP_SUM_4D_
1062 #define MPP_SUM_4D_ mpp_sum_cmplx4_4d
1063 #undef MPP_SUM_5D_
1064 #define MPP_SUM_5D_ mpp_sum_cmplx4_5d
1065 #undef MPP_TYPE_
1066 #define MPP_TYPE_ complex(c4_kind)
1067 #undef MPI_TYPE_
1068 #define MPI_TYPE_ MPI_COMPLEX
1069 #undef MPP_TYPE_BYTELEN_
1070 #define MPP_TYPE_BYTELEN_ 8
1071 #include <mpp_sum_mpi.fh>
1072 #endif
1073 
1074 #undef MPP_SUM_
1075 #define MPP_SUM_ mpp_sum_int8
1076 #undef MPP_SUM_SCALAR_
1077 #define MPP_SUM_SCALAR_ mpp_sum_int8_scalar
1078 #undef MPP_SUM_2D_
1079 #define MPP_SUM_2D_ mpp_sum_int8_2d
1080 #undef MPP_SUM_3D_
1081 #define MPP_SUM_3D_ mpp_sum_int8_3d
1082 #undef MPP_SUM_4D_
1083 #define MPP_SUM_4D_ mpp_sum_int8_4d
1084 #undef MPP_SUM_5D_
1085 #define MPP_SUM_5D_ mpp_sum_int8_5d
1086 #undef MPP_TYPE_
1087 #define MPP_TYPE_ integer(i8_kind)
1088 #undef MPI_TYPE_
1089 #define MPI_TYPE_ MPI_INTEGER8
1090 #undef MPP_TYPE_BYTELEN_
1091 #define MPP_TYPE_BYTELEN_ 8
1092 #include <mpp_sum_mpi.fh>
1093 
1094 #undef MPP_SUM_
1095 #define MPP_SUM_ mpp_sum_int4
1096 #undef MPP_SUM_SCALAR_
1097 #define MPP_SUM_SCALAR_ mpp_sum_int4_scalar
1098 #undef MPP_SUM_2D_
1099 #define MPP_SUM_2D_ mpp_sum_int4_2d
1100 #undef MPP_SUM_3D_
1101 #define MPP_SUM_3D_ mpp_sum_int4_3d
1102 #undef MPP_SUM_4D_
1103 #define MPP_SUM_4D_ mpp_sum_int4_4d
1104 #undef MPP_SUM_5D_
1105 #define MPP_SUM_5D_ mpp_sum_int4_5d
1106 #undef MPP_TYPE_
1107 #define MPP_TYPE_ integer(i4_kind)
1108 #undef MPI_TYPE_
1109 #define MPI_TYPE_ MPI_INTEGER4
1110 #undef MPP_TYPE_BYTELEN_
1111 #define MPP_TYPE_BYTELEN_ 4
1112 #include <mpp_sum_mpi.fh>
1113 !--------------------------------
1114 #undef MPP_SUM_AD_
1115 #define MPP_SUM_AD_ mpp_sum_real8_ad
1116 #undef MPP_SUM_SCALAR_AD_
1117 #define MPP_SUM_SCALAR_AD_ mpp_sum_real8_scalar_ad
1118 #undef MPP_SUM_2D_AD_
1119 #define MPP_SUM_2D_AD_ mpp_sum_real8_2d_ad
1120 #undef MPP_SUM_3D_AD_
1121 #define MPP_SUM_3D_AD_ mpp_sum_real8_3d_ad
1122 #undef MPP_SUM_4D_AD_
1123 #define MPP_SUM_4D_AD_ mpp_sum_real8_4d_ad
1124 #undef MPP_SUM_5D_AD_
1125 #define MPP_SUM_5D_AD_ mpp_sum_real8_5d_ad
1126 #undef MPP_TYPE_
1127 #define MPP_TYPE_ real(r8_kind)
1128 #undef MPI_TYPE_
1129 #define MPI_TYPE_ MPI_REAL8
1130 #undef MPP_TYPE_BYTELEN_
1131 #define MPP_TYPE_BYTELEN_ 8
1132 #include <mpp_sum_mpi_ad.fh>
1133 
1134 #ifdef OVERLOAD_C8
1135 #undef MPP_SUM_AD_
1136 #define MPP_SUM_AD_ mpp_sum_cmplx8_ad
1137 #undef MPP_SUM_SCALAR_AD_
1138 #define MPP_SUM_SCALAR_AD_ mpp_sum_cmplx8_scalar_ad
1139 #undef MPP_SUM_2D_AD_
1140 #define MPP_SUM_2D_AD_ mpp_sum_cmplx8_2d_ad
1141 #undef MPP_SUM_3D_AD_
1142 #define MPP_SUM_3D_AD_ mpp_sum_cmplx8_3d_ad
1143 #undef MPP_SUM_4D_AD_
1144 #define MPP_SUM_4D_AD_ mpp_sum_cmplx8_4d_ad
1145 #undef MPP_SUM_5D_AD_
1146 #define MPP_SUM_5D_AD_ mpp_sum_cmplx8_5d_ad
1147 #undef MPP_TYPE_
1148 #define MPP_TYPE_ complex(c8_kind)
1149 #undef MPI_TYPE_
1150 #define MPI_TYPE_ MPI_DOUBLE_COMPLEX
1151 #undef MPP_TYPE_BYTELEN_
1152 #define MPP_TYPE_BYTELEN_ 16
1153 #include <mpp_sum_mpi_ad.fh>
1154 #endif
1155 
1156 #undef MPP_SUM_AD_
1157 #define MPP_SUM_AD_ mpp_sum_real4_ad
1158 #undef MPP_SUM_SCALAR_AD_
1159 #define MPP_SUM_SCALAR_AD_ mpp_sum_real4_scalar_ad
1160 #undef MPP_SUM_2D_AD_
1161 #define MPP_SUM_2D_AD_ mpp_sum_real4_2d_ad
1162 #undef MPP_SUM_3D_AD_
1163 #define MPP_SUM_3D_AD_ mpp_sum_real4_3d_ad
1164 #undef MPP_SUM_4D_AD_
1165 #define MPP_SUM_4D_AD_ mpp_sum_real4_4d_ad
1166 #undef MPP_SUM_5D_AD_
1167 #define MPP_SUM_5D_AD_ mpp_sum_real4_5d_ad
1168 #undef MPP_TYPE_
1169 #define MPP_TYPE_ real(r4_kind)
1170 #undef MPI_TYPE_
1171 #define MPI_TYPE_ MPI_REAL4
1172 #undef MPP_TYPE_BYTELEN_
1173 #define MPP_TYPE_BYTELEN_ 4
1174 #include <mpp_sum_mpi_ad.fh>
1175 
1176 #ifdef OVERLOAD_C4
1177 #undef MPP_SUM_AD_
1178 #define MPP_SUM_AD_ mpp_sum_cmplx4_ad
1179 #undef MPP_SUM_SCALAR_AD_
1180 #define MPP_SUM_SCALAR_AD_ mpp_sum_cmplx4_scalar_ad
1181 #undef MPP_SUM_2D_AD_
1182 #define MPP_SUM_2D_AD_ mpp_sum_cmplx4_2d_ad
1183 #undef MPP_SUM_3D_AD_
1184 #define MPP_SUM_3D_AD_ mpp_sum_cmplx4_3d_ad
1185 #undef MPP_SUM_4D_AD_
1186 #define MPP_SUM_4D_AD_ mpp_sum_cmplx4_4d_ad
1187 #undef MPP_SUM_5D_AD_
1188 #define MPP_SUM_5D_AD_ mpp_sum_cmplx4_5d_ad
1189 #undef MPP_TYPE_
1190 #define MPP_TYPE_ complex(c4_kind)
1191 #undef MPI_TYPE_
1192 #define MPI_TYPE_ MPI_COMPLEX
1193 #undef MPP_TYPE_BYTELEN_
1194 #define MPP_TYPE_BYTELEN_ 8
1195 #include <mpp_sum_mpi_ad.fh>
1196 #endif
1197 
1198 #undef MPP_SUM_AD_
1199 #define MPP_SUM_AD_ mpp_sum_int8_ad
1200 #undef MPP_SUM_SCALAR_AD_
1201 #define MPP_SUM_SCALAR_AD_ mpp_sum_int8_scalar_ad
1202 #undef MPP_SUM_2D_AD_
1203 #define MPP_SUM_2D_AD_ mpp_sum_int8_2d_ad
1204 #undef MPP_SUM_3D_AD_
1205 #define MPP_SUM_3D_AD_ mpp_sum_int8_3d_ad
1206 #undef MPP_SUM_4D_AD_
1207 #define MPP_SUM_4D_AD_ mpp_sum_int8_4d_ad
1208 #undef MPP_SUM_5D_AD_
1209 #define MPP_SUM_5D_AD_ mpp_sum_int8_5d_ad
1210 #undef MPP_TYPE_
1211 #define MPP_TYPE_ integer(i8_kind)
1212 #undef MPI_TYPE_
1213 #define MPI_TYPE_ MPI_INTEGER8
1214 #undef MPP_TYPE_BYTELEN_
1215 #define MPP_TYPE_BYTELEN_ 8
1216 #include <mpp_sum_mpi_ad.fh>
1217 
1218 #undef MPP_SUM_AD_
1219 #define MPP_SUM_AD_ mpp_sum_int4_ad
1220 #undef MPP_SUM_SCALAR_AD_
1221 #define MPP_SUM_SCALAR_AD_ mpp_sum_int4_scalar_ad
1222 #undef MPP_SUM_2D_AD_
1223 #define MPP_SUM_2D_AD_ mpp_sum_int4_2d_ad
1224 #undef MPP_SUM_3D_AD_
1225 #define MPP_SUM_3D_AD_ mpp_sum_int4_3d_ad
1226 #undef MPP_SUM_4D_AD_
1227 #define MPP_SUM_4D_AD_ mpp_sum_int4_4d_ad
1228 #undef MPP_SUM_5D_AD_
1229 #define MPP_SUM_5D_AD_ mpp_sum_int4_5d_ad
1230 #undef MPP_TYPE_
1231 #define MPP_TYPE_ integer(i4_kind)
1232 #undef MPI_TYPE_
1233 #define MPI_TYPE_ MPI_INTEGER4
1234 #undef MPP_TYPE_BYTELEN_
1235 #define MPP_TYPE_BYTELEN_ 4
1236 #include <mpp_sum_mpi_ad.fh>
1237 
1238 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1239 ! !
1240 ! SCATTER AND GATHER ROUTINES: mpp_alltoall !
1241 ! !
1242 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1243 
1244 #undef MPP_ALLTOALL_
1245 #undef MPP_ALLTOALLV_
1246 #undef MPP_ALLTOALLW_
1247 #undef MPP_TYPE_
1248 #undef MPP_TYPE_BYTELEN_
1249 #undef MPI_TYPE_
1250 #define MPP_ALLTOALL_ mpp_alltoall_int4
1251 #define MPP_ALLTOALLV_ mpp_alltoall_int4_v
1252 #define MPP_ALLTOALLW_ mpp_alltoall_int4_w
1253 #define MPP_TYPE_ integer(i4_kind)
1254 #define MPP_TYPE_BYTELEN_ 4
1255 #define MPI_TYPE_ MPI_INTEGER4
1256 #include <mpp_alltoall_mpi.fh>
1257 
1258 #undef MPP_ALLTOALL_
1259 #undef MPP_ALLTOALLV_
1260 #undef MPP_ALLTOALLW_
1261 #undef MPP_TYPE_
1262 #undef MPP_TYPE_BYTELEN_
1263 #undef MPI_TYPE_
1264 #define MPP_ALLTOALL_ mpp_alltoall_int8
1265 #define MPP_ALLTOALLV_ mpp_alltoall_int8_v
1266 #define MPP_ALLTOALLW_ mpp_alltoall_int8_w
1267 #define MPP_TYPE_ integer(i8_kind)
1268 #define MPP_TYPE_BYTELEN_ 8
1269 #define MPI_TYPE_ MPI_INTEGER8
1270 #include <mpp_alltoall_mpi.fh>
1271 
1272 #undef MPP_ALLTOALL_
1273 #undef MPP_ALLTOALLV_
1274 #undef MPP_ALLTOALLW_
1275 #undef MPP_TYPE_
1276 #undef MPP_TYPE_BYTELEN_
1277 #undef MPI_TYPE_
1278 #define MPP_ALLTOALL_ mpp_alltoall_real4
1279 #define MPP_ALLTOALLV_ mpp_alltoall_real4_v
1280 #define MPP_ALLTOALLW_ mpp_alltoall_real4_w
1281 #define MPP_TYPE_ real(r4_kind)
1282 #define MPP_TYPE_BYTELEN_ 4
1283 #define MPI_TYPE_ MPI_REAL4
1284 #include <mpp_alltoall_mpi.fh>
1285 
1286 #undef MPP_ALLTOALL_
1287 #undef MPP_ALLTOALLV_
1288 #undef MPP_ALLTOALLW_
1289 #undef MPP_TYPE_
1290 #undef MPP_TYPE_BYTELEN_
1291 #undef MPI_TYPE_
1292 #define MPP_ALLTOALL_ mpp_alltoall_real8
1293 #define MPP_ALLTOALLV_ mpp_alltoall_real8_v
1294 #define MPP_ALLTOALLW_ mpp_alltoall_real8_w
1295 #define MPP_TYPE_ real(r8_kind)
1296 #define MPP_TYPE_BYTELEN_ 8
1297 #define MPI_TYPE_ MPI_REAL8
1298 #include <mpp_alltoall_mpi.fh>
1299 
1300 #ifdef OVERLOAD_C4
1301 #undef MPP_ALLTOALL_
1302 #undef MPP_ALLTOALLV_
1303 #undef MPP_ALLTOALLW_
1304 #undef MPP_TYPE_
1305 #undef MPP_TYPE_BYTELEN_
1306 #undef MPI_TYPE_
1307 #define MPP_ALLTOALL_ mpp_alltoall_cmplx4
1308 #define MPP_ALLTOALLV_ mpp_alltoall_cmplx4_v
1309 #define MPP_ALLTOALLW_ mpp_alltoall_cmplx4_w
1310 #define MPP_TYPE_ complex(c4_kind)
1311 #define MPP_TYPE_BYTELEN_ 8
1312 #define MPI_TYPE_ MPI_COMPLEX8
1313 #include <mpp_alltoall_mpi.fh>
1314 #endif
1315 
1316 #ifdef OVERLOAD_C8
1317 #undef MPP_ALLTOALL_
1318 #undef MPP_ALLTOALLV_
1319 #undef MPP_ALLTOALLW_
1320 #undef MPP_TYPE_
1321 #undef MPP_TYPE_BYTELEN_
1322 #undef MPI_TYPE_
1323 #define MPP_ALLTOALL_ mpp_alltoall_cmplx8
1324 #define MPP_ALLTOALLV_ mpp_alltoall_cmplx8_v
1325 #define MPP_ALLTOALLW_ mpp_alltoall_cmplx8_w
1326 #define MPP_TYPE_ complex(c8_kind)
1327 #define MPP_TYPE_BYTELEN_ 16
1328 #define MPI_TYPE_ MPI_COMPLEX16
1329 #include <mpp_alltoall_mpi.fh>
1330 #endif
1331 
1332 #undef MPP_ALLTOALL_
1333 #undef MPP_ALLTOALLV_
1334 #undef MPP_ALLTOALLW_
1335 #undef MPP_TYPE_
1336 #undef MPP_TYPE_BYTELEN_
1337 #undef MPI_TYPE_
1338 #define MPP_ALLTOALL_ mpp_alltoall_logical4
1339 #define MPP_ALLTOALLV_ mpp_alltoall_logical4_v
1340 #define MPP_ALLTOALLW_ mpp_alltoall_logical4_w
1341 #define MPP_TYPE_ logical(l4_kind)
1342 #define MPP_TYPE_BYTELEN_ 4
1343 #define MPI_TYPE_ MPI_INTEGER4
1344 #include <mpp_alltoall_mpi.fh>
1345 
1346 #undef MPP_ALLTOALL_
1347 #undef MPP_ALLTOALLV_
1348 #undef MPP_ALLTOALLW_
1349 #undef MPP_TYPE_
1350 #undef MPP_TYPE_BYTELEN_
1351 #undef MPI_TYPE_
1352 #define MPP_ALLTOALL_ mpp_alltoall_logical8
1353 #define MPP_ALLTOALLV_ mpp_alltoall_logical8_v
1354 #define MPP_ALLTOALLW_ mpp_alltoall_logical8_w
1355 #define MPP_TYPE_ logical(l8_kind)
1356 #define MPP_TYPE_BYTELEN_ 8
1357 #define MPI_TYPE_ MPI_INTEGER8
1358 #include <mpp_alltoall_mpi.fh>
1359 
1360 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1361 ! !
1362 ! DATA TRANSFER TYPES: mpp_type_create, mpp_type_free !
1363 ! !
1364 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1365 
1366 #undef MPP_TYPE_CREATE_
1367 #undef MPP_TYPE_
1368 #undef MPI_TYPE_
1369 #define MPP_TYPE_CREATE_ mpp_type_create_int4
1370 #define MPP_TYPE_ integer(i4_kind)
1371 #define MPI_TYPE_ MPI_INTEGER4
1372 #include <mpp_type_mpi.fh>
1373 
1374 #undef MPP_TYPE_CREATE_
1375 #undef MPP_TYPE_
1376 #undef MPI_TYPE_
1377 #define MPP_TYPE_CREATE_ mpp_type_create_int8
1378 #define MPP_TYPE_ integer(i8_kind)
1379 #define MPI_TYPE_ MPI_INTEGER8
1380 #include <mpp_type_mpi.fh>
1381 
1382 #undef MPP_TYPE_CREATE_
1383 #undef MPP_TYPE_
1384 #undef MPI_TYPE_
1385 #define MPP_TYPE_CREATE_ mpp_type_create_real4
1386 #define MPP_TYPE_ real(r4_kind)
1387 #define MPI_TYPE_ MPI_REAL4
1388 #include <mpp_type_mpi.fh>
1389 
1390 #undef MPP_TYPE_CREATE_
1391 #undef MPP_TYPE_
1392 #undef MPI_TYPE_
1393 #define MPP_TYPE_CREATE_ mpp_type_create_real8
1394 #define MPP_TYPE_ real(r8_kind)
1395 #define MPI_TYPE_ MPI_REAL8
1396 #include <mpp_type_mpi.fh>
1397 
1398 #undef MPP_TYPE_CREATE_
1399 #undef MPP_TYPE_
1400 #undef MPI_TYPE_
1401 #define MPP_TYPE_CREATE_ mpp_type_create_cmplx4
1402 #define MPP_TYPE_ complex(c4_kind)
1403 #define MPI_TYPE_ MPI_COMPLEX8
1404 #include <mpp_type_mpi.fh>
1405 
1406 #undef MPP_TYPE_CREATE_
1407 #undef MPP_TYPE_
1408 #undef MPI_TYPE_
1409 #define MPP_TYPE_CREATE_ mpp_type_create_cmplx8
1410 #define MPP_TYPE_ complex(c8_kind)
1411 #define MPI_TYPE_ MPI_COMPLEX16
1412 #include <mpp_type_mpi.fh>
1413 
1414 #undef MPP_TYPE_CREATE_
1415 #undef MPP_TYPE_
1416 #undef MPI_TYPE_
1417 #define MPP_TYPE_CREATE_ mpp_type_create_logical4
1418 #define MPP_TYPE_ logical(l4_kind)
1419 #define MPI_TYPE_ MPI_INTEGER4
1420 #include <mpp_type_mpi.fh>
1421 
1422 #undef MPP_TYPE_CREATE_
1423 #undef MPP_TYPE_
1424 #undef MPI_TYPE_
1425 #define MPP_TYPE_CREATE_ mpp_type_create_logical8
1426 #define MPP_TYPE_ logical(l8_kind)
1427 #define MPI_TYPE_ MPI_INTEGER8
1428 #include <mpp_type_mpi.fh>
1429 
1430 ! Clear preprocessor flags
1431 #undef MPI_TYPE_
1432 #undef MPP_TYPE_
1433 #undef MPP_TYPE_CREATE_
1434 
1435 !> Deallocates memory for mpp_type objects
1436 !! @TODO This should probably not take a pointer, but for now we do this.
1437 subroutine mpp_type_free(dtype)
1438  type(mpp_type), pointer, intent(inout) :: dtype
1439 
1440  if (.NOT. module_is_initialized) &
1441  call mpp_error(fatal, 'MPP_TYPE_FREE: You must first call mpp_init.')
1442 
1443  if (current_clock .NE. 0) &
1444  call system_clock(start_tick)
1445 
1446  if (verbose) &
1447  call mpp_error(note, 'MPP_TYPE_FREE: using MPI_Type_free...')
1448 
1449  ! Decrement the reference counter
1450  dtype%counter = dtype%counter - 1
1451 
1452  if (dtype%counter < 1) then
1453  ! Remove from list
1454  dtype%prev => dtype%next
1455  datatypes%length = datatypes%length - 1
1456 
1457  ! Free resources
1458  deallocate(dtype%sizes)
1459  deallocate(dtype%subsizes)
1460  deallocate(dtype%starts)
1461 
1462  ! User-defined datatype cleanup
1463  if (dtype%id /= mpi_byte) then
1464  call mpi_type_free(dtype%id, error)
1465  deallocate(dtype)
1466  endif
1467  end if
1468 
1469  if (current_clock .NE. 0) &
1470  call increment_current_clock(event_type_free, mpp_type_bytelen_)
1471 
1472 end subroutine mpp_type_free
1473 !> @}
integer function stdout()
This function returns the current standard fortran unit numbers for output.
Definition: mpp_util.inc:42
subroutine mpp_init_warninglog()
Opens the warning log file, called during mpp_init.
Definition: mpp_util.inc:124
subroutine mpp_set_current_pelist(pelist, no_sync)
Set context pelist.
Definition: mpp_util.inc:498
subroutine mpp_init(flags, localcomm, test_level, alt_input_nml_path)
Initialize the mpp_mod module. Must be called before any usage.
integer function stderr()
This function returns the current standard fortran unit numbers for error messages.
Definition: mpp_util.inc:50
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:1227
subroutine mpp_type_free(dtype)
Deallocates memory for mpp_type objects @TODO This should probably not take a pointer,...
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:58
integer function mpp_npes()
Returns processor count for current pelist.
Definition: mpp_util.inc:420
subroutine mpp_set_stack_size(n)
Set the mpp_stack variable to be at least n LONG words long.
integer function mpp_pe()
Returns processor ID.
Definition: mpp_util.inc:406
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:713
subroutine mpp_broadcast_char(char_data, length, from_pe, pelist)
Broadcasts a character string from the given pe to it's pelist.