mpp_global_sum.h

Go to the documentation of this file.
00001   function MPP_GLOBAL_SUM_( domain, field, flags )
00002     MPP_TYPE_ :: MPP_GLOBAL_SUM_
00003     type(domain2D), intent(in) :: domain
00004     MPP_TYPE_, intent(in) :: field(:,: MPP_EXTRA_INDICES_ )
00005     integer, intent(in), optional :: flags
00006     MPP_TYPE_, allocatable, dimension(:,:) :: field2D, global2D
00007     integer :: i,j, ioff,joff
00008 
00009     if( size(field,1).EQ.domain%x%compute%size .AND. size(field,2).EQ.domain%y%compute%size )then
00010 !field is on compute domain
00011         ioff = -domain%x%compute%begin + 1
00012         joff = -domain%y%compute%begin + 1
00013     else if( size(field,1).EQ.domain%x%data%size .AND. size(field,2).EQ.domain%y%data%size )then
00014 !field is on data domain
00015         ioff = -domain%x%data%begin + 1
00016         joff = -domain%y%data%begin + 1
00017     else
00018         call mpp_error( FATAL, 'MPP_GLOBAL_SUM_: incoming field array must match either compute domain or data domain.' )
00019     end if
00020     if( PRESENT(flags) )then
00021         if( flags.NE.BITWISE_EXACT_SUM )call mpp_error( FATAL, 'MPP_GLOBAL_SUM_: only valid flag is BITWISE_EXACT_SUM.' )
00022 !this is bitwise exact across different PE counts.
00023         allocate( field2D(domain%x%compute%begin:domain%x%compute%end,domain%y%compute%begin:domain%y%compute%end) )
00024         allocate( global2D(domain%x%global%size,domain%y%global%size) )
00025         do j = domain%y%compute%begin, domain%y%compute%end
00026            do i = domain%x%compute%begin, domain%x%compute%end
00027               field2D(i,j) = sum( field(i+ioff:i+ioff,j+joff:j+joff MPP_EXTRA_INDICES_) )
00028            end do
00029         end do
00030 
00031         call mpp_global_field( domain, field2D, global2D )
00032         MPP_GLOBAL_SUM_ = sum(global2D)
00033         deallocate( field2D)
00034         deallocate(global2D)
00035     else
00036 !this is not bitwise-exact across different PE counts
00037         MPP_GLOBAL_SUM_ = sum( field(domain%x%compute%begin+ioff:domain%x%compute%end+ioff, &
00038                                      domain%y%compute%begin+joff:domain%y%compute%end+joff MPP_EXTRA_INDICES_) )
00039         call mpp_sum( MPP_GLOBAL_SUM_, domain%list(:)%pe )
00040     end if
00041 
00042     return
00043   end function MPP_GLOBAL_SUM_