FV3 Bundle
mpp_comm_sma.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 ! dummy here, used only in MPI
33  integer :: num_pes, len
34  integer :: i, logunit
35  logical :: opened, existed
36  integer :: unit_begin, unit_end, unit_nml, io_status
37 #ifdef _CRAYT3E
38  intrinsic my_pe
39 #else
40  integer :: my_pe
41 #endif
42 
43  if( module_is_initialized )return
44 
45  call START_PES(0) !the argument 0 means extract from environment variable NPES on PVP/SGI, from mpprun -n on t3e
46  pe = my_pe()
47  npes = num_pes()
48 
49  module_is_initialized = .TRUE.
50 
51  !PEsets: make defaults illegal
52  allocate(peset(0:current_peset_max))
53  peset(:)%count = -1
54  peset(:)%id = -1
55  peset(:)%group = -1
56  peset(:)%start = -1
57  peset(:)%log2stride = -1
58  peset(:)%name = " "
59  !0=single-PE, initialized so that count returns 1
60  peset(0)%count = 1
61  allocate( peset(0)%list(1) )
62  peset(0)%list = pe
63  world_peset_num = get_peset( (/(i,i=0,npes-1)/) )
64  current_peset_num = world_peset_num !initialize current PEset to world
65 
66  !initialize clocks
67  call SYSTEM_CLOCK( count=tick0, count_rate=ticks_per_sec, count_max=max_ticks )
68  tick_rate = 1./ticks_per_sec
69  clock0 = mpp_clock_id( 'Total runtime', flags=MPP_CLOCK_SYNC )
70 
71  ! Initialize mpp_datatypes
72  ! NOTE: mpp_datatypes are not implemented in SHMEM; this is an empty list
73  datatypes%head => null()
74  datatypes%tail => null()
75  datatypes%length = 0
76 
77  ! Create the bytestream (default) mpp_datatype
78  ! NOTE: mpp_byte is unused in SHMEM
79  mpp_byte%counter = -1
80  mpp_byte%ndims = -1
81  allocate(mpp_byte%sizes(0))
82  allocate(mpp_byte%subsizes(0))
83  allocate(mpp_byte%starts(0))
84  mpp_byte%etype = -1
85  mpp_byte%id = -1
86 
87  mpp_byte%prev => null()
88  mpp_byte%next => null()
89 
90  if( PRESENT(flags) )then
91  debug = flags.EQ.MPP_DEBUG
92  verbose = flags.EQ.MPP_VERBOSE .OR. debug
93  end if
94 
95  !we use shpalloc to ensure all these are remotely accessible
96  len=0; ptr_sync = LOC(pe) !null initialization
97  call mpp_malloc( ptr_sync, size(TRANSFER(sync,word)), len )
98  len=0; ptr_status = LOC(pe) !null initialization
99  call mpp_malloc( ptr_status, npes*size(TRANSFER(status(0),word)), len )
100  len=0; ptr_remote = LOC(pe) !null initialization
101  call mpp_malloc( ptr_remote, npes*size(TRANSFER(remote_data_loc(0),word)), len )
102  len=0; ptr_from = LOC(pe) !null initialization
103  call mpp_malloc( ptr_from, size(TRANSFER(mpp_from_pe,word)), len )
104 
105  sync(:) = SHMEM_SYNC_VALUE
106  status(0:npes-1) = MPP_READY
107  remote_data_loc(0:npes-1) = MPP_WAIT
108  call mpp_set_stack_size(32768) !default initial value
109 
110  call mpp_init_logfile()
111  call read_input_nml
112 
113  !--- read namelist
114 #ifdef INTERNAL_FILE_NML
115  read (input_nml_file, mpp_nml, iostat=io_status)
116 #else
117  unit_begin = 103
118  unit_end = 512
119  do unit_nml = unit_begin, unit_end
120  inquire( unit_nml,OPENED=opened )
121  if( .NOT.opened )exit
122  end do
123 
124  open(unit_nml,file='input.nml', iostat=io_status)
125  read(unit_nml,mpp_nml,iostat=io_status)
126  close(unit_nml)
127 #endif
128 
129  if (io_status > 0) then
130  call mpp_error(FATAL,'=>mpp_init: Error reading input.nml')
131  endif
132 
133 
134 ! non-root pe messages written to other location than stdout()
135  if(etc_unit_is_stderr) then
136  etc_unit = stderr()
137  else
138  ! 9 is reserved for etc_unit
139  etc_unit=9
140  inquire(unit=etc_unit,opened=opened)
141  if(opened) call mpp_error(FATAL,'Unit 9 is already in use (etc_unit) in mpp_comm_sma')
142  if (trim(etcfile) /= '/dev/null') then
143  write( etcfile,'(a,i6.6)' )trim(etcfile)//'.', pe
144  endif
145  inquire(file=etcfile, exist=existed)
146  if(existed) then
147  open( unit=etc_unit, file=trim(etcfile), status='REPLACE' )
148  else
149  open( unit=etc_unit, file=trim(etcfile) )
150  endif
151  endif
152  !if optional argument logunit=stdout, write messages to stdout instead.
153  !if specifying non-defaults, you must specify units not yet in use.
154  ! if( PRESENT(in) )then
155  ! inquire( unit=in, opened=opened )
156  ! if( opened )call mpp_error( FATAL, 'MPP_INIT: unable to open stdin.' )
157  ! in_unit=in
158  ! end if
159  ! if( PRESENT(out) )then
160  ! inquire( unit=out, opened=opened )
161  ! if( opened )call mpp_error( FATAL, 'MPP_INIT: unable to open stdout.' )
162  ! out_unit=out
163  ! end if
164  ! if( PRESENT(err) )then
165  ! inquire( unit=err, opened=opened )
166  ! if( opened )call mpp_error( FATAL, 'MPP_INIT: unable to open stderr.' )
167  ! err_unit=err
168  ! end if
169  ! log_unit=get_unit()
170  ! if( PRESENT(log) )then
171  ! inquire( unit=log, opened=opened )
172  ! if( opened .AND. log.NE.out_unit )call mpp_error( FATAL, 'MPP_INIT: unable to open stdlog.' )
173  ! log_unit=log
174  ! end if
175  !!log_unit can be written to only from root_pe, all others write to stdout
176  ! if( log_unit.NE.out_unit )then
177  ! inquire( unit=log_unit, opened=opened )
178  ! if( opened )call mpp_error( FATAL, 'MPP_INIT: specified unit for stdlog already in use.' )
179  ! if( pe.EQ.root_pe )open( unit=log_unit, file=trim(configfile), status='REPLACE' )
180  ! call mpp_sync()
181  ! if( pe.NE.root_pe )open( unit=log_unit, file=trim(configfile), status='OLD' )
182  ! end if
183 
184 
185  !messages
186  if( verbose )call mpp_error( NOTE, 'MPP_INIT: initializing MPP module...' )
187  if( pe.EQ.root_pe )then
188 logunit = stdlog()
189  write( logunit,'(/a)' )'MPP module '//trim(version)
190  write( logunit,'(a,i6)' )'MPP started with NPES=', npes
191  write( logunit,'(a)' )'Using SMA (shmem) library for message passing...'
192  write( logunit, '(a,es12.4,a,i10,a)' ) &
193  'Realtime clock resolution=', tick_rate, ' sec (', ticks_per_sec, ' ticks/sec)'
194  write( logunit, '(a,es12.4,a,i20,a)' ) &
195  'Clock rolls over after ', max_ticks*tick_rate, ' sec (', max_ticks, ' ticks)'
196  end if
197 
198  stdoutunit = stdout()
199 
200  call mpp_clock_begin(clock0)
201 
202  return
203 end subroutine mpp_init
204 
205 !#######################################################################
206  !to be called at the end of a run
207 subroutine mpp_exit()
208  integer :: i, j, k, n, nmax, istat, outunit,logunit
209  real :: t, tmin, tmax, tavg, tstd
210  real :: m, mmin, mmax, mavg, mstd, t_total
211  logical :: opened
212 
213  if( .NOT.module_is_initialized )return
214  call mpp_set_current_pelist()
215  call mpp_clock_end(clock0)
216  outunit = stdout()
217  logunit = stdlog()
218  t_total = clocks(clock0)%total_ticks*tick_rate
219  if( clock_num.GT.0 )then
220  if( ANY(clocks(1:clock_num)%detailed) )then
221  call sum_clock_data; call dump_clock_summary
222  end if
223  if( pe.EQ.root_pe )then
224  write( outunit,'(/a,i6,a)' ) 'Tabulating mpp_clock statistics across ', npes, ' PEs...'
225  if( ANY(clocks(1:clock_num)%detailed) ) &
226  write( outunit,'(a)' )' ... see mpp_clock.out.#### for details on individual PEs.'
227  write( outunit,'(/32x,a)' ) ' tmin tmax tavg tstd tfrac grain pemin pemax'
228  end if
229  write( logunit, '(/37x,a)' ) 'time'
230  call FLUSH( outunit )
231  call mpp_sync()
232  do i = 1,clock_num
233  if( .NOT.ANY(peset(clocks(i)%peset_num)%list(:).EQ.pe) )cycle
234  call mpp_set_current_pelist( peset(clocks(i)%peset_num)%list )
235  !times between mpp_clock ticks
236  t = clocks(i)%total_ticks*tick_rate
237  tmin = t; call mpp_min(tmin)
238  tmax = t; call mpp_max(tmax)
239  tavg = t; call mpp_sum(tavg); tavg = tavg/mpp_npes()
240  tstd = (t-tavg)**2; call mpp_sum(tstd); tstd = sqrt( tstd/mpp_npes() )
241  if( pe.EQ.root_pe )write( outunit,'(a32,4f14.6,f7.3,3i6)' ) &
242  clocks(i)%name, tmin, tmax, tavg, tstd, tavg/t_total, &
243  clocks(i)%grain, minval(peset(clocks(i)%peset_num)%list), &
244  maxval(peset(clocks(i)%peset_num)%list)
245  write(logunit,'(a32,f14.6)') clocks(i)%name, clocks(i)%total_ticks*tick_rate
246  end do
247  if( ANY(clocks(1:clock_num)%detailed) .AND. pe.EQ.root_pe )write( outunit,'(/32x,a)' ) &
248  ' tmin tmax tavg tstd mmin mmax mavg mstd mavg/tavg'
249  do i = 1,clock_num
250  !messages: bytelengths and times
251  if( .NOT.clocks(i)%detailed )cycle
252  do j = 1,MAX_EVENT_TYPES
253  n = clocks(i)%events(j)%calls; nmax = n
254  call mpp_max(nmax)
255  if( nmax.NE.0 )then
256  !don't divide by n because n might be 0
257  m = 0
258  if( n.GT.0 )m = sum(clocks(i)%events(j)%bytes(1:n))
259  mmin = m; call mpp_min(mmin)
260  mmax = m; call mpp_max(mmax)
261  mavg = m; call mpp_sum(mavg); mavg = mavg/mpp_npes()
262  mstd = (m-mavg)**2; call mpp_sum(mstd); mstd = sqrt( mstd/mpp_npes() )
263  t = 0
264  if( n.GT.0 )t = sum(clocks(i)%events(j)%ticks(1:n))*tick_rate
265  tmin = t; call mpp_min(tmin)
266  tmax = t; call mpp_max(tmax)
267  tavg = t; call mpp_sum(tavg); tavg = tavg/mpp_npes()
268  tstd = (t-tavg)**2; call mpp_sum(tstd); tstd = sqrt( tstd/mpp_npes() )
269  if( pe.EQ.root_pe )write( outunit,'(a32,4f11.3,5es11.3)' ) &
270  trim(clocks(i)%name)//' '//trim(clocks(i)%events(j)%name), &
271  tmin, tmax, tavg, tstd, mmin, mmax, mavg, mstd, mavg/tavg
272  end if
273  end do
274  end do
275  end if
276 
277 ! close down etc_unit: 9
278  inquire(unit=etc_unit, opened=opened)
279  if (opened) then
280  call FLUSH (etc_unit)
281  close(etc_unit)
282  endif
283 
284  call mpp_set_current_pelist()
285  call mpp_sync()
286  call mpp_max(mpp_stack_hwm)
287  if( pe.EQ.root_pe )write( outunit,* )'MPP_STACK high water mark=', mpp_stack_hwm
288  return
289 end subroutine mpp_exit
290 
291 !#######################################################################
292  !routine to perform symmetric allocation:
293  !this is required on the t3e/O2k for variables that will be non-local arguments
294  !to a shmem call (see man intro_shmem(3F)).
295  !newlen is the required allocation length for the pointer ptr
296  ! len is the current allocation (0 if unallocated)
297 subroutine mpp_malloc( ptr, newlen, len )
298  integer, intent(in) :: newlen
299  integer, intent(inout) :: len
300  real :: dummy
301  integer :: words_per_long, outunit
302  integer(LONG_KIND) :: long
303  !argument ptr is a cray pointer, points to a dummy argument in this routine
304  pointer( ptr, dummy )
305  ! integer(LONG_KIND) :: error_8
306 
307  if( .NOT.module_is_initialized )call mpp_error( FATAL, 'MPP_MALLOC: You must first call mpp_init.' )
308  !use existing allocation if it is enough
309  if( newlen.LE.len )return
310 
311  call SHMEM_BARRIER_ALL()
312  !if the pointer is already allocated, deallocate
313  ! 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)
314  if( len.NE.0 )call SHPDEALLC( ptr, error, -1 )
315  !allocate new length: assume that the array is KIND=8
316  words_per_long = size(transfer(long,word))
317  call SHPALLOC( ptr, newlen*words_per_long, error, -1 )
318  len = newlen
319  call SHMEM_BARRIER_ALL()
320 
321  if( debug )then
322  call SYSTEM_CLOCK(tick)
323  outunit = stdout()
324  write( outunit,'(a,i18,a,i5,a,2i8,i16)' )'T=', tick, ' PE=', pe, ' MPP_MALLOC: len, newlen, ptr=', len, newlen, ptr
325  end if
326  return
327 end subroutine mpp_malloc
328 
329 !#######################################################################
330  !set the mpp_stack variable to be at least n LONG words long
331  subroutine mpp_set_stack_size(n)
332  integer, intent(in) :: n
333  character(len=8) :: text
334 
335  call mpp_malloc( ptr_stack, n, mpp_stack_size )
336  write( text,'(i8)' )n
337  if( pe.EQ.root_pe )call mpp_error( NOTE, 'MPP_SET_STACK_SIZE: stack size set to '//text//'.' )
338 
339  return
340  end subroutine mpp_set_stack_size
341 
342 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
343 ! !
344 ! BASIC MESSAGE PASSING ROUTINE: mpp_transmit !
345 ! !
346 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
347 
348 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
349 ! !
350 ! BASIC MESSAGE PASSING ROUTINE: mpp_transmit !
351 ! !
352 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
353  subroutine mpp_broadcast_char(data, length, from_pe, pelist )
354  character(len=*), intent(inout) :: data(:)
355  integer, intent(in) :: length, from_pe
356  integer, intent(in), optional :: pelist(:)
357  integer :: n, i, from_rank, out_unit
358 
359 !pointer to remote data
360  character :: bdata(length)
361  pointer( ptr, bdata )
362  integer :: words
363  character(len=8) :: text
364 
365  if( .NOT.module_is_initialized )call mpp_error( FATAL, 'mpp_broadcast_text: You must first call mpp_init.' )
366  n = get_peset(pelist); if( peset(n)%count.EQ.1 )return
367 
368  if( debug )then
369  call SYSTEM_CLOCK(tick)
370  if(mpp_pe() == mpp_root_pe()) then
371  out_unit = stdout()
372  write( out_unit,'(a,i18,a,i5,a,2i5,2i8)' )&
373  'T=',tick, ' PE=',pe, 'mpp_broadcast_text begin: from_pe, length=', from_pe, length
374  endif
375  end if
376 
377  if( .NOT.ANY(from_pe.EQ.peset(current_peset_num)%list) ) &
378  call mpp_error( FATAL, 'mpp_broadcast_text: broadcasting from invalid PE.' )
379 
380  if( debug .and. (current_clock.NE.0) )call SYSTEM_CLOCK(start_tick)
381 
382  ptr = LOC(mpp_stack)
383  words = size(bdata(:))*size(transfer(bdata(1),word))
384  if( words.GT.mpp_stack_size )then
385  write( text, '(i8)' )words
386  call mpp_error( FATAL, 'MPP_BROADCAST user stack overflow: call mpp_set_stack_size('//text//') from all PEs.' )
387  end if
388  mpp_stack_hwm = max( words, mpp_stack_hwm )
389  if( mpp_npes().GT.1 )then
390 !dir$ IVDEP
391  do i = 1,length
392  bdata(i) = data(i)
393  end do
394  call mpp_sync(pelist) !eliminate?
395 #ifdef _CRAYT90
396  call SHMEM_UDCFLUSH !invalidate data cache
397 #endif
398  call SHMEM_BROADCAST_( bdata, bdata, length, from_pe, peset(n)%start, peset(n)%log2stride, peset(n)%count, sync )
399  call mpp_sync(pelist) !eliminate?
400 !dir$ IVDEP
401  do i = 1,length
402  data(i) = bdata(i)
403  end do
404  end if
405 
406  if( debug .and. (current_clock.NE.0) )call increment_current_clock( EVENT_BROADCAST, length )
407  return
408  end subroutine mpp_broadcast_char
409 
410 
411 #undef MPP_TRANSMIT_
412 #define MPP_TRANSMIT_ mpp_transmit_real8
413 #undef MPP_TRANSMIT_SCALAR_
414 #define MPP_TRANSMIT_SCALAR_ mpp_transmit_real8_scalar
415 #undef MPP_TRANSMIT_2D_
416 #define MPP_TRANSMIT_2D_ mpp_transmit_real8_2d
417 #undef MPP_TRANSMIT_3D_
418 #define MPP_TRANSMIT_3D_ mpp_transmit_real8_3d
419 #undef MPP_TRANSMIT_4D_
420 #define MPP_TRANSMIT_4D_ mpp_transmit_real8_4d
421 #undef MPP_TRANSMIT_5D_
422 #define MPP_TRANSMIT_5D_ mpp_transmit_real8_5d
423 #undef MPP_RECV_
424 #define MPP_RECV_ mpp_recv_real8
425 #undef MPP_RECV_SCALAR_
426 #define MPP_RECV_SCALAR_ mpp_recv_real8_scalar
427 #undef MPP_RECV_2D_
428 #define MPP_RECV_2D_ mpp_recv_real8_2d
429 #undef MPP_RECV_3D_
430 #define MPP_RECV_3D_ mpp_recv_real8_3d
431 #undef MPP_RECV_4D_
432 #define MPP_RECV_4D_ mpp_recv_real8_4d
433 #undef MPP_RECV_5D_
434 #define MPP_RECV_5D_ mpp_recv_real8_5d
435 #undef MPP_SEND_
436 #define MPP_SEND_ mpp_send_real8
437 #undef MPP_SEND_SCALAR_
438 #define MPP_SEND_SCALAR_ mpp_send_real8_scalar
439 #undef MPP_SEND_2D_
440 #define MPP_SEND_2D_ mpp_send_real8_2d
441 #undef MPP_SEND_3D_
442 #define MPP_SEND_3D_ mpp_send_real8_3d
443 #undef MPP_SEND_4D_
444 #define MPP_SEND_4D_ mpp_send_real8_4d
445 #undef MPP_SEND_5D_
446 #define MPP_SEND_5D_ mpp_send_real8_5d
447 #undef MPP_BROADCAST_
448 #define MPP_BROADCAST_ mpp_broadcast_real8
449 #undef MPP_BROADCAST_SCALAR_
450 #define MPP_BROADCAST_SCALAR_ mpp_broadcast_real8_scalar
451 #undef MPP_BROADCAST_2D_
452 #define MPP_BROADCAST_2D_ mpp_broadcast_real8_2d
453 #undef MPP_BROADCAST_3D_
454 #define MPP_BROADCAST_3D_ mpp_broadcast_real8_3d
455 #undef MPP_BROADCAST_4D_
456 #define MPP_BROADCAST_4D_ mpp_broadcast_real8_4d
457 #undef MPP_BROADCAST_5D_
458 #define MPP_BROADCAST_5D_ mpp_broadcast_real8_5d
459 #undef MPP_TYPE_
460 #define MPP_TYPE_ real(DOUBLE_KIND)
461 #undef MPP_TYPE_BYTELEN_
462 #define MPP_TYPE_BYTELEN_ 8
463 #undef SHMEM_BROADCAST_
464 #define SHMEM_BROADCAST_ SHMEM_BROADCAST8
465 #undef SHMEM_GET_
466 #define SHMEM_GET_ SHMEM_GET8
467 #include <mpp_transmit_sma.h>
468 
469 #ifdef OVERLOAD_C8
470 #undef MPP_TRANSMIT_
471 #define MPP_TRANSMIT_ mpp_transmit_cmplx8
472 #undef MPP_TRANSMIT_SCALAR_
473 #define MPP_TRANSMIT_SCALAR_ mpp_transmit_cmplx8_scalar
474 #undef MPP_TRANSMIT_2D_
475 #define MPP_TRANSMIT_2D_ mpp_transmit_cmplx8_2d
476 #undef MPP_TRANSMIT_3D_
477 #define MPP_TRANSMIT_3D_ mpp_transmit_cmplx8_3d
478 #undef MPP_TRANSMIT_4D_
479 #define MPP_TRANSMIT_4D_ mpp_transmit_cmplx8_4d
480 #undef MPP_TRANSMIT_5D_
481 #define MPP_TRANSMIT_5D_ mpp_transmit_cmplx8_5d
482 #undef MPP_RECV_
483 #define MPP_RECV_ mpp_recv_cmplx8
484 #undef MPP_RECV_SCALAR_
485 #define MPP_RECV_SCALAR_ mpp_recv_cmplx8_scalar
486 #undef MPP_RECV_2D_
487 #define MPP_RECV_2D_ mpp_recv_cmplx8_2d
488 #undef MPP_RECV_3D_
489 #define MPP_RECV_3D_ mpp_recv_cmplx8_3d
490 #undef MPP_RECV_4D_
491 #define MPP_RECV_4D_ mpp_recv_cmplx8_4d
492 #undef MPP_RECV_5D_
493 #define MPP_RECV_5D_ mpp_recv_cmplx8_5d
494 #undef MPP_SEND_
495 #define MPP_SEND_ mpp_send_cmplx8
496 #undef MPP_SEND_SCALAR_
497 #define MPP_SEND_SCALAR_ mpp_send_cmplx8_scalar
498 #undef MPP_SEND_2D_
499 #define MPP_SEND_2D_ mpp_send_cmplx8_2d
500 #undef MPP_SEND_3D_
501 #define MPP_SEND_3D_ mpp_send_cmplx8_3d
502 #undef MPP_SEND_4D_
503 #define MPP_SEND_4D_ mpp_send_cmplx8_4d
504 #undef MPP_SEND_5D_
505 #define MPP_SEND_5D_ mpp_send_cmplx8_5d
506 #undef MPP_BROADCAST_
507 #define MPP_BROADCAST_ mpp_broadcast_cmplx8
508 #undef MPP_BROADCAST_SCALAR_
509 #define MPP_BROADCAST_SCALAR_ mpp_broadcast_cmplx8_scalar
510 #undef MPP_BROADCAST_2D_
511 #define MPP_BROADCAST_2D_ mpp_broadcast_cmplx8_2d
512 #undef MPP_BROADCAST_3D_
513 #define MPP_BROADCAST_3D_ mpp_broadcast_cmplx8_3d
514 #undef MPP_BROADCAST_4D_
515 #define MPP_BROADCAST_4D_ mpp_broadcast_cmplx8_4d
516 #undef MPP_BROADCAST_5D_
517 #define MPP_BROADCAST_5D_ mpp_broadcast_cmplx8_5d
518 #undef MPP_TYPE_
519 #define MPP_TYPE_ complex(DOUBLE_KIND)
520 #undef MPP_TYPE_BYTELEN_
521 #define MPP_TYPE_BYTELEN_ 16
522 #undef SHMEM_BROADCAST_
523 #define SHMEM_BROADCAST_ SHMEM_BROADCAST8
524 #undef SHMEM_GET_
525 #define SHMEM_GET_ SHMEM_GET128
526 #include <mpp_transmit_sma.h>
527 #endif
528 
529 #ifdef OVERLOAD_R4
530 #undef MPP_TRANSMIT_
531 #define MPP_TRANSMIT_ mpp_transmit_real4
532 #undef MPP_TRANSMIT_SCALAR_
533 #define MPP_TRANSMIT_SCALAR_ mpp_transmit_real4_scalar
534 #undef MPP_TRANSMIT_2D_
535 #define MPP_TRANSMIT_2D_ mpp_transmit_real4_2d
536 #undef MPP_TRANSMIT_3D_
537 #define MPP_TRANSMIT_3D_ mpp_transmit_real4_3d
538 #undef MPP_TRANSMIT_4D_
539 #define MPP_TRANSMIT_4D_ mpp_transmit_real4_4d
540 #undef MPP_TRANSMIT_5D_
541 #define MPP_TRANSMIT_5D_ mpp_transmit_real4_5d
542 #undef MPP_RECV_
543 #define MPP_RECV_ mpp_recv_real4
544 #undef MPP_RECV_SCALAR_
545 #define MPP_RECV_SCALAR_ mpp_recv_real4_scalar
546 #undef MPP_RECV_2D_
547 #define MPP_RECV_2D_ mpp_recv_real4_2d
548 #undef MPP_RECV_3D_
549 #define MPP_RECV_3D_ mpp_recv_real4_3d
550 #undef MPP_RECV_4D_
551 #define MPP_RECV_4D_ mpp_recv_real4_4d
552 #undef MPP_RECV_5D_
553 #define MPP_RECV_5D_ mpp_recv_real4_5d
554 #undef MPP_SEND_
555 #define MPP_SEND_ mpp_send_real4
556 #undef MPP_SEND_SCALAR_
557 #define MPP_SEND_SCALAR_ mpp_send_real4_scalar
558 #undef MPP_SEND_2D_
559 #define MPP_SEND_2D_ mpp_send_real4_2d
560 #undef MPP_SEND_3D_
561 #define MPP_SEND_3D_ mpp_send_real4_3d
562 #undef MPP_SEND_4D_
563 #define MPP_SEND_4D_ mpp_send_real4_4d
564 #undef MPP_SEND_5D_
565 #define MPP_SEND_5D_ mpp_send_real4_5d
566 #undef MPP_BROADCAST_
567 #define MPP_BROADCAST_ mpp_broadcast_real4
568 #undef MPP_BROADCAST_SCALAR_
569 #define MPP_BROADCAST_SCALAR_ mpp_broadcast_real4_scalar
570 #undef MPP_BROADCAST_2D_
571 #define MPP_BROADCAST_2D_ mpp_broadcast_real4_2d
572 #undef MPP_BROADCAST_3D_
573 #define MPP_BROADCAST_3D_ mpp_broadcast_real4_3d
574 #undef MPP_BROADCAST_4D_
575 #define MPP_BROADCAST_4D_ mpp_broadcast_real4_4d
576 #undef MPP_BROADCAST_5D_
577 #define MPP_BROADCAST_5D_ mpp_broadcast_real4_5d
578 #undef MPP_TYPE_
579 #define MPP_TYPE_ real(FLOAT_KIND)
580 #undef MPP_TYPE_BYTELEN_
581 #define MPP_TYPE_BYTELEN_ 4
582 #undef SHMEM_BROADCAST_
583 #define SHMEM_BROADCAST_ SHMEM_BROADCAST4
584 #undef SHMEM_GET_
585 #define SHMEM_GET_ SHMEM_GET4
586 #include <mpp_transmit_sma.h>
587 #endif
588 
589 #ifdef OVERLOAD_C4
590 #undef MPP_TRANSMIT_
591 #define MPP_TRANSMIT_ mpp_transmit_cmplx4
592 #undef MPP_TRANSMIT_SCALAR_
593 #define MPP_TRANSMIT_SCALAR_ mpp_transmit_cmplx4_scalar
594 #undef MPP_TRANSMIT_2D_
595 #define MPP_TRANSMIT_2D_ mpp_transmit_cmplx4_2d
596 #undef MPP_TRANSMIT_3D_
597 #define MPP_TRANSMIT_3D_ mpp_transmit_cmplx4_3d
598 #undef MPP_TRANSMIT_4D_
599 #define MPP_TRANSMIT_4D_ mpp_transmit_cmplx4_4d
600 #undef MPP_TRANSMIT_5D_
601 #define MPP_TRANSMIT_5D_ mpp_transmit_cmplx4_5d
602 #undef MPP_RECV_
603 #define MPP_RECV_ mpp_recv_cmplx4
604 #undef MPP_RECV_SCALAR_
605 #define MPP_RECV_SCALAR_ mpp_recv_cmplx4_scalar
606 #undef MPP_RECV_2D_
607 #define MPP_RECV_2D_ mpp_recv_cmplx4_2d
608 #undef MPP_RECV_3D_
609 #define MPP_RECV_3D_ mpp_recv_cmplx4_3d
610 #undef MPP_RECV_4D_
611 #define MPP_RECV_4D_ mpp_recv_cmplx4_4d
612 #undef MPP_RECV_5D_
613 #define MPP_RECV_5D_ mpp_recv_cmplx4_5d
614 #undef MPP_SEND_
615 #define MPP_SEND_ mpp_send_cmplx4
616 #undef MPP_SEND_SCALAR_
617 #define MPP_SEND_SCALAR_ mpp_send_cmplx4_scalar
618 #undef MPP_SEND_2D_
619 #define MPP_SEND_2D_ mpp_send_cmplx4_2d
620 #undef MPP_SEND_3D_
621 #define MPP_SEND_3D_ mpp_send_cmplx4_3d
622 #undef MPP_SEND_4D_
623 #define MPP_SEND_4D_ mpp_send_cmplx4_4d
624 #undef MPP_SEND_5D_
625 #define MPP_SEND_5D_ mpp_send_cmplx4_5d
626 #undef MPP_BROADCAST_
627 #define MPP_BROADCAST_ mpp_broadcast_cmplx4
628 #undef MPP_BROADCAST_SCALAR_
629 #define MPP_BROADCAST_SCALAR_ mpp_broadcast_cmplx4_scalar
630 #undef MPP_BROADCAST_2D_
631 #define MPP_BROADCAST_2D_ mpp_broadcast_cmplx4_2d
632 #undef MPP_BROADCAST_3D_
633 #define MPP_BROADCAST_3D_ mpp_broadcast_cmplx4_3d
634 #undef MPP_BROADCAST_4D_
635 #define MPP_BROADCAST_4D_ mpp_broadcast_cmplx4_4d
636 #undef MPP_BROADCAST_5D_
637 #define MPP_BROADCAST_5D_ mpp_broadcast_cmplx4_5d
638 #undef MPP_TYPE_
639 #define MPP_TYPE_ complex(FLOAT_KIND)
640 #undef MPP_TYPE_BYTELEN_
641 #define MPP_TYPE_BYTELEN_ 8
642 #undef SHMEM_BROADCAST_
643 #define SHMEM_BROADCAST_ SHMEM_BROADCAST4
644 #undef SHMEM_GET_
645 #define SHMEM_GET_ SHMEM_GET64
646 #include <mpp_transmit_sma.h>
647 #endif
648 
649 #ifndef no_8byte_integers
650 #undef MPP_TRANSMIT_
651 #define MPP_TRANSMIT_ mpp_transmit_int8
652 #undef MPP_TRANSMIT_SCALAR_
653 #define MPP_TRANSMIT_SCALAR_ mpp_transmit_int8_scalar
654 #undef MPP_TRANSMIT_2D_
655 #define MPP_TRANSMIT_2D_ mpp_transmit_int8_2d
656 #undef MPP_TRANSMIT_3D_
657 #define MPP_TRANSMIT_3D_ mpp_transmit_int8_3d
658 #undef MPP_TRANSMIT_4D_
659 #define MPP_TRANSMIT_4D_ mpp_transmit_int8_4d
660 #undef MPP_TRANSMIT_5D_
661 #define MPP_TRANSMIT_5D_ mpp_transmit_int8_5d
662 #undef MPP_RECV_
663 #define MPP_RECV_ mpp_recv_int8
664 #undef MPP_RECV_SCALAR_
665 #define MPP_RECV_SCALAR_ mpp_recv_int8_scalar
666 #undef MPP_RECV_2D_
667 #define MPP_RECV_2D_ mpp_recv_int8_2d
668 #undef MPP_RECV_3D_
669 #define MPP_RECV_3D_ mpp_recv_int8_3d
670 #undef MPP_RECV_4D_
671 #define MPP_RECV_4D_ mpp_recv_int8_4d
672 #undef MPP_RECV_5D_
673 #define MPP_RECV_5D_ mpp_recv_int8_5d
674 #undef MPP_SEND_
675 #define MPP_SEND_ mpp_send_int8
676 #undef MPP_SEND_SCALAR_
677 #define MPP_SEND_SCALAR_ mpp_send_int8_scalar
678 #undef MPP_SEND_2D_
679 #define MPP_SEND_2D_ mpp_send_int8_2d
680 #undef MPP_SEND_3D_
681 #define MPP_SEND_3D_ mpp_send_int8_3d
682 #undef MPP_SEND_4D_
683 #define MPP_SEND_4D_ mpp_send_int8_4d
684 #undef MPP_SEND_5D_
685 #define MPP_SEND_5D_ mpp_send_int8_5d
686 #undef MPP_BROADCAST_
687 #define MPP_BROADCAST_ mpp_broadcast_int8
688 #undef MPP_BROADCAST_SCALAR_
689 #define MPP_BROADCAST_SCALAR_ mpp_broadcast_int8_scalar
690 #undef MPP_BROADCAST_2D_
691 #define MPP_BROADCAST_2D_ mpp_broadcast_int8_2d
692 #undef MPP_BROADCAST_3D_
693 #define MPP_BROADCAST_3D_ mpp_broadcast_int8_3d
694 #undef MPP_BROADCAST_4D_
695 #define MPP_BROADCAST_4D_ mpp_broadcast_int8_4d
696 #undef MPP_BROADCAST_5D_
697 #define MPP_BROADCAST_5D_ mpp_broadcast_int8_5d
698 #undef MPP_TYPE_
699 #define MPP_TYPE_ integer(LONG_KIND)
700 #undef MPP_TYPE_BYTELEN_
701 #define MPP_TYPE_BYTELEN_ 8
702 #undef SHMEM_BROADCAST_
703 #define SHMEM_BROADCAST_ SHMEM_BROADCAST8
704 #undef SHMEM_GET_
705 #define SHMEM_GET_ SHMEM_GET8
706 #include <mpp_transmit_sma.h>
707 #endif
708 
709 #undef MPP_TRANSMIT_
710 #define MPP_TRANSMIT_ mpp_transmit_int4
711 #undef MPP_TRANSMIT_SCALAR_
712 #define MPP_TRANSMIT_SCALAR_ mpp_transmit_int4_scalar
713 #undef MPP_TRANSMIT_2D_
714 #define MPP_TRANSMIT_2D_ mpp_transmit_int4_2d
715 #undef MPP_TRANSMIT_3D_
716 #define MPP_TRANSMIT_3D_ mpp_transmit_int4_3d
717 #undef MPP_TRANSMIT_4D_
718 #define MPP_TRANSMIT_4D_ mpp_transmit_int4_4d
719 #undef MPP_TRANSMIT_5D_
720 #define MPP_TRANSMIT_5D_ mpp_transmit_int4_5d
721 #undef MPP_RECV_
722 #define MPP_RECV_ mpp_recv_int4
723 #undef MPP_RECV_SCALAR_
724 #define MPP_RECV_SCALAR_ mpp_recv_int4_scalar
725 #undef MPP_RECV_2D_
726 #define MPP_RECV_2D_ mpp_recv_int4_2d
727 #undef MPP_RECV_3D_
728 #define MPP_RECV_3D_ mpp_recv_int4_3d
729 #undef MPP_RECV_4D_
730 #define MPP_RECV_4D_ mpp_recv_int4_4d
731 #undef MPP_RECV_5D_
732 #define MPP_RECV_5D_ mpp_recv_int4_5d
733 #undef MPP_SEND_
734 #define MPP_SEND_ mpp_send_int4
735 #undef MPP_SEND_SCALAR_
736 #define MPP_SEND_SCALAR_ mpp_send_int4_scalar
737 #undef MPP_SEND_2D_
738 #define MPP_SEND_2D_ mpp_send_int4_2d
739 #undef MPP_SEND_3D_
740 #define MPP_SEND_3D_ mpp_send_int4_3d
741 #undef MPP_SEND_4D_
742 #define MPP_SEND_4D_ mpp_send_int4_4d
743 #undef MPP_SEND_5D_
744 #define MPP_SEND_5D_ mpp_send_int4_5d
745 #undef MPP_BROADCAST_
746 #define MPP_BROADCAST_ mpp_broadcast_int4
747 #undef MPP_BROADCAST_SCALAR_
748 #define MPP_BROADCAST_SCALAR_ mpp_broadcast_int4_scalar
749 #undef MPP_BROADCAST_2D_
750 #define MPP_BROADCAST_2D_ mpp_broadcast_int4_2d
751 #undef MPP_BROADCAST_3D_
752 #define MPP_BROADCAST_3D_ mpp_broadcast_int4_3d
753 #undef MPP_BROADCAST_4D_
754 #define MPP_BROADCAST_4D_ mpp_broadcast_int4_4d
755 #undef MPP_BROADCAST_5D_
756 #define MPP_BROADCAST_5D_ mpp_broadcast_int4_5d
757 #undef MPP_TYPE_
758 #define MPP_TYPE_ integer(INT_KIND)
759 #undef MPP_TYPE_BYTELEN_
760 #define MPP_TYPE_BYTELEN_ 4
761 #undef SHMEM_BROADCAST_
762 #define SHMEM_BROADCAST_ SHMEM_BROADCAST4
763 #undef SHMEM_GET_
764 #define SHMEM_GET_ SHMEM_GET4
765 #include <mpp_transmit_sma.h>
766 
767 #ifndef no_8byte_integers
768 #undef MPP_TRANSMIT_
769 #define MPP_TRANSMIT_ mpp_transmit_logical8
770 #undef MPP_TRANSMIT_SCALAR_
771 #define MPP_TRANSMIT_SCALAR_ mpp_transmit_logical8_scalar
772 #undef MPP_TRANSMIT_2D_
773 #define MPP_TRANSMIT_2D_ mpp_transmit_logical8_2d
774 #undef MPP_TRANSMIT_3D_
775 #define MPP_TRANSMIT_3D_ mpp_transmit_logical8_3d
776 #undef MPP_TRANSMIT_4D_
777 #define MPP_TRANSMIT_4D_ mpp_transmit_logical8_4d
778 #undef MPP_TRANSMIT_5D_
779 #define MPP_TRANSMIT_5D_ mpp_transmit_logical8_5d
780 #undef MPP_RECV_
781 #define MPP_RECV_ mpp_recv_logical8
782 #undef MPP_RECV_SCALAR_
783 #define MPP_RECV_SCALAR_ mpp_recv_logical8_scalar
784 #undef MPP_RECV_2D_
785 #define MPP_RECV_2D_ mpp_recv_logical8_2d
786 #undef MPP_RECV_3D_
787 #define MPP_RECV_3D_ mpp_recv_logical8_3d
788 #undef MPP_RECV_4D_
789 #define MPP_RECV_4D_ mpp_recv_logical8_4d
790 #undef MPP_RECV_5D_
791 #define MPP_RECV_5D_ mpp_recv_logical8_5d
792 #undef MPP_SEND_
793 #define MPP_SEND_ mpp_send_logical8
794 #undef MPP_SEND_SCALAR_
795 #define MPP_SEND_SCALAR_ mpp_send_logical8_scalar
796 #undef MPP_SEND_2D_
797 #define MPP_SEND_2D_ mpp_send_logical8_2d
798 #undef MPP_SEND_3D_
799 #define MPP_SEND_3D_ mpp_send_logical8_3d
800 #undef MPP_SEND_4D_
801 #define MPP_SEND_4D_ mpp_send_logical8_4d
802 #undef MPP_SEND_5D_
803 #define MPP_SEND_5D_ mpp_send_logical8_5d
804 #undef MPP_BROADCAST_
805 #define MPP_BROADCAST_ mpp_broadcast_logical8
806 #undef MPP_BROADCAST_SCALAR_
807 #define MPP_BROADCAST_SCALAR_ mpp_broadcast_logical8_scalar
808 #undef MPP_BROADCAST_2D_
809 #define MPP_BROADCAST_2D_ mpp_broadcast_logical8_2d
810 #undef MPP_BROADCAST_3D_
811 #define MPP_BROADCAST_3D_ mpp_broadcast_logical8_3d
812 #undef MPP_BROADCAST_4D_
813 #define MPP_BROADCAST_4D_ mpp_broadcast_logical8_4d
814 #undef MPP_BROADCAST_5D_
815 #define MPP_BROADCAST_5D_ mpp_broadcast_logical8_5d
816 #undef MPP_TYPE_
817 #define MPP_TYPE_ logical(LONG_KIND)
818 #undef MPP_TYPE_BYTELEN_
819 #define MPP_TYPE_BYTELEN_ 8
820 #undef SHMEM_BROADCAST_
821 #define SHMEM_BROADCAST_ SHMEM_BROADCAST8
822 #undef SHMEM_GET_
823 #define SHMEM_GET_ SHMEM_GET8
824 #include <mpp_transmit_sma.h>
825 #endif
826 
827 #undef MPP_TRANSMIT_
828 #define MPP_TRANSMIT_ mpp_transmit_logical4
829 #undef MPP_TRANSMIT_SCALAR_
830 #define MPP_TRANSMIT_SCALAR_ mpp_transmit_logical4_scalar
831 #undef MPP_TRANSMIT_2D_
832 #define MPP_TRANSMIT_2D_ mpp_transmit_logical4_2d
833 #undef MPP_TRANSMIT_3D_
834 #define MPP_TRANSMIT_3D_ mpp_transmit_logical4_3d
835 #undef MPP_TRANSMIT_4D_
836 #define MPP_TRANSMIT_4D_ mpp_transmit_logical4_4d
837 #undef MPP_TRANSMIT_5D_
838 #define MPP_TRANSMIT_5D_ mpp_transmit_logical4_5d
839 #undef MPP_RECV_
840 #define MPP_RECV_ mpp_recv_logical4
841 #undef MPP_RECV_SCALAR_
842 #define MPP_RECV_SCALAR_ mpp_recv_logical4_scalar
843 #undef MPP_RECV_2D_
844 #define MPP_RECV_2D_ mpp_recv_logical4_2d
845 #undef MPP_RECV_3D_
846 #define MPP_RECV_3D_ mpp_recv_logical4_3d
847 #undef MPP_RECV_4D_
848 #define MPP_RECV_4D_ mpp_recv_logical4_4d
849 #undef MPP_RECV_5D_
850 #define MPP_RECV_5D_ mpp_recv_logical4_5d
851 #undef MPP_SEND_
852 #define MPP_SEND_ mpp_send_logical4
853 #undef MPP_SEND_SCALAR_
854 #define MPP_SEND_SCALAR_ mpp_send_logical4_scalar
855 #undef MPP_SEND_2D_
856 #define MPP_SEND_2D_ mpp_send_logical4_2d
857 #undef MPP_SEND_3D_
858 #define MPP_SEND_3D_ mpp_send_logical4_3d
859 #undef MPP_SEND_4D_
860 #define MPP_SEND_4D_ mpp_send_logical4_4d
861 #undef MPP_SEND_5D_
862 #define MPP_SEND_5D_ mpp_send_logical4_5d
863 #undef MPP_BROADCAST_
864 #define MPP_BROADCAST_ mpp_broadcast_logical4
865 #undef MPP_BROADCAST_SCALAR_
866 #define MPP_BROADCAST_SCALAR_ mpp_broadcast_logical4_scalar
867 #undef MPP_BROADCAST_2D_
868 #define MPP_BROADCAST_2D_ mpp_broadcast_logical4_2d
869 #undef MPP_BROADCAST_3D_
870 #define MPP_BROADCAST_3D_ mpp_broadcast_logical4_3d
871 #undef MPP_BROADCAST_4D_
872 #define MPP_BROADCAST_4D_ mpp_broadcast_logical4_4d
873 #undef MPP_BROADCAST_5D_
874 #define MPP_BROADCAST_5D_ mpp_broadcast_logical4_5d
875 #undef MPP_TYPE_
876 #define MPP_TYPE_ logical(INT_KIND)
877 #undef MPP_TYPE_BYTELEN_
878 #define MPP_TYPE_BYTELEN_ 4
879 #undef SHMEM_BROADCAST_
880 #define SHMEM_BROADCAST_ SHMEM_BROADCAST4
881 #undef SHMEM_GET_
882 #define SHMEM_GET_ SHMEM_GET4
883 #include <mpp_transmit_sma.h>
884 
885 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
886 ! !
887 ! GLOBAL REDUCTION ROUTINES: mpp_max, mpp_sum, mpp_min !
888 ! !
889 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
890 
891 #undef MPP_REDUCE_0D_
892 #define MPP_REDUCE_0D_ mpp_max_real8_0d
893 #undef MPP_REDUCE_1D_
894 #define MPP_REDUCE_1D_ mpp_max_real8_1d
895 #undef MPP_TYPE_
896 #define MPP_TYPE_ real(DOUBLE_KIND)
897 #undef MPP_TYPE_BYTELEN_
898 #define MPP_TYPE_BYTELEN_ 8
899 #undef SHMEM_REDUCE_
900 #define SHMEM_REDUCE_ SHMEM_REAL8_MAX_TO_ALL
901 #include <mpp_reduce_sma.h>
902 
903 #ifdef OVERLOAD_R4
904 #undef MPP_REDUCE_0D_
905 #define MPP_REDUCE_0D_ mpp_max_real4_0d
906 #undef MPP_REDUCE_1D_
907 #define MPP_REDUCE_1D_ mpp_max_real4_1d
908 #undef MPP_TYPE_
909 #define MPP_TYPE_ real(FLOAT_KIND)
910 #undef MPP_TYPE_BYTELEN_
911 #define MPP_TYPE_BYTELEN_ 4
912 #undef SHMEM_REDUCE_
913 #define SHMEM_REDUCE_ SHMEM_REAL4_MAX_TO_ALL
914 #include <mpp_reduce_sma.h>
915 #endif
916 
917 #ifndef no_8byte_integers
918 #undef MPP_REDUCE_0D_
919 #define MPP_REDUCE_0D_ mpp_max_int8_0d
920 #undef MPP_REDUCE_1D_
921 #define MPP_REDUCE_1D_ mpp_max_int8_1d
922 #undef MPP_TYPE_
923 #define MPP_TYPE_ integer(LONG_KIND)
924 #undef MPP_TYPE_BYTELEN_
925 #define MPP_TYPE_BYTELEN_ 8
926 #undef SHMEM_REDUCE_
927 #define SHMEM_REDUCE_ SHMEM_INT8_MAX_TO_ALL
928 #include <mpp_reduce_sma.h>
929 #endif
930 
931 #undef MPP_REDUCE_0D_
932 #define MPP_REDUCE_0D_ mpp_max_int4_0d
933 #undef MPP_REDUCE_1D_
934 #define MPP_REDUCE_1D_ mpp_max_int4_1d
935 #undef MPP_TYPE_
936 #define MPP_TYPE_ integer(INT_KIND)
937 #undef MPP_TYPE_BYTELEN_
938 #define MPP_TYPE_BYTELEN_ 4
939 #undef SHMEM_REDUCE_
940 #define SHMEM_REDUCE_ SHMEM_INT4_MAX_TO_ALL
941 #include <mpp_reduce_sma.h>
942 
943 #undef MPP_REDUCE_0D_
944 #define MPP_REDUCE_0D_ mpp_min_real8_0d
945 #undef MPP_REDUCE_1D_
946 #define MPP_REDUCE_1D_ mpp_min_real8_1d
947 #undef MPP_TYPE_
948 #define MPP_TYPE_ real(DOUBLE_KIND)
949 #undef MPP_TYPE_BYTELEN_
950 #define MPP_TYPE_BYTELEN_ 8
951 #undef SHMEM_REDUCE_
952 #define SHMEM_REDUCE_ SHMEM_REAL8_MIN_TO_ALL
953 #include <mpp_reduce_sma.h>
954 
955 #ifdef OVERLOAD_R4
956 #undef MPP_REDUCE_0D_
957 #define MPP_REDUCE_0D_ mpp_min_real4_0d
958 #undef MPP_REDUCE_1D_
959 #define MPP_REDUCE_1D_ mpp_min_real4_1d
960 #undef MPP_TYPE_
961 #define MPP_TYPE_ real(FLOAT_KIND)
962 #undef MPP_TYPE_BYTELEN_
963 #define MPP_TYPE_BYTELEN_ 4
964 #undef SHMEM_REDUCE_
965 #define SHMEM_REDUCE_ SHMEM_REAL4_MIN_TO_ALL
966 #include <mpp_reduce_sma.h>
967 #endif
968 
969 #ifndef no_8byte_integers
970 #undef MPP_REDUCE_0D_
971 #define MPP_REDUCE_0D_ mpp_min_int8_0d
972 #undef MPP_REDUCE_1D_
973 #define MPP_REDUCE_1D_ mpp_min_int8_1d
974 #undef MPP_TYPE_
975 #define MPP_TYPE_ integer(LONG_KIND)
976 #undef MPP_TYPE_BYTELEN_
977 #define MPP_TYPE_BYTELEN_ 8
978 #undef SHMEM_REDUCE_
979 #define SHMEM_REDUCE_ SHMEM_INT8_MIN_TO_ALL
980 #include <mpp_reduce_sma.h>
981 #endif
982 
983 #undef MPP_REDUCE_0D_
984 #define MPP_REDUCE_0D_ mpp_min_int4_0d
985 #undef MPP_REDUCE_1D_
986 #define MPP_REDUCE_1D_ mpp_min_int4_1d
987 #undef MPP_TYPE_
988 #define MPP_TYPE_ integer(INT_KIND)
989 #undef MPP_TYPE_BYTELEN_
990 #define MPP_TYPE_BYTELEN_ 4
991 #undef SHMEM_REDUCE_
992 #define SHMEM_REDUCE_ SHMEM_INT4_MIN_TO_ALL
993 #include <mpp_reduce_sma.h>
994 
995 #undef MPP_SUM_
996 #define MPP_SUM_ mpp_sum_real8
997 #undef MPP_SUM_SCALAR_
998 #define MPP_SUM_SCALAR_ mpp_sum_real8_scalar
999 #undef MPP_SUM_2D_
1000 #define MPP_SUM_2D_ mpp_sum_real8_2d
1001 #undef MPP_SUM_3D_
1002 #define MPP_SUM_3D_ mpp_sum_real8_3d
1003 #undef MPP_SUM_4D_
1004 #define MPP_SUM_4D_ mpp_sum_real8_4d
1005 #undef MPP_SUM_5D_
1006 #define MPP_SUM_5D_ mpp_sum_real8_5d
1007 #undef MPP_TYPE_
1008 #define MPP_TYPE_ real(DOUBLE_KIND)
1009 #undef SHMEM_SUM_
1010 #define SHMEM_SUM_ SHMEM_REAL8_SUM_TO_ALL
1011 #undef MPP_TYPE_BYTELEN_
1012 #define MPP_TYPE_BYTELEN_ 8
1013 #include <mpp_sum_sma.h>
1014 
1015 #ifdef OVERLOAD_C8
1016 #undef MPP_SUM_
1017 #define MPP_SUM_ mpp_sum_cmplx8
1018 #undef MPP_SUM_SCALAR_
1019 #define MPP_SUM_SCALAR_ mpp_sum_cmplx8_scalar
1020 #undef MPP_SUM_2D_
1021 #define MPP_SUM_2D_ mpp_sum_cmplx8_2d
1022 #undef MPP_SUM_3D_
1023 #define MPP_SUM_3D_ mpp_sum_cmplx8_3d
1024 #undef MPP_SUM_4D_
1025 #define MPP_SUM_4D_ mpp_sum_cmplx8_4d
1026 #undef MPP_SUM_5D_
1027 #define MPP_SUM_5D_ mpp_sum_cmplx8_5d
1028 #undef MPP_TYPE_
1029 #define MPP_TYPE_ complex(DOUBLE_KIND)
1030 #undef SHMEM_SUM_
1031 #define SHMEM_SUM_ SHMEM_COMP8_SUM_TO_ALL
1032 #undef MPP_TYPE_BYTELEN_
1033 #define MPP_TYPE_BYTELEN_ 16
1034 #include <mpp_sum_sma.h>
1035 #endif
1036 
1037 #ifdef OVERLOAD_R4
1038 #undef MPP_SUM_
1039 #define MPP_SUM_ mpp_sum_real4
1040 #undef MPP_SUM_SCALAR_
1041 #define MPP_SUM_SCALAR_ mpp_sum_real4_scalar
1042 #undef MPP_SUM_2D_
1043 #define MPP_SUM_2D_ mpp_sum_real4_2d
1044 #undef MPP_SUM_3D_
1045 #define MPP_SUM_3D_ mpp_sum_real4_3d
1046 #undef MPP_SUM_4D_
1047 #define MPP_SUM_4D_ mpp_sum_real4_4d
1048 #undef MPP_SUM_5D_
1049 #define MPP_SUM_5D_ mpp_sum_real4_5d
1050 #undef MPP_TYPE_
1051 #define MPP_TYPE_ real(FLOAT_KIND)
1052 #undef SHMEM_SUM_
1053 #define SHMEM_SUM_ SHMEM_REAL4_SUM_TO_ALL
1054 #undef MPP_TYPE_BYTELEN_
1055 #define MPP_TYPE_BYTELEN_ 4
1056 #include <mpp_sum_sma.h>
1057 #endif
1058 
1059 #ifdef OVERLOAD_C4
1060 #undef MPP_SUM_
1061 #define MPP_SUM_ mpp_sum_cmplx4
1062 #undef MPP_SUM_SCALAR_
1063 #define MPP_SUM_SCALAR_ mpp_sum_cmplx4_scalar
1064 #undef MPP_SUM_2D_
1065 #define MPP_SUM_2D_ mpp_sum_cmplx4_2d
1066 #undef MPP_SUM_3D_
1067 #define MPP_SUM_3D_ mpp_sum_cmplx4_3d
1068 #undef MPP_SUM_4D_
1069 #define MPP_SUM_4D_ mpp_sum_cmplx4_4d
1070 #undef MPP_SUM_5D_
1071 #define MPP_SUM_5D_ mpp_sum_cmplx4_5d
1072 #undef MPP_TYPE_
1073 #define MPP_TYPE_ complex(FLOAT_KIND)
1074 #undef SHMEM_SUM_
1075 #define SHMEM_SUM_ SHMEM_COMP4_SUM_TO_ALL
1076 #undef MPP_TYPE_BYTELEN_
1077 #define MPP_TYPE_BYTELEN_ 8
1078 #include <mpp_sum_sma.h>
1079 #endif
1080 
1081 #ifndef no_8byte_integers
1082 #undef MPP_SUM_
1083 #define MPP_SUM_ mpp_sum_int8
1084 #undef MPP_SUM_SCALAR_
1085 #define MPP_SUM_SCALAR_ mpp_sum_int8_scalar
1086 #undef MPP_SUM_2D_
1087 #define MPP_SUM_2D_ mpp_sum_int8_2d
1088 #undef MPP_SUM_3D_
1089 #define MPP_SUM_3D_ mpp_sum_int8_3d
1090 #undef MPP_SUM_4D_
1091 #define MPP_SUM_4D_ mpp_sum_int8_4d
1092 #undef MPP_SUM_5D_
1093 #define MPP_SUM_5D_ mpp_sum_int8_5d
1094 #undef MPP_TYPE_
1095 #define MPP_TYPE_ integer(LONG_KIND)
1096 #undef SHMEM_SUM_
1097 #define SHMEM_SUM_ SHMEM_INT8_SUM_TO_ALL
1098 #undef MPP_TYPE_BYTELEN_
1099 #define MPP_TYPE_BYTELEN_ 8
1100 #include <mpp_sum_sma.h>
1101 #endif
1102 
1103 #undef MPP_SUM_
1104 #define MPP_SUM_ mpp_sum_int4
1105 #undef MPP_SUM_SCALAR_
1106 #define MPP_SUM_SCALAR_ mpp_sum_int4_scalar
1107 #undef MPP_SUM_2D_
1108 #define MPP_SUM_2D_ mpp_sum_int4_2d
1109 #undef MPP_SUM_3D_
1110 #define MPP_SUM_3D_ mpp_sum_int4_3d
1111 #undef MPP_SUM_4D_
1112 #define MPP_SUM_4D_ mpp_sum_int4_4d
1113 #undef MPP_SUM_5D_
1114 #define MPP_SUM_5D_ mpp_sum_int4_5d
1115 #undef MPP_TYPE_
1116 #define MPP_TYPE_ integer(INT_KIND)
1117 #undef SHMEM_SUM_
1118 #define SHMEM_SUM_ SHMEM_INT4_SUM_TO_ALL
1119 #undef MPP_TYPE_BYTELEN_
1120 #define MPP_TYPE_BYTELEN_ 4
1121 #include <mpp_sum_sma.h>
1122 
1123 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1124 ! !
1125 ! SCATTER AND GATHER ROUTINES: mpp_alltoall !
1126 ! !
1127 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1128 
1129 #undef MPP_ALLTOALL_
1130 #undef MPP_ALLTOALLV_
1131 #undef MPP_TYPE_
1132 #undef MPP_TYPE_BYTELEN_
1133 #undef MPI_TYPE_
1134 #define MPP_ALLTOALL_ mpp_alltoall_int4
1135 #define MPP_ALLTOALLV_ mpp_alltoall_int4_v
1136 #define MPP_TYPE_ integer(INT_KIND)
1137 #define MPP_TYPE_BYTELEN_ 4
1138 #define MPI_TYPE_ MPI_INTEGER4
1139 #include <mpp_alltoall_sma.h>
1140 
1141 #undef MPP_ALLTOALL_
1142 #undef MPP_ALLTOALLV_
1143 #undef MPP_TYPE_
1144 #undef MPP_TYPE_BYTELEN_
1145 #undef MPI_TYPE_
1146 #define MPP_ALLTOALL_ mpp_alltoall_int8
1147 #define MPP_ALLTOALLV_ mpp_alltoall_int8_v
1148 #define MPP_TYPE_ integer(LONG_KIND)
1149 #define MPP_TYPE_BYTELEN_ 8
1150 #define MPI_TYPE_ MPI_INTEGER8
1151 #include <mpp_alltoall_sma.h>
1152 
1153 #undef MPP_ALLTOALL_
1154 #undef MPP_ALLTOALLV_
1155 #undef MPP_TYPE_
1156 #undef MPP_TYPE_BYTELEN_
1157 #undef MPI_TYPE_
1158 #define MPP_ALLTOALL_ mpp_alltoall_real4
1159 #define MPP_ALLTOALLV_ mpp_alltoall_real4_v
1160 #define MPP_TYPE_ real(FLOAT_KIND)
1161 #define MPP_TYPE_BYTELEN_ 4
1162 #define MPI_TYPE_ MPI_REAL4
1163 #include <mpp_alltoall_sma.h>
1164 
1165 #undef MPP_ALLTOALL_
1166 #undef MPP_ALLTOALLV_
1167 #undef MPP_TYPE_
1168 #undef MPP_TYPE_BYTELEN_
1169 #undef MPI_TYPE_
1170 #define MPP_ALLTOALL_ mpp_alltoall_real8
1171 #define MPP_ALLTOALLV_ mpp_alltoall_real8_v
1172 #define MPP_TYPE_ real(DOUBLE_KIND)
1173 #define MPP_TYPE_BYTELEN_ 8
1174 #define MPI_TYPE_ MPI_REAL8
1175 #include <mpp_alltoall_sma.h>
1176 
1177 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1178 ! !
1179 ! DATA TRANSFER TYPES: mpp_type_create, mpp_type_free !
1180 ! !
1181 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1182 
1183 #define MPP_TYPE_CREATE_ mpp_type_create_int4
1184 #define MPP_TYPE_ integer(INT_KIND)
1185 #define MPI_TYPE_ MPI_INTEGER4
1186 #include <mpp_type_sma.h>
1187 
1188 #define MPP_TYPE_CREATE_ mpp_type_create_int8
1189 #define MPP_TYPE_ integer(LONG_KIND)
1190 #define MPI_TYPE_ MPI_INTEGER8
1191 #include <mpp_type_sma.h>
1192 
1193 #define MPP_TYPE_CREATE_ mpp_type_create_real4
1194 #define MPP_TYPE_ real(FLOAT_KIND)
1195 #define MPI_TYPE_ MPI_REAL4
1196 #include <mpp_type_sma.h>
1197 
1198 #define MPP_TYPE_CREATE_ mpp_type_create_real8
1199 #define MPP_TYPE_ real(DOUBLE_KIND)
1200 #define MPI_TYPE_ MPI_REAL8
1201 #include <mpp_type_sma.h>
1202 
1203 #define MPP_TYPE_CREATE_ mpp_type_create_logical4
1204 #define MPP_TYPE_ logical(INT_KIND)
1205 #define MPI_TYPE_ MPI_INTEGER4
1206 #include <mpp_type_sma.h>
1207 
1208 #define MPP_TYPE_CREATE_ mpp_type_create_logical8
1209 #define MPP_TYPE_ logical(LONG_KIND)
1210 #define MPI_TYPE_ MPI_INTEGER8
1211 #include <mpp_type_sma.h>
1212 
1213 ! Clear preprocessor flags
1214 #undef MPI_TYPE_
1215 #undef MPP_TYPE_
1216 #undef MPP_TYPE_CREATE_
1217 
1218 subroutine mpp_type_free(dtype)
1219  type(mpp_type), pointer, intent(inout) :: dtype
1220 
1221  call mpp_error(FATAL, 'MPP_TYPE_FREE: Unsupported for SHMEM.')
1222 end subroutine mpp_type_free
1223 
1224 !#######################################################################
1225 !these local versions are written for grouping into shmem_integer_wait
1226 subroutine shmem_int4_wait_local( ivar, cmp_value )
1227 #ifdef __ia64
1228  !dir$ ATTRIBUTE FORCEINLINE shmem_int4_wait_local
1229 #else
1230  !dir$ INLINEALWAYS shmem_int4_wait_local
1231 #endif
1232  integer(INT_KIND), intent(in) :: cmp_value
1233  integer(INT_KIND), intent(inout) :: ivar
1234  call SHMEM_INT4_WAIT( ivar, cmp_value )
1235  return
1236 end subroutine shmem_int4_wait_local
1237 
1238 subroutine shmem_int8_wait_local( ivar, cmp_value )
1239 #ifdef __ia64
1240  !dir$ ATTRIBUTE FORCEINLINE shmem_int4_wait_local
1241 #else
1242  !dir$ INLINEALWAYS shmem_int4_wait_local
1243 #endif
1244  integer(LONG_KIND), intent(in) :: cmp_value
1245  integer(LONG_KIND), intent(inout) :: ivar
1246  call SHMEM_INT8_WAIT( ivar, cmp_value )
1247  return
1248 end subroutine shmem_int8_wait_local
1249 
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
i18
************************************************************************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) i18
Definition: mpp_transmit_mpi.h:178
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_mod::max_ticks
integer(long_kind) max_ticks
Definition: mpp.F90:1299
mpp_reduce_sma.h
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
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_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
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_alltoall_sma.h
mpp_mod::etc_unit
integer etc_unit
Definition: mpp.F90:1306
MPP_BROADCAST
************************************************************************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 end if MPP_BROADCAST
Definition: mpp_transmit_mpi.h:187
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
time_interp_external_mod::outunit
integer outunit
Definition: time_interp_external.F90:135
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
T
************************************************************************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) & T
Definition: mpp_transmit_mpi.h:179
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
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_mod::current_peset_max
integer current_peset_max
Definition: mpp.F90:1294
mpp_transmit_sma.h
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_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
mpp_mod::datatypes
type(mpp_type_list) datatypes
Definition: mpp.F90:1314
mpp_mod::configfile
character(len=32) configfile
Definition: mpp.F90:1307
type_distribution::received
logical function received(this, seqno)
Definition: m_distribution.f90:72
interpolator_mod::len
integer len
Definition: interpolator.F90:321
LONG_KIND
#define LONG_KIND
field_manager_mod::root
type(field_def), target, save root
Definition: field_manager.F90:564
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
mpp_mod::word
integer(long_kind), dimension(1) word
Definition: mpp.F90:1364
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
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
INT_KIND
#define INT_KIND
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
sat_vapor_pres_mod::stdoutunit
integer stdoutunit
Definition: sat_vapor_pres.F90:531
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
mpp_sum_sma.h
sat_vapor_pres_mod::tmin
real tmin
Definition: sat_vapor_pres.F90:534
mpp_type_sma.h
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
c2f.module
module
Definition: c2f.py:21
diag_data_mod::empty
real empty
Definition: diag_data.F90:755
amip_interp_mod::verbose
integer verbose
Definition: amip_interp.F90:354
begin
************************************************************************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 begin
Definition: mpp_transmit_mpi.h:179