32 subroutine mpp_init( flags, localcomm, test_level, alt_input_nml_path )
33 integer,
optional,
intent(in) :: flags
34 integer,
optional,
intent(in) :: localcomm
35 integer,
optional,
intent(in) :: test_level
37 character(len=*),
optional,
intent(in) :: alt_input_nml_path
39 logical :: opened, existed
43 if( module_is_initialized )
return
45 call mpi_initialized( opened, error )
46 if(opened .and. .NOT.
PRESENT(localcomm))
call mpp_error( fatal,
'MPP_INIT: communicator is required' )
47 if( .NOT.opened )
then
49 mpp_comm_private = mpi_comm_world
51 mpp_comm_private = localcomm
53 call mpi_comm_rank( mpp_comm_private, pe, error )
54 call mpi_comm_size( mpp_comm_private, npes, error )
56 module_is_initialized = .true.
57 if (
present(test_level))
then
62 if (t_level == 0)
return
65 allocate(peset(0:current_peset_max))
70 peset(:)%log2stride = -1
74 allocate( peset(0)%list(1) )
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
81 if (t_level == 1)
return
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
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
98 mpp_byte%prev => null()
99 mpp_byte%next => null()
102 datatypes%head => mpp_byte
103 datatypes%tail => mpp_byte
106 if(
PRESENT(flags) )
then
107 debug = flags.EQ.mpp_debug
108 verbose = flags.EQ.mpp_verbose .OR. debug
110 if (t_level == 3)
return
112 call mpp_init_logfile()
114 if (
present(alt_input_nml_path))
then
119 if (t_level == 4)
return
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')
126 if (t_level == 5)
return
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.")
133 if(etc_unit_is_stderr)
then
136 if (trim(etcfile) /=
'/dev/null')
then
137 write( etcfile,
'(a,i6.6)' )trim(etcfile)//
'.', pe
139 inquire(file=etcfile, exist=existed)
141 open( newunit=etc_unit, file=trim(etcfile), status=
'REPLACE' )
143 open( newunit=etc_unit, file=trim(etcfile) )
147 if (t_level == 6)
return
150 max_request = max(max_request_min,
mpp_npes()*request_multiply)
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
161 if (t_level == 7)
return
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)
180 call mpp_clock_begin(clock0)
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
193 type(mpp_type),
pointer :: dtype, next_dtype
195 if( .NOT.module_is_initialized )
return
197 call mpp_clock_end(clock0)
198 t_total = clocks(clock0)%total_ticks*tick_rate
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
207 call flush( out_unit )
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'
217 write( log_unit,
'(/37x,a)' )
'time'
219 call flush( out_unit )
222 if( .NOT.any(peset(clocks(i)%peset_num)%list(:).EQ.pe) )cycle
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
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'
244 if( .NOT.clocks(i)%detailed )cycle
245 if( .NOT.any(peset(clocks(i)%peset_num)%list(:).EQ.pe) )cycle
248 do j = 1,max_event_types
249 n = clocks(i)%events(j)%calls; nmax = n
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() )
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
274 call flush( out_unit )
276 inquire(unit=etc_unit, opened=opened)
278 call flush (etc_unit)
283 dtype => datatypes%head
284 do while (
associated(dtype))
285 next_dtype => dtype%next
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)
302 integer,
intent(in) :: n
303 character(len=8) :: text
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) )
311 write( text,
'(i8)' )n
312 if( pe.EQ.root_pe )
call mpp_error( note,
'MPP_SET_STACK_SIZE: stack size set to '//text//
'.' )
324 character(len=*),
intent(inout) :: char_data(:)
325 integer,
intent(in) :: length
326 integer,
intent(in) :: from_pe
327 integer,
intent(in),
optional :: pelist(:)
328 integer :: n, i, from_rank
329 character :: str1D(length*size(char_data(:)))
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
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
344 if( .NOT.any(from_pe.EQ.peset(current_peset_num)%list) ) &
345 call mpp_error( fatal,
'mpp_broadcast_text: broadcasting from invalid PE.' )
347 if( debug .and. (current_clock.NE.0) )
call system_clock(start_tick)
350 if(peset(n)%list(i) == from_pe)
then
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 )
363 #define MPP_TYPE_INIT_VALUE 0.
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
378 #define MPP_RECV_ mpp_recv_real8
379 #undef MPP_RECV_SCALAR_
380 #define MPP_RECV_SCALAR_ mpp_recv_real8_scalar
382 #define MPP_RECV_2D_ mpp_recv_real8_2d
384 #define MPP_RECV_3D_ mpp_recv_real8_3d
386 #define MPP_RECV_4D_ mpp_recv_real8_4d
388 #define MPP_RECV_5D_ mpp_recv_real8_5d
390 #define MPP_SEND_ mpp_send_real8
391 #undef MPP_SEND_SCALAR_
392 #define MPP_SEND_SCALAR_ mpp_send_real8_scalar
394 #define MPP_SEND_2D_ mpp_send_real8_2d
396 #define MPP_SEND_3D_ mpp_send_real8_3d
398 #define MPP_SEND_4D_ mpp_send_real8_4d
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
414 #define MPP_SCATTERV_ mpp_scatterv_real8
416 #define MPP_GATHER_ mpp_gather_real8
418 #define MPP_GATHERV_ mpp_gatherv_real8
420 #define MPP_TYPE_ real(r8_kind)
421 #undef MPP_TYPE_BYTELEN_
422 #define MPP_TYPE_BYTELEN_ 8
424 #define MPI_TYPE_ MPI_REAL8
428 #include <mpp_transmit_mpi.fh>
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
444 #define MPP_RECV_ mpp_recv_cmplx8
445 #undef MPP_RECV_SCALAR_
446 #define MPP_RECV_SCALAR_ mpp_recv_cmplx8_scalar
448 #define MPP_RECV_2D_ mpp_recv_cmplx8_2d
450 #define MPP_RECV_3D_ mpp_recv_cmplx8_3d
452 #define MPP_RECV_4D_ mpp_recv_cmplx8_4d
454 #define MPP_RECV_5D_ mpp_recv_cmplx8_5d
456 #define MPP_SEND_ mpp_send_cmplx8
457 #undef MPP_SEND_SCALAR_
458 #define MPP_SEND_SCALAR_ mpp_send_cmplx8_scalar
460 #define MPP_SEND_2D_ mpp_send_cmplx8_2d
462 #define MPP_SEND_3D_ mpp_send_cmplx8_3d
464 #define MPP_SEND_4D_ mpp_send_cmplx8_4d
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
480 #define MPP_SCATTERV_ mpp_scatterv_complx8
482 #define MPP_GATHER_ mpp_gather_complx8
484 #define MPP_GATHERV_ mpp_gatherv_complx8
486 #define MPP_TYPE_ complex(c8_kind)
487 #undef MPP_TYPE_BYTELEN_
488 #define MPP_TYPE_BYTELEN_ 16
490 #define MPI_TYPE_ MPI_DOUBLE_COMPLEX
491 #include <mpp_transmit_mpi.fh>
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
507 #define MPP_RECV_ mpp_recv_real4
508 #undef MPP_RECV_SCALAR_
509 #define MPP_RECV_SCALAR_ mpp_recv_real4_scalar
511 #define MPP_RECV_2D_ mpp_recv_real4_2d
513 #define MPP_RECV_3D_ mpp_recv_real4_3d
515 #define MPP_RECV_4D_ mpp_recv_real4_4d
517 #define MPP_RECV_5D_ mpp_recv_real4_5d
519 #define MPP_SEND_ mpp_send_real4
520 #undef MPP_SEND_SCALAR_
521 #define MPP_SEND_SCALAR_ mpp_send_real4_scalar
523 #define MPP_SEND_2D_ mpp_send_real4_2d
525 #define MPP_SEND_3D_ mpp_send_real4_3d
527 #define MPP_SEND_4D_ mpp_send_real4_4d
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
543 #define MPP_SCATTERV_ mpp_scatterv_real4
545 #define MPP_GATHER_ mpp_gather_real4
547 #define MPP_GATHERV_ mpp_gatherv_real4
549 #define MPP_TYPE_ real(r4_kind)
550 #undef MPP_TYPE_BYTELEN_
551 #define MPP_TYPE_BYTELEN_ 4
553 #define MPI_TYPE_ MPI_REAL4
554 #include <mpp_transmit_mpi.fh>
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
570 #define MPP_RECV_ mpp_recv_cmplx4
571 #undef MPP_RECV_SCALAR_
572 #define MPP_RECV_SCALAR_ mpp_recv_cmplx4_scalar
574 #define MPP_RECV_2D_ mpp_recv_cmplx4_2d
576 #define MPP_RECV_3D_ mpp_recv_cmplx4_3d
578 #define MPP_RECV_4D_ mpp_recv_cmplx4_4d
580 #define MPP_RECV_5D_ mpp_recv_cmplx4_5d
582 #define MPP_SEND_ mpp_send_cmplx4
583 #undef MPP_SEND_SCALAR_
584 #define MPP_SEND_SCALAR_ mpp_send_cmplx4_scalar
586 #define MPP_SEND_2D_ mpp_send_cmplx4_2d
588 #define MPP_SEND_3D_ mpp_send_cmplx4_3d
590 #define MPP_SEND_4D_ mpp_send_cmplx4_4d
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
606 #define MPP_SCATTERV_ mpp_scatterv_cmplx4
608 #define MPP_GATHER_ mpp_gather_cmplx4
610 #define MPP_GATHERV_ mpp_gatherv_cmplx4
612 #define MPP_TYPE_ complex(c4_kind)
613 #undef MPP_TYPE_BYTELEN_
614 #define MPP_TYPE_BYTELEN_ 8
616 #define MPI_TYPE_ MPI_COMPLEX
617 #include <mpp_transmit_mpi.fh>
620 #undef MPP_TYPE_INIT_VALUE
621 #define MPP_TYPE_INIT_VALUE 0
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
635 #define MPP_RECV_ mpp_recv_int8
636 #undef MPP_RECV_SCALAR_
637 #define MPP_RECV_SCALAR_ mpp_recv_int8_scalar
639 #define MPP_RECV_2D_ mpp_recv_int8_2d
641 #define MPP_RECV_3D_ mpp_recv_int8_3d
643 #define MPP_RECV_4D_ mpp_recv_int8_4d
645 #define MPP_RECV_5D_ mpp_recv_int8_5d
647 #define MPP_SEND_ mpp_send_int8
648 #undef MPP_SEND_SCALAR_
649 #define MPP_SEND_SCALAR_ mpp_send_int8_scalar
651 #define MPP_SEND_2D_ mpp_send_int8_2d
653 #define MPP_SEND_3D_ mpp_send_int8_3d
655 #define MPP_SEND_4D_ mpp_send_int8_4d
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
671 #define MPP_SCATTERV_ mpp_scatterv_int8
673 #define MPP_GATHER_ mpp_gather_int8
675 #define MPP_GATHERV_ mpp_gatherv_int8
677 #define MPP_TYPE_ integer(i8_kind)
678 #undef MPP_TYPE_BYTELEN_
679 #define MPP_TYPE_BYTELEN_ 8
681 #define MPI_TYPE_ MPI_INTEGER8
682 #include <mpp_transmit_mpi.fh>
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
697 #define MPP_RECV_ mpp_recv_int4
698 #undef MPP_RECV_SCALAR_
699 #define MPP_RECV_SCALAR_ mpp_recv_int4_scalar
701 #define MPP_RECV_2D_ mpp_recv_int4_2d
703 #define MPP_RECV_3D_ mpp_recv_int4_3d
705 #define MPP_RECV_4D_ mpp_recv_int4_4d
707 #define MPP_RECV_5D_ mpp_recv_int4_5d
709 #define MPP_SEND_ mpp_send_int4
710 #undef MPP_SEND_SCALAR_
711 #define MPP_SEND_SCALAR_ mpp_send_int4_scalar
713 #define MPP_SEND_2D_ mpp_send_int4_2d
715 #define MPP_SEND_3D_ mpp_send_int4_3d
717 #define MPP_SEND_4D_ mpp_send_int4_4d
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
733 #define MPP_SCATTERV_ mpp_scatterv_int4
735 #define MPP_GATHER_ mpp_gather_int4
737 #define MPP_GATHERV_ mpp_gatherv_int4
739 #define MPP_TYPE_ integer(i4_kind)
740 #undef MPP_TYPE_BYTELEN_
741 #define MPP_TYPE_BYTELEN_ 4
743 #define MPI_TYPE_ MPI_INTEGER4
744 #include <mpp_transmit_mpi.fh>
746 #undef MPP_TYPE_INIT_VALUE
747 #define MPP_TYPE_INIT_VALUE .false.
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
761 #define MPP_RECV_ mpp_recv_logical8
762 #undef MPP_RECV_SCALAR_
763 #define MPP_RECV_SCALAR_ mpp_recv_logical8_scalar
765 #define MPP_RECV_2D_ mpp_recv_logical8_2d
767 #define MPP_RECV_3D_ mpp_recv_logical8_3d
769 #define MPP_RECV_4D_ mpp_recv_logical8_4d
771 #define MPP_RECV_5D_ mpp_recv_logical8_5d
773 #define MPP_SEND_ mpp_send_logical8
774 #undef MPP_SEND_SCALAR_
775 #define MPP_SEND_SCALAR_ mpp_send_logical8_scalar
777 #define MPP_SEND_2D_ mpp_send_logical8_2d
779 #define MPP_SEND_3D_ mpp_send_logical8_3d
781 #define MPP_SEND_4D_ mpp_send_logical8_4d
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
797 #define MPP_SCATTERV_ mpp_scatterv_logical8
799 #define MPP_GATHER_ mpp_gather_logical8
801 #define MPP_GATHERV_ mpp_gatherv_logical8
803 #define MPP_TYPE_ logical(l8_kind)
804 #undef MPP_TYPE_BYTELEN_
805 #define MPP_TYPE_BYTELEN_ 8
807 #define MPI_TYPE_ MPI_INTEGER8
808 #include <mpp_transmit_mpi.fh>
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
823 #define MPP_RECV_ mpp_recv_logical4
824 #undef MPP_RECV_SCALAR_
825 #define MPP_RECV_SCALAR_ mpp_recv_logical4_scalar
827 #define MPP_RECV_2D_ mpp_recv_logical4_2d
829 #define MPP_RECV_3D_ mpp_recv_logical4_3d
831 #define MPP_RECV_4D_ mpp_recv_logical4_4d
833 #define MPP_RECV_5D_ mpp_recv_logical4_5d
835 #define MPP_SEND_ mpp_send_logical4
836 #undef MPP_SEND_SCALAR_
837 #define MPP_SEND_SCALAR_ mpp_send_logical4_scalar
839 #define MPP_SEND_2D_ mpp_send_logical4_2d
841 #define MPP_SEND_3D_ mpp_send_logical4_3d
843 #define MPP_SEND_4D_ mpp_send_logical4_4d
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
859 #define MPP_SCATTERV_ mpp_scatterv_logical4
861 #define MPP_GATHER_ mpp_gather_logical4
863 #define MPP_GATHERV_ mpp_gatherv_logical4
865 #define MPP_TYPE_ logical(l4_kind)
866 #undef MPP_TYPE_BYTELEN_
867 #define MPP_TYPE_BYTELEN_ 4
869 #define MPI_TYPE_ MPI_INTEGER4
870 #include <mpp_transmit_mpi.fh>
871 #undef MPP_TYPE_INIT_VALUE
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
883 #define MPP_TYPE_ real(r8_kind)
884 #undef MPP_TYPE_BYTELEN_
885 #define MPP_TYPE_BYTELEN_ 8
887 #define MPI_TYPE_ MPI_REAL8
889 #define MPI_REDUCE_ MPI_MAX
890 #include <mpp_reduce_mpi.fh>
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
897 #define MPP_TYPE_ real(r4_kind)
898 #undef MPP_TYPE_BYTELEN_
899 #define MPP_TYPE_BYTELEN_ 4
901 #define MPI_TYPE_ MPI_REAL4
903 #define MPI_REDUCE_ MPI_MAX
904 #include <mpp_reduce_mpi.fh>
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
911 #define MPP_TYPE_ integer(i8_kind)
912 #undef MPP_TYPE_BYTELEN_
913 #define MPP_TYPE_BYTELEN_ 8
915 #define MPI_TYPE_ MPI_INTEGER8
917 #define MPI_REDUCE_ MPI_MAX
918 #include <mpp_reduce_mpi.fh>
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
925 #define MPP_TYPE_ integer(i4_kind)
926 #undef MPP_TYPE_BYTELEN_
927 #define MPP_TYPE_BYTELEN_ 4
929 #define MPI_TYPE_ MPI_INTEGER4
931 #define MPI_REDUCE_ MPI_MAX
932 #include <mpp_reduce_mpi.fh>
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
939 #define MPP_TYPE_ real(r8_kind)
940 #undef MPP_TYPE_BYTELEN_
941 #define MPP_TYPE_BYTELEN_ 8
943 #define MPI_TYPE_ MPI_REAL8
945 #define MPI_REDUCE_ MPI_MIN
946 #include <mpp_reduce_mpi.fh>
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
953 #define MPP_TYPE_ real(r4_kind)
954 #undef MPP_TYPE_BYTELEN_
955 #define MPP_TYPE_BYTELEN_ 4
957 #define MPI_TYPE_ MPI_REAL4
959 #define MPI_REDUCE_ MPI_MIN
960 #include <mpp_reduce_mpi.fh>
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
967 #define MPP_TYPE_ integer(i8_kind)
968 #undef MPP_TYPE_BYTELEN_
969 #define MPP_TYPE_BYTELEN_ 8
971 #define MPI_TYPE_ MPI_INTEGER8
973 #define MPI_REDUCE_ MPI_MIN
974 #include <mpp_reduce_mpi.fh>
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
981 #define MPP_TYPE_ integer(i4_kind)
982 #undef MPP_TYPE_BYTELEN_
983 #define MPP_TYPE_BYTELEN_ 4
985 #define MPI_TYPE_ MPI_INTEGER4
987 #define MPI_REDUCE_ MPI_MIN
988 #include <mpp_reduce_mpi.fh>
991 #define MPP_SUM_ mpp_sum_real8
992 #undef MPP_SUM_SCALAR_
993 #define MPP_SUM_SCALAR_ mpp_sum_real8_scalar
995 #define MPP_SUM_2D_ mpp_sum_real8_2d
997 #define MPP_SUM_3D_ mpp_sum_real8_3d
999 #define MPP_SUM_4D_ mpp_sum_real8_4d
1001 #define MPP_SUM_5D_ mpp_sum_real8_5d
1003 #define MPP_TYPE_ real(r8_kind)
1005 #define MPI_TYPE_ MPI_REAL8
1006 #undef MPP_TYPE_BYTELEN_
1007 #define MPP_TYPE_BYTELEN_ 8
1008 #include <mpp_sum_mpi.fh>
1012 #define MPP_SUM_ mpp_sum_cmplx8
1013 #undef MPP_SUM_SCALAR_
1014 #define MPP_SUM_SCALAR_ mpp_sum_cmplx8_scalar
1016 #define MPP_SUM_2D_ mpp_sum_cmplx8_2d
1018 #define MPP_SUM_3D_ mpp_sum_cmplx8_3d
1020 #define MPP_SUM_4D_ mpp_sum_cmplx8_4d
1022 #define MPP_SUM_5D_ mpp_sum_cmplx8_5d
1024 #define MPP_TYPE_ complex(c8_kind)
1026 #define MPI_TYPE_ MPI_DOUBLE_COMPLEX
1027 #undef MPP_TYPE_BYTELEN_
1028 #define MPP_TYPE_BYTELEN_ 16
1029 #include <mpp_sum_mpi.fh>
1033 #define MPP_SUM_ mpp_sum_real4
1034 #undef MPP_SUM_SCALAR_
1035 #define MPP_SUM_SCALAR_ mpp_sum_real4_scalar
1037 #define MPP_SUM_2D_ mpp_sum_real4_2d
1039 #define MPP_SUM_3D_ mpp_sum_real4_3d
1041 #define MPP_SUM_4D_ mpp_sum_real4_4d
1043 #define MPP_SUM_5D_ mpp_sum_real4_5d
1045 #define MPP_TYPE_ real(r4_kind)
1047 #define MPI_TYPE_ MPI_REAL4
1048 #undef MPP_TYPE_BYTELEN_
1049 #define MPP_TYPE_BYTELEN_ 4
1050 #include <mpp_sum_mpi.fh>
1054 #define MPP_SUM_ mpp_sum_cmplx4
1055 #undef MPP_SUM_SCALAR_
1056 #define MPP_SUM_SCALAR_ mpp_sum_cmplx4_scalar
1058 #define MPP_SUM_2D_ mpp_sum_cmplx4_2d
1060 #define MPP_SUM_3D_ mpp_sum_cmplx4_3d
1062 #define MPP_SUM_4D_ mpp_sum_cmplx4_4d
1064 #define MPP_SUM_5D_ mpp_sum_cmplx4_5d
1066 #define MPP_TYPE_ complex(c4_kind)
1068 #define MPI_TYPE_ MPI_COMPLEX
1069 #undef MPP_TYPE_BYTELEN_
1070 #define MPP_TYPE_BYTELEN_ 8
1071 #include <mpp_sum_mpi.fh>
1075 #define MPP_SUM_ mpp_sum_int8
1076 #undef MPP_SUM_SCALAR_
1077 #define MPP_SUM_SCALAR_ mpp_sum_int8_scalar
1079 #define MPP_SUM_2D_ mpp_sum_int8_2d
1081 #define MPP_SUM_3D_ mpp_sum_int8_3d
1083 #define MPP_SUM_4D_ mpp_sum_int8_4d
1085 #define MPP_SUM_5D_ mpp_sum_int8_5d
1087 #define MPP_TYPE_ integer(i8_kind)
1089 #define MPI_TYPE_ MPI_INTEGER8
1090 #undef MPP_TYPE_BYTELEN_
1091 #define MPP_TYPE_BYTELEN_ 8
1092 #include <mpp_sum_mpi.fh>
1095 #define MPP_SUM_ mpp_sum_int4
1096 #undef MPP_SUM_SCALAR_
1097 #define MPP_SUM_SCALAR_ mpp_sum_int4_scalar
1099 #define MPP_SUM_2D_ mpp_sum_int4_2d
1101 #define MPP_SUM_3D_ mpp_sum_int4_3d
1103 #define MPP_SUM_4D_ mpp_sum_int4_4d
1105 #define MPP_SUM_5D_ mpp_sum_int4_5d
1107 #define MPP_TYPE_ integer(i4_kind)
1109 #define MPI_TYPE_ MPI_INTEGER4
1110 #undef MPP_TYPE_BYTELEN_
1111 #define MPP_TYPE_BYTELEN_ 4
1112 #include <mpp_sum_mpi.fh>
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
1127 #define MPP_TYPE_ real(r8_kind)
1129 #define MPI_TYPE_ MPI_REAL8
1130 #undef MPP_TYPE_BYTELEN_
1131 #define MPP_TYPE_BYTELEN_ 8
1132 #include <mpp_sum_mpi_ad.fh>
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
1148 #define MPP_TYPE_ complex(c8_kind)
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>
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
1169 #define MPP_TYPE_ real(r4_kind)
1171 #define MPI_TYPE_ MPI_REAL4
1172 #undef MPP_TYPE_BYTELEN_
1173 #define MPP_TYPE_BYTELEN_ 4
1174 #include <mpp_sum_mpi_ad.fh>
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
1190 #define MPP_TYPE_ complex(c4_kind)
1192 #define MPI_TYPE_ MPI_COMPLEX
1193 #undef MPP_TYPE_BYTELEN_
1194 #define MPP_TYPE_BYTELEN_ 8
1195 #include <mpp_sum_mpi_ad.fh>
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
1211 #define MPP_TYPE_ integer(i8_kind)
1213 #define MPI_TYPE_ MPI_INTEGER8
1214 #undef MPP_TYPE_BYTELEN_
1215 #define MPP_TYPE_BYTELEN_ 8
1216 #include <mpp_sum_mpi_ad.fh>
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
1231 #define MPP_TYPE_ integer(i4_kind)
1233 #define MPI_TYPE_ MPI_INTEGER4
1234 #undef MPP_TYPE_BYTELEN_
1235 #define MPP_TYPE_BYTELEN_ 4
1236 #include <mpp_sum_mpi_ad.fh>
1244 #undef MPP_ALLTOALL_
1245 #undef MPP_ALLTOALLV_
1246 #undef MPP_ALLTOALLW_
1248 #undef MPP_TYPE_BYTELEN_
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>
1258 #undef MPP_ALLTOALL_
1259 #undef MPP_ALLTOALLV_
1260 #undef MPP_ALLTOALLW_
1262 #undef MPP_TYPE_BYTELEN_
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>
1272 #undef MPP_ALLTOALL_
1273 #undef MPP_ALLTOALLV_
1274 #undef MPP_ALLTOALLW_
1276 #undef MPP_TYPE_BYTELEN_
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>
1286 #undef MPP_ALLTOALL_
1287 #undef MPP_ALLTOALLV_
1288 #undef MPP_ALLTOALLW_
1290 #undef MPP_TYPE_BYTELEN_
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>
1301 #undef MPP_ALLTOALL_
1302 #undef MPP_ALLTOALLV_
1303 #undef MPP_ALLTOALLW_
1305 #undef MPP_TYPE_BYTELEN_
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>
1317 #undef MPP_ALLTOALL_
1318 #undef MPP_ALLTOALLV_
1319 #undef MPP_ALLTOALLW_
1321 #undef MPP_TYPE_BYTELEN_
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>
1332 #undef MPP_ALLTOALL_
1333 #undef MPP_ALLTOALLV_
1334 #undef MPP_ALLTOALLW_
1336 #undef MPP_TYPE_BYTELEN_
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>
1346 #undef MPP_ALLTOALL_
1347 #undef MPP_ALLTOALLV_
1348 #undef MPP_ALLTOALLW_
1350 #undef MPP_TYPE_BYTELEN_
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>
1366 #undef MPP_TYPE_CREATE_
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>
1374 #undef MPP_TYPE_CREATE_
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>
1382 #undef MPP_TYPE_CREATE_
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>
1390 #undef MPP_TYPE_CREATE_
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>
1398 #undef MPP_TYPE_CREATE_
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>
1406 #undef MPP_TYPE_CREATE_
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>
1414 #undef MPP_TYPE_CREATE_
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>
1422 #undef MPP_TYPE_CREATE_
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>
1433 #undef MPP_TYPE_CREATE_
1438 type(mpp_type),
pointer,
intent(inout) :: dtype
1440 if (.NOT. module_is_initialized) &
1441 call mpp_error(fatal,
'MPP_TYPE_FREE: You must first call mpp_init.')
1443 if (current_clock .NE. 0) &
1444 call system_clock(start_tick)
1447 call mpp_error(note,
'MPP_TYPE_FREE: using MPI_Type_free...')
1450 dtype%counter = dtype%counter - 1
1452 if (dtype%counter < 1)
then
1454 dtype%prev => dtype%next
1455 datatypes%length = datatypes%length - 1
1458 deallocate(dtype%sizes)
1459 deallocate(dtype%subsizes)
1460 deallocate(dtype%starts)
1463 if (dtype%id /= mpi_byte)
then
1464 call mpi_type_free(dtype%id, error)
1469 if (current_clock .NE. 0) &
1470 call increment_current_clock(event_type_free, mpp_type_bytelen_)
integer function stdout()
This function returns the current standard fortran unit numbers for output.
subroutine mpp_init_warninglog()
Opens the warning log file, called during mpp_init.
subroutine mpp_set_current_pelist(pelist, no_sync)
Set context pelist.
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.
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....
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,...
integer function mpp_npes()
Returns processor count for current pelist.
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.
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.
subroutine mpp_broadcast_char(char_data, length, from_pe, pelist)
Broadcasts a character string from the given pe to it's pelist.