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.