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