FV3 Bundle
mpp_comm_nocomm.inc
Go to the documentation of this file.
1 ! -*-f90-*-
2 
3 !***********************************************************************
4 !* GNU Lesser General Public License
5 !*
6 !* This file is part of the GFDL Flexible Modeling System (FMS).
7 !*
8 !* FMS is free software: you can redistribute it and/or modify it under
9 !* the terms of the GNU Lesser General Public License as published by
10 !* the Free Software Foundation, either version 3 of the License, or (at
11 !* your option) any later version.
12 !*
13 !* FMS is distributed in the hope that it will be useful, but WITHOUT
14 !* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
15 !* FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
16 !* for more details.
17 !*
18 !* You should have received a copy of the GNU Lesser General Public
19 !* License along with FMS. If not, see <http://www.gnu.org/licenses/>.
20 !***********************************************************************
21 
22 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
23 ! !
24 ! ROUTINES TO INITIALIZE/FINALIZE MPP MODULE: mpp_init, mpp_exit !
25 ! !
26 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
27  ! subroutine mpp_init( flags, in, out, err, log )
28  ! integer, optional, intent(in) :: flags, in, out, err, log
29 subroutine mpp_init( flags,localcomm )
30  integer, optional, intent(in) :: flags
31  integer, optional, intent(in) :: localcomm ! dummy here, used only in MPI
32  integer :: my_pe, num_pes, len, i, logunit
33  logical :: opened, existed
34  integer :: unit_begin, unit_end, unit_nml, io_status
35 
36  if( module_is_initialized )return
37 
38  module_is_initialized = .TRUE.
39 
40  allocate(peset(0:0))
41  !PEsets: make defaults illegal
42  peset(:)%count = -1
43  peset(:)%id = -1
44  peset(:)%group = -1
45  !0=single-PE, initialized so that count returns 1
46  peset(0)%count = 1
47  allocate( peset(0)%list(1) )
48  peset(0)%list = pe
49  current_peset_num = 0
50  peset(0)%id = 0
51  world_peset_num = 0
52  current_peset_num = world_peset_num !initialize current PEset to world
53 
54  !initialize clocks
55  call SYSTEM_CLOCK( count=tick0, count_rate=ticks_per_sec, count_max=max_ticks )
56  tick_rate = 1./ticks_per_sec
57  clock0 = mpp_clock_id( 'Total runtime', flags=MPP_CLOCK_SYNC )
58 
59  ! Initialize mpp_datatypes
60  ! NOTE: mpp_datatypes is unused in serial mode; this is an empty list
61  datatypes%head => null()
62  datatypes%tail => null()
63  datatypes%length = 0
64 
65  ! Create the bytestream (default) mpp_datatype
66  ! NOTE: mpp_byte is unused in serial mode
67  mpp_byte%counter = -1
68  mpp_byte%ndims = -1
69  allocate(mpp_byte%sizes(0))
70  allocate(mpp_byte%subsizes(0))
71  allocate(mpp_byte%starts(0))
72  mpp_byte%etype = -1
73  mpp_byte%id = -1
74 
75  mpp_byte%prev => null()
76  mpp_byte%next => null()
77 
78  if( PRESENT(flags) )then
79  debug = flags.EQ.MPP_DEBUG
80  verbose = flags.EQ.MPP_VERBOSE .OR. debug
81  end if
82 
83  call mpp_init_logfile()
84  call read_input_nml
85 
86  !--- read namelist
87 #ifdef INTERNAL_FILE_NML
88  read (input_nml_file, mpp_nml, iostat=io_status)
89 #else
90  unit_begin = 103
91  unit_end = 512
92  do unit_nml = unit_begin, unit_end
93  inquire( unit_nml,OPENED=opened )
94  if( .NOT.opened )exit
95  end do
96 
97  open(unit_nml,file='input.nml', iostat=io_status)
98  read(unit_nml,mpp_nml,iostat=io_status)
99  close(unit_nml)
100 #endif
101 
102  if (io_status > 0) then
103  call mpp_error(FATAL,'=>mpp_init: Error reading input.nml')
104  endif
105 
106 ! non-root pe messages written to other location than stdout()
107 ! 9 is reserved for etc_unit
108  etc_unit=9
109  inquire(unit=etc_unit,opened=opened)
110  if(opened) call mpp_error(FATAL,'Unit 9 is already in use (etc_unit) in mpp_comm_nocomm')
111  if (trim(etcfile) /= '/dev/null') then
112  write( etcfile,'(a,i6.6)' )trim(etcfile)//'.', pe
113  endif
114  inquire(file=etcfile, exist=existed)
115  if(existed) then
116  open( unit=etc_unit, file=trim(etcfile), status='REPLACE' )
117  else
118  open( unit=etc_unit, file=trim(etcfile) )
119  endif
120  !if optional argument logunit=stdout, write messages to stdout instead.
121  !if specifying non-defaults, you must specify units not yet in use.
122  ! if( PRESENT(in) )then
123  ! inquire( unit=in, opened=opened )
124  ! if( opened )call mpp_error( FATAL, 'MPP_INIT: unable to open stdin.' )
125  ! in_unit=in
126  ! end if
127  ! if( PRESENT(out) )then
128  ! inquire( unit=out, opened=opened )
129  ! if( opened )call mpp_error( FATAL, 'MPP_INIT: unable to open stdout.' )
130  ! out_unit=out
131  ! end if
132  ! if( PRESENT(err) )then
133  ! inquire( unit=err, opened=opened )
134  ! if( opened )call mpp_error( FATAL, 'MPP_INIT: unable to open stderr.' )
135  ! err_unit=err
136  ! end if
137  ! log_unit=get_unit()
138  ! if( PRESENT(log) )then
139  ! inquire( unit=log, opened=opened )
140  ! if( opened .AND. log.NE.out_unit )call mpp_error( FATAL, 'MPP_INIT: unable to open stdlog.' )
141  ! log_unit=log
142  ! end if
143  !!log_unit can be written to only from root_pe, all others write to stdout
144  ! if( log_unit.NE.out_unit )then
145  ! inquire( unit=log_unit, opened=opened )
146  ! if( opened )call mpp_error( FATAL, 'MPP_INIT: specified unit for stdlog already in use.' )
147  ! if( pe.EQ.root_pe )open( unit=log_unit, file=trim(configfile), status='REPLACE' )
148  ! call mpp_sync()
149  ! if( pe.NE.root_pe )open( unit=log_unit, file=trim(configfile), status='OLD' )
150  ! end if
151 
152 
153  !messages
154  if( verbose )call mpp_error( NOTE, 'MPP_INIT: initializing MPP module...' )
155  if( pe.EQ.root_pe )then
156  logunit = stdlog()
157  write( logunit,'(/a)' )'MPP module '//trim(version)
158  write( logunit,'(a,i6)' )'MPP started with NPES=', npes
159  write( logunit,'(a)' )'Using no library for message passing...'
160  write( logunit, '(a26,es12.4,a6,i10,a11)' ) &
161  'Realtime clock resolution=', tick_rate, ' sec (', ticks_per_sec, ' ticks/sec)'
162  write( logunit, '(a23,es12.4,a6,i20,a7)' ) &
163  'Clock rolls over after ', max_ticks*tick_rate, ' sec (', max_ticks, ' ticks)'
164  end if
165 
166  call mpp_clock_begin(clock0)
167 
168  return
169 end subroutine mpp_init
170 
171 !#######################################################################
172  !to be called at the end of a run
173 subroutine mpp_exit()
174  integer :: i, j, k, n, nmax, istat, out_unit
175  real :: t, tmin, tmax, tavg, tstd
176  real :: m, mmin, mmax, mavg, mstd, t_total
177  logical :: opened
178 
179  if( .NOT.module_is_initialized )return
180  call mpp_set_current_pelist()
181  call mpp_clock_end(clock0)
182  t_total = clocks(clock0)%total_ticks*tick_rate
183  out_unit = stdout()
184  if( clock_num.GT.0 )then
185  if( ANY(clocks(1:clock_num)%detailed) )then
186  call sum_clock_data; call dump_clock_summary
187  end if
188  if( pe.EQ.root_pe )then
189  write( out_unit,'(/a,i6,a)' ) 'Tabulating mpp_clock statistics across ', npes, ' PEs...'
190  if( ANY(clocks(1:clock_num)%detailed) ) &
191  write( out_unit,'(a)' )' ... see mpp_clock.out.#### for details on individual PEs.'
192  write( out_unit,'(/32x,a)' ) ' tmin tmax tavg tstd tfrac grain pemin pemax'
193  else
194  write( out_unit,'(/37x,a)' ) 'time'
195  end if
196  call FLUSH( out_unit )
197  call mpp_sync()
198  do i = 1,clock_num
199  if( .NOT.ANY(peset(clocks(i)%peset_num)%list(:).EQ.pe) )cycle
200  call mpp_set_current_pelist( peset(clocks(i)%peset_num)%list )
201  !times between mpp_clock ticks
202  t = clocks(i)%total_ticks*tick_rate
203  tmin = t; call mpp_min(tmin)
204  tmax = t; call mpp_max(tmax)
205  tavg = t; call mpp_sum(tavg); tavg = tavg/mpp_npes()
206  tstd = (t-tavg)**2; call mpp_sum(tstd); tstd = sqrt( tstd/mpp_npes() )
207  if( pe.EQ.root_pe )write( out_unit,'(a32,4f14.6,f7.3,3i6)' ) &
208  clocks(i)%name, tmin, tmax, tavg, tstd, tavg/t_total, &
209  clocks(i)%grain, minval(peset(clocks(i)%peset_num)%list), &
210  maxval(peset(clocks(i)%peset_num)%list)
211  if (pe.NE.root_pe) write(out_unit,'(a32,f14.6)') clocks(i)%name, clocks(i)%total_ticks*tick_rate
212  end do
213  if( ANY(clocks(1:clock_num)%detailed) .AND. pe.EQ.root_pe )write( out_unit,'(/32x,a)' ) &
214  ' tmin tmax tavg tstd mmin mmax mavg mstd mavg/tavg'
215 
216  do i = 1,clock_num
217  !messages: bytelengths and times
218  if( .NOT.clocks(i)%detailed )cycle
219  do j = 1,MAX_EVENT_TYPES
220  n = clocks(i)%events(j)%calls; nmax = n
221  call mpp_max(nmax)
222  if( nmax.NE.0 )then
223  !don't divide by n because n might be 0
224  m = 0
225  if( n.GT.0 )m = sum(clocks(i)%events(j)%bytes(1:n))
226  mmin = m; call mpp_min(mmin)
227  mmax = m; call mpp_max(mmax)
228  mavg = m; call mpp_sum(mavg); mavg = mavg/mpp_npes()
229  mstd = (m-mavg)**2; call mpp_sum(mstd); mstd = sqrt( mstd/mpp_npes() )
230  t = 0
231  if( n.GT.0 )t = sum(clocks(i)%events(j)%ticks(1:n))*tick_rate
232  tmin = t; call mpp_min(tmin)
233  tmax = t; call mpp_max(tmax)
234  tavg = t; call mpp_sum(tavg); tavg = tavg/mpp_npes()
235  tstd = (t-tavg)**2; call mpp_sum(tstd); tstd = sqrt( tstd/mpp_npes() )
236  if( pe.EQ.root_pe )write( out_unit,'(a32,4f11.3,5es11.3)' ) &
237  trim(clocks(i)%name)//' '//trim(clocks(i)%events(j)%name), &
238  tmin, tmax, tavg, tstd, mmin, mmax, mavg, mstd, mavg/tavg
239  end if
240  end do
241  end do
242  end if
243 
244 ! close down etc_unit: 9
245  inquire(unit=etc_unit, opened=opened)
246  if (opened) then
247  call FLUSH (etc_unit)
248  close(etc_unit)
249  endif
250 
251  call mpp_set_current_pelist()
252  call mpp_sync()
253  call mpp_max(mpp_stack_hwm)
254  if( pe.EQ.root_pe )write( out_unit,* )'MPP_STACK high water mark=', mpp_stack_hwm
255 
256  return
257 end subroutine mpp_exit
258 
259 !#######################################################################
260  !--- dummy routine, should never been called -------------------------
261  subroutine mpp_malloc( ptr, newlen, len )
262  integer, intent(in) :: newlen
263  integer, intent(inout) :: len
264  real :: dummy
265  pointer( ptr, dummy )
266 
267  call mpp_error(FATAL,'mpp_malloc: Should not been called when lib_SMA is not used')
268 
269  return
270  end subroutine mpp_malloc
271 
272 !#######################################################################
273  !set the mpp_stack variable to be at least n LONG words long
274  subroutine mpp_set_stack_size(n)
275  integer, intent(in) :: n
276  character(len=8) :: text
277 
278  if( n.GT.mpp_stack_size .AND. allocated(mpp_stack) )deallocate(mpp_stack)
279  if( .NOT.allocated(mpp_stack) )then
280  allocate( mpp_stack(n) )
281  mpp_stack_size = n
282  end if
283 
284  write( text,'(i8)' )n
285  if( pe.EQ.root_pe )call mpp_error( NOTE, 'MPP_SET_STACK_SIZE: stack size set to '//text//'.' )
286 
287  return
288  end subroutine mpp_set_stack_size
289 
290  subroutine mpp_broadcast_char(data, length, from_pe, pelist )
291  character(len=*), intent(inout) :: data(:)
292  integer, intent(in) :: length, from_pe
293  integer, intent(in), optional :: pelist(:)
294 
295  if( .NOT.module_is_initialized )call mpp_error( FATAL, 'mpp_broadcast_text: You must first call mpp_init.' )
296  return
297  end subroutine mpp_broadcast_char
298 
299 
300 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
301 ! !
302 ! BASIC MESSAGE PASSING ROUTINE: mpp_transmit !
303 ! !
304 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
305 
306 #undef MPP_TRANSMIT_
307 #define MPP_TRANSMIT_ mpp_transmit_real8
308 #undef MPP_TRANSMIT_SCALAR_
309 #define MPP_TRANSMIT_SCALAR_ mpp_transmit_real8_scalar
310 #undef MPP_TRANSMIT_2D_
311 #define MPP_TRANSMIT_2D_ mpp_transmit_real8_2d
312 #undef MPP_TRANSMIT_3D_
313 #define MPP_TRANSMIT_3D_ mpp_transmit_real8_3d
314 #undef MPP_TRANSMIT_4D_
315 #define MPP_TRANSMIT_4D_ mpp_transmit_real8_4d
316 #undef MPP_TRANSMIT_5D_
317 #define MPP_TRANSMIT_5D_ mpp_transmit_real8_5d
318 #undef MPP_RECV_
319 #define MPP_RECV_ mpp_recv_real8
320 #undef MPP_RECV_SCALAR_
321 #define MPP_RECV_SCALAR_ mpp_recv_real8_scalar
322 #undef MPP_RECV_2D_
323 #define MPP_RECV_2D_ mpp_recv_real8_2d
324 #undef MPP_RECV_3D_
325 #define MPP_RECV_3D_ mpp_recv_real8_3d
326 #undef MPP_RECV_4D_
327 #define MPP_RECV_4D_ mpp_recv_real8_4d
328 #undef MPP_RECV_5D_
329 #define MPP_RECV_5D_ mpp_recv_real8_5d
330 #undef MPP_SEND_
331 #define MPP_SEND_ mpp_send_real8
332 #undef MPP_SEND_SCALAR_
333 #define MPP_SEND_SCALAR_ mpp_send_real8_scalar
334 #undef MPP_SEND_2D_
335 #define MPP_SEND_2D_ mpp_send_real8_2d
336 #undef MPP_SEND_3D_
337 #define MPP_SEND_3D_ mpp_send_real8_3d
338 #undef MPP_SEND_4D_
339 #define MPP_SEND_4D_ mpp_send_real8_4d
340 #undef MPP_SEND_5D_
341 #define MPP_SEND_5D_ mpp_send_real8_5d
342 #undef MPP_BROADCAST_
343 #define MPP_BROADCAST_ mpp_broadcast_real8
344 #undef MPP_BROADCAST_SCALAR_
345 #define MPP_BROADCAST_SCALAR_ mpp_broadcast_real8_scalar
346 #undef MPP_BROADCAST_2D_
347 #define MPP_BROADCAST_2D_ mpp_broadcast_real8_2d
348 #undef MPP_BROADCAST_3D_
349 #define MPP_BROADCAST_3D_ mpp_broadcast_real8_3d
350 #undef MPP_BROADCAST_4D_
351 #define MPP_BROADCAST_4D_ mpp_broadcast_real8_4d
352 #undef MPP_BROADCAST_5D_
353 #define MPP_BROADCAST_5D_ mpp_broadcast_real8_5d
354 #undef MPP_TYPE_
355 #define MPP_TYPE_ real(DOUBLE_KIND)
356 #undef MPP_TYPE_BYTELEN_
357 #define MPP_TYPE_BYTELEN_ 8
358 #undef MPI_TYPE_
359 #define MPI_TYPE_ MPI_REAL8
360 #include <mpp_transmit_nocomm.h>
361 
362 #ifdef OVERLOAD_C8
363 #undef MPP_TRANSMIT_
364 #define MPP_TRANSMIT_ mpp_transmit_cmplx8
365 #undef MPP_TRANSMIT_SCALAR_
366 #define MPP_TRANSMIT_SCALAR_ mpp_transmit_cmplx8_scalar
367 #undef MPP_TRANSMIT_2D_
368 #define MPP_TRANSMIT_2D_ mpp_transmit_cmplx8_2d
369 #undef MPP_TRANSMIT_3D_
370 #define MPP_TRANSMIT_3D_ mpp_transmit_cmplx8_3d
371 #undef MPP_TRANSMIT_4D_
372 #define MPP_TRANSMIT_4D_ mpp_transmit_cmplx8_4d
373 #undef MPP_TRANSMIT_5D_
374 #define MPP_TRANSMIT_5D_ mpp_transmit_cmplx8_5d
375 #undef MPP_RECV_
376 #define MPP_RECV_ mpp_recv_cmplx8
377 #undef MPP_RECV_SCALAR_
378 #define MPP_RECV_SCALAR_ mpp_recv_cmplx8_scalar
379 #undef MPP_RECV_2D_
380 #define MPP_RECV_2D_ mpp_recv_cmplx8_2d
381 #undef MPP_RECV_3D_
382 #define MPP_RECV_3D_ mpp_recv_cmplx8_3d
383 #undef MPP_RECV_4D_
384 #define MPP_RECV_4D_ mpp_recv_cmplx8_4d
385 #undef MPP_RECV_5D_
386 #define MPP_RECV_5D_ mpp_recv_cmplx8_5d
387 #undef MPP_SEND_
388 #define MPP_SEND_ mpp_send_cmplx8
389 #undef MPP_SEND_SCALAR_
390 #define MPP_SEND_SCALAR_ mpp_send_cmplx8_scalar
391 #undef MPP_SEND_2D_
392 #define MPP_SEND_2D_ mpp_send_cmplx8_2d
393 #undef MPP_SEND_3D_
394 #define MPP_SEND_3D_ mpp_send_cmplx8_3d
395 #undef MPP_SEND_4D_
396 #define MPP_SEND_4D_ mpp_send_cmplx8_4d
397 #undef MPP_SEND_5D_
398 #define MPP_SEND_5D_ mpp_send_cmplx8_5d
399 #undef MPP_BROADCAST_
400 #define MPP_BROADCAST_ mpp_broadcast_cmplx8
401 #undef MPP_BROADCAST_SCALAR_
402 #define MPP_BROADCAST_SCALAR_ mpp_broadcast_cmplx8_scalar
403 #undef MPP_BROADCAST_2D_
404 #define MPP_BROADCAST_2D_ mpp_broadcast_cmplx8_2d
405 #undef MPP_BROADCAST_3D_
406 #define MPP_BROADCAST_3D_ mpp_broadcast_cmplx8_3d
407 #undef MPP_BROADCAST_4D_
408 #define MPP_BROADCAST_4D_ mpp_broadcast_cmplx8_4d
409 #undef MPP_BROADCAST_5D_
410 #define MPP_BROADCAST_5D_ mpp_broadcast_cmplx8_5d
411 #undef MPP_TYPE_
412 #define MPP_TYPE_ complex(DOUBLE_KIND)
413 #undef MPP_TYPE_BYTELEN_
414 #define MPP_TYPE_BYTELEN_ 16
415 #undef MPI_TYPE_
416 #define MPI_TYPE_ MPI_DOUBLE_COMPLEX
417 #include <mpp_transmit_nocomm.h>
418 #endif
419 
420 #undef MPP_TRANSMIT_
421 #define MPP_TRANSMIT_ mpp_transmit_real4
422 #undef MPP_TRANSMIT_SCALAR_
423 #define MPP_TRANSMIT_SCALAR_ mpp_transmit_real4_scalar
424 #undef MPP_TRANSMIT_2D_
425 #define MPP_TRANSMIT_2D_ mpp_transmit_real4_2d
426 #undef MPP_TRANSMIT_3D_
427 #define MPP_TRANSMIT_3D_ mpp_transmit_real4_3d
428 #undef MPP_TRANSMIT_4D_
429 #define MPP_TRANSMIT_4D_ mpp_transmit_real4_4d
430 #undef MPP_TRANSMIT_5D_
431 #define MPP_TRANSMIT_5D_ mpp_transmit_real4_5d
432 #undef MPP_RECV_
433 #define MPP_RECV_ mpp_recv_real4
434 #undef MPP_RECV_SCALAR_
435 #define MPP_RECV_SCALAR_ mpp_recv_real4_scalar
436 #undef MPP_RECV_2D_
437 #define MPP_RECV_2D_ mpp_recv_real4_2d
438 #undef MPP_RECV_3D_
439 #define MPP_RECV_3D_ mpp_recv_real4_3d
440 #undef MPP_RECV_4D_
441 #define MPP_RECV_4D_ mpp_recv_real4_4d
442 #undef MPP_RECV_5D_
443 #define MPP_RECV_5D_ mpp_recv_real4_5d
444 #undef MPP_SEND_
445 #define MPP_SEND_ mpp_send_real4
446 #undef MPP_SEND_SCALAR_
447 #define MPP_SEND_SCALAR_ mpp_send_real4_scalar
448 #undef MPP_SEND_2D_
449 #define MPP_SEND_2D_ mpp_send_real4_2d
450 #undef MPP_SEND_3D_
451 #define MPP_SEND_3D_ mpp_send_real4_3d
452 #undef MPP_SEND_4D_
453 #define MPP_SEND_4D_ mpp_send_real4_4d
454 #undef MPP_SEND_5D_
455 #define MPP_SEND_5D_ mpp_send_real4_5d
456 #undef MPP_BROADCAST_
457 #define MPP_BROADCAST_ mpp_broadcast_real4
458 #undef MPP_BROADCAST_SCALAR_
459 #define MPP_BROADCAST_SCALAR_ mpp_broadcast_real4_scalar
460 #undef MPP_BROADCAST_2D_
461 #define MPP_BROADCAST_2D_ mpp_broadcast_real4_2d
462 #undef MPP_BROADCAST_3D_
463 #define MPP_BROADCAST_3D_ mpp_broadcast_real4_3d
464 #undef MPP_BROADCAST_4D_
465 #define MPP_BROADCAST_4D_ mpp_broadcast_real4_4d
466 #undef MPP_BROADCAST_5D_
467 #define MPP_BROADCAST_5D_ mpp_broadcast_real4_5d
468 #undef MPP_TYPE_
469 #define MPP_TYPE_ real(FLOAT_KIND)
470 #undef MPP_TYPE_BYTELEN_
471 #define MPP_TYPE_BYTELEN_ 4
472 #undef MPI_TYPE_
473 #define MPI_TYPE_ MPI_REAL4
474 #include <mpp_transmit_nocomm.h>
475 
476 #ifdef OVERLOAD_C4
477 #undef MPP_TRANSMIT_
478 #define MPP_TRANSMIT_ mpp_transmit_cmplx4
479 #undef MPP_TRANSMIT_SCALAR_
480 #define MPP_TRANSMIT_SCALAR_ mpp_transmit_cmplx4_scalar
481 #undef MPP_TRANSMIT_2D_
482 #define MPP_TRANSMIT_2D_ mpp_transmit_cmplx4_2d
483 #undef MPP_TRANSMIT_3D_
484 #define MPP_TRANSMIT_3D_ mpp_transmit_cmplx4_3d
485 #undef MPP_TRANSMIT_4D_
486 #define MPP_TRANSMIT_4D_ mpp_transmit_cmplx4_4d
487 #undef MPP_TRANSMIT_5D_
488 #define MPP_TRANSMIT_5D_ mpp_transmit_cmplx4_5d
489 #undef MPP_RECV_
490 #define MPP_RECV_ mpp_recv_cmplx4
491 #undef MPP_RECV_SCALAR_
492 #define MPP_RECV_SCALAR_ mpp_recv_cmplx4_scalar
493 #undef MPP_RECV_2D_
494 #define MPP_RECV_2D_ mpp_recv_cmplx4_2d
495 #undef MPP_RECV_3D_
496 #define MPP_RECV_3D_ mpp_recv_cmplx4_3d
497 #undef MPP_RECV_4D_
498 #define MPP_RECV_4D_ mpp_recv_cmplx4_4d
499 #undef MPP_RECV_5D_
500 #define MPP_RECV_5D_ mpp_recv_cmplx4_5d
501 #undef MPP_SEND_
502 #define MPP_SEND_ mpp_send_cmplx4
503 #undef MPP_SEND_SCALAR_
504 #define MPP_SEND_SCALAR_ mpp_send_cmplx4_scalar
505 #undef MPP_SEND_2D_
506 #define MPP_SEND_2D_ mpp_send_cmplx4_2d
507 #undef MPP_SEND_3D_
508 #define MPP_SEND_3D_ mpp_send_cmplx4_3d
509 #undef MPP_SEND_4D_
510 #define MPP_SEND_4D_ mpp_send_cmplx4_4d
511 #undef MPP_SEND_5D_
512 #define MPP_SEND_5D_ mpp_send_cmplx4_5d
513 #undef MPP_BROADCAST_
514 #define MPP_BROADCAST_ mpp_broadcast_cmplx4
515 #undef MPP_BROADCAST_SCALAR_
516 #define MPP_BROADCAST_SCALAR_ mpp_broadcast_cmplx4_scalar
517 #undef MPP_BROADCAST_2D_
518 #define MPP_BROADCAST_2D_ mpp_broadcast_cmplx4_2d
519 #undef MPP_BROADCAST_3D_
520 #define MPP_BROADCAST_3D_ mpp_broadcast_cmplx4_3d
521 #undef MPP_BROADCAST_4D_
522 #define MPP_BROADCAST_4D_ mpp_broadcast_cmplx4_4d
523 #undef MPP_BROADCAST_5D_
524 #define MPP_BROADCAST_5D_ mpp_broadcast_cmplx4_5d
525 #undef MPP_TYPE_
526 #define MPP_TYPE_ complex(FLOAT_KIND)
527 #undef MPP_TYPE_BYTELEN_
528 #define MPP_TYPE_BYTELEN_ 8
529 #undef MPI_TYPE_
530 #define MPI_TYPE_ MPI_COMPLEX
531 #include <mpp_transmit_nocomm.h>
532 #endif
533 
534 #ifndef no_8byte_integers
535 #undef MPP_TRANSMIT_
536 #define MPP_TRANSMIT_ mpp_transmit_int8
537 #undef MPP_TRANSMIT_SCALAR_
538 #define MPP_TRANSMIT_SCALAR_ mpp_transmit_int8_scalar
539 #undef MPP_TRANSMIT_2D_
540 #define MPP_TRANSMIT_2D_ mpp_transmit_int8_2d
541 #undef MPP_TRANSMIT_3D_
542 #define MPP_TRANSMIT_3D_ mpp_transmit_int8_3d
543 #undef MPP_TRANSMIT_4D_
544 #define MPP_TRANSMIT_4D_ mpp_transmit_int8_4d
545 #undef MPP_TRANSMIT_5D_
546 #define MPP_TRANSMIT_5D_ mpp_transmit_int8_5d
547 #undef MPP_RECV_
548 #define MPP_RECV_ mpp_recv_int8
549 #undef MPP_RECV_SCALAR_
550 #define MPP_RECV_SCALAR_ mpp_recv_int8_scalar
551 #undef MPP_RECV_2D_
552 #define MPP_RECV_2D_ mpp_recv_int8_2d
553 #undef MPP_RECV_3D_
554 #define MPP_RECV_3D_ mpp_recv_int8_3d
555 #undef MPP_RECV_4D_
556 #define MPP_RECV_4D_ mpp_recv_int8_4d
557 #undef MPP_RECV_5D_
558 #define MPP_RECV_5D_ mpp_recv_int8_5d
559 #undef MPP_SEND_
560 #define MPP_SEND_ mpp_send_int8
561 #undef MPP_SEND_SCALAR_
562 #define MPP_SEND_SCALAR_ mpp_send_int8_scalar
563 #undef MPP_SEND_2D_
564 #define MPP_SEND_2D_ mpp_send_int8_2d
565 #undef MPP_SEND_3D_
566 #define MPP_SEND_3D_ mpp_send_int8_3d
567 #undef MPP_SEND_4D_
568 #define MPP_SEND_4D_ mpp_send_int8_4d
569 #undef MPP_SEND_5D_
570 #define MPP_SEND_5D_ mpp_send_int8_5d
571 #undef MPP_BROADCAST_
572 #define MPP_BROADCAST_ mpp_broadcast_int8
573 #undef MPP_BROADCAST_SCALAR_
574 #define MPP_BROADCAST_SCALAR_ mpp_broadcast_int8_scalar
575 #undef MPP_BROADCAST_2D_
576 #define MPP_BROADCAST_2D_ mpp_broadcast_int8_2d
577 #undef MPP_BROADCAST_3D_
578 #define MPP_BROADCAST_3D_ mpp_broadcast_int8_3d
579 #undef MPP_BROADCAST_4D_
580 #define MPP_BROADCAST_4D_ mpp_broadcast_int8_4d
581 #undef MPP_BROADCAST_5D_
582 #define MPP_BROADCAST_5D_ mpp_broadcast_int8_5d
583 #undef MPP_TYPE_
584 #define MPP_TYPE_ integer(LONG_KIND)
585 #undef MPP_TYPE_BYTELEN_
586 #define MPP_TYPE_BYTELEN_ 8
587 #undef MPI_TYPE_
588 #define MPI_TYPE_ MPI_INTEGER8
589 #include <mpp_transmit_nocomm.h>
590 #endif
591 
592 #undef MPP_TRANSMIT_
593 #define MPP_TRANSMIT_ mpp_transmit_int4
594 #undef MPP_TRANSMIT_SCALAR_
595 #define MPP_TRANSMIT_SCALAR_ mpp_transmit_int4_scalar
596 #undef MPP_TRANSMIT_2D_
597 #define MPP_TRANSMIT_2D_ mpp_transmit_int4_2d
598 #undef MPP_TRANSMIT_3D_
599 #define MPP_TRANSMIT_3D_ mpp_transmit_int4_3d
600 #undef MPP_TRANSMIT_4D_
601 #define MPP_TRANSMIT_4D_ mpp_transmit_int4_4d
602 #undef MPP_TRANSMIT_5D_
603 #define MPP_TRANSMIT_5D_ mpp_transmit_int4_5d
604 #undef MPP_RECV_
605 #define MPP_RECV_ mpp_recv_int4
606 #undef MPP_RECV_SCALAR_
607 #define MPP_RECV_SCALAR_ mpp_recv_int4_scalar
608 #undef MPP_RECV_2D_
609 #define MPP_RECV_2D_ mpp_recv_int4_2d
610 #undef MPP_RECV_3D_
611 #define MPP_RECV_3D_ mpp_recv_int4_3d
612 #undef MPP_RECV_4D_
613 #define MPP_RECV_4D_ mpp_recv_int4_4d
614 #undef MPP_RECV_5D_
615 #define MPP_RECV_5D_ mpp_recv_int4_5d
616 #undef MPP_SEND_
617 #define MPP_SEND_ mpp_send_int4
618 #undef MPP_SEND_SCALAR_
619 #define MPP_SEND_SCALAR_ mpp_send_int4_scalar
620 #undef MPP_SEND_2D_
621 #define MPP_SEND_2D_ mpp_send_int4_2d
622 #undef MPP_SEND_3D_
623 #define MPP_SEND_3D_ mpp_send_int4_3d
624 #undef MPP_SEND_4D_
625 #define MPP_SEND_4D_ mpp_send_int4_4d
626 #undef MPP_SEND_5D_
627 #define MPP_SEND_5D_ mpp_send_int4_5d
628 #undef MPP_BROADCAST_
629 #define MPP_BROADCAST_ mpp_broadcast_int4
630 #undef MPP_BROADCAST_SCALAR_
631 #define MPP_BROADCAST_SCALAR_ mpp_broadcast_int4_scalar
632 #undef MPP_BROADCAST_2D_
633 #define MPP_BROADCAST_2D_ mpp_broadcast_int4_2d
634 #undef MPP_BROADCAST_3D_
635 #define MPP_BROADCAST_3D_ mpp_broadcast_int4_3d
636 #undef MPP_BROADCAST_4D_
637 #define MPP_BROADCAST_4D_ mpp_broadcast_int4_4d
638 #undef MPP_BROADCAST_5D_
639 #define MPP_BROADCAST_5D_ mpp_broadcast_int4_5d
640 #undef MPP_TYPE_
641 #define MPP_TYPE_ integer(INT_KIND)
642 #undef MPP_TYPE_BYTELEN_
643 #define MPP_TYPE_BYTELEN_ 4
644 #undef MPI_TYPE_
645 #define MPI_TYPE_ MPI_INTEGER4
646 #include <mpp_transmit_nocomm.h>
647 
648 #ifndef no_8byte_integers
649 #undef MPP_TRANSMIT_
650 #define MPP_TRANSMIT_ mpp_transmit_logical8
651 #undef MPP_TRANSMIT_SCALAR_
652 #define MPP_TRANSMIT_SCALAR_ mpp_transmit_logical8_scalar
653 #undef MPP_TRANSMIT_2D_
654 #define MPP_TRANSMIT_2D_ mpp_transmit_logical8_2d
655 #undef MPP_TRANSMIT_3D_
656 #define MPP_TRANSMIT_3D_ mpp_transmit_logical8_3d
657 #undef MPP_TRANSMIT_4D_
658 #define MPP_TRANSMIT_4D_ mpp_transmit_logical8_4d
659 #undef MPP_TRANSMIT_5D_
660 #define MPP_TRANSMIT_5D_ mpp_transmit_logical8_5d
661 #undef MPP_RECV_
662 #define MPP_RECV_ mpp_recv_logical8
663 #undef MPP_RECV_SCALAR_
664 #define MPP_RECV_SCALAR_ mpp_recv_logical8_scalar
665 #undef MPP_RECV_2D_
666 #define MPP_RECV_2D_ mpp_recv_logical8_2d
667 #undef MPP_RECV_3D_
668 #define MPP_RECV_3D_ mpp_recv_logical8_3d
669 #undef MPP_RECV_4D_
670 #define MPP_RECV_4D_ mpp_recv_logical8_4d
671 #undef MPP_RECV_5D_
672 #define MPP_RECV_5D_ mpp_recv_logical8_5d
673 #undef MPP_SEND_
674 #define MPP_SEND_ mpp_send_logical8
675 #undef MPP_SEND_SCALAR_
676 #define MPP_SEND_SCALAR_ mpp_send_logical8_scalar
677 #undef MPP_SEND_2D_
678 #define MPP_SEND_2D_ mpp_send_logical8_2d
679 #undef MPP_SEND_3D_
680 #define MPP_SEND_3D_ mpp_send_logical8_3d
681 #undef MPP_SEND_4D_
682 #define MPP_SEND_4D_ mpp_send_logical8_4d
683 #undef MPP_SEND_5D_
684 #define MPP_SEND_5D_ mpp_send_logical8_5d
685 #undef MPP_BROADCAST_
686 #define MPP_BROADCAST_ mpp_broadcast_logical8
687 #undef MPP_BROADCAST_SCALAR_
688 #define MPP_BROADCAST_SCALAR_ mpp_broadcast_logical8_scalar
689 #undef MPP_BROADCAST_2D_
690 #define MPP_BROADCAST_2D_ mpp_broadcast_logical8_2d
691 #undef MPP_BROADCAST_3D_
692 #define MPP_BROADCAST_3D_ mpp_broadcast_logical8_3d
693 #undef MPP_BROADCAST_4D_
694 #define MPP_BROADCAST_4D_ mpp_broadcast_logical8_4d
695 #undef MPP_BROADCAST_5D_
696 #define MPP_BROADCAST_5D_ mpp_broadcast_logical8_5d
697 #undef MPP_TYPE_
698 #define MPP_TYPE_ logical(LONG_KIND)
699 #undef MPP_TYPE_BYTELEN_
700 #define MPP_TYPE_BYTELEN_ 8
701 #undef MPI_TYPE_
702 #define MPI_TYPE_ MPI_INTEGER8
703 #include <mpp_transmit_nocomm.h>
704 #endif
705 
706 #undef MPP_TRANSMIT_
707 #define MPP_TRANSMIT_ mpp_transmit_logical4
708 #undef MPP_TRANSMIT_SCALAR_
709 #define MPP_TRANSMIT_SCALAR_ mpp_transmit_logical4_scalar
710 #undef MPP_TRANSMIT_2D_
711 #define MPP_TRANSMIT_2D_ mpp_transmit_logical4_2d
712 #undef MPP_TRANSMIT_3D_
713 #define MPP_TRANSMIT_3D_ mpp_transmit_logical4_3d
714 #undef MPP_TRANSMIT_4D_
715 #define MPP_TRANSMIT_4D_ mpp_transmit_logical4_4d
716 #undef MPP_TRANSMIT_5D_
717 #define MPP_TRANSMIT_5D_ mpp_transmit_logical4_5d
718 #undef MPP_RECV_
719 #define MPP_RECV_ mpp_recv_logical4
720 #undef MPP_RECV_SCALAR_
721 #define MPP_RECV_SCALAR_ mpp_recv_logical4_scalar
722 #undef MPP_RECV_2D_
723 #define MPP_RECV_2D_ mpp_recv_logical4_2d
724 #undef MPP_RECV_3D_
725 #define MPP_RECV_3D_ mpp_recv_logical4_3d
726 #undef MPP_RECV_4D_
727 #define MPP_RECV_4D_ mpp_recv_logical4_4d
728 #undef MPP_RECV_5D_
729 #define MPP_RECV_5D_ mpp_recv_logical4_5d
730 #undef MPP_SEND_
731 #define MPP_SEND_ mpp_send_logical4
732 #undef MPP_SEND_SCALAR_
733 #define MPP_SEND_SCALAR_ mpp_send_logical4_scalar
734 #undef MPP_SEND_2D_
735 #define MPP_SEND_2D_ mpp_send_logical4_2d
736 #undef MPP_SEND_3D_
737 #define MPP_SEND_3D_ mpp_send_logical4_3d
738 #undef MPP_SEND_4D_
739 #define MPP_SEND_4D_ mpp_send_logical4_4d
740 #undef MPP_SEND_5D_
741 #define MPP_SEND_5D_ mpp_send_logical4_5d
742 #undef MPP_BROADCAST_
743 #define MPP_BROADCAST_ mpp_broadcast_logical4
744 #undef MPP_BROADCAST_SCALAR_
745 #define MPP_BROADCAST_SCALAR_ mpp_broadcast_logical4_scalar
746 #undef MPP_BROADCAST_2D_
747 #define MPP_BROADCAST_2D_ mpp_broadcast_logical4_2d
748 #undef MPP_BROADCAST_3D_
749 #define MPP_BROADCAST_3D_ mpp_broadcast_logical4_3d
750 #undef MPP_BROADCAST_4D_
751 #define MPP_BROADCAST_4D_ mpp_broadcast_logical4_4d
752 #undef MPP_BROADCAST_5D_
753 #define MPP_BROADCAST_5D_ mpp_broadcast_logical4_5d
754 #undef MPP_TYPE_
755 #define MPP_TYPE_ logical(INT_KIND)
756 #undef MPP_TYPE_BYTELEN_
757 #define MPP_TYPE_BYTELEN_ 4
758 #undef MPI_TYPE_
759 #define MPI_TYPE_ MPI_INTEGER4
760 #include <mpp_transmit_nocomm.h>
761 
762 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
763 ! !
764 ! GLOBAL REDUCTION ROUTINES: mpp_max, mpp_sum, mpp_min !
765 ! !
766 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
767 #undef MPP_REDUCE_0D_
768 #define MPP_REDUCE_0D_ mpp_max_real8_0d
769 #undef MPP_REDUCE_1D_
770 #define MPP_REDUCE_1D_ mpp_max_real8_1d
771 #undef MPP_TYPE_
772 #define MPP_TYPE_ real(DOUBLE_KIND)
773 #undef MPP_TYPE_BYTELEN_
774 #define MPP_TYPE_BYTELEN_ 8
775 #undef MPI_TYPE_
776 #define MPI_TYPE_ MPI_REAL8
777 #undef MPI_REDUCE_
778 #define MPI_REDUCE_ MPI_MAX
779 #include <mpp_reduce_nocomm.h>
780 
781 #ifdef OVERLOAD_R4
782 #undef MPP_REDUCE_0D_
783 #define MPP_REDUCE_0D_ mpp_max_real4_0d
784 #undef MPP_REDUCE_1D_
785 #define MPP_REDUCE_1D_ mpp_max_real4_1d
786 #undef MPP_TYPE_
787 #define MPP_TYPE_ real(FLOAT_KIND)
788 #undef MPP_TYPE_BYTELEN_
789 #define MPP_TYPE_BYTELEN_ 4
790 #undef MPI_TYPE_
791 #define MPI_TYPE_ MPI_REAL4
792 #undef MPI_REDUCE_
793 #define MPI_REDUCE_ MPI_MAX
794 #include <mpp_reduce_nocomm.h>
795 #endif
796 
797 #ifndef no_8byte_integers
798 #undef MPP_REDUCE_0D_
799 #define MPP_REDUCE_0D_ mpp_max_int8_0d
800 #undef MPP_REDUCE_1D_
801 #define MPP_REDUCE_1D_ mpp_max_int8_1d
802 #undef MPP_TYPE_
803 #define MPP_TYPE_ integer(LONG_KIND)
804 #undef MPP_TYPE_BYTELEN_
805 #define MPP_TYPE_BYTELEN_ 8
806 #undef MPI_TYPE_
807 #define MPI_TYPE_ MPI_INTEGER8
808 #undef MPI_REDUCE_
809 #define MPI_REDUCE_ MPI_MAX
810 #include <mpp_reduce_nocomm.h>
811 #endif
812 
813 #undef MPP_REDUCE_0D_
814 #define MPP_REDUCE_0D_ mpp_max_int4_0d
815 #undef MPP_REDUCE_1D_
816 #define MPP_REDUCE_1D_ mpp_max_int4_1d
817 #undef MPP_TYPE_
818 #define MPP_TYPE_ integer(INT_KIND)
819 #undef MPP_TYPE_BYTELEN_
820 #define MPP_TYPE_BYTELEN_ 4
821 #undef MPI_TYPE_
822 #define MPI_TYPE_ MPI_INTEGER4
823 #undef MPI_REDUCE_
824 #define MPI_REDUCE_ MPI_MAX
825 #include <mpp_reduce_nocomm.h>
826 
827 #undef MPP_REDUCE_0D_
828 #define MPP_REDUCE_0D_ mpp_min_real8_0d
829 #undef MPP_REDUCE_1D_
830 #define MPP_REDUCE_1D_ mpp_min_real8_1d
831 #undef MPP_TYPE_
832 #define MPP_TYPE_ real(DOUBLE_KIND)
833 #undef MPP_TYPE_BYTELEN_
834 #define MPP_TYPE_BYTELEN_ 8
835 #undef MPI_TYPE_
836 #define MPI_TYPE_ MPI_REAL8
837 #undef MPI_REDUCE_
838 #define MPI_REDUCE_ MPI_MIN
839 #include <mpp_reduce_nocomm.h>
840 
841 #ifdef OVERLOAD_R4
842 #undef MPP_REDUCE_0D_
843 #define MPP_REDUCE_0D_ mpp_min_real4_0d
844 #undef MPP_REDUCE_1D_
845 #define MPP_REDUCE_1D_ mpp_min_real4_1d
846 #undef MPP_TYPE_
847 #define MPP_TYPE_ real(FLOAT_KIND)
848 #undef MPP_TYPE_BYTELEN_
849 #define MPP_TYPE_BYTELEN_ 4
850 #undef MPI_TYPE_
851 #define MPI_TYPE_ MPI_REAL4
852 #undef MPI_REDUCE_
853 #define MPI_REDUCE_ MPI_MIN
854 #include <mpp_reduce_nocomm.h>
855 #endif
856 
857 #ifndef no_8byte_integers
858 #undef MPP_REDUCE_0D_
859 #define MPP_REDUCE_0D_ mpp_min_int8_0d
860 #undef MPP_REDUCE_1D_
861 #define MPP_REDUCE_1D_ mpp_min_int8_1d
862 #undef MPP_TYPE_
863 #define MPP_TYPE_ integer(LONG_KIND)
864 #undef MPP_TYPE_BYTELEN_
865 #define MPP_TYPE_BYTELEN_ 8
866 #undef MPI_TYPE_
867 #define MPI_TYPE_ MPI_INTEGER8
868 #undef MPI_REDUCE_
869 #define MPI_REDUCE_ MPI_MIN
870 #include <mpp_reduce_nocomm.h>
871 #endif
872 
873 #undef MPP_REDUCE_0D_
874 #define MPP_REDUCE_0D_ mpp_min_int4_0d
875 #undef MPP_REDUCE_1D_
876 #define MPP_REDUCE_1D_ mpp_min_int4_1d
877 #undef MPP_TYPE_
878 #define MPP_TYPE_ integer(INT_KIND)
879 #undef MPP_TYPE_BYTELEN_
880 #define MPP_TYPE_BYTELEN_ 4
881 #undef MPI_TYPE_
882 #define MPI_TYPE_ MPI_INTEGER4
883 #undef MPI_REDUCE_
884 #define MPI_REDUCE_ MPI_MIN
885 #include <mpp_reduce_nocomm.h>
886 
887 #undef MPP_SUM_
888 #define MPP_SUM_ mpp_sum_real8
889 #undef MPP_SUM_SCALAR_
890 #define MPP_SUM_SCALAR_ mpp_sum_real8_scalar
891 #undef MPP_SUM_2D_
892 #define MPP_SUM_2D_ mpp_sum_real8_2d
893 #undef MPP_SUM_3D_
894 #define MPP_SUM_3D_ mpp_sum_real8_3d
895 #undef MPP_SUM_4D_
896 #define MPP_SUM_4D_ mpp_sum_real8_4d
897 #undef MPP_SUM_5D_
898 #define MPP_SUM_5D_ mpp_sum_real8_5d
899 #undef MPP_TYPE_
900 #define MPP_TYPE_ real(DOUBLE_KIND)
901 #undef MPI_TYPE_
902 #define MPI_TYPE_ MPI_REAL8
903 #undef MPP_TYPE_BYTELEN_
904 #define MPP_TYPE_BYTELEN_ 8
905 #include <mpp_sum_nocomm.h>
906 
907 #ifdef OVERLOAD_C8
908 #undef MPP_SUM_
909 #define MPP_SUM_ mpp_sum_cmplx8
910 #undef MPP_SUM_SCALAR_
911 #define MPP_SUM_SCALAR_ mpp_sum_cmplx8_scalar
912 #undef MPP_SUM_2D_
913 #define MPP_SUM_2D_ mpp_sum_cmplx8_2d
914 #undef MPP_SUM_3D_
915 #define MPP_SUM_3D_ mpp_sum_cmplx8_3d
916 #undef MPP_SUM_4D_
917 #define MPP_SUM_4D_ mpp_sum_cmplx8_4d
918 #undef MPP_SUM_5D_
919 #define MPP_SUM_5D_ mpp_sum_cmplx8_5d
920 #undef MPP_TYPE_
921 #define MPP_TYPE_ complex(DOUBLE_KIND)
922 #undef MPI_TYPE_
923 #define MPI_TYPE_ MPI_DOUBLE_COMPLEX
924 #undef MPP_TYPE_BYTELEN_
925 #define MPP_TYPE_BYTELEN_ 16
926 #include <mpp_sum_nocomm.h>
927 #endif
928 
929 #ifdef OVERLOAD_R4
930 #undef MPP_SUM_
931 #define MPP_SUM_ mpp_sum_real4
932 #undef MPP_SUM_SCALAR_
933 #define MPP_SUM_SCALAR_ mpp_sum_real4_scalar
934 #undef MPP_SUM_2D_
935 #define MPP_SUM_2D_ mpp_sum_real4_2d
936 #undef MPP_SUM_3D_
937 #define MPP_SUM_3D_ mpp_sum_real4_3d
938 #undef MPP_SUM_4D_
939 #define MPP_SUM_4D_ mpp_sum_real4_4d
940 #undef MPP_SUM_5D_
941 #define MPP_SUM_5D_ mpp_sum_real4_5d
942 #undef MPP_TYPE_
943 #define MPP_TYPE_ real(FLOAT_KIND)
944 #undef MPI_TYPE_
945 #define MPI_TYPE_ MPI_REAL4
946 #undef MPP_TYPE_BYTELEN_
947 #define MPP_TYPE_BYTELEN_ 4
948 #include <mpp_sum_nocomm.h>
949 #endif
950 
951 #ifdef OVERLOAD_C4
952 #undef MPP_SUM_
953 #define MPP_SUM_ mpp_sum_cmplx4
954 #undef MPP_SUM_SCALAR_
955 #define MPP_SUM_SCALAR_ mpp_sum_cmplx4_scalar
956 #undef MPP_SUM_2D_
957 #define MPP_SUM_2D_ mpp_sum_cmplx4_2d
958 #undef MPP_SUM_3D_
959 #define MPP_SUM_3D_ mpp_sum_cmplx4_3d
960 #undef MPP_SUM_4D_
961 #define MPP_SUM_4D_ mpp_sum_cmplx4_4d
962 #undef MPP_SUM_5D_
963 #define MPP_SUM_5D_ mpp_sum_cmplx4_5d
964 #undef MPP_TYPE_
965 #define MPP_TYPE_ complex(FLOAT_KIND)
966 #undef MPI_TYPE_
967 #define MPI_TYPE_ MPI_COMPLEX
968 #undef MPP_TYPE_BYTELEN_
969 #define MPP_TYPE_BYTELEN_ 8
970 #include <mpp_sum_nocomm.h>
971 #endif
972 
973 #ifndef no_8byte_integers
974 #undef MPP_SUM_
975 #define MPP_SUM_ mpp_sum_int8
976 #undef MPP_SUM_SCALAR_
977 #define MPP_SUM_SCALAR_ mpp_sum_int8_scalar
978 #undef MPP_SUM_2D_
979 #define MPP_SUM_2D_ mpp_sum_int8_2d
980 #undef MPP_SUM_3D_
981 #define MPP_SUM_3D_ mpp_sum_int8_3d
982 #undef MPP_SUM_4D_
983 #define MPP_SUM_4D_ mpp_sum_int8_4d
984 #undef MPP_SUM_5D_
985 #define MPP_SUM_5D_ mpp_sum_int8_5d
986 #undef MPP_TYPE_
987 #define MPP_TYPE_ integer(LONG_KIND)
988 #undef MPI_TYPE_
989 #define MPI_TYPE_ MPI_INTEGER8
990 #undef MPP_TYPE_BYTELEN_
991 #define MPP_TYPE_BYTELEN_ 8
992 #include <mpp_sum_nocomm.h>
993 #endif
994 
995 #undef MPP_SUM_
996 #define MPP_SUM_ mpp_sum_int4
997 #undef MPP_SUM_SCALAR_
998 #define MPP_SUM_SCALAR_ mpp_sum_int4_scalar
999 #undef MPP_SUM_2D_
1000 #define MPP_SUM_2D_ mpp_sum_int4_2d
1001 #undef MPP_SUM_3D_
1002 #define MPP_SUM_3D_ mpp_sum_int4_3d
1003 #undef MPP_SUM_4D_
1004 #define MPP_SUM_4D_ mpp_sum_int4_4d
1005 #undef MPP_SUM_5D_
1006 #define MPP_SUM_5D_ mpp_sum_int4_5d
1007 #undef MPP_TYPE_
1008 #define MPP_TYPE_ integer(INT_KIND)
1009 #undef MPI_TYPE_
1010 #define MPI_TYPE_ MPI_INTEGER4
1011 #undef MPP_TYPE_BYTELEN_
1012 #define MPP_TYPE_BYTELEN_ 4
1013 #include <mpp_sum_nocomm.h>
1014 
1015 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1016 ! !
1017 ! SCATTER AND GATHER ROUTINES: mpp_alltoall !
1018 ! !
1019 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1020 
1021 #undef MPP_ALLTOALL_
1022 #undef MPP_ALLTOALLV_
1023 #undef MPP_TYPE_
1024 #undef MPP_TYPE_BYTELEN_
1025 #undef MPI_TYPE_
1026 #define MPP_ALLTOALL_ mpp_alltoall_int4
1027 #define MPP_ALLTOALLV_ mpp_alltoall_int4_v
1028 #define MPP_TYPE_ integer(INT_KIND)
1029 #define MPP_TYPE_BYTELEN_ 4
1030 #define MPI_TYPE_ MPI_INTEGER4
1031 #include <mpp_alltoall_nocomm.h>
1032 
1033 #undef MPP_ALLTOALL_
1034 #undef MPP_ALLTOALLV_
1035 #undef MPP_TYPE_
1036 #undef MPP_TYPE_BYTELEN_
1037 #undef MPI_TYPE_
1038 #define MPP_ALLTOALL_ mpp_alltoall_int8
1039 #define MPP_ALLTOALLV_ mpp_alltoall_int8_v
1040 #define MPP_TYPE_ integer(LONG_KIND)
1041 #define MPP_TYPE_BYTELEN_ 8
1042 #define MPI_TYPE_ MPI_INTEGER8
1043 #include <mpp_alltoall_nocomm.h>
1044 
1045 #undef MPP_ALLTOALL_
1046 #undef MPP_ALLTOALLV_
1047 #undef MPP_TYPE_
1048 #undef MPP_TYPE_BYTELEN_
1049 #undef MPI_TYPE_
1050 #define MPP_ALLTOALL_ mpp_alltoall_real4
1051 #define MPP_ALLTOALLV_ mpp_alltoall_real4_v
1052 #define MPP_TYPE_ real(FLOAT_KIND)
1053 #define MPP_TYPE_BYTELEN_ 4
1054 #define MPI_TYPE_ MPI_REAL4
1055 #include <mpp_alltoall_nocomm.h>
1056 
1057 #undef MPP_ALLTOALL_
1058 #undef MPP_ALLTOALLV_
1059 #undef MPP_TYPE_
1060 #undef MPP_TYPE_BYTELEN_
1061 #undef MPI_TYPE_
1062 #define MPP_ALLTOALL_ mpp_alltoall_real8
1063 #define MPP_ALLTOALLV_ mpp_alltoall_real8_v
1064 #define MPP_TYPE_ real(DOUBLE_KIND)
1065 #define MPP_TYPE_BYTELEN_ 8
1066 #define MPI_TYPE_ MPI_REAL8
1067 #include <mpp_alltoall_nocomm.h>
1068 
1069 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1070 ! !
1071 ! DATA TRANSFER TYPES: mpp_type_create, mpp_type_free !
1072 ! !
1073 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1074 
1075 #define MPP_TYPE_CREATE_ mpp_type_create_int4
1076 #define MPP_TYPE_ integer(INT_KIND)
1077 #define MPI_TYPE_ MPI_INTEGER4
1078 #include <mpp_type_nocomm.h>
1079 
1080 #define MPP_TYPE_CREATE_ mpp_type_create_int8
1081 #define MPP_TYPE_ integer(LONG_KIND)
1082 #define MPI_TYPE_ MPI_INTEGER8
1083 #include <mpp_type_nocomm.h>
1084 
1085 #define MPP_TYPE_CREATE_ mpp_type_create_real4
1086 #define MPP_TYPE_ real(FLOAT_KIND)
1087 #define MPI_TYPE_ MPI_REAL4
1088 #include <mpp_type_nocomm.h>
1089 
1090 #define MPP_TYPE_CREATE_ mpp_type_create_real8
1091 #define MPP_TYPE_ real(DOUBLE_KIND)
1092 #define MPI_TYPE_ MPI_REAL8
1093 #include <mpp_type_nocomm.h>
1094 
1095 #define MPP_TYPE_CREATE_ mpp_type_create_logical4
1096 #define MPP_TYPE_ logical(INT_KIND)
1097 #define MPI_TYPE_ MPI_INTEGER4
1098 #include <mpp_type_nocomm.h>
1099 
1100 #define MPP_TYPE_CREATE_ mpp_type_create_logical8
1101 #define MPP_TYPE_ logical(LONG_KIND)
1102 #define MPI_TYPE_ MPI_INTEGER8
1103 #include <mpp_type_nocomm.h>
1104 
1105 ! Clear preprocessor flags
1106 #undef MPI_TYPE_
1107 #undef MPP_TYPE_
1108 #undef MPP_TYPE_CREATE_
1109 
1110 subroutine mpp_type_free(dtype)
1111  type(mpp_type), pointer, intent(inout) :: dtype
1112 
1113  call mpp_error(NOTE, 'MPP_TYPE_FREE: ' &
1114  'This function should not be used in serial mode.')
1115 
1116  ! For consistency with MPI, we deallocate the pointer
1117  deallocate(dtype)
1118 
1119 end subroutine mpp_type_free
data_override_mod::undef
integer, parameter undef
Definition: data_override.F90:136
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
FLOAT_KIND
#define FLOAT_KIND
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 MPP_BROADCAST_(data, length, from_pe, pelist) !this call was originally bundled in with mpp_transmit
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
crtm_parameters::no
integer, parameter, public no
Definition: CRTM_Parameters.f90:112
mpp_mod::max_ticks
integer(long_kind) max_ticks
Definition: mpp.F90:1299
type_kinds::long
integer, parameter, public long
Definition: Type_Kinds.f90:76
npes
int npes
Definition: threadloc.c:26
mpp_mod::current_peset_num
integer current_peset_num
Definition: mpp.F90:1308
fv3jedi_increment_mod::copy
subroutine, public copy(self, rhs)
Definition: fv3jedi_increment_mod.f90:254
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
MPP_TYPE_
************************************************************************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 MPP_TYPE_
Definition: mpp_transmit_mpi.h:166
j
l_size ! loop over number of fields ke do j
Definition: mpp_do_redistribute.h:70
mpp_mod::etc_unit
integer etc_unit
Definition: mpp.F90:1306
interpolator_mod::name
character(len=32) name
Definition: interpolator.F90:329
if
l_size ! loop over number of fields ke do je do ie to je n if(.NOT. d_comm%R_do_buf(list)) cycle from_pe
amip_interp_mod::module_is_initialized
logical module_is_initialized
Definition: amip_interp.F90:272
mersennetwister_mod::m
integer, parameter m
Definition: MersenneTwister.F90:79
ensemble_manager_mod::pe
integer pe
Definition: ensemble_manager.F90:50
mpp_mod::input_nml_file
character(len=input_str_length), dimension(:), allocatable, target, public input_nml_file
Definition: mpp.F90:1378
diag_integral_mod::version
character(len=128) version
Definition: diag_integral.F90:121
mpp_mod::clock0
integer clock0
Definition: mpp.F90:1360
mpp_mod::world_peset_num
integer world_peset_num
Definition: mpp.F90:1309
mpp_mod::debug
logical debug
Definition: mpp.F90:1297
is
l_size ! loop over number of fields ke do je do ie to is
Definition: mpp_do_redistribute.h:72
mpp_mod::peset
type(communicator), dimension(:), allocatable peset
Definition: mpp.F90:1295
mpp_mod::out_unit
integer out_unit
Definition: mpp.F90:1332
SYSTEM_CLOCK
#define SYSTEM_CLOCK
c2f.type
type
Definition: c2f.py:15
mpp_mod::clock_num
integer clock_num
Definition: mpp.F90:1311
length
************************************************************************GNU Lesser General Public License **This file is part of the GFDL Flexible Modeling System(FMS). ! *! *FMS is free software without even the implied warranty of MERCHANTABILITY or *FITNESS FOR A PARTICULAR PURPOSE See the GNU General Public License *for more details **You should have received a copy of the GNU Lesser General Public *License along with FMS If see< http:! ***********************************************************************!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! MPP_TRANSMIT !! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine MPP_TRANSMIT_(put_data, put_len, to_pe, get_data, get_len, from_pe, block, tag, recv_request, send_request)!a message-passing routine intended to be reminiscent equally of both MPI and SHMEM!put_data and get_data are contiguous MPP_TYPE_ arrays!at each call, your put_data array is put to to_pe 's get_data! your get_data array is got from from_pe 's put_data!i.e we assume that typically(e.g updating halo regions) each PE performs a put _and_ a get!special PE designations:! NULL_PE:to disable a put or a get(e.g at boundaries)! ANY_PE:if remote PE for the put or get is to be unspecific! ALL_PES:broadcast and collect operations(collect not yet implemented)!ideally we would not pass length, but this f77-style call performs better(arrays passed by address, not descriptor)!further, this permits< length > contiguous words from an array of any rank to be passed(avoiding f90 rank conformance check)!caller is responsible for completion checks(mpp_sync_self) before and after integer, intent(in) ::put_len, to_pe, get_len, from_pe MPP_TYPE_, intent(in) ::put_data(*) MPP_TYPE_, intent(out) ::get_data(*) logical, intent(in), optional ::block integer, intent(in), optional ::tag integer, intent(out), optional ::recv_request, send_request logical ::block_comm integer ::i MPP_TYPE_, allocatable, save ::local_data(:) !local copy used by non-parallel code(no SHMEM or MPI) integer ::comm_tag integer ::rsize if(.NOT.module_is_initialized) call mpp_error(FATAL, 'MPP_TRANSMIT:You must first call mpp_init.') if(to_pe.EQ.NULL_PE .AND. from_pe.EQ.NULL_PE) return block_comm=.true. if(PRESENT(block)) block_comm=block if(debug) then call SYSTEM_CLOCK(tick) write(stdout_unit,'(a, i18, a, i6, a, 2i6, 2i8)')&'T=', tick, ' PE=', pe, ' MPP_TRANSMIT begin:to_pe, from_pe, put_len, get_len=', to_pe, from_pe, put_len, get_len end if comm_tag=DEFAULT_TAG if(present(tag)) comm_tag=tag!do put first and then get if(to_pe.GE.0 .AND. to_pe.LT.npes) then!use non-blocking sends if(debug .and.(current_clock.NE.0)) call SYSTEM_CLOCK(start_tick)!z1l:truly non-blocking send.! if(request(to_pe).NE.MPI_REQUEST_NULL) then !only one message from pe-> to_pe in queue *PE waiting for to_pe ! call error else get_len so only do gets but you cannot have a pure get with MPI call a get means do a wait to ensure put on remote PE is complete error call increase mpp_nml request_multiply call MPP_TRANSMIT get_len end if return end subroutine MPP_TRANSMIT_ ! MPP_BROADCAST ! subroutine but that doesn t allow !broadcast to a subset of PEs This version and mpp_transmit will remain !backward compatible intent(inout) MPP_BROADCAST length
Definition: mpp_transmit_mpi.h:179
field_manager_mod::initialize
subroutine, private initialize
Definition: field_manager.F90:5419
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
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::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::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
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
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
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
MPI_TYPE_
************************************************************************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 MPI_TYPE_
Definition: mpp_transmit_mpi.h:81
MPP_TYPE_CREATE_
subroutine MPP_TYPE_CREATE_(field, array_of_subsizes, array_of_starts, &dtype_out) MPP_TYPE_
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
DOUBLE_KIND
#define DOUBLE_KIND
mpp_mod::ticks_per_sec
integer(long_kind) ticks_per_sec
Definition: mpp.F90:1299
sat_vapor_pres_mod::tmin
real tmin
Definition: sat_vapor_pres.F90:534
mpp_mod::mpp_byte
type(mpp_type), target, public mpp_byte
Definition: mpp.F90:1315
mpp_mod::clocks
type(clock), dimension(max_clocks), save clocks
Definition: mpp.F90:1305
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