FV3 Bundle
mpp_comm_mpi.inc
Go to the documentation of this file.
1 ! -*-f90-*-
2 
3 
4 !***********************************************************************
5 !* GNU Lesser General Public License
6 !*
7 !* This file is part of the GFDL Flexible Modeling System (FMS).
8 !*
9 !* FMS is free software: you can redistribute it and/or modify it under
10 !* the terms of the GNU Lesser General Public License as published by
11 !* the Free Software Foundation, either version 3 of the License, or (at
12 !* your option) any later version.
13 !*
14 !* FMS is distributed in the hope that it will be useful, but WITHOUT
15 !* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
16 !* FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
17 !* for more details.
18 !*
19 !* You should have received a copy of the GNU Lesser General Public
20 !* License along with FMS. If not, see <http://www.gnu.org/licenses/>.
21 !***********************************************************************
22 
23 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
24 ! !
25 ! ROUTINES TO INITIALIZE/FINALIZE MPP MODULE: mpp_init, mpp_exit !
26 ! !
27 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
28  ! subroutine mpp_init( flags, in, out, err, log )
29  ! integer, optional, intent(in) :: flags, in, out, err, log
30  subroutine mpp_init( flags, localcomm )
31  integer, optional, intent(in) :: flags
32  integer, optional, intent(in) :: localcomm
33  integer :: my_pe, num_pes, len, i, iunit
34  logical :: opened, existed
35  integer :: unit_begin, unit_end, unit_nml, io_status
36  character(len=5) :: this_pe
37  type(mpp_type), pointer :: dtype
38 
39  if( module_is_initialized )return
40 
41  call MPI_INITIALIZED( opened, error ) !in case called from another MPI package
42  if(opened .and. .NOT. PRESENT(localcomm)) call mpp_error( FATAL, 'MPP_INIT: communicator is required' )
43  if( .NOT.opened ) then
44  call MPI_INIT(error)
45  mpp_comm_private = MPI_COMM_WORLD
46  else
47  mpp_comm_private = localcomm
48  endif
49  call MPI_COMM_RANK( mpp_comm_private, pe, error )
50  call MPI_COMM_SIZE( mpp_comm_private, npes, error )
51 #ifdef use_MPI_SMA
52  call SHMEM_BARRIER_ALL()
53  call SHPALLOC( p_pSync, SHMEM_BARRIER_SYNC_SIZE, error, -1 )
54  call SHMEM_BARRIER_ALL()
55 #endif
56 
57  module_is_initialized = .TRUE.
58 
59 
60  !PEsets: make defaults illegal
61  allocate(peset(0:current_peset_max))
62  peset(:)%count = -1
63  peset(:)%id = -1
64  peset(:)%group = -1
65  peset(:)%start = -1
66  peset(:)%log2stride = -1
67  peset(:)%name = " "
68  !0=single-PE, initialized so that count returns 1
69  peset(0)%count = 1
70  allocate( peset(0)%list(1) )
71  peset(0)%list = pe
72  current_peset_num = 0
73  peset(0)%id = mpp_comm_private
74  call MPI_COMM_GROUP( mpp_comm_private, peset(0)%group, error )
75  world_peset_num = get_peset( (/(i,i=0,npes-1)/) )
76  current_peset_num = world_peset_num !initialize current PEset to world
77 
78  !initialize clocks
79  call SYSTEM_CLOCK( count=tick0, count_rate=ticks_per_sec, count_max=max_ticks )
80  tick_rate = 1./ticks_per_sec
81  clock0 = mpp_clock_id( 'Total runtime', flags=MPP_CLOCK_SYNC )
82 
83  ! Create the bytestream (default) mpp_datatype
84  mpp_byte%counter = 1
85  mpp_byte%ndims = 0
86  allocate(mpp_byte%sizes(0))
87  allocate(mpp_byte%subsizes(0))
88  allocate(mpp_byte%starts(0))
89  mpp_byte%etype = MPI_BYTE
90  mpp_byte%id = MPI_BYTE
91 
92  mpp_byte%prev => null()
93  mpp_byte%next => null()
94 
95  ! Initialize datatype list with mpp_byte
96  datatypes%head => mpp_byte
97  datatypes%tail => mpp_byte
98  datatypes%length = 0
99 
100  if( PRESENT(flags) )then
101  debug = flags.EQ.MPP_DEBUG
102  verbose = flags.EQ.MPP_VERBOSE .OR. debug
103  end if
104 
105  call mpp_init_logfile()
106  call read_input_nml
107 
108  !--- read namelist
109 #ifdef INTERNAL_FILE_NML
110  read (input_nml_file, mpp_nml, iostat=io_status)
111 #else
112  unit_begin = 103
113  unit_end = 512
114  do unit_nml = unit_begin, unit_end
115  inquire( unit_nml,OPENED=opened )
116  if( .NOT.opened )exit
117  end do
118 
119  open(unit_nml,file='input.nml', iostat=io_status)
120  read(unit_nml,mpp_nml,iostat=io_status)
121  close(unit_nml)
122 #endif
123 
124  if (io_status > 0) then
125  call mpp_error(FATAL,'=>mpp_init: Error reading input.nml')
126  endif
127 
128  if(sync_all_clocks .AND. mpp_pe()==mpp_root_pe() ) call mpp_error(NOTE, &
129  "mpp_mod: mpp_nml variable sync_all_clocks is set to .true., all clocks are synchronized in mpp_clock_begin.")
130 
131 ! non-root pe messages written to other location than stdout()
132 
133  if(etc_unit_is_stderr) then
134  etc_unit = stderr()
135  else
136 ! 9 is reserved for etc_unit
137  etc_unit=9
138  inquire(unit=etc_unit,opened=opened)
139  if(opened) call mpp_error(FATAL,'Unit 9 is already in use (etc_unit) in mpp_comm_mpi')
140  if (trim(etcfile) /= '/dev/null') then
141  write( etcfile,'(a,i6.6)' )trim(etcfile)//'.', pe
142  endif
143  inquire(file=etcfile, exist=existed)
144  if(existed) then
145  open( unit=etc_unit, file=trim(etcfile), status='REPLACE' )
146  else
147  open( unit=etc_unit, file=trim(etcfile) )
148  endif
149  endif
150 
151 ! max_request is set to maximum of npes * REQUEST_MULTIPLY ( default is 20) and MAX_REQUEST_MIN ( default 10000)
152  max_request = max(MAX_REQUEST_MIN, mpp_npes()*REQUEST_MULTIPLY)
153 
154  allocate( request_send(max_request) )
155  allocate( request_recv(max_request) )
156  allocate( size_recv(max_request) )
157  allocate( type_recv(max_request) )
158  request_send(:) = MPI_REQUEST_NULL
159  request_recv(:) = MPI_REQUEST_NULL
160  size_recv(:) = 0
161  type_recv(:) = 0
162 
163  !if optional argument logunit=stdout, write messages to stdout instead.
164  !if specifying non-defaults, you must specify units not yet in use.
165  ! if( PRESENT(in) )then
166  ! inquire( unit=in, opened=opened )
167  ! if( opened )call mpp_error( FATAL, 'MPP_INIT: unable to open stdin.' )
168  ! in_unit=in
169  ! end if
170  ! if( PRESENT(out) )then
171  ! inquire( unit=out, opened=opened )
172  ! if( opened )call mpp_error( FATAL, 'MPP_INIT: unable to open stdout.' )
173  ! out_unit=out
174  ! end if
175  ! if( PRESENT(err) )then
176  ! inquire( unit=err, opened=opened )
177  ! if( opened )call mpp_error( FATAL, 'MPP_INIT: unable to open stderr.' )
178  ! err_unit=err
179  ! end if
180  ! log_unit=get_unit()
181  ! if( PRESENT(log) )then
182  ! inquire( unit=log, opened=opened )
183  ! if( opened .AND. log.NE.out_unit )call mpp_error( FATAL, 'MPP_INIT: unable to open stdlog.' )
184  ! log_unit=log
185  ! end if
186  !!log_unit can be written to only from root_pe, all others write to stdout
187  ! if( log_unit.NE.out_unit )then
188  ! inquire( unit=log_unit, opened=opened )
189  ! if( opened )call mpp_error( FATAL, 'MPP_INIT: specified unit for stdlog already in use.' )
190  ! if( pe.EQ.root_pe )open( unit=log_unit, file=trim(configfile), status='REPLACE' )
191  ! call mpp_sync()
192  ! if( pe.NE.root_pe )open( unit=log_unit, file=trim(configfile), status='OLD' )
193  ! end if
194 
195 
196  !messages
197  iunit = stdlog() ! workaround for lf95.
198  if( verbose )call mpp_error( NOTE, 'MPP_INIT: initializing MPP module...' )
199  if( pe.EQ.root_pe )then
200  write( iunit,'(/a)' )'MPP module '//trim(version)
201  write( iunit,'(a,i6)' )'MPP started with NPES=', npes
202  write( iunit,'(a)' )'Using MPI library for message passing...'
203  write( iunit, '(a,es12.4,a,i10,a)' ) &
204  'Realtime clock resolution=', tick_rate, ' sec (', ticks_per_sec, ' ticks/sec)'
205  write( iunit, '(a,es12.4,a,i20,a)' ) &
206  'Clock rolls over after ', max_ticks*tick_rate, ' sec (', max_ticks, ' ticks)'
207  write( iunit,'(/a)' )'MPP Parameter module '//trim(mpp_parameter_version)
208  write( iunit,'(/a)' )'MPP Data module '//trim(mpp_data_version)
209  end if
210 
211  stdout_unit = stdout()
212 
213  call mpp_clock_begin(clock0)
214 
215  return
216 end subroutine mpp_init
217 
218 !#######################################################################
219  !to be called at the end of a run
220 subroutine mpp_exit()
221  integer :: i, j, k, n, nmax, istat, out_unit, log_unit
222  real :: t, tmin, tmax, tavg, tstd
223  real :: m, mmin, mmax, mavg, mstd, t_total
224  logical :: opened
225  type(mpp_type), pointer :: dtype
226 
227  if( .NOT.module_is_initialized )return
228  call mpp_set_current_pelist()
229  call mpp_clock_end(clock0)
230  t_total = clocks(clock0)%total_ticks*tick_rate
231  out_unit = stdout()
232  log_unit = stdlog()
233  if( clock_num.GT.0 )then
234  if( ANY(clocks(1:clock_num)%detailed) )then
235  call sum_clock_data; call dump_clock_summary
236  end if
237 
238  call mpp_sync()
239  call FLUSH( out_unit )
240 
241  if( pe.EQ.root_pe )then
242  write( out_unit,'(/a,i6,a)' ) 'Tabulating mpp_clock statistics across ', npes, ' PEs...'
243  if( ANY(clocks(1:clock_num)%detailed) ) &
244  write( out_unit,'(a)' )' ... see mpp_clock.out.#### for details on individual PEs.'
245  write( out_unit,'(/32x,a)' ) ' tmin tmax tavg tstd tfrac grain pemin pemax'
246  end if
247  write( log_unit,'(/37x,a)' ) 'time'
248 
249  call FLUSH( out_unit )
250  call mpp_sync()
251  do i = 1,clock_num
252  if( .NOT.ANY(peset(clocks(i)%peset_num)%list(:).EQ.pe) )cycle
253  call mpp_set_current_pelist( peset(clocks(i)%peset_num)%list )
254  out_unit = stdout()
255  log_unit = stdlog()
256  !times between mpp_clock ticks
257  t = clocks(i)%total_ticks*tick_rate
258  tmin = t; call mpp_min(tmin)
259  tmax = t; call mpp_max(tmax)
260  tavg = t; call mpp_sum(tavg); tavg = tavg/mpp_npes()
261  tstd = (t-tavg)**2; call mpp_sum(tstd); tstd = sqrt( tstd/mpp_npes() )
262  if( pe.EQ.root_pe )write( out_unit,'(a32,4f14.6,f7.3,3i6)' ) &
263  clocks(i)%name, tmin, tmax, tavg, tstd, tavg/t_total, &
264  clocks(i)%grain, minval(peset(clocks(i)%peset_num)%list), &
265  maxval(peset(clocks(i)%peset_num)%list)
266  write(log_unit,'(a32,f14.6)') clocks(i)%name, clocks(i)%total_ticks*tick_rate
267  end do
268 
269  if( ANY(clocks(1:clock_num)%detailed) .AND. pe.EQ.root_pe )write( out_unit,'(/32x,a)' ) &
270  ' tmin tmax tavg tstd mmin mmax mavg mstd mavg/tavg'
271 
272  do i = 1,clock_num
273  !messages: bytelengths and times
274  if( .NOT.clocks(i)%detailed )cycle
275  if( .NOT.ANY(peset(clocks(i)%peset_num)%list(:).EQ.pe) )cycle
276  call mpp_set_current_pelist( peset(clocks(i)%peset_num)%list )
277  out_unit = stdout()
278  do j = 1,MAX_EVENT_TYPES
279  n = clocks(i)%events(j)%calls; nmax = n
280  call mpp_max(nmax)
281  if( nmax.NE.0 )then
282  !don't divide by n because n might be 0
283  m = 0
284  if( n.GT.0 )m = sum(clocks(i)%events(j)%bytes(1:n))
285  mmin = m; call mpp_min(mmin)
286  mmax = m; call mpp_max(mmax)
287  mavg = m; call mpp_sum(mavg); mavg = mavg/mpp_npes()
288  mstd = (m-mavg)**2; call mpp_sum(mstd); mstd = sqrt( mstd/mpp_npes() )
289  t = 0
290  if( n.GT.0 )t = sum(clocks(i)%events(j)%ticks(1:n))*tick_rate
291  tmin = t; call mpp_min(tmin)
292  tmax = t; call mpp_max(tmax)
293  tavg = t; call mpp_sum(tavg); tavg = tavg/mpp_npes()
294  tstd = (t-tavg)**2; call mpp_sum(tstd); tstd = sqrt( tstd/mpp_npes() )
295  if( pe.EQ.root_pe )write( out_unit,'(a32,4f11.3,5es11.3)' ) &
296  trim(clocks(i)%name)//' '//trim(clocks(i)%events(j)%name), &
297  tmin, tmax, tavg, tstd, mmin, mmax, mavg, mstd, mavg/tavg
298  end if
299  end do
300  end do
301 
302  end if
303 
304  call FLUSH( out_unit )
305 
306 ! close down etc_unit: 9
307  inquire(unit=etc_unit, opened=opened)
308  if (opened) then
309  call FLUSH (etc_unit)
310  close(etc_unit)
311  endif
312 
313  ! Clear derived data types (skipping list head, mpp_byte)
314  dtype => datatypes%head
315  do while (.not. associated(dtype))
316  dtype => dtype%next
317  dtype%counter = 1 ! Force deallocation
318  call mpp_type_free(dtype)
319  end do
320 
321  call mpp_set_current_pelist()
322  call mpp_sync()
323  call mpp_max(mpp_stack_hwm)
324  if( pe.EQ.root_pe )write( out_unit,* )'MPP_STACK high water mark=', mpp_stack_hwm
325  if(mpp_comm_private == MPI_COMM_WORLD ) call MPI_FINALIZE(error)
326 
327  return
328 end subroutine mpp_exit
329 
330 !#######################################################################
331  subroutine mpp_malloc( ptr, newlen, len )
332  integer, intent(in) :: newlen
333  integer, intent(inout) :: len
334 #ifdef use_MPI_SMA
335  real :: dummy
336  pointer( ptr, dummy )
337  if( .NOT.module_is_initialized )call mpp_error( FATAL, 'MPP_MALLOC: You must first call mpp_init.' )
338 !use existing allocation if it is enough
339  if( newlen.LE.len )return
340 
341  call SHMEM_BARRIER_ALL()
342 !if the pointer is already allocated, deallocate
343 ! if( len.NE.0 )call SHPDEALLC( ptr, error_8, -1 ) !BWA: error_8 instead of error, see PV 682618 (fixed in mpt.1.3.0.1)
344  if( len.NE.0 )call SHPDEALLC( ptr, error, -1 )
345 !allocate new length: assume that the array is KIND=8
346  call SHPALLOC( ptr, newlen, error, -1 )
347  len = newlen
348  call SHMEM_BARRIER_ALL()
349 #else
350  integer(POINTER_KIND), intent(in) :: ptr
351  call mpp_error( FATAL, 'mpp_malloc: requires use_MPI_SMA' )
352 #endif
353  return
354  end subroutine mpp_malloc
355 
356 #ifdef use_MPI_GSM
357 !#######################################################################
358  !--- routine to perform GSM allocations
359  !
360 subroutine mpp_gsm_malloc( ptr, len )
361  use mpp_data_mod, only : peset, current_peset_num
362  integer(KIND=MPI_ADDRESS_KIND), intent(in) :: len
363  real :: dummy
364  integer :: ierror
365  !argument ptr is a cray pointer, points to a dummy argument in this routine
366  pointer( ptr, dummy )
367  include "mpi_gsmf.h"
368  if( .NOT.module_is_initialized )call mpp_error( FATAL, 'MPP_GSM_MALLOC: You must first call mpp_init.' )
369 
370  call gsm_alloc(len, GSM_SINGLERANK, 0, peset(current_peset_num)%id, ptr, ierror)
371  if (ierror .eq. -1) call mpp_error( FATAL, 'MPP_GSM_MALLOC: gsm_alloc failed.' )
372  return
373 end subroutine mpp_gsm_malloc
374 
375 !#######################################################################
376  !--- routine to free GSM allocations
377  !
378 subroutine mpp_gsm_free( ptr )
379  use mpp_data_mod, only : peset, current_peset_num
380  real :: dummy
381  integer :: ierror
382  !argument ptr is a cray pointer, points to a dummy argument in this routine
383  pointer( ptr, dummy )
384  include "mpi_gsmf.h"
385 
386  call gsm_free(dummy, peset(current_peset_num)%id, ierror)
387  if (ierror .eq. -1) call mpp_error( FATAL, 'MPP_GSM_FREE: gsm_free failed.' )
388  return
389 end subroutine mpp_gsm_free
390 #endif
391 
392 !#######################################################################
393  !set the mpp_stack variable to be at least n LONG words long
394  subroutine mpp_set_stack_size(n)
395  integer, intent(in) :: n
396  character(len=8) :: text
397 
398  if( n.GT.mpp_stack_size .AND. allocated(mpp_stack) )deallocate(mpp_stack)
399  if( .NOT.allocated(mpp_stack) )then
400  allocate( mpp_stack(n) )
401  mpp_stack_size = n
402  end if
403 
404  write( text,'(i8)' )n
405  if( pe.EQ.root_pe )call mpp_error( NOTE, 'MPP_SET_STACK_SIZE: stack size set to '//text//'.' )
406 
407  return
408  end subroutine mpp_set_stack_size
409 
410 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
411 ! !
412 ! BASIC MESSAGE PASSING ROUTINE: mpp_transmit !
413 ! !
414 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
415  subroutine mpp_broadcast_char(data, length, from_pe, pelist )
416  character(len=*), intent(inout) :: data(:)
417  integer, intent(in) :: length, from_pe
418  integer, intent(in), optional :: pelist(:)
419  integer :: n, i, from_rank, out_unit
420  character :: str1D(length*size(data(:)))
421  pointer(lptr, str1D)
422 
423  if( .NOT.module_is_initialized )call mpp_error( FATAL, 'mpp_broadcast_text: You must first call mpp_init.' )
424  n = get_peset(pelist); if( peset(n)%count.EQ.1 )return
425 
426 
427  if( debug )then
428  call SYSTEM_CLOCK(tick)
429  if(mpp_pe() == mpp_root_pe()) then
430  write( stdout_unit,'(a,i18,a,i5,a,2i5,2i8)' )&
431  'T=',tick, ' PE=',pe, 'mpp_broadcast_text begin: from_pe, length=', from_pe, length
432  endif
433  end if
434 
435  if( .NOT.ANY(from_pe.EQ.peset(current_peset_num)%list) ) &
436  call mpp_error( FATAL, 'mpp_broadcast_text: broadcasting from invalid PE.' )
437 
438  if( debug .and. (current_clock.NE.0) )call SYSTEM_CLOCK(start_tick)
439  ! find the rank of from_pe in the pelist.
440  do i = 1, mpp_npes()
441  if(peset(n)%list(i) == from_pe) then
442  from_rank = i - 1
443  exit
444  endif
445  enddo
446  lptr = LOC (data)
447  if( mpp_npes().GT.1 ) call MPI_BCAST( data, length*size(data(:)), MPI_CHARACTER, from_rank, peset(n)%id, error )
448  if( debug .and. (current_clock.NE.0) )call increment_current_clock( EVENT_BROADCAST, length )
449  return
450  end subroutine mpp_broadcast_char
451 
452 #undef MPP_TRANSMIT_
453 #define MPP_TRANSMIT_ mpp_transmit_real8
454 #undef MPP_TRANSMIT_SCALAR_
455 #define MPP_TRANSMIT_SCALAR_ mpp_transmit_real8_scalar
456 #undef MPP_TRANSMIT_2D_
457 #define MPP_TRANSMIT_2D_ mpp_transmit_real8_2d
458 #undef MPP_TRANSMIT_3D_
459 #define MPP_TRANSMIT_3D_ mpp_transmit_real8_3d
460 #undef MPP_TRANSMIT_4D_
461 #define MPP_TRANSMIT_4D_ mpp_transmit_real8_4d
462 #undef MPP_TRANSMIT_5D_
463 #define MPP_TRANSMIT_5D_ mpp_transmit_real8_5d
464 #undef MPP_RECV_
465 #define MPP_RECV_ mpp_recv_real8
466 #undef MPP_RECV_SCALAR_
467 #define MPP_RECV_SCALAR_ mpp_recv_real8_scalar
468 #undef MPP_RECV_2D_
469 #define MPP_RECV_2D_ mpp_recv_real8_2d
470 #undef MPP_RECV_3D_
471 #define MPP_RECV_3D_ mpp_recv_real8_3d
472 #undef MPP_RECV_4D_
473 #define MPP_RECV_4D_ mpp_recv_real8_4d
474 #undef MPP_RECV_5D_
475 #define MPP_RECV_5D_ mpp_recv_real8_5d
476 #undef MPP_SEND_
477 #define MPP_SEND_ mpp_send_real8
478 #undef MPP_SEND_SCALAR_
479 #define MPP_SEND_SCALAR_ mpp_send_real8_scalar
480 #undef MPP_SEND_2D_
481 #define MPP_SEND_2D_ mpp_send_real8_2d
482 #undef MPP_SEND_3D_
483 #define MPP_SEND_3D_ mpp_send_real8_3d
484 #undef MPP_SEND_4D_
485 #define MPP_SEND_4D_ mpp_send_real8_4d
486 #undef MPP_SEND_5D_
487 #define MPP_SEND_5D_ mpp_send_real8_5d
488 #undef MPP_BROADCAST_
489 #define MPP_BROADCAST_ mpp_broadcast_real8
490 #undef MPP_BROADCAST_SCALAR_
491 #define MPP_BROADCAST_SCALAR_ mpp_broadcast_real8_scalar
492 #undef MPP_BROADCAST_2D_
493 #define MPP_BROADCAST_2D_ mpp_broadcast_real8_2d
494 #undef MPP_BROADCAST_3D_
495 #define MPP_BROADCAST_3D_ mpp_broadcast_real8_3d
496 #undef MPP_BROADCAST_4D_
497 #define MPP_BROADCAST_4D_ mpp_broadcast_real8_4d
498 #undef MPP_BROADCAST_5D_
499 #define MPP_BROADCAST_5D_ mpp_broadcast_real8_5d
500 #undef MPP_TYPE_
501 #define MPP_TYPE_ real(DOUBLE_KIND)
502 #undef MPP_TYPE_BYTELEN_
503 #define MPP_TYPE_BYTELEN_ 8
504 #undef MPI_TYPE_
505 #define MPI_TYPE_ MPI_REAL8
506 #include <mpp_transmit_mpi.h>
507 
508 #ifdef OVERLOAD_C8
509 #undef MPP_TRANSMIT_
510 #define MPP_TRANSMIT_ mpp_transmit_cmplx8
511 #undef MPP_TRANSMIT_SCALAR_
512 #define MPP_TRANSMIT_SCALAR_ mpp_transmit_cmplx8_scalar
513 #undef MPP_TRANSMIT_2D_
514 #define MPP_TRANSMIT_2D_ mpp_transmit_cmplx8_2d
515 #undef MPP_TRANSMIT_3D_
516 #define MPP_TRANSMIT_3D_ mpp_transmit_cmplx8_3d
517 #undef MPP_TRANSMIT_4D_
518 #define MPP_TRANSMIT_4D_ mpp_transmit_cmplx8_4d
519 #undef MPP_TRANSMIT_5D_
520 #define MPP_TRANSMIT_5D_ mpp_transmit_cmplx8_5d
521 #undef MPP_RECV_
522 #define MPP_RECV_ mpp_recv_cmplx8
523 #undef MPP_RECV_SCALAR_
524 #define MPP_RECV_SCALAR_ mpp_recv_cmplx8_scalar
525 #undef MPP_RECV_2D_
526 #define MPP_RECV_2D_ mpp_recv_cmplx8_2d
527 #undef MPP_RECV_3D_
528 #define MPP_RECV_3D_ mpp_recv_cmplx8_3d
529 #undef MPP_RECV_4D_
530 #define MPP_RECV_4D_ mpp_recv_cmplx8_4d
531 #undef MPP_RECV_5D_
532 #define MPP_RECV_5D_ mpp_recv_cmplx8_5d
533 #undef MPP_SEND_
534 #define MPP_SEND_ mpp_send_cmplx8
535 #undef MPP_SEND_SCALAR_
536 #define MPP_SEND_SCALAR_ mpp_send_cmplx8_scalar
537 #undef MPP_SEND_2D_
538 #define MPP_SEND_2D_ mpp_send_cmplx8_2d
539 #undef MPP_SEND_3D_
540 #define MPP_SEND_3D_ mpp_send_cmplx8_3d
541 #undef MPP_SEND_4D_
542 #define MPP_SEND_4D_ mpp_send_cmplx8_4d
543 #undef MPP_SEND_5D_
544 #define MPP_SEND_5D_ mpp_send_cmplx8_5d
545 #undef MPP_BROADCAST_
546 #define MPP_BROADCAST_ mpp_broadcast_cmplx8
547 #undef MPP_BROADCAST_SCALAR_
548 #define MPP_BROADCAST_SCALAR_ mpp_broadcast_cmplx8_scalar
549 #undef MPP_BROADCAST_2D_
550 #define MPP_BROADCAST_2D_ mpp_broadcast_cmplx8_2d
551 #undef MPP_BROADCAST_3D_
552 #define MPP_BROADCAST_3D_ mpp_broadcast_cmplx8_3d
553 #undef MPP_BROADCAST_4D_
554 #define MPP_BROADCAST_4D_ mpp_broadcast_cmplx8_4d
555 #undef MPP_BROADCAST_5D_
556 #define MPP_BROADCAST_5D_ mpp_broadcast_cmplx8_5d
557 #undef MPP_TYPE_
558 #define MPP_TYPE_ complex(DOUBLE_KIND)
559 #undef MPP_TYPE_BYTELEN_
560 #define MPP_TYPE_BYTELEN_ 16
561 #undef MPI_TYPE_
562 #define MPI_TYPE_ MPI_DOUBLE_COMPLEX
563 #include <mpp_transmit_mpi.h>
564 #endif
565 
566 #undef MPP_TRANSMIT_
567 #define MPP_TRANSMIT_ mpp_transmit_real4
568 #undef MPP_TRANSMIT_SCALAR_
569 #define MPP_TRANSMIT_SCALAR_ mpp_transmit_real4_scalar
570 #undef MPP_TRANSMIT_2D_
571 #define MPP_TRANSMIT_2D_ mpp_transmit_real4_2d
572 #undef MPP_TRANSMIT_3D_
573 #define MPP_TRANSMIT_3D_ mpp_transmit_real4_3d
574 #undef MPP_TRANSMIT_4D_
575 #define MPP_TRANSMIT_4D_ mpp_transmit_real4_4d
576 #undef MPP_TRANSMIT_5D_
577 #define MPP_TRANSMIT_5D_ mpp_transmit_real4_5d
578 #undef MPP_RECV_
579 #define MPP_RECV_ mpp_recv_real4
580 #undef MPP_RECV_SCALAR_
581 #define MPP_RECV_SCALAR_ mpp_recv_real4_scalar
582 #undef MPP_RECV_2D_
583 #define MPP_RECV_2D_ mpp_recv_real4_2d
584 #undef MPP_RECV_3D_
585 #define MPP_RECV_3D_ mpp_recv_real4_3d
586 #undef MPP_RECV_4D_
587 #define MPP_RECV_4D_ mpp_recv_real4_4d
588 #undef MPP_RECV_5D_
589 #define MPP_RECV_5D_ mpp_recv_real4_5d
590 #undef MPP_SEND_
591 #define MPP_SEND_ mpp_send_real4
592 #undef MPP_SEND_SCALAR_
593 #define MPP_SEND_SCALAR_ mpp_send_real4_scalar
594 #undef MPP_SEND_2D_
595 #define MPP_SEND_2D_ mpp_send_real4_2d
596 #undef MPP_SEND_3D_
597 #define MPP_SEND_3D_ mpp_send_real4_3d
598 #undef MPP_SEND_4D_
599 #define MPP_SEND_4D_ mpp_send_real4_4d
600 #undef MPP_SEND_5D_
601 #define MPP_SEND_5D_ mpp_send_real4_5d
602 #undef MPP_BROADCAST_
603 #define MPP_BROADCAST_ mpp_broadcast_real4
604 #undef MPP_BROADCAST_SCALAR_
605 #define MPP_BROADCAST_SCALAR_ mpp_broadcast_real4_scalar
606 #undef MPP_BROADCAST_2D_
607 #define MPP_BROADCAST_2D_ mpp_broadcast_real4_2d
608 #undef MPP_BROADCAST_3D_
609 #define MPP_BROADCAST_3D_ mpp_broadcast_real4_3d
610 #undef MPP_BROADCAST_4D_
611 #define MPP_BROADCAST_4D_ mpp_broadcast_real4_4d
612 #undef MPP_BROADCAST_5D_
613 #define MPP_BROADCAST_5D_ mpp_broadcast_real4_5d
614 #undef MPP_TYPE_
615 #define MPP_TYPE_ real(FLOAT_KIND)
616 #undef MPP_TYPE_BYTELEN_
617 #define MPP_TYPE_BYTELEN_ 4
618 #undef MPI_TYPE_
619 #define MPI_TYPE_ MPI_REAL4
620 #include <mpp_transmit_mpi.h>
621 
622 #ifdef OVERLOAD_C4
623 #undef MPP_TRANSMIT_
624 #define MPP_TRANSMIT_ mpp_transmit_cmplx4
625 #undef MPP_TRANSMIT_SCALAR_
626 #define MPP_TRANSMIT_SCALAR_ mpp_transmit_cmplx4_scalar
627 #undef MPP_TRANSMIT_2D_
628 #define MPP_TRANSMIT_2D_ mpp_transmit_cmplx4_2d
629 #undef MPP_TRANSMIT_3D_
630 #define MPP_TRANSMIT_3D_ mpp_transmit_cmplx4_3d
631 #undef MPP_TRANSMIT_4D_
632 #define MPP_TRANSMIT_4D_ mpp_transmit_cmplx4_4d
633 #undef MPP_TRANSMIT_5D_
634 #define MPP_TRANSMIT_5D_ mpp_transmit_cmplx4_5d
635 #undef MPP_RECV_
636 #define MPP_RECV_ mpp_recv_cmplx4
637 #undef MPP_RECV_SCALAR_
638 #define MPP_RECV_SCALAR_ mpp_recv_cmplx4_scalar
639 #undef MPP_RECV_2D_
640 #define MPP_RECV_2D_ mpp_recv_cmplx4_2d
641 #undef MPP_RECV_3D_
642 #define MPP_RECV_3D_ mpp_recv_cmplx4_3d
643 #undef MPP_RECV_4D_
644 #define MPP_RECV_4D_ mpp_recv_cmplx4_4d
645 #undef MPP_RECV_5D_
646 #define MPP_RECV_5D_ mpp_recv_cmplx4_5d
647 #undef MPP_SEND_
648 #define MPP_SEND_ mpp_send_cmplx4
649 #undef MPP_SEND_SCALAR_
650 #define MPP_SEND_SCALAR_ mpp_send_cmplx4_scalar
651 #undef MPP_SEND_2D_
652 #define MPP_SEND_2D_ mpp_send_cmplx4_2d
653 #undef MPP_SEND_3D_
654 #define MPP_SEND_3D_ mpp_send_cmplx4_3d
655 #undef MPP_SEND_4D_
656 #define MPP_SEND_4D_ mpp_send_cmplx4_4d
657 #undef MPP_SEND_5D_
658 #define MPP_SEND_5D_ mpp_send_cmplx4_5d
659 #undef MPP_BROADCAST_
660 #define MPP_BROADCAST_ mpp_broadcast_cmplx4
661 #undef MPP_BROADCAST_SCALAR_
662 #define MPP_BROADCAST_SCALAR_ mpp_broadcast_cmplx4_scalar
663 #undef MPP_BROADCAST_2D_
664 #define MPP_BROADCAST_2D_ mpp_broadcast_cmplx4_2d
665 #undef MPP_BROADCAST_3D_
666 #define MPP_BROADCAST_3D_ mpp_broadcast_cmplx4_3d
667 #undef MPP_BROADCAST_4D_
668 #define MPP_BROADCAST_4D_ mpp_broadcast_cmplx4_4d
669 #undef MPP_BROADCAST_5D_
670 #define MPP_BROADCAST_5D_ mpp_broadcast_cmplx4_5d
671 #undef MPP_TYPE_
672 #define MPP_TYPE_ complex(FLOAT_KIND)
673 #undef MPP_TYPE_BYTELEN_
674 #define MPP_TYPE_BYTELEN_ 8
675 #undef MPI_TYPE_
676 #define MPI_TYPE_ MPI_COMPLEX
677 #include <mpp_transmit_mpi.h>
678 #endif
679 
680 #ifndef no_8byte_integers
681 #undef MPP_TRANSMIT_
682 #define MPP_TRANSMIT_ mpp_transmit_int8
683 #undef MPP_TRANSMIT_SCALAR_
684 #define MPP_TRANSMIT_SCALAR_ mpp_transmit_int8_scalar
685 #undef MPP_TRANSMIT_2D_
686 #define MPP_TRANSMIT_2D_ mpp_transmit_int8_2d
687 #undef MPP_TRANSMIT_3D_
688 #define MPP_TRANSMIT_3D_ mpp_transmit_int8_3d
689 #undef MPP_TRANSMIT_4D_
690 #define MPP_TRANSMIT_4D_ mpp_transmit_int8_4d
691 #undef MPP_TRANSMIT_5D_
692 #define MPP_TRANSMIT_5D_ mpp_transmit_int8_5d
693 #undef MPP_RECV_
694 #define MPP_RECV_ mpp_recv_int8
695 #undef MPP_RECV_SCALAR_
696 #define MPP_RECV_SCALAR_ mpp_recv_int8_scalar
697 #undef MPP_RECV_2D_
698 #define MPP_RECV_2D_ mpp_recv_int8_2d
699 #undef MPP_RECV_3D_
700 #define MPP_RECV_3D_ mpp_recv_int8_3d
701 #undef MPP_RECV_4D_
702 #define MPP_RECV_4D_ mpp_recv_int8_4d
703 #undef MPP_RECV_5D_
704 #define MPP_RECV_5D_ mpp_recv_int8_5d
705 #undef MPP_SEND_
706 #define MPP_SEND_ mpp_send_int8
707 #undef MPP_SEND_SCALAR_
708 #define MPP_SEND_SCALAR_ mpp_send_int8_scalar
709 #undef MPP_SEND_2D_
710 #define MPP_SEND_2D_ mpp_send_int8_2d
711 #undef MPP_SEND_3D_
712 #define MPP_SEND_3D_ mpp_send_int8_3d
713 #undef MPP_SEND_4D_
714 #define MPP_SEND_4D_ mpp_send_int8_4d
715 #undef MPP_SEND_5D_
716 #define MPP_SEND_5D_ mpp_send_int8_5d
717 #undef MPP_BROADCAST_
718 #define MPP_BROADCAST_ mpp_broadcast_int8
719 #undef MPP_BROADCAST_SCALAR_
720 #define MPP_BROADCAST_SCALAR_ mpp_broadcast_int8_scalar
721 #undef MPP_BROADCAST_2D_
722 #define MPP_BROADCAST_2D_ mpp_broadcast_int8_2d
723 #undef MPP_BROADCAST_3D_
724 #define MPP_BROADCAST_3D_ mpp_broadcast_int8_3d
725 #undef MPP_BROADCAST_4D_
726 #define MPP_BROADCAST_4D_ mpp_broadcast_int8_4d
727 #undef MPP_BROADCAST_5D_
728 #define MPP_BROADCAST_5D_ mpp_broadcast_int8_5d
729 #undef MPP_TYPE_
730 #define MPP_TYPE_ integer(LONG_KIND)
731 #undef MPP_TYPE_BYTELEN_
732 #define MPP_TYPE_BYTELEN_ 8
733 #undef MPI_TYPE_
734 #define MPI_TYPE_ MPI_INTEGER8
735 #include <mpp_transmit_mpi.h>
736 #endif
737 
738 #undef MPP_TRANSMIT_
739 #define MPP_TRANSMIT_ mpp_transmit_int4
740 #undef MPP_TRANSMIT_SCALAR_
741 #define MPP_TRANSMIT_SCALAR_ mpp_transmit_int4_scalar
742 #undef MPP_TRANSMIT_2D_
743 #define MPP_TRANSMIT_2D_ mpp_transmit_int4_2d
744 #undef MPP_TRANSMIT_3D_
745 #define MPP_TRANSMIT_3D_ mpp_transmit_int4_3d
746 #undef MPP_TRANSMIT_4D_
747 #define MPP_TRANSMIT_4D_ mpp_transmit_int4_4d
748 #undef MPP_TRANSMIT_5D_
749 #define MPP_TRANSMIT_5D_ mpp_transmit_int4_5d
750 #undef MPP_RECV_
751 #define MPP_RECV_ mpp_recv_int4
752 #undef MPP_RECV_SCALAR_
753 #define MPP_RECV_SCALAR_ mpp_recv_int4_scalar
754 #undef MPP_RECV_2D_
755 #define MPP_RECV_2D_ mpp_recv_int4_2d
756 #undef MPP_RECV_3D_
757 #define MPP_RECV_3D_ mpp_recv_int4_3d
758 #undef MPP_RECV_4D_
759 #define MPP_RECV_4D_ mpp_recv_int4_4d
760 #undef MPP_RECV_5D_
761 #define MPP_RECV_5D_ mpp_recv_int4_5d
762 #undef MPP_SEND_
763 #define MPP_SEND_ mpp_send_int4
764 #undef MPP_SEND_SCALAR_
765 #define MPP_SEND_SCALAR_ mpp_send_int4_scalar
766 #undef MPP_SEND_2D_
767 #define MPP_SEND_2D_ mpp_send_int4_2d
768 #undef MPP_SEND_3D_
769 #define MPP_SEND_3D_ mpp_send_int4_3d
770 #undef MPP_SEND_4D_
771 #define MPP_SEND_4D_ mpp_send_int4_4d
772 #undef MPP_SEND_5D_
773 #define MPP_SEND_5D_ mpp_send_int4_5d
774 #undef MPP_BROADCAST_
775 #define MPP_BROADCAST_ mpp_broadcast_int4
776 #undef MPP_BROADCAST_SCALAR_
777 #define MPP_BROADCAST_SCALAR_ mpp_broadcast_int4_scalar
778 #undef MPP_BROADCAST_2D_
779 #define MPP_BROADCAST_2D_ mpp_broadcast_int4_2d
780 #undef MPP_BROADCAST_3D_
781 #define MPP_BROADCAST_3D_ mpp_broadcast_int4_3d
782 #undef MPP_BROADCAST_4D_
783 #define MPP_BROADCAST_4D_ mpp_broadcast_int4_4d
784 #undef MPP_BROADCAST_5D_
785 #define MPP_BROADCAST_5D_ mpp_broadcast_int4_5d
786 #undef MPP_TYPE_
787 #define MPP_TYPE_ integer(INT_KIND)
788 #undef MPP_TYPE_BYTELEN_
789 #define MPP_TYPE_BYTELEN_ 4
790 #undef MPI_TYPE_
791 #define MPI_TYPE_ MPI_INTEGER4
792 #include <mpp_transmit_mpi.h>
793 
794 #ifndef no_8byte_integers
795 #undef MPP_TRANSMIT_
796 #define MPP_TRANSMIT_ mpp_transmit_logical8
797 #undef MPP_TRANSMIT_SCALAR_
798 #define MPP_TRANSMIT_SCALAR_ mpp_transmit_logical8_scalar
799 #undef MPP_TRANSMIT_2D_
800 #define MPP_TRANSMIT_2D_ mpp_transmit_logical8_2d
801 #undef MPP_TRANSMIT_3D_
802 #define MPP_TRANSMIT_3D_ mpp_transmit_logical8_3d
803 #undef MPP_TRANSMIT_4D_
804 #define MPP_TRANSMIT_4D_ mpp_transmit_logical8_4d
805 #undef MPP_TRANSMIT_5D_
806 #define MPP_TRANSMIT_5D_ mpp_transmit_logical8_5d
807 #undef MPP_RECV_
808 #define MPP_RECV_ mpp_recv_logical8
809 #undef MPP_RECV_SCALAR_
810 #define MPP_RECV_SCALAR_ mpp_recv_logical8_scalar
811 #undef MPP_RECV_2D_
812 #define MPP_RECV_2D_ mpp_recv_logical8_2d
813 #undef MPP_RECV_3D_
814 #define MPP_RECV_3D_ mpp_recv_logical8_3d
815 #undef MPP_RECV_4D_
816 #define MPP_RECV_4D_ mpp_recv_logical8_4d
817 #undef MPP_RECV_5D_
818 #define MPP_RECV_5D_ mpp_recv_logical8_5d
819 #undef MPP_SEND_
820 #define MPP_SEND_ mpp_send_logical8
821 #undef MPP_SEND_SCALAR_
822 #define MPP_SEND_SCALAR_ mpp_send_logical8_scalar
823 #undef MPP_SEND_2D_
824 #define MPP_SEND_2D_ mpp_send_logical8_2d
825 #undef MPP_SEND_3D_
826 #define MPP_SEND_3D_ mpp_send_logical8_3d
827 #undef MPP_SEND_4D_
828 #define MPP_SEND_4D_ mpp_send_logical8_4d
829 #undef MPP_SEND_5D_
830 #define MPP_SEND_5D_ mpp_send_logical8_5d
831 #undef MPP_BROADCAST_
832 #define MPP_BROADCAST_ mpp_broadcast_logical8
833 #undef MPP_BROADCAST_SCALAR_
834 #define MPP_BROADCAST_SCALAR_ mpp_broadcast_logical8_scalar
835 #undef MPP_BROADCAST_2D_
836 #define MPP_BROADCAST_2D_ mpp_broadcast_logical8_2d
837 #undef MPP_BROADCAST_3D_
838 #define MPP_BROADCAST_3D_ mpp_broadcast_logical8_3d
839 #undef MPP_BROADCAST_4D_
840 #define MPP_BROADCAST_4D_ mpp_broadcast_logical8_4d
841 #undef MPP_BROADCAST_5D_
842 #define MPP_BROADCAST_5D_ mpp_broadcast_logical8_5d
843 #undef MPP_TYPE_
844 #define MPP_TYPE_ logical(LONG_KIND)
845 #undef MPP_TYPE_BYTELEN_
846 #define MPP_TYPE_BYTELEN_ 8
847 #undef MPI_TYPE_
848 #define MPI_TYPE_ MPI_INTEGER8
849 #include <mpp_transmit_mpi.h>
850 #endif
851 
852 #undef MPP_TRANSMIT_
853 #define MPP_TRANSMIT_ mpp_transmit_logical4
854 #undef MPP_TRANSMIT_SCALAR_
855 #define MPP_TRANSMIT_SCALAR_ mpp_transmit_logical4_scalar
856 #undef MPP_TRANSMIT_2D_
857 #define MPP_TRANSMIT_2D_ mpp_transmit_logical4_2d
858 #undef MPP_TRANSMIT_3D_
859 #define MPP_TRANSMIT_3D_ mpp_transmit_logical4_3d
860 #undef MPP_TRANSMIT_4D_
861 #define MPP_TRANSMIT_4D_ mpp_transmit_logical4_4d
862 #undef MPP_TRANSMIT_5D_
863 #define MPP_TRANSMIT_5D_ mpp_transmit_logical4_5d
864 #undef MPP_RECV_
865 #define MPP_RECV_ mpp_recv_logical4
866 #undef MPP_RECV_SCALAR_
867 #define MPP_RECV_SCALAR_ mpp_recv_logical4_scalar
868 #undef MPP_RECV_2D_
869 #define MPP_RECV_2D_ mpp_recv_logical4_2d
870 #undef MPP_RECV_3D_
871 #define MPP_RECV_3D_ mpp_recv_logical4_3d
872 #undef MPP_RECV_4D_
873 #define MPP_RECV_4D_ mpp_recv_logical4_4d
874 #undef MPP_RECV_5D_
875 #define MPP_RECV_5D_ mpp_recv_logical4_5d
876 #undef MPP_SEND_
877 #define MPP_SEND_ mpp_send_logical4
878 #undef MPP_SEND_SCALAR_
879 #define MPP_SEND_SCALAR_ mpp_send_logical4_scalar
880 #undef MPP_SEND_2D_
881 #define MPP_SEND_2D_ mpp_send_logical4_2d
882 #undef MPP_SEND_3D_
883 #define MPP_SEND_3D_ mpp_send_logical4_3d
884 #undef MPP_SEND_4D_
885 #define MPP_SEND_4D_ mpp_send_logical4_4d
886 #undef MPP_SEND_5D_
887 #define MPP_SEND_5D_ mpp_send_logical4_5d
888 #undef MPP_BROADCAST_
889 #define MPP_BROADCAST_ mpp_broadcast_logical4
890 #undef MPP_BROADCAST_SCALAR_
891 #define MPP_BROADCAST_SCALAR_ mpp_broadcast_logical4_scalar
892 #undef MPP_BROADCAST_2D_
893 #define MPP_BROADCAST_2D_ mpp_broadcast_logical4_2d
894 #undef MPP_BROADCAST_3D_
895 #define MPP_BROADCAST_3D_ mpp_broadcast_logical4_3d
896 #undef MPP_BROADCAST_4D_
897 #define MPP_BROADCAST_4D_ mpp_broadcast_logical4_4d
898 #undef MPP_BROADCAST_5D_
899 #define MPP_BROADCAST_5D_ mpp_broadcast_logical4_5d
900 #undef MPP_TYPE_
901 #define MPP_TYPE_ logical(INT_KIND)
902 #undef MPP_TYPE_BYTELEN_
903 #define MPP_TYPE_BYTELEN_ 4
904 #undef MPI_TYPE_
905 #define MPI_TYPE_ MPI_INTEGER4
906 #include <mpp_transmit_mpi.h>
907 
908 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
909 ! !
910 ! GLOBAL REDUCTION ROUTINES: mpp_max, mpp_sum, mpp_min !
911 ! !
912 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
913 #undef MPP_REDUCE_0D_
914 #define MPP_REDUCE_0D_ mpp_max_real8_0d
915 #undef MPP_REDUCE_1D_
916 #define MPP_REDUCE_1D_ mpp_max_real8_1d
917 #undef MPP_TYPE_
918 #define MPP_TYPE_ real(DOUBLE_KIND)
919 #undef MPP_TYPE_BYTELEN_
920 #define MPP_TYPE_BYTELEN_ 8
921 #undef MPI_TYPE_
922 #define MPI_TYPE_ MPI_REAL8
923 #undef MPI_REDUCE_
924 #define MPI_REDUCE_ MPI_MAX
925 #include <mpp_reduce_mpi.h>
926 
927 #ifdef OVERLOAD_R4
928 #undef MPP_REDUCE_0D_
929 #define MPP_REDUCE_0D_ mpp_max_real4_0d
930 #undef MPP_REDUCE_1D_
931 #define MPP_REDUCE_1D_ mpp_max_real4_1d
932 #undef MPP_TYPE_
933 #define MPP_TYPE_ real(FLOAT_KIND)
934 #undef MPP_TYPE_BYTELEN_
935 #define MPP_TYPE_BYTELEN_ 4
936 #undef MPI_TYPE_
937 #define MPI_TYPE_ MPI_REAL4
938 #undef MPI_REDUCE_
939 #define MPI_REDUCE_ MPI_MAX
940 #include <mpp_reduce_mpi.h>
941 #endif
942 
943 #ifndef no_8byte_integers
944 #undef MPP_REDUCE_0D_
945 #define MPP_REDUCE_0D_ mpp_max_int8_0d
946 #undef MPP_REDUCE_1D_
947 #define MPP_REDUCE_1D_ mpp_max_int8_1d
948 #undef MPP_TYPE_
949 #define MPP_TYPE_ integer(LONG_KIND)
950 #undef MPP_TYPE_BYTELEN_
951 #define MPP_TYPE_BYTELEN_ 8
952 #undef MPI_TYPE_
953 #define MPI_TYPE_ MPI_INTEGER8
954 #undef MPI_REDUCE_
955 #define MPI_REDUCE_ MPI_MAX
956 #include <mpp_reduce_mpi.h>
957 #endif
958 
959 #undef MPP_REDUCE_0D_
960 #define MPP_REDUCE_0D_ mpp_max_int4_0d
961 #undef MPP_REDUCE_1D_
962 #define MPP_REDUCE_1D_ mpp_max_int4_1d
963 #undef MPP_TYPE_
964 #define MPP_TYPE_ integer(INT_KIND)
965 #undef MPP_TYPE_BYTELEN_
966 #define MPP_TYPE_BYTELEN_ 4
967 #undef MPI_TYPE_
968 #define MPI_TYPE_ MPI_INTEGER4
969 #undef MPI_REDUCE_
970 #define MPI_REDUCE_ MPI_MAX
971 #include <mpp_reduce_mpi.h>
972 
973 #undef MPP_REDUCE_0D_
974 #define MPP_REDUCE_0D_ mpp_min_real8_0d
975 #undef MPP_REDUCE_1D_
976 #define MPP_REDUCE_1D_ mpp_min_real8_1d
977 #undef MPP_TYPE_
978 #define MPP_TYPE_ real(DOUBLE_KIND)
979 #undef MPP_TYPE_BYTELEN_
980 #define MPP_TYPE_BYTELEN_ 8
981 #undef MPI_TYPE_
982 #define MPI_TYPE_ MPI_REAL8
983 #undef MPI_REDUCE_
984 #define MPI_REDUCE_ MPI_MIN
985 #include <mpp_reduce_mpi.h>
986 
987 #ifdef OVERLOAD_R4
988 #undef MPP_REDUCE_0D_
989 #define MPP_REDUCE_0D_ mpp_min_real4_0d
990 #undef MPP_REDUCE_1D_
991 #define MPP_REDUCE_1D_ mpp_min_real4_1d
992 #undef MPP_TYPE_
993 #define MPP_TYPE_ real(FLOAT_KIND)
994 #undef MPP_TYPE_BYTELEN_
995 #define MPP_TYPE_BYTELEN_ 4
996 #undef MPI_TYPE_
997 #define MPI_TYPE_ MPI_REAL4
998 #undef MPI_REDUCE_
999 #define MPI_REDUCE_ MPI_MIN
1000 #include <mpp_reduce_mpi.h>
1001 #endif
1002 
1003 #ifndef no_8byte_integers
1004 #undef MPP_REDUCE_0D_
1005 #define MPP_REDUCE_0D_ mpp_min_int8_0d
1006 #undef MPP_REDUCE_1D_
1007 #define MPP_REDUCE_1D_ mpp_min_int8_1d
1008 #undef MPP_TYPE_
1009 #define MPP_TYPE_ integer(LONG_KIND)
1010 #undef MPP_TYPE_BYTELEN_
1011 #define MPP_TYPE_BYTELEN_ 8
1012 #undef MPI_TYPE_
1013 #define MPI_TYPE_ MPI_INTEGER8
1014 #undef MPI_REDUCE_
1015 #define MPI_REDUCE_ MPI_MIN
1016 #include <mpp_reduce_mpi.h>
1017 #endif
1018 
1019 #undef MPP_REDUCE_0D_
1020 #define MPP_REDUCE_0D_ mpp_min_int4_0d
1021 #undef MPP_REDUCE_1D_
1022 #define MPP_REDUCE_1D_ mpp_min_int4_1d
1023 #undef MPP_TYPE_
1024 #define MPP_TYPE_ integer(INT_KIND)
1025 #undef MPP_TYPE_BYTELEN_
1026 #define MPP_TYPE_BYTELEN_ 4
1027 #undef MPI_TYPE_
1028 #define MPI_TYPE_ MPI_INTEGER4
1029 #undef MPI_REDUCE_
1030 #define MPI_REDUCE_ MPI_MIN
1031 #include <mpp_reduce_mpi.h>
1032 
1033 #undef MPP_SUM_
1034 #define MPP_SUM_ mpp_sum_real8
1035 #undef MPP_SUM_SCALAR_
1036 #define MPP_SUM_SCALAR_ mpp_sum_real8_scalar
1037 #undef MPP_SUM_2D_
1038 #define MPP_SUM_2D_ mpp_sum_real8_2d
1039 #undef MPP_SUM_3D_
1040 #define MPP_SUM_3D_ mpp_sum_real8_3d
1041 #undef MPP_SUM_4D_
1042 #define MPP_SUM_4D_ mpp_sum_real8_4d
1043 #undef MPP_SUM_5D_
1044 #define MPP_SUM_5D_ mpp_sum_real8_5d
1045 #undef MPP_TYPE_
1046 #define MPP_TYPE_ real(DOUBLE_KIND)
1047 #undef MPI_TYPE_
1048 #define MPI_TYPE_ MPI_REAL8
1049 #undef MPP_TYPE_BYTELEN_
1050 #define MPP_TYPE_BYTELEN_ 8
1051 #include <mpp_sum_mpi.h>
1052 
1053 #ifdef OVERLOAD_C8
1054 #undef MPP_SUM_
1055 #define MPP_SUM_ mpp_sum_cmplx8
1056 #undef MPP_SUM_SCALAR_
1057 #define MPP_SUM_SCALAR_ mpp_sum_cmplx8_scalar
1058 #undef MPP_SUM_2D_
1059 #define MPP_SUM_2D_ mpp_sum_cmplx8_2d
1060 #undef MPP_SUM_3D_
1061 #define MPP_SUM_3D_ mpp_sum_cmplx8_3d
1062 #undef MPP_SUM_4D_
1063 #define MPP_SUM_4D_ mpp_sum_cmplx8_4d
1064 #undef MPP_SUM_5D_
1065 #define MPP_SUM_5D_ mpp_sum_cmplx8_5d
1066 #undef MPP_TYPE_
1067 #define MPP_TYPE_ complex(DOUBLE_KIND)
1068 #undef MPI_TYPE_
1069 #define MPI_TYPE_ MPI_DOUBLE_COMPLEX
1070 #undef MPP_TYPE_BYTELEN_
1071 #define MPP_TYPE_BYTELEN_ 16
1072 #include <mpp_sum_mpi.h>
1073 #endif
1074 
1075 #ifdef OVERLOAD_R4
1076 #undef MPP_SUM_
1077 #define MPP_SUM_ mpp_sum_real4
1078 #undef MPP_SUM_SCALAR_
1079 #define MPP_SUM_SCALAR_ mpp_sum_real4_scalar
1080 #undef MPP_SUM_2D_
1081 #define MPP_SUM_2D_ mpp_sum_real4_2d
1082 #undef MPP_SUM_3D_
1083 #define MPP_SUM_3D_ mpp_sum_real4_3d
1084 #undef MPP_SUM_4D_
1085 #define MPP_SUM_4D_ mpp_sum_real4_4d
1086 #undef MPP_SUM_5D_
1087 #define MPP_SUM_5D_ mpp_sum_real4_5d
1088 #undef MPP_TYPE_
1089 #define MPP_TYPE_ real(FLOAT_KIND)
1090 #undef MPI_TYPE_
1091 #define MPI_TYPE_ MPI_REAL4
1092 #undef MPP_TYPE_BYTELEN_
1093 #define MPP_TYPE_BYTELEN_ 4
1094 #include <mpp_sum_mpi.h>
1095 #endif
1096 
1097 #ifdef OVERLOAD_C4
1098 #undef MPP_SUM_
1099 #define MPP_SUM_ mpp_sum_cmplx4
1100 #undef MPP_SUM_SCALAR_
1101 #define MPP_SUM_SCALAR_ mpp_sum_cmplx4_scalar
1102 #undef MPP_SUM_2D_
1103 #define MPP_SUM_2D_ mpp_sum_cmplx4_2d
1104 #undef MPP_SUM_3D_
1105 #define MPP_SUM_3D_ mpp_sum_cmplx4_3d
1106 #undef MPP_SUM_4D_
1107 #define MPP_SUM_4D_ mpp_sum_cmplx4_4d
1108 #undef MPP_SUM_5D_
1109 #define MPP_SUM_5D_ mpp_sum_cmplx4_5d
1110 #undef MPP_TYPE_
1111 #define MPP_TYPE_ complex(FLOAT_KIND)
1112 #undef MPI_TYPE_
1113 #define MPI_TYPE_ MPI_COMPLEX
1114 #undef MPP_TYPE_BYTELEN_
1115 #define MPP_TYPE_BYTELEN_ 8
1116 #include <mpp_sum_mpi.h>
1117 #endif
1118 
1119 #ifndef no_8byte_integers
1120 #undef MPP_SUM_
1121 #define MPP_SUM_ mpp_sum_int8
1122 #undef MPP_SUM_SCALAR_
1123 #define MPP_SUM_SCALAR_ mpp_sum_int8_scalar
1124 #undef MPP_SUM_2D_
1125 #define MPP_SUM_2D_ mpp_sum_int8_2d
1126 #undef MPP_SUM_3D_
1127 #define MPP_SUM_3D_ mpp_sum_int8_3d
1128 #undef MPP_SUM_4D_
1129 #define MPP_SUM_4D_ mpp_sum_int8_4d
1130 #undef MPP_SUM_5D_
1131 #define MPP_SUM_5D_ mpp_sum_int8_5d
1132 #undef MPP_TYPE_
1133 #define MPP_TYPE_ integer(LONG_KIND)
1134 #undef MPI_TYPE_
1135 #define MPI_TYPE_ MPI_INTEGER8
1136 #undef MPP_TYPE_BYTELEN_
1137 #define MPP_TYPE_BYTELEN_ 8
1138 #include <mpp_sum_mpi.h>
1139 #endif
1140 
1141 #undef MPP_SUM_
1142 #define MPP_SUM_ mpp_sum_int4
1143 #undef MPP_SUM_SCALAR_
1144 #define MPP_SUM_SCALAR_ mpp_sum_int4_scalar
1145 #undef MPP_SUM_2D_
1146 #define MPP_SUM_2D_ mpp_sum_int4_2d
1147 #undef MPP_SUM_3D_
1148 #define MPP_SUM_3D_ mpp_sum_int4_3d
1149 #undef MPP_SUM_4D_
1150 #define MPP_SUM_4D_ mpp_sum_int4_4d
1151 #undef MPP_SUM_5D_
1152 #define MPP_SUM_5D_ mpp_sum_int4_5d
1153 #undef MPP_TYPE_
1154 #define MPP_TYPE_ integer(INT_KIND)
1155 #undef MPI_TYPE_
1156 #define MPI_TYPE_ MPI_INTEGER4
1157 #undef MPP_TYPE_BYTELEN_
1158 #define MPP_TYPE_BYTELEN_ 4
1159 #include <mpp_sum_mpi.h>
1160 !--------------------------------
1161 #undef MPP_SUM_AD_
1162 #define MPP_SUM_AD_ mpp_sum_real8_ad
1163 #undef MPP_SUM_SCALAR_AD_
1164 #define MPP_SUM_SCALAR_AD_ mpp_sum_real8_scalar_ad
1165 #undef MPP_SUM_2D_AD_
1166 #define MPP_SUM_2D_AD_ mpp_sum_real8_2d_ad
1167 #undef MPP_SUM_3D_AD_
1168 #define MPP_SUM_3D_AD_ mpp_sum_real8_3d_ad
1169 #undef MPP_SUM_4D_AD_
1170 #define MPP_SUM_4D_AD_ mpp_sum_real8_4d_ad
1171 #undef MPP_SUM_5D_AD_
1172 #define MPP_SUM_5D_AD_ mpp_sum_real8_5d_ad
1173 #undef MPP_TYPE_
1174 #define MPP_TYPE_ real(DOUBLE_KIND)
1175 #undef MPI_TYPE_
1176 #define MPI_TYPE_ MPI_REAL8
1177 #undef MPP_TYPE_BYTELEN_
1178 #define MPP_TYPE_BYTELEN_ 8
1179 #include <mpp_sum_mpi_ad.h>
1180 
1181 #ifdef OVERLOAD_C8
1182 #undef MPP_SUM_AD_
1183 #define MPP_SUM_AD_ mpp_sum_cmplx8_ad
1184 #undef MPP_SUM_SCALAR_AD_
1185 #define MPP_SUM_SCALAR_AD_ mpp_sum_cmplx8_scalar_ad
1186 #undef MPP_SUM_2D_AD_
1187 #define MPP_SUM_2D_AD_ mpp_sum_cmplx8_2d_ad
1188 #undef MPP_SUM_3D_AD_
1189 #define MPP_SUM_3D_AD_ mpp_sum_cmplx8_3d_ad
1190 #undef MPP_SUM_4D_AD_
1191 #define MPP_SUM_4D_AD_ mpp_sum_cmplx8_4d_ad
1192 #undef MPP_SUM_5D_AD_
1193 #define MPP_SUM_5D_AD_ mpp_sum_cmplx8_5d_ad
1194 #undef MPP_TYPE_
1195 #define MPP_TYPE_ complex(DOUBLE_KIND)
1196 #undef MPI_TYPE_
1197 #define MPI_TYPE_ MPI_DOUBLE_COMPLEX
1198 #undef MPP_TYPE_BYTELEN_
1199 #define MPP_TYPE_BYTELEN_ 16
1200 #include <mpp_sum_mpi_ad.h>
1201 #endif
1202 
1203 #ifdef OVERLOAD_R4
1204 #undef MPP_SUM_AD_
1205 #define MPP_SUM_AD_ mpp_sum_real4_ad
1206 #undef MPP_SUM_SCALAR_AD_
1207 #define MPP_SUM_SCALAR_AD_ mpp_sum_real4_scalar_ad
1208 #undef MPP_SUM_2D_AD_
1209 #define MPP_SUM_2D_AD_ mpp_sum_real4_2d_ad
1210 #undef MPP_SUM_3D_AD_
1211 #define MPP_SUM_3D_AD_ mpp_sum_real4_3d_ad
1212 #undef MPP_SUM_4D_AD_
1213 #define MPP_SUM_4D_AD_ mpp_sum_real4_4d_ad
1214 #undef MPP_SUM_5D_AD_
1215 #define MPP_SUM_5D_AD_ mpp_sum_real4_5d_ad
1216 #undef MPP_TYPE_
1217 #define MPP_TYPE_ real(FLOAT_KIND)
1218 #undef MPI_TYPE_
1219 #define MPI_TYPE_ MPI_REAL4
1220 #undef MPP_TYPE_BYTELEN_
1221 #define MPP_TYPE_BYTELEN_ 4
1222 #include <mpp_sum_mpi_ad.h>
1223 #endif
1224 
1225 #ifdef OVERLOAD_C4
1226 #undef MPP_SUM_AD_
1227 #define MPP_SUM_AD_ mpp_sum_cmplx4_ad
1228 #undef MPP_SUM_SCALAR_AD_
1229 #define MPP_SUM_SCALAR_AD_ mpp_sum_cmplx4_scalar_ad
1230 #undef MPP_SUM_2D_AD_
1231 #define MPP_SUM_2D_AD_ mpp_sum_cmplx4_2d_ad
1232 #undef MPP_SUM_3D_AD_
1233 #define MPP_SUM_3D_AD_ mpp_sum_cmplx4_3d_ad
1234 #undef MPP_SUM_4D_AD_
1235 #define MPP_SUM_4D_AD_ mpp_sum_cmplx4_4d_ad
1236 #undef MPP_SUM_5D_AD_
1237 #define MPP_SUM_5D_AD_ mpp_sum_cmplx4_5d_ad
1238 #undef MPP_TYPE_
1239 #define MPP_TYPE_ complex(FLOAT_KIND)
1240 #undef MPI_TYPE_
1241 #define MPI_TYPE_ MPI_COMPLEX
1242 #undef MPP_TYPE_BYTELEN_
1243 #define MPP_TYPE_BYTELEN_ 8
1244 #include <mpp_sum_mpi_ad.h>
1245 #endif
1246 
1247 #ifndef no_8byte_integers
1248 #undef MPP_SUM_AD_
1249 #define MPP_SUM_AD_ mpp_sum_int8_ad
1250 #undef MPP_SUM_SCALAR_AD_
1251 #define MPP_SUM_SCALAR_AD_ mpp_sum_int8_scalar_ad
1252 #undef MPP_SUM_2D_AD_
1253 #define MPP_SUM_2D_AD_ mpp_sum_int8_2d_ad
1254 #undef MPP_SUM_3D_AD_
1255 #define MPP_SUM_3D_AD_ mpp_sum_int8_3d_ad
1256 #undef MPP_SUM_4D_AD_
1257 #define MPP_SUM_4D_AD_ mpp_sum_int8_4d_ad
1258 #undef MPP_SUM_5D_AD_
1259 #define MPP_SUM_5D_AD_ mpp_sum_int8_5d_ad
1260 #undef MPP_TYPE_
1261 #define MPP_TYPE_ integer(LONG_KIND)
1262 #undef MPI_TYPE_
1263 #define MPI_TYPE_ MPI_INTEGER8
1264 #undef MPP_TYPE_BYTELEN_
1265 #define MPP_TYPE_BYTELEN_ 8
1266 #include <mpp_sum_mpi_ad.h>
1267 #endif
1268 
1269 #undef MPP_SUM_AD_
1270 #define MPP_SUM_AD_ mpp_sum_int4_ad
1271 #undef MPP_SUM_SCALAR_AD_
1272 #define MPP_SUM_SCALAR_AD_ mpp_sum_int4_scalar_ad
1273 #undef MPP_SUM_2D_AD_
1274 #define MPP_SUM_2D_AD_ mpp_sum_int4_2d_ad
1275 #undef MPP_SUM_3D_AD_
1276 #define MPP_SUM_3D_AD_ mpp_sum_int4_3d_ad
1277 #undef MPP_SUM_4D_AD_
1278 #define MPP_SUM_4D_AD_ mpp_sum_int4_4d_ad
1279 #undef MPP_SUM_5D_AD_
1280 #define MPP_SUM_5D_AD_ mpp_sum_int4_5d_ad
1281 #undef MPP_TYPE_
1282 #define MPP_TYPE_ integer(INT_KIND)
1283 #undef MPI_TYPE_
1284 #define MPI_TYPE_ MPI_INTEGER4
1285 #undef MPP_TYPE_BYTELEN_
1286 #define MPP_TYPE_BYTELEN_ 4
1287 #include <mpp_sum_mpi_ad.h>
1288 
1289 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1290 ! !
1291 ! SCATTER AND GATHER ROUTINES: mpp_alltoall !
1292 ! !
1293 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1294 
1295 #undef MPP_ALLTOALL_
1296 #undef MPP_ALLTOALLV_
1297 #undef MPP_ALLTOALLW_
1298 #undef MPP_TYPE_
1299 #undef MPP_TYPE_BYTELEN_
1300 #undef MPI_TYPE_
1301 #define MPP_ALLTOALL_ mpp_alltoall_int4
1302 #define MPP_ALLTOALLV_ mpp_alltoall_int4_v
1303 #define MPP_ALLTOALLW_ mpp_alltoall_int4_w
1304 #define MPP_TYPE_ integer(INT_KIND)
1305 #define MPP_TYPE_BYTELEN_ 4
1306 #define MPI_TYPE_ MPI_INTEGER4
1307 #include <mpp_alltoall_mpi.h>
1308 
1309 #undef MPP_ALLTOALL_
1310 #undef MPP_ALLTOALLV_
1311 #undef MPP_ALLTOALLW_
1312 #undef MPP_TYPE_
1313 #undef MPP_TYPE_BYTELEN_
1314 #undef MPI_TYPE_
1315 #define MPP_ALLTOALL_ mpp_alltoall_int8
1316 #define MPP_ALLTOALLV_ mpp_alltoall_int8_v
1317 #define MPP_ALLTOALLW_ mpp_alltoall_int8_w
1318 #define MPP_TYPE_ integer(LONG_KIND)
1319 #define MPP_TYPE_BYTELEN_ 8
1320 #define MPI_TYPE_ MPI_INTEGER8
1321 #include <mpp_alltoall_mpi.h>
1322 
1323 #undef MPP_ALLTOALL_
1324 #undef MPP_ALLTOALLV_
1325 #undef MPP_ALLTOALLW_
1326 #undef MPP_TYPE_
1327 #undef MPP_TYPE_BYTELEN_
1328 #undef MPI_TYPE_
1329 #define MPP_ALLTOALL_ mpp_alltoall_real4
1330 #define MPP_ALLTOALLV_ mpp_alltoall_real4_v
1331 #define MPP_ALLTOALLW_ mpp_alltoall_real4_w
1332 #define MPP_TYPE_ real(FLOAT_KIND)
1333 #define MPP_TYPE_BYTELEN_ 4
1334 #define MPI_TYPE_ MPI_REAL4
1335 #include <mpp_alltoall_mpi.h>
1336 
1337 #undef MPP_ALLTOALL_
1338 #undef MPP_ALLTOALLV_
1339 #undef MPP_ALLTOALLW_
1340 #undef MPP_TYPE_
1341 #undef MPP_TYPE_BYTELEN_
1342 #undef MPI_TYPE_
1343 #define MPP_ALLTOALL_ mpp_alltoall_real8
1344 #define MPP_ALLTOALLV_ mpp_alltoall_real8_v
1345 #define MPP_ALLTOALLW_ mpp_alltoall_real8_w
1346 #define MPP_TYPE_ real(DOUBLE_KIND)
1347 #define MPP_TYPE_BYTELEN_ 8
1348 #define MPI_TYPE_ MPI_REAL8
1349 #include <mpp_alltoall_mpi.h>
1350 
1351 #undef MPP_ALLTOALL_
1352 #undef MPP_ALLTOALLV_
1353 #undef MPP_ALLTOALLW_
1354 #undef MPP_TYPE_
1355 #undef MPP_TYPE_BYTELEN_
1356 #undef MPI_TYPE_
1357 #define MPP_ALLTOALL_ mpp_alltoall_logical4
1358 #define MPP_ALLTOALLV_ mpp_alltoall_logical4_v
1359 #define MPP_ALLTOALLW_ mpp_alltoall_logical4_w
1360 #define MPP_TYPE_ logical(INT_KIND)
1361 #define MPP_TYPE_BYTELEN_ 4
1362 #define MPI_TYPE_ MPI_INTEGER4
1363 #include <mpp_alltoall_mpi.h>
1364 
1365 #undef MPP_ALLTOALL_
1366 #undef MPP_ALLTOALLV_
1367 #undef MPP_ALLTOALLW_
1368 #undef MPP_TYPE_
1369 #undef MPP_TYPE_BYTELEN_
1370 #undef MPI_TYPE_
1371 #define MPP_ALLTOALL_ mpp_alltoall_logical8
1372 #define MPP_ALLTOALLV_ mpp_alltoall_logical8_v
1373 #define MPP_ALLTOALLW_ mpp_alltoall_logical8_w
1374 #define MPP_TYPE_ logical(LONG_KIND)
1375 #define MPP_TYPE_BYTELEN_ 8
1376 #define MPI_TYPE_ MPI_INTEGER8
1377 #include <mpp_alltoall_mpi.h>
1378 
1379 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1380 ! !
1381 ! DATA TRANSFER TYPES: mpp_type_create, mpp_type_free !
1382 ! !
1383 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1384 
1385 #define MPP_TYPE_CREATE_ mpp_type_create_int4
1386 #define MPP_TYPE_ integer(INT_KIND)
1387 #define MPI_TYPE_ MPI_INTEGER4
1388 #include <mpp_type_mpi.h>
1389 
1390 #define MPP_TYPE_CREATE_ mpp_type_create_int8
1391 #define MPP_TYPE_ integer(LONG_KIND)
1392 #define MPI_TYPE_ MPI_INTEGER8
1393 #include <mpp_type_mpi.h>
1394 
1395 #define MPP_TYPE_CREATE_ mpp_type_create_real4
1396 #define MPP_TYPE_ real(FLOAT_KIND)
1397 #define MPI_TYPE_ MPI_REAL4
1398 #include <mpp_type_mpi.h>
1399 
1400 #define MPP_TYPE_CREATE_ mpp_type_create_real8
1401 #define MPP_TYPE_ real(DOUBLE_KIND)
1402 #define MPI_TYPE_ MPI_REAL8
1403 #include <mpp_type_mpi.h>
1404 
1405 #define MPP_TYPE_CREATE_ mpp_type_create_logical4
1406 #define MPP_TYPE_ logical(INT_KIND)
1407 #define MPI_TYPE_ MPI_INTEGER4
1408 #include <mpp_type_mpi.h>
1409 
1410 #define MPP_TYPE_CREATE_ mpp_type_create_logical8
1411 #define MPP_TYPE_ logical(LONG_KIND)
1412 #define MPI_TYPE_ MPI_INTEGER8
1413 #include <mpp_type_mpi.h>
1414 
1415 ! Clear preprocessor flags
1416 #undef MPI_TYPE_
1417 #undef MPP_TYPE_
1418 #undef MPP_TYPE_CREATE_
1419 
1420 ! NOTE: This should probably not take a pointer, but for now we do this.
1421 subroutine mpp_type_free(dtype)
1422  type(mpp_type), pointer, intent(inout) :: dtype
1423 
1424  if (.NOT. module_is_initialized) &
1425  call mpp_error(FATAL, 'MPP_TYPE_FREE: You must first call mpp_init.')
1426 
1427  if (current_clock .NE. 0) &
1428  call SYSTEM_CLOCK(start_tick)
1429 
1430  if (verbose) &
1431  call mpp_error(NOTE, 'MPP_TYPE_FREE: using MPI_Type_free...')
1432 
1433  ! Decrement the reference counter
1434  dtype%counter = dtype%counter - 1
1435 
1436  if (dtype%counter < 1) then
1437  ! De-register the datatype in MPI runtime
1438  call MPI_Type_free(dtype%id, error)
1439 
1440  ! Remove from list
1441  dtype%prev => dtype%next
1442 
1443  ! Remove from memory
1444  if (allocated(dtype%sizes)) deallocate(dtype%sizes)
1445  if (allocated(dtype%subsizes)) deallocate(dtype%subsizes)
1446  if (allocated(dtype%starts)) deallocate(dtype%starts)
1447  deallocate(dtype)
1448 
1449  datatypes%length = datatypes%length - 1
1450  end if
1451 
1452  if (current_clock .NE. 0) &
1453  call increment_current_clock(EVENT_TYPE_FREE, MPP_TYPE_BYTELEN_)
1454 
1455 end subroutine mpp_type_free
mpp_transmit_mpi.h
external_ic_nlm_mod::iunit
integer iunit
Definition: external_ic_nlm.F90:74
will
************************************************************************GNU Lesser General Public License **This file is part of the GFDL Flexible Modeling System(FMS). ! *! *FMS is free software without even the implied warranty of MERCHANTABILITY or *FITNESS FOR A PARTICULAR PURPOSE See the GNU General Public License *for more details **You should have received a copy of the GNU Lesser General Public *License along with FMS If see< http:! ***********************************************************************!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! MPP_TRANSMIT !! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine MPP_TRANSMIT_(put_data, put_len, to_pe, get_data, get_len, from_pe, block, tag, recv_request, send_request)!a message-passing routine intended to be reminiscent equally of both MPI and SHMEM!put_data and get_data are contiguous MPP_TYPE_ arrays!at each call, your put_data array is put to to_pe 's get_data! your get_data array is got from from_pe 's put_data!i.e we assume that typically(e.g updating halo regions) each PE performs a put _and_ a get!special PE designations:! NULL_PE:to disable a put or a get(e.g at boundaries)! ANY_PE:if remote PE for the put or get is to be unspecific! ALL_PES:broadcast and collect operations(collect not yet implemented)!ideally we would not pass length, but this f77-style call performs better(arrays passed by address, not descriptor)!further, this permits< length > contiguous words from an array of any rank to be passed(avoiding f90 rank conformance check)!caller is responsible for completion checks(mpp_sync_self) before and after integer, intent(in) ::put_len, to_pe, get_len, from_pe MPP_TYPE_, intent(in) ::put_data(*) MPP_TYPE_, intent(out) ::get_data(*) logical, intent(in), optional ::block integer, intent(in), optional ::tag integer, intent(out), optional ::recv_request, send_request logical ::block_comm integer ::i MPP_TYPE_, allocatable, save ::local_data(:) !local copy used by non-parallel code(no SHMEM or MPI) integer ::comm_tag integer ::rsize if(.NOT.module_is_initialized) call mpp_error(FATAL, 'MPP_TRANSMIT:You must first call mpp_init.') if(to_pe.EQ.NULL_PE .AND. from_pe.EQ.NULL_PE) return block_comm=.true. if(PRESENT(block)) block_comm=block if(debug) then call SYSTEM_CLOCK(tick) write(stdout_unit,'(a, i18, a, i6, a, 2i6, 2i8)')&'T=', tick, ' PE=', pe, ' MPP_TRANSMIT begin:to_pe, from_pe, put_len, get_len=', to_pe, from_pe, put_len, get_len end if comm_tag=DEFAULT_TAG if(present(tag)) comm_tag=tag!do put first and then get if(to_pe.GE.0 .AND. to_pe.LT.npes) then!use non-blocking sends if(debug .and.(current_clock.NE.0)) call SYSTEM_CLOCK(start_tick)!z1l:truly non-blocking send.! if(request(to_pe).NE.MPI_REQUEST_NULL) then !only one message from pe-> to_pe in queue *PE waiting for to_pe ! call error else get_len so only do gets but you cannot have a pure get with MPI call a get means do a wait to ensure put on remote PE is complete error call increase mpp_nml request_multiply call MPP_TRANSMIT get_len end if return end subroutine MPP_TRANSMIT_ ! MPP_BROADCAST ! subroutine but that doesn t allow !broadcast to a subset of PEs This version will
Definition: mpp_transmit_mpi.h:166
integer
*f90 *************************************************************************GNU Lesser General Public License **This file is part of the GFDL Flexible Modeling System(FMS). ! *! *FMS is free software without even the implied warranty of MERCHANTABILITY or *FITNESS FOR A PARTICULAR PURPOSE See the GNU General Public License *for more details **You should have received a copy of the GNU Lesser General Public *License along with FMS If see< http:! ***********************************************************************subroutine MPP_UPDATE_NEST_FINE_2D_(field, nest_domain, wbuffer, ebuffer, sbuffer, nbuffer, &flags, complete, position, extra_halo, name, tile_count) MPP_TYPE_, intent(in) ::field(:,:) type(nest_domain_type), intent(inout) ::nest_domain MPP_TYPE_, intent(inout) ::wbuffer(:,:) MPP_TYPE_, intent(inout) ::ebuffer(:,:) MPP_TYPE_, intent(inout) ::sbuffer(:,:) MPP_TYPE_, intent(inout) ::nbuffer(:,:) integer, intent(in), optional ::flags logical, intent(in), optional ::complete integer, intent(in), optional ::position integer, intent(in), optional ::extra_halo character(len= *), intent(in), optional ::name integer, intent(in), optional ::tile_count MPP_TYPE_ ::field3D(size(field, 1), size(field, 2), 1) MPP_TYPE_ ::wbuffer3D(size(wbuffer, 1), size(wbuffer, 2), 1) MPP_TYPE_ ::ebuffer3D(size(ebuffer, 1), size(ebuffer, 2), 1) MPP_TYPE_ ::sbuffer3D(size(sbuffer, 1), size(sbuffer, 2), 1) MPP_TYPE_ ::nbuffer3D(size(nbuffer, 1), size(nbuffer, 2), 1) pointer(ptr, field3D) pointer(ptr_w, wbuffer3D) pointer(ptr_e, ebuffer3D) pointer(ptr_s, sbuffer3D) pointer(ptr_n, nbuffer3D) ptr=LOC(field) ptr_w=LOC(wbuffer) ptr_e=LOC(ebuffer) ptr_s=LOC(sbuffer) ptr_n=LOC(nbuffer) call mpp_update_nest_fine(field3D, nest_domain, wbuffer3D, ebuffer3D, sbuffer3D, nbuffer3D, &flags, complete, position, extra_halo, name, tile_count) returnend subroutine MPP_UPDATE_NEST_FINE_2D_subroutine MPP_UPDATE_NEST_FINE_3D_(field, nest_domain, wbuffer, sbuffer, ebuffer, nbuffer, &flags, complete, position, extra_halo, name, tile_count) MPP_TYPE_, intent(in) ::field(:,:,:) type(nest_domain_type), intent(inout) ::nest_domain MPP_TYPE_, intent(inout) ::wbuffer(:,:,:) MPP_TYPE_, intent(inout) ::ebuffer(:,:,:) MPP_TYPE_, intent(inout) ::sbuffer(:,:,:) MPP_TYPE_, intent(inout) ::nbuffer(:,:,:) integer, intent(in), optional ::flags logical, intent(in), optional ::complete integer, intent(in), optional ::position integer, intent(in), optional ::extra_halo character(len= *), intent(in), optional ::name integer, intent(in), optional ::tile_count MPP_TYPE_ ::d_type type(nestSpec), pointer ::update=> set_mismatch integer ::tile update_position nbuffersz l_size integer
Definition: mpp_update_nest_domains.h:79
i
l_size ! loop over number of fields ke do je do i
Definition: mpp_do_redistribute.h:71
PE
l_size ! loop over number of fields ke do je do ie to PE
Definition: mpp_do_redistribute.h:72
unit
************************************************************************GNU Lesser General Public License **This file is part of the GFDL Flexible Modeling System(FMS). ! *! *FMS is free software without even the implied warranty of MERCHANTABILITY or *FITNESS FOR A PARTICULAR PURPOSE See the GNU General Public License *for more details **You should have received a copy of the GNU Lesser General Public *License along with FMS If see< http:! ***********************************************************************subroutine READ_RECORD_CORE_(unit, field, nwords, data, start, axsiz) integer, intent(in) ::unit type(fieldtype), intent(in) ::field integer, intent(in) ::nwords MPP_TYPE_, intent(inout) ::data(nwords) integer, intent(in) ::start(:), axsiz(:) integer(SHORT_KIND) ::i2vals(nwords)!rab used in conjunction with transfer intrinsic to determine size of a variable integer(KIND=1) ::one_byte(8) integer ::word_sz!#ifdef __sgi integer(INT_KIND) ::ivals(nwords) real(FLOAT_KIND) ::rvals(nwords)!#else! integer ::ivals(nwords)! real ::rvals(nwords)!#endif real(DOUBLE_KIND) ::r8vals(nwords) pointer(ptr1, i2vals) pointer(ptr2, ivals) pointer(ptr3, rvals) pointer(ptr4, r8vals) if(mpp_io_stack_size< nwords) call mpp_io_set_stack_size(nwords) call mpp_error(FATAL, 'MPP_READ currently requires use_netCDF option') end subroutine READ_RECORD_CORE_ subroutine READ_RECORD_(unit, field, nwords, data, time_level, domain, position, tile_count, start_in, axsiz_in)!routine that is finally called by all mpp_read routines to perform the read!a non-netCDF record contains:! field ID! a set of 4 coordinates(is:ie, js:je) giving the data subdomain! a timelevel and a timestamp(=NULLTIME if field is static)! 3D real data(stored as 1D)!if you are using direct access I/O, the RECL argument to OPEN must be large enough for the above!in a global direct access file, record position on PE is given by %record.!Treatment of timestamp:! We assume that static fields have been passed without a timestamp.! Here that is converted into a timestamp of NULLTIME.! For non-netCDF fields, field is treated no differently, but is written! with a timestamp of NULLTIME. There is no check in the code to prevent! the user from repeatedly writing a static field. integer, intent(in) ::unit, nwords type(fieldtype), intent(in) ::field MPP_TYPE_, intent(inout) ::data(nwords) integer, intent(in), optional ::time_level type(domain2D), intent(in), optional ::domain integer, intent(in), optional ::position, tile_count integer, intent(in), optional ::start_in(:), axsiz_in(:) integer, dimension(size(field%axes(:))) ::start, axsiz integer ::tlevel !, subdomain(4) integer ::i, error, is, ie, js, je, isg, ieg, jsg, jeg type(domain2d), pointer ::io_domain=> unit
Definition: mpp_read_2Ddecomp.h:167
mpp_io_mod::unit_begin
integer unit_begin
Definition: mpp_io.F90:1047
mpp_io_mod::unit_end
integer unit_end
Definition: mpp_io.F90:1047
crtm_lowfrequency_mwssem::n
integer n
Definition: CRTM_LowFrequency_MWSSEM.f90:172
mpp_data_mod
Definition: mpp_data.F90:19
mpp_mod::max_ticks
integer(long_kind) max_ticks
Definition: mpp.F90:1299
type_kinds::long
integer, parameter, public long
Definition: Type_Kinds.f90:76
npes
int npes
Definition: threadloc.c:26
mpp_mod::current_peset_num
integer current_peset_num
Definition: mpp.F90:1308
fv3jedi_increment_mod::copy
subroutine, public copy(self, rhs)
Definition: fv3jedi_increment_mod.f90:254
mpp_sum_mpi.h
end
************************************************************************GNU Lesser General Public License **This file is part of the GFDL Flexible Modeling System(FMS). ! *! *FMS is free software without even the implied warranty of MERCHANTABILITY or *FITNESS FOR A PARTICULAR PURPOSE See the GNU General Public License *for more details **You should have received a copy of the GNU Lesser General Public *License along with FMS If see< http:! ***********************************************************************!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! MPP_TRANSMIT !! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine MPP_TRANSMIT_(put_data, put_len, to_pe, get_data, get_len, from_pe, block, tag, recv_request, send_request)!a message-passing routine intended to be reminiscent equally of both MPI and SHMEM!put_data and get_data are contiguous MPP_TYPE_ arrays!at each call, your put_data array is put to to_pe 's get_data! your get_data array is got from from_pe 's put_data!i.e we assume that typically(e.g updating halo regions) each PE performs a put _and_ a get!special PE designations:! NULL_PE:to disable a put or a get(e.g at boundaries)! ANY_PE:if remote PE for the put or get is to be unspecific! ALL_PES:broadcast and collect operations(collect not yet implemented)!ideally we would not pass length, but this f77-style call performs better(arrays passed by address, not descriptor)!further, this permits< length > contiguous words from an array of any rank to be passed(avoiding f90 rank conformance check)!caller is responsible for completion checks(mpp_sync_self) before and after integer, intent(in) ::put_len, to_pe, get_len, from_pe MPP_TYPE_, intent(in) ::put_data(*) MPP_TYPE_, intent(out) ::get_data(*) logical, intent(in), optional ::block integer, intent(in), optional ::tag integer, intent(out), optional ::recv_request, send_request logical ::block_comm integer ::i MPP_TYPE_, allocatable, save ::local_data(:) !local copy used by non-parallel code(no SHMEM or MPI) integer ::comm_tag integer ::rsize if(.NOT.module_is_initialized) call mpp_error(FATAL, 'MPP_TRANSMIT:You must first call mpp_init.') if(to_pe.EQ.NULL_PE .AND. from_pe.EQ.NULL_PE) return block_comm=.true. if(PRESENT(block)) block_comm=block if(debug) then call SYSTEM_CLOCK(tick) write(stdout_unit,'(a, i18, a, i6, a, 2i6, 2i8)')&'T=', tick, ' PE=', pe, ' MPP_TRANSMIT begin:to_pe, from_pe, put_len, get_len=', to_pe, from_pe, put_len, get_len end if comm_tag=DEFAULT_TAG if(present(tag)) comm_tag=tag!do put first and then get if(to_pe.GE.0 .AND. to_pe.LT.npes) then!use non-blocking sends if(debug .and.(current_clock.NE.0)) call SYSTEM_CLOCK(start_tick)!z1l:truly non-blocking send.! if(request(to_pe).NE.MPI_REQUEST_NULL) then !only one message from pe-> to_pe in queue *PE waiting for to_pe ! call error else get_len so only do gets but you cannot have a pure get with MPI call a get means do a wait to ensure put on remote PE is complete error call increase mpp_nml request_multiply call MPP_TRANSMIT end
Definition: mpp_transmit_mpi.h:153
cloudcoeff_define::set
integer, parameter set
Definition: CloudCoeff_Define.f90:63
mpp_type_mpi.h
mpp_mod::mpp_stack_hwm
integer mpp_stack_hwm
Definition: mpp.F90:1361
mpp_io_mod::text
character(len=256) text
Definition: mpp_io.F90:1051
tools_func::divide
subroutine, public divide(value, num)
Definition: tools_func.F90:214
make_check_data.out
out
Definition: make_check_data.py:458
mpp_mod::mpp_stack_size
integer mpp_stack_size
Definition: mpp.F90:1361
external_ic_nlm_mod::status
integer status
Definition: external_ic_nlm.F90:73
horiz_interp_conserve_mod::root_pe
integer root_pe
Definition: horiz_interp_conserve.F90:110
interpolator_mod::units
character(len=32) units
No description.
Definition: interpolator.F90:329
mpp_mod::in_unit
integer in_unit
Definition: mpp.F90:1332
mpp_mod::etcfile
character(len=32) etcfile
Definition: mpp.F90:1326
type_kinds::single
integer, parameter, public single
Definition: Type_Kinds.f90:105
mpp_mod::stdout_unit
integer stdout_unit
Definition: mpp.F90:1337
from_pe
from from_pe
Definition: mpp_do_redistribute.h:93
j
l_size ! loop over number of fields ke do j
Definition: mpp_do_redistribute.h:70
mpp_mod::etc_unit
integer etc_unit
Definition: mpp.F90:1306
interpolator_mod::name
character(len=32) name
Definition: interpolator.F90:329
if
l_size ! loop over number of fields ke do je do ie to je n if(.NOT. d_comm%R_do_buf(list)) cycle from_pe
amip_interp_mod::module_is_initialized
logical module_is_initialized
Definition: amip_interp.F90:272
mersennetwister_mod::m
integer, parameter m
Definition: MersenneTwister.F90:79
ensemble_manager_mod::pe
integer pe
Definition: ensemble_manager.F90:50
mpp_mod::input_nml_file
character(len=input_str_length), dimension(:), allocatable, target, public input_nml_file
Definition: mpp.F90:1378
diag_integral_mod::version
character(len=128) version
Definition: diag_integral.F90:121
mpp_mod::clock0
integer clock0
Definition: mpp.F90:1360
mpp_mod::world_peset_num
integer world_peset_num
Definition: mpp.F90:1309
mpp_mod::debug
logical debug
Definition: mpp.F90:1297
is
l_size ! loop over number of fields ke do je do ie to is
Definition: mpp_do_redistribute.h:72
mpp_mod::peset
type(communicator), dimension(:), allocatable peset
Definition: mpp.F90:1295
mpp_mod::out_unit
integer out_unit
Definition: mpp.F90:1332
SYSTEM_CLOCK
#define SYSTEM_CLOCK
c2f.type
type
Definition: c2f.py:15
mpp_mod::clock_num
integer clock_num
Definition: mpp.F90:1311
length
************************************************************************GNU Lesser General Public License **This file is part of the GFDL Flexible Modeling System(FMS). ! *! *FMS is free software without even the implied warranty of MERCHANTABILITY or *FITNESS FOR A PARTICULAR PURPOSE See the GNU General Public License *for more details **You should have received a copy of the GNU Lesser General Public *License along with FMS If see< http:! ***********************************************************************!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! MPP_TRANSMIT !! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine MPP_TRANSMIT_(put_data, put_len, to_pe, get_data, get_len, from_pe, block, tag, recv_request, send_request)!a message-passing routine intended to be reminiscent equally of both MPI and SHMEM!put_data and get_data are contiguous MPP_TYPE_ arrays!at each call, your put_data array is put to to_pe 's get_data! your get_data array is got from from_pe 's put_data!i.e we assume that typically(e.g updating halo regions) each PE performs a put _and_ a get!special PE designations:! NULL_PE:to disable a put or a get(e.g at boundaries)! ANY_PE:if remote PE for the put or get is to be unspecific! ALL_PES:broadcast and collect operations(collect not yet implemented)!ideally we would not pass length, but this f77-style call performs better(arrays passed by address, not descriptor)!further, this permits< length > contiguous words from an array of any rank to be passed(avoiding f90 rank conformance check)!caller is responsible for completion checks(mpp_sync_self) before and after integer, intent(in) ::put_len, to_pe, get_len, from_pe MPP_TYPE_, intent(in) ::put_data(*) MPP_TYPE_, intent(out) ::get_data(*) logical, intent(in), optional ::block integer, intent(in), optional ::tag integer, intent(out), optional ::recv_request, send_request logical ::block_comm integer ::i MPP_TYPE_, allocatable, save ::local_data(:) !local copy used by non-parallel code(no SHMEM or MPI) integer ::comm_tag integer ::rsize if(.NOT.module_is_initialized) call mpp_error(FATAL, 'MPP_TRANSMIT:You must first call mpp_init.') if(to_pe.EQ.NULL_PE .AND. from_pe.EQ.NULL_PE) return block_comm=.true. if(PRESENT(block)) block_comm=block if(debug) then call SYSTEM_CLOCK(tick) write(stdout_unit,'(a, i18, a, i6, a, 2i6, 2i8)')&'T=', tick, ' PE=', pe, ' MPP_TRANSMIT begin:to_pe, from_pe, put_len, get_len=', to_pe, from_pe, put_len, get_len end if comm_tag=DEFAULT_TAG if(present(tag)) comm_tag=tag!do put first and then get if(to_pe.GE.0 .AND. to_pe.LT.npes) then!use non-blocking sends if(debug .and.(current_clock.NE.0)) call SYSTEM_CLOCK(start_tick)!z1l:truly non-blocking send.! if(request(to_pe).NE.MPI_REQUEST_NULL) then !only one message from pe-> to_pe in queue *PE waiting for to_pe ! call error else get_len so only do gets but you cannot have a pure get with MPI call a get means do a wait to ensure put on remote PE is complete error call increase mpp_nml request_multiply call MPP_TRANSMIT get_len end if return end subroutine MPP_TRANSMIT_ ! MPP_BROADCAST ! subroutine but that doesn t allow !broadcast to a subset of PEs This version and mpp_transmit will remain !backward compatible intent(inout) MPP_BROADCAST length
Definition: mpp_transmit_mpi.h:179
field_manager_mod::initialize
subroutine, private initialize
Definition: field_manager.F90:5419
start
************************************************************************GNU Lesser General Public License **This file is part of the GFDL Flexible Modeling System(FMS). ! *! *FMS is free software without even the implied warranty of MERCHANTABILITY or *FITNESS FOR A PARTICULAR PURPOSE See the GNU General Public License *for more details **You should have received a copy of the GNU Lesser General Public *License along with FMS If see< http:! ***********************************************************************subroutine READ_RECORD_CORE_(unit, field, nwords, data, start, axsiz) integer, intent(in) ::unit type(fieldtype), intent(in) ::field integer, intent(in) ::nwords MPP_TYPE_, intent(inout) ::data(nwords) integer, intent(in) ::start(:), axsiz(:) integer(SHORT_KIND) ::i2vals(nwords)!rab used in conjunction with transfer intrinsic to determine size of a variable integer(KIND=1) ::one_byte(8) integer ::word_sz!#ifdef __sgi integer(INT_KIND) ::ivals(nwords) real(FLOAT_KIND) ::rvals(nwords)!#else! integer ::ivals(nwords)! real ::rvals(nwords)!#endif real(DOUBLE_KIND) ::r8vals(nwords) pointer(ptr1, i2vals) pointer(ptr2, ivals) pointer(ptr3, rvals) pointer(ptr4, r8vals) if(mpp_io_stack_size< nwords) call mpp_io_set_stack_size(nwords) call mpp_error(FATAL, 'MPP_READ currently requires use_netCDF option') end subroutine READ_RECORD_CORE_ subroutine READ_RECORD_(unit, field, nwords, data, time_level, domain, position, tile_count, start_in, axsiz_in)!routine that is finally called by all mpp_read routines to perform the read!a non-netCDF record contains:! field ID! a set of 4 coordinates(is:ie, js:je) giving the data subdomain! a timelevel and a timestamp(=NULLTIME if field is static)! 3D real data(stored as 1D)!if you are using direct access I/O, the RECL argument to OPEN must be large enough for the above!in a global direct access file, record position on PE is given by %record.!Treatment of timestamp:! We assume that static fields have been passed without a timestamp.! Here that is converted into a timestamp of NULLTIME.! For non-netCDF fields, field is treated no differently, but is written! with a timestamp of NULLTIME. There is no check in the code to prevent! the user from repeatedly writing a static field. integer, intent(in) ::unit, nwords type(fieldtype), intent(in) ::field MPP_TYPE_, intent(inout) ::data(nwords) integer, intent(in), optional ::time_level type(domain2D), intent(in), optional ::domain integer, intent(in), optional ::position, tile_count integer, intent(in), optional ::start_in(:), axsiz_in(:) integer, dimension(size(field%axes(:))) ::start, axsiz integer ::tlevel !, subdomain(4) integer ::i, error, is, ie, js, je, isg, ieg, jsg, jeg type(domain2d), pointer ::io_domain=> tlevel if(PRESENT(start_in) .AND. PRESENT(axsiz_in)) then if(size(start(! the data domain and compute domain must refer to the subdomain being passed ! In this ! since that attempts to gather all data on PE start
Definition: mpp_read_2Ddecomp.h:197
mpp_error
************************************************************************GNU Lesser General Public License **This file is part of the GFDL Flexible Modeling System(FMS). ! *! *FMS is free software without even the implied warranty of MERCHANTABILITY or *FITNESS FOR A PARTICULAR PURPOSE See the GNU General Public License *for more details **You should have received a copy of the GNU Lesser General Public *License along with FMS If see< http:! ***********************************************************************!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! MPP_TRANSMIT !! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine MPP_TRANSMIT_(put_data, put_len, to_pe, get_data, get_len, from_pe, block, tag, recv_request, send_request)!a message-passing routine intended to be reminiscent equally of both MPI and SHMEM!put_data and get_data are contiguous MPP_TYPE_ arrays!at each call, your put_data array is put to to_pe 's get_data! your get_data array is got from from_pe 's put_data!i.e we assume that typically(e.g updating halo regions) each PE performs a put _and_ a get!special PE designations:! NULL_PE:to disable a put or a get(e.g at boundaries)! ANY_PE:if remote PE for the put or get is to be unspecific! ALL_PES:broadcast and collect operations(collect not yet implemented)!ideally we would not pass length, but this f77-style call performs better(arrays passed by address, not descriptor)!further, this permits< length > contiguous words from an array of any rank to be passed(avoiding f90 rank conformance check)!caller is responsible for completion checks(mpp_sync_self) before and after integer, intent(in) ::put_len, to_pe, get_len, from_pe MPP_TYPE_, intent(in) ::put_data(*) MPP_TYPE_, intent(out) ::get_data(*) logical, intent(in), optional ::block integer, intent(in), optional ::tag integer, intent(out), optional ::recv_request, send_request logical ::block_comm integer ::i MPP_TYPE_, allocatable, save ::local_data(:) !local copy used by non-parallel code(no SHMEM or MPI) integer ::comm_tag integer ::rsize if(.NOT.module_is_initialized) call mpp_error(FATAL, 'MPP_TRANSMIT:You must first call mpp_init.') if(to_pe.EQ.NULL_PE .AND. from_pe.EQ.NULL_PE) return block_comm=.true. if(PRESENT(block)) block_comm=block if(debug) then call SYSTEM_CLOCK(tick) write(stdout_unit,'(a, i18, a, i6, a, 2i6, 2i8)')&'T=', tick, ' PE=', pe, ' MPP_TRANSMIT begin:to_pe, from_pe, put_len, get_len=', to_pe, from_pe, put_len, get_len end if comm_tag=DEFAULT_TAG if(present(tag)) comm_tag=tag!do put first and then get if(to_pe.GE.0 .AND. to_pe.LT.npes) then!use non-blocking sends if(debug .and.(current_clock.NE.0)) call SYSTEM_CLOCK(start_tick)!z1l:truly non-blocking send.! if(request(to_pe).NE.MPI_REQUEST_NULL) then !only one message from pe-> to_pe in queue *PE waiting for to_pe ! call error else get_len so only do gets but you cannot have a pure get with MPI call mpp_error(FATAL, 'MPP_TRANSMIT:you cannot transmit to ANY_PE using MPI.') else if(to_pe.NE.NULL_PE) then !no other valid cases except NULL_PE call mpp_error(FATAL
mpp_mod::error
integer error
Definition: mpp.F90:1310
gsw_mod_sp_coefficients::k
real(r8), parameter k
Definition: gsw_mod_sp_coefficients.f90:40
case
************************************************************************GNU Lesser General Public License **This file is part of the GFDL Flexible Modeling System(FMS). ! *! *FMS is free software without even the implied warranty of MERCHANTABILITY or *FITNESS FOR A PARTICULAR PURPOSE See the GNU General Public License *for more details **You should have received a copy of the GNU Lesser General Public *License along with FMS If see< http:! ***********************************************************************subroutine READ_RECORD_CORE_(unit, field, nwords, data, start, axsiz) integer, intent(in) ::unit type(fieldtype), intent(in) ::field integer, intent(in) ::nwords MPP_TYPE_, intent(inout) ::data(nwords) integer, intent(in) ::start(:), axsiz(:) integer(SHORT_KIND) ::i2vals(nwords)!rab used in conjunction with transfer intrinsic to determine size of a variable integer(KIND=1) ::one_byte(8) integer ::word_sz!#ifdef __sgi integer(INT_KIND) ::ivals(nwords) real(FLOAT_KIND) ::rvals(nwords)!#else! integer ::ivals(nwords)! real ::rvals(nwords)!#endif real(DOUBLE_KIND) ::r8vals(nwords) pointer(ptr1, i2vals) pointer(ptr2, ivals) pointer(ptr3, rvals) pointer(ptr4, r8vals) if(mpp_io_stack_size< nwords) call mpp_io_set_stack_size(nwords) call mpp_error(FATAL, 'MPP_READ currently requires use_netCDF option') end subroutine READ_RECORD_CORE_ subroutine READ_RECORD_(unit, field, nwords, data, time_level, domain, position, tile_count, start_in, axsiz_in)!routine that is finally called by all mpp_read routines to perform the read!a non-netCDF record contains:! field ID! a set of 4 coordinates(is:ie, js:je) giving the data subdomain! a timelevel and a timestamp(=NULLTIME if field is static)! 3D real data(stored as 1D)!if you are using direct access I/O, the RECL argument to OPEN must be large enough for the above!in a global direct access file, record position on PE is given by %record.!Treatment of timestamp:! We assume that static fields have been passed without a timestamp.! Here that is converted into a timestamp of NULLTIME.! For non-netCDF fields, field is treated no differently, but is written! with a timestamp of NULLTIME. There is no check in the code to prevent! the user from repeatedly writing a static field. integer, intent(in) ::unit, nwords type(fieldtype), intent(in) ::field MPP_TYPE_, intent(inout) ::data(nwords) integer, intent(in), optional ::time_level type(domain2D), intent(in), optional ::domain integer, intent(in), optional ::position, tile_count integer, intent(in), optional ::start_in(:), axsiz_in(:) integer, dimension(size(field%axes(:))) ::start, axsiz integer ::tlevel !, subdomain(4) integer ::i, error, is, ie, js, je, isg, ieg, jsg, jeg type(domain2d), pointer ::io_domain=> tlevel if(PRESENT(start_in) .AND. PRESENT(axsiz_in)) then if(size(start(! the data domain and compute domain must refer to the subdomain being passed ! In this case
Definition: mpp_read_2Ddecomp.h:169
crtm_parameters::down
integer, parameter, public down
Definition: CRTM_Parameters.f90:97
id
************************************************************************GNU Lesser General Public License **This file is part of the GFDL Flexible Modeling System(FMS). ! *! *FMS is free software without even the implied warranty of MERCHANTABILITY or *FITNESS FOR A PARTICULAR PURPOSE See the GNU General Public License *for more details **You should have received a copy of the GNU Lesser General Public *License along with FMS If see< http:! ***********************************************************************subroutine READ_RECORD_CORE_(unit, field, nwords, data, start, axsiz) integer, intent(in) ::unit type(fieldtype), intent(in) ::field integer, intent(in) ::nwords MPP_TYPE_, intent(inout) ::data(nwords) integer, intent(in) ::start(:), axsiz(:) integer(SHORT_KIND) ::i2vals(nwords)!rab used in conjunction with transfer intrinsic to determine size of a variable integer(KIND=1) ::one_byte(8) integer ::word_sz!#ifdef __sgi integer(INT_KIND) ::ivals(nwords) real(FLOAT_KIND) ::rvals(nwords)!#else! integer ::ivals(nwords)! real ::rvals(nwords)!#endif real(DOUBLE_KIND) ::r8vals(nwords) pointer(ptr1, i2vals) pointer(ptr2, ivals) pointer(ptr3, rvals) pointer(ptr4, r8vals) if(mpp_io_stack_size< nwords) call mpp_io_set_stack_size(nwords) call mpp_error(FATAL, 'MPP_READ currently requires use_netCDF option') end subroutine READ_RECORD_CORE_ subroutine READ_RECORD_(unit, field, nwords, data, time_level, domain, position, tile_count, start_in, axsiz_in)!routine that is finally called by all mpp_read routines to perform the read!a non-netCDF record contains:! field ID! a set of 4 coordinates(is:ie, js:je) giving the data subdomain! a timelevel and a timestamp(=NULLTIME if field is static)! 3D real data(stored as 1D)!if you are using direct access I/O, the RECL argument to OPEN must be large enough for the above!in a global direct access file, record position on PE is given by %record.!Treatment of timestamp:! We assume that static fields have been passed without a timestamp.! Here that is converted into a timestamp of NULLTIME.! For non-netCDF fields, field is treated no differently, but is written! with a timestamp of NULLTIME. There is no check in the code to prevent! the user from repeatedly writing a static field. integer, intent(in) ::unit, nwords type(fieldtype), intent(in) ::field MPP_TYPE_, intent(inout) ::data(nwords) integer, intent(in), optional ::time_level type(domain2D), intent(in), optional ::domain integer, intent(in), optional ::position, tile_count integer, intent(in), optional ::start_in(:), axsiz_in(:) integer, dimension(size(field%axes(:))) ::start, axsiz integer ::tlevel !, subdomain(4) integer ::i, error, is, ie, js, je, isg, ieg, jsg, jeg type(domain2d), pointer ::io_domain=> id
Definition: mpp_read_2Ddecomp.h:167
mpp_comm_private
************************************************************************GNU Lesser General Public License **This file is part of the GFDL Flexible Modeling System(FMS). ! *! *FMS is free software without even the implied warranty of MERCHANTABILITY or *FITNESS FOR A PARTICULAR PURPOSE See the GNU General Public License *for more details **You should have received a copy of the GNU Lesser General Public *License along with FMS If see< http:! ***********************************************************************!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! MPP_TRANSMIT !! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine MPP_TRANSMIT_(put_data, put_len, to_pe, get_data, get_len, from_pe, block, tag, recv_request, send_request)!a message-passing routine intended to be reminiscent equally of both MPI and SHMEM!put_data and get_data are contiguous MPP_TYPE_ arrays!at each call, your put_data array is put to to_pe 's get_data! your get_data array is got from from_pe 's put_data!i.e we assume that typically(e.g updating halo regions) each PE performs a put _and_ a get!special PE designations:! NULL_PE:to disable a put or a get(e.g at boundaries)! ANY_PE:if remote PE for the put or get is to be unspecific! ALL_PES:broadcast and collect operations(collect not yet implemented)!ideally we would not pass length, but this f77-style call performs better(arrays passed by address, not descriptor)!further, this permits< length > contiguous words from an array of any rank to be passed(avoiding f90 rank conformance check)!caller is responsible for completion checks(mpp_sync_self) before and after integer, intent(in) ::put_len, to_pe, get_len, from_pe MPP_TYPE_, intent(in) ::put_data(*) MPP_TYPE_, intent(out) ::get_data(*) logical, intent(in), optional ::block integer, intent(in), optional ::tag integer, intent(out), optional ::recv_request, send_request logical ::block_comm integer ::i MPP_TYPE_, allocatable, save ::local_data(:) !local copy used by non-parallel code(no SHMEM or MPI) integer ::comm_tag integer ::rsize if(.NOT.module_is_initialized) call mpp_error(FATAL, 'MPP_TRANSMIT:You must first call mpp_init.') if(to_pe.EQ.NULL_PE .AND. from_pe.EQ.NULL_PE) return block_comm=.true. if(PRESENT(block)) block_comm=block if(debug) then call SYSTEM_CLOCK(tick) write(stdout_unit,'(a, i18, a, i6, a, 2i6, 2i8)')&'T=', tick, ' PE=', pe, ' MPP_TRANSMIT begin:to_pe, from_pe, put_len, get_len=', to_pe, from_pe, put_len, get_len end if comm_tag=DEFAULT_TAG if(present(tag)) comm_tag=tag!do put first and then get if(to_pe.GE.0 .AND. to_pe.LT.npes) then!use non-blocking sends if(debug .and.(current_clock.NE.0)) call SYSTEM_CLOCK(start_tick)!z1l:truly non-blocking send.! if(request(to_pe).NE.MPI_REQUEST_NULL) then !only one message from pe-> to_pe in queue *PE waiting for to_pe ! call mpp_comm_private
Definition: mpp_transmit_mpi.h:81
mpp_mod::current_peset_max
integer current_peset_max
Definition: mpp.F90:1294
mpp_mod::peset_num
integer peset_num
Definition: mpp.F90:1308
mpp_mod::log_unit
integer log_unit
Definition: mpp.F90:1306
horiz_interp_bilinear_mod::dummy
integer, parameter dummy
Definition: horiz_interp_bilinear.F90:57
mpp_reduce_mpi.h
fv_mp_adm_mod::ierror
integer ierror
Definition: fv_mp_adm.F90:32
mpp_mod::err_unit
integer err_unit
Definition: mpp.F90:1332
mpp_mod::etc_unit_is_stderr
logical etc_unit_is_stderr
Definition: mpp.F90:1389
now
enddo ! cludge for now
Definition: mpp_write_compressed.h:125
mpp_mod::datatypes
type(mpp_type_list) datatypes
Definition: mpp.F90:1314
mpp_mod::configfile
character(len=32) configfile
Definition: mpp.F90:1307
POINTER_KIND
#define POINTER_KIND
type_distribution::received
logical function received(this, seqno)
Definition: m_distribution.f90:72
interpolator_mod::len
integer len
Definition: interpolator.F90:321
field_manager_mod::root
type(field_def), target, save root
Definition: field_manager.F90:564
mpp_mod::request_recv
integer, dimension(:), allocatable request_recv
Definition: mpp.F90:1320
size
************************************************************************GNU Lesser General Public License **This file is part of the GFDL Flexible Modeling System(FMS). ! *! *FMS is free software without even the implied warranty of MERCHANTABILITY or *FITNESS FOR A PARTICULAR PURPOSE See the GNU General Public License *for more details **You should have received a copy of the GNU Lesser General Public *License along with FMS If see< http:! ***********************************************************************subroutine READ_RECORD_CORE_(unit, field, nwords, data, start, axsiz) integer, intent(in) ::unit type(fieldtype), intent(in) ::field integer, intent(in) ::nwords MPP_TYPE_, intent(inout) ::data(nwords) integer, intent(in) ::start(:), axsiz(:) integer(SHORT_KIND) ::i2vals(nwords)!rab used in conjunction with transfer intrinsic to determine size of a variable integer(KIND=1) ::one_byte(8) integer ::word_sz!#ifdef __sgi integer(INT_KIND) ::ivals(nwords) real(FLOAT_KIND) ::rvals(nwords)!#else! integer ::ivals(nwords)! real ::rvals(nwords)!#endif real(DOUBLE_KIND) ::r8vals(nwords) pointer(ptr1, i2vals) pointer(ptr2, ivals) pointer(ptr3, rvals) pointer(ptr4, r8vals) if(mpp_io_stack_size< nwords) call mpp_io_set_stack_size(nwords) call mpp_error(FATAL, 'MPP_READ currently requires use_netCDF option') end subroutine READ_RECORD_CORE_ subroutine READ_RECORD_(unit, field, nwords, data, time_level, domain, position, tile_count, start_in, axsiz_in)!routine that is finally called by all mpp_read routines to perform the read!a non-netCDF record contains:! field ID! a set of 4 coordinates(is:ie, js:je) giving the data subdomain! a timelevel and a timestamp(=NULLTIME if field is static)! 3D real data(stored as 1D)!if you are using direct access I/O, the RECL argument to OPEN must be large enough for the above!in a global direct access file, record position on PE is given by %record.!Treatment of timestamp:! We assume that static fields have been passed without a timestamp.! Here that is converted into a timestamp of NULLTIME.! For non-netCDF fields, field is treated no differently, but is written! with a timestamp of NULLTIME. There is no check in the code to prevent! the user from repeatedly writing a static field. integer, intent(in) ::unit, nwords type(fieldtype), intent(in) ::field MPP_TYPE_, intent(inout) ::data(nwords) integer, intent(in), optional ::time_level type(domain2D), intent(in), optional ::domain integer, intent(in), optional ::position, tile_count integer, intent(in), optional ::start_in(:), axsiz_in(:) integer, dimension(size(field%axes(:))) ::start, axsiz integer ::tlevel !, subdomain(4) integer ::i, error, is, ie, js, je, isg, ieg, jsg, jeg type(domain2d), pointer ::io_domain=> tlevel if(PRESENT(start_in) .AND. PRESENT(axsiz_in)) then if(size(start(! the data domain and compute domain must refer to the subdomain being passed ! In this ! since that attempts to gather all data on PE size(field%axes(:)) axsiz(i)
a
************************************************************************GNU Lesser General Public License **This file is part of the GFDL Flexible Modeling System(FMS). ! *! *FMS is free software without even the implied warranty of MERCHANTABILITY or *FITNESS FOR A PARTICULAR PURPOSE See the GNU General Public License *for more details **You should have received a copy of the GNU Lesser General Public *License along with FMS If see< http:! ***********************************************************************!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! MPP_TRANSMIT !! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine MPP_TRANSMIT_(put_data, put_len, to_pe, get_data, get_len, from_pe, block, tag, recv_request, send_request)!a message-passing routine intended to be reminiscent equally of both MPI and SHMEM!put_data and get_data are contiguous MPP_TYPE_ arrays!at each call, your put_data array is put to to_pe 's get_data! your get_data array is got from from_pe 's put_data!i.e we assume that typically(e.g updating halo regions) each PE performs a put _and_ a get!special PE designations:! NULL_PE:to disable a put or a get(e.g at boundaries)! ANY_PE:if remote PE for the put or get is to be unspecific! ALL_PES:broadcast and collect operations(collect not yet implemented)!ideally we would not pass length, but this f77-style call performs better(arrays passed by address, not descriptor)!further, this permits< length > contiguous words from an array of any rank to be passed(avoiding f90 rank conformance check)!caller is responsible for completion checks(mpp_sync_self) before and after integer, intent(in) ::put_len, to_pe, get_len, from_pe MPP_TYPE_, intent(in) ::put_data(*) MPP_TYPE_, intent(out) ::get_data(*) logical, intent(in), optional ::block integer, intent(in), optional ::tag integer, intent(out), optional ::recv_request, send_request logical ::block_comm integer ::i MPP_TYPE_, allocatable, save ::local_data(:) !local copy used by non-parallel code(no SHMEM or MPI) integer ::comm_tag integer ::rsize if(.NOT.module_is_initialized) call mpp_error(FATAL, 'MPP_TRANSMIT:You must first call mpp_init.') if(to_pe.EQ.NULL_PE .AND. from_pe.EQ.NULL_PE) return block_comm=.true. if(PRESENT(block)) block_comm=block if(debug) then call SYSTEM_CLOCK(tick) write(stdout_unit,'(a, i18, a, i6, a, 2i6, 2i8)')&'T=', tick, ' PE=', pe, ' MPP_TRANSMIT begin:to_pe, from_pe, put_len, get_len=', to_pe, from_pe, put_len, get_len end if comm_tag=DEFAULT_TAG if(present(tag)) comm_tag=tag!do put first and then get if(to_pe.GE.0 .AND. to_pe.LT.npes) then!use non-blocking sends if(debug .and.(current_clock.NE.0)) call SYSTEM_CLOCK(start_tick)!z1l:truly non-blocking send.! if(request(to_pe).NE.MPI_REQUEST_NULL) then !only one message from pe-> to_pe in queue *PE waiting for to_pe ! call error else get_len so only do gets but you cannot have a pure get with MPI call a get means do a wait to ensure put on remote PE is complete error call increase mpp_nml request_multiply call MPP_TRANSMIT get_len end if return end subroutine MPP_TRANSMIT_ ! MPP_BROADCAST ! subroutine but that doesn t allow !broadcast to a subset of PEs This version and mpp_transmit will remain !backward compatible intent(inout) a
Definition: mpp_transmit_mpi.h:178
max
#define max(a, b)
Definition: mosaic_util.h:33
i6
************************************************************************GNU Lesser General Public License **This file is part of the GFDL Flexible Modeling System(FMS). ! *! *FMS is free software without even the implied warranty of MERCHANTABILITY or *FITNESS FOR A PARTICULAR PURPOSE See the GNU General Public License *for more details **You should have received a copy of the GNU Lesser General Public *License along with FMS If see< http:! ***********************************************************************!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! MPP_TRANSMIT !! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine MPP_TRANSMIT_(put_data, put_len, to_pe, get_data, get_len, from_pe, block, tag, recv_request, send_request)!a message-passing routine intended to be reminiscent equally of both MPI and SHMEM!put_data and get_data are contiguous MPP_TYPE_ arrays!at each call, your put_data array is put to to_pe 's get_data! your get_data array is got from from_pe 's put_data!i.e we assume that typically(e.g updating halo regions) each PE performs a put _and_ a get!special PE designations:! NULL_PE:to disable a put or a get(e.g at boundaries)! ANY_PE:if remote PE for the put or get is to be unspecific! ALL_PES:broadcast and collect operations(collect not yet implemented)!ideally we would not pass length, but this f77-style call performs better(arrays passed by address, not descriptor)!further, this permits< length > contiguous words from an array of any rank to be passed(avoiding f90 rank conformance check)!caller is responsible for completion checks(mpp_sync_self) before and after integer, intent(in) ::put_len, to_pe, get_len, from_pe MPP_TYPE_, intent(in) ::put_data(*) MPP_TYPE_, intent(out) ::get_data(*) logical, intent(in), optional ::block integer, intent(in), optional ::tag integer, intent(out), optional ::recv_request, send_request logical ::block_comm integer ::i MPP_TYPE_, allocatable, save ::local_data(:) !local copy used by non-parallel code(no SHMEM or MPI) integer ::comm_tag integer ::rsize if(.NOT.module_is_initialized) call mpp_error(FATAL, 'MPP_TRANSMIT:You must first call mpp_init.') if(to_pe.EQ.NULL_PE .AND. from_pe.EQ.NULL_PE) return block_comm=.true. if(PRESENT(block)) block_comm=block if(debug) then call SYSTEM_CLOCK(tick) write(stdout_unit,'(a, i18, a, i6, a, 2i6, 2i8)')&'T=', tick, ' PE=', pe, ' MPP_TRANSMIT begin:to_pe, from_pe, put_len, get_len=', to_pe, from_pe, put_len, get_len end if comm_tag=DEFAULT_TAG if(present(tag)) comm_tag=tag!do put first and then get if(to_pe.GE.0 .AND. to_pe.LT.npes) then!use non-blocking sends if(debug .and.(current_clock.NE.0)) call SYSTEM_CLOCK(start_tick)!z1l:truly non-blocking send.! if(request(to_pe).NE.MPI_REQUEST_NULL) then !only one message from pe-> to_pe in queue *PE waiting for to_pe ! call error else get_len so only do gets but you cannot have a pure get with MPI call a get means do a wait to ensure put on remote PE is complete error call increase mpp_nml request_multiply call MPP_TRANSMIT get_len end if return end subroutine MPP_TRANSMIT_ ! MPP_BROADCAST ! subroutine but that doesn t allow !broadcast to a subset of PEs This version and mpp_transmit will remain !backward compatible intent(inout) i6
Definition: mpp_transmit_mpi.h:178
mpp_mod::size_recv
integer, dimension(:), allocatable size_recv
Definition: mpp.F90:1321
gsw_mod_check_data::t
real(r8), dimension(cast_m, cast_n) t
Definition: gsw_mod_check_data.f90:224
station_data_mod::pelist
integer, dimension(:), allocatable pelist
Definition: station_data.F90:293
mpp_mod::current_clock
integer current_clock
Definition: mpp.F90:1311
not
*f90 *************************************************************************GNU Lesser General Public License **This file is part of the GFDL Flexible Modeling System(FMS). ! *! *FMS is free software without even the implied warranty of MERCHANTABILITY or *FITNESS FOR A PARTICULAR PURPOSE See the GNU General Public License *for more details **You should have received a copy of the GNU Lesser General Public *License along with FMS If not
Definition: drifters_compute_k.h:5
mpp_sum_mpi_ad.h
mpp_mod::sync_all_clocks
logical sync_all_clocks
Definition: mpp.F90:1391
mpp_alltoall_mpi.h
mpp_mod::tick0
integer(long_kind) tick0
Definition: mpp.F90:1299
fv_control_nlm_mod::ndims
integer, pointer ndims
Definition: fv_control_nlm.F90:217
mpp_mod::tick_rate
real tick_rate
Definition: mpp.F90:1312
mpp_mod::max_request
integer max_request
Definition: mpp.F90:1390
mpp_mod::request_send
integer, dimension(:), allocatable request_send
Definition: mpp.F90:1319
mpp_mod::ticks_per_sec
integer(long_kind) ticks_per_sec
Definition: mpp.F90:1299
mpp_mod::start_tick
integer(long_kind) start_tick
Definition: mpp.F90:1299
sat_vapor_pres_mod::tmin
real tmin
Definition: sat_vapor_pres.F90:534
mpp_mod::mpp_byte
type(mpp_type), target, public mpp_byte
Definition: mpp.F90:1315
mpp_mod::clocks
type(clock), dimension(max_clocks), save clocks
Definition: mpp.F90:1305
tick
************************************************************************GNU Lesser General Public License **This file is part of the GFDL Flexible Modeling System(FMS). ! *! *FMS is free software without even the implied warranty of MERCHANTABILITY or *FITNESS FOR A PARTICULAR PURPOSE See the GNU General Public License *for more details **You should have received a copy of the GNU Lesser General Public *License along with FMS If see< http:! ***********************************************************************!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! MPP_TRANSMIT !! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine MPP_TRANSMIT_(put_data, put_len, to_pe, get_data, get_len, from_pe, block, tag, recv_request, send_request)!a message-passing routine intended to be reminiscent equally of both MPI and SHMEM!put_data and get_data are contiguous MPP_TYPE_ arrays!at each call, your put_data array is put to to_pe 's get_data! your get_data array is got from from_pe 's put_data!i.e we assume that typically(e.g updating halo regions) each PE performs a put _and_ a get!special PE designations:! NULL_PE:to disable a put or a get(e.g at boundaries)! ANY_PE:if remote PE for the put or get is to be unspecific! ALL_PES:broadcast and collect operations(collect not yet implemented)!ideally we would not pass length, but this f77-style call performs better(arrays passed by address, not descriptor)!further, this permits< length > contiguous words from an array of any rank to be passed(avoiding f90 rank conformance check)!caller is responsible for completion checks(mpp_sync_self) before and after integer, intent(in) ::put_len, to_pe, get_len, from_pe MPP_TYPE_, intent(in) ::put_data(*) MPP_TYPE_, intent(out) ::get_data(*) logical, intent(in), optional ::block integer, intent(in), optional ::tag integer, intent(out), optional ::recv_request, send_request logical ::block_comm integer ::i MPP_TYPE_, allocatable, save ::local_data(:) !local copy used by non-parallel code(no SHMEM or MPI) integer ::comm_tag integer ::rsize if(.NOT.module_is_initialized) call mpp_error(FATAL, 'MPP_TRANSMIT:You must first call mpp_init.') if(to_pe.EQ.NULL_PE .AND. from_pe.EQ.NULL_PE) return block_comm=.true. if(PRESENT(block)) block_comm=block if(debug) then call SYSTEM_CLOCK(tick) write(stdout_unit,'(a, i18, a, i6, a, 2i6, 2i8)')&'T=', tick, ' PE=', pe, ' MPP_TRANSMIT begin:to_pe, from_pe, put_len, get_len=', to_pe, from_pe, put_len, get_len end if comm_tag=DEFAULT_TAG if(present(tag)) comm_tag=tag!do put first and then get if(to_pe.GE.0 .AND. to_pe.LT.npes) then!use non-blocking sends if(debug .and.(current_clock.NE.0)) call SYSTEM_CLOCK(start_tick)!z1l:truly non-blocking send.! if(request(to_pe).NE.MPI_REQUEST_NULL) then !only one message from pe-> to_pe in queue *PE waiting for to_pe ! call error else get_len so only do gets but you cannot have a pure get with MPI call a get means do a wait to ensure put on remote PE is complete error call increase mpp_nml request_multiply call tick
Definition: mpp_transmit_mpi.h:153
tools_repro::eq
logical function, public eq(x, y)
Definition: tools_repro.F90:28
mpp_mod::type_recv
integer, dimension(:), allocatable type_recv
Definition: mpp.F90:1322
amip_interp_mod::verbose
integer verbose
Definition: amip_interp.F90:354