| 1 | function MPP_GLOBAL_SUM_( domain, field, flags ) |
|---|
| 2 | MPP_TYPE_ :: MPP_GLOBAL_SUM_ |
|---|
| 3 | type(domain2D), intent(in) :: domain |
|---|
| 4 | MPP_TYPE_, intent(in) :: field(:,: MPP_EXTRA_INDICES_ ) |
|---|
| 5 | integer, intent(in), optional :: flags |
|---|
| 6 | MPP_TYPE_, allocatable, dimension(:,:) :: field2D, global2D |
|---|
| 7 | integer :: i,j, ioff,joff |
|---|
| 8 | |
|---|
| 9 | if( size(field,1).EQ.domain%x%compute%size .AND. size(field,2).EQ.domain%y%compute%size )then |
|---|
| 10 | !field is on compute domain |
|---|
| 11 | ioff = -domain%x%compute%begin + 1 |
|---|
| 12 | joff = -domain%y%compute%begin + 1 |
|---|
| 13 | else if( size(field,1).EQ.domain%x%data%size .AND. size(field,2).EQ.domain%y%data%size )then |
|---|
| 14 | !field is on data domain |
|---|
| 15 | ioff = -domain%x%data%begin + 1 |
|---|
| 16 | joff = -domain%y%data%begin + 1 |
|---|
| 17 | else |
|---|
| 18 | call mpp_error( FATAL, 'MPP_GLOBAL_SUM_: incoming field array must match either compute domain or data domain.' ) |
|---|
| 19 | end if |
|---|
| 20 | if( PRESENT(flags) )then |
|---|
| 21 | if( flags.NE.BITWISE_EXACT_SUM )call mpp_error( FATAL, 'MPP_GLOBAL_SUM_: only valid flag is BITWISE_EXACT_SUM.' ) |
|---|
| 22 | !this is bitwise exact across different PE counts. |
|---|
| 23 | allocate( field2D(domain%x%compute%begin:domain%x%compute%end,domain%y%compute%begin:domain%y%compute%end) ) |
|---|
| 24 | allocate( global2D(domain%x%global%size,domain%y%global%size) ) |
|---|
| 25 | do j = domain%y%compute%begin, domain%y%compute%end |
|---|
| 26 | do i = domain%x%compute%begin, domain%x%compute%end |
|---|
| 27 | field2D(i,j) = sum( field(i+ioff:i+ioff,j+joff:j+joff MPP_EXTRA_INDICES_) ) |
|---|
| 28 | end do |
|---|
| 29 | end do |
|---|
| 30 | |
|---|
| 31 | call mpp_global_field( domain, field2D, global2D ) |
|---|
| 32 | MPP_GLOBAL_SUM_ = sum(global2D) |
|---|
| 33 | deallocate( field2D) |
|---|
| 34 | deallocate(global2D) |
|---|
| 35 | else |
|---|
| 36 | !this is not bitwise-exact across different PE counts |
|---|
| 37 | MPP_GLOBAL_SUM_ = sum( field(domain%x%compute%begin+ioff:domain%x%compute%end+ioff, & |
|---|
| 38 | domain%y%compute%begin+joff:domain%y%compute%end+joff MPP_EXTRA_INDICES_) ) |
|---|
| 39 | call mpp_sum( MPP_GLOBAL_SUM_, domain%list(:)%pe ) |
|---|
| 40 | end if |
|---|
| 41 | |
|---|
| 42 | return |
|---|
| 43 | end function MPP_GLOBAL_SUM_ |
|---|
