da_proc_sum_count_obs.inc

1 subroutine da_proc_sum_count_obs (count_obs)
2 
3    !---------------------------------------------------------------------------
4    !  Purpose: Do MPI sum operation across processors to get the global sum of
5    !           count_obs. The sum is returned only on the root processor,
6    !           i.e., processor 0. (In this way, we do not have to do all-to-all 
7    !           communication.)
8    !----------------------------------------------------------------------------
9 
10    implicit none
11    
12    integer, parameter:: numvals = num_ob_indexes*4
13 
14    type (count_obs_type), intent(inout)     :: count_obs
15 
16    integer           :: sumval(1:numvals)     ! Sum across processors.
17    integer           :: procval(1:numvals)    ! Partial values on processor to sum.
18    integer           :: offset                ! Index into procval and sumval arrays.
19 
20 #ifdef DM_PARALLEL
21 
22    offset = 1
23    call da_pack_count_obs(count_obs % num_synop, offset, procval)
24    call da_pack_count_obs(count_obs % num_sound, offset, procval)
25    call da_pack_count_obs(count_obs % num_sound, offset, procval)
26    call da_pack_count_obs(count_obs % num_satem, offset, procval)
27    call da_pack_count_obs(count_obs % num_geoamv, offset, procval)
28    call da_pack_count_obs(count_obs % num_polaramv, offset, procval)
29    call da_pack_count_obs(count_obs % num_metar, offset, procval)
30    call da_pack_count_obs(count_obs % num_airep, offset, procval)
31    call da_pack_count_obs(count_obs % num_ships, offset, procval)
32    call da_pack_count_obs(count_obs % num_pilot, offset, procval)
33    call da_pack_count_obs(count_obs % num_gpspw, offset, procval)
34    call da_pack_count_obs(count_obs % num_ssmi_retrieval, offset, procval)
35    call da_pack_count_obs(count_obs % num_ssmi_tb, offset, procval)
36    call da_pack_count_obs(count_obs % num_ssmt1, offset, procval)
37    call da_pack_count_obs(count_obs % num_ssmt2, offset, procval)
38    call da_pack_count_obs(count_obs % num_qscat, offset, procval)
39    call da_pack_count_obs(count_obs % num_profiler, offset, procval)
40    call da_pack_count_obs(count_obs % num_bogus, offset, procval)
41    call da_pack_count_obs(count_obs % num_buoy, offset, procval)
42 
43    call mpi_reduce(procval, sumval, numvals, mpi_integer, mpi_sum, root, comm, ierr)
44    
45    if (myproc == root) then
46       offset = 1
47       call da_unpack_count_obs(count_obs % num_synop, offset, sumval)
48       call da_unpack_count_obs(count_obs % num_sound, offset, sumval)
49       call da_unpack_count_obs(count_obs % num_sound, offset, sumval)
50       call da_unpack_count_obs(count_obs % num_satem, offset, sumval)
51       call da_unpack_count_obs(count_obs % num_geoamv, offset, sumval)
52       call da_unpack_count_obs(count_obs % num_polaramv, offset, sumval)
53       call da_unpack_count_obs(count_obs % num_metar, offset, sumval)
54       call da_unpack_count_obs(count_obs % num_airep, offset, sumval)
55       call da_unpack_count_obs(count_obs % num_ships, offset, sumval)
56       call da_unpack_count_obs(count_obs % num_pilot, offset, sumval)
57       call da_unpack_count_obs(count_obs % num_gpspw, offset, sumval)
58       call da_unpack_count_obs(count_obs % num_ssmi_retrieval, offset, procval)
59       call da_unpack_count_obs(count_obs % num_ssmi_tb, offset, procval)
60       call da_unpack_count_obs(count_obs % num_ssmt1, offset, sumval)
61       call da_unpack_count_obs(count_obs % num_ssmt2, offset, sumval)
62       call da_unpack_count_obs(count_obs % num_qscat, offset, sumval)
63       call da_unpack_count_obs(count_obs % num_profiler, offset, sumval)
64       call da_unpack_count_obs(count_obs % num_bogus, offset, sumval)
65       call da_unpack_count_obs(count_obs % num_buoy, offset, sumval)
66    end if
67 #endif
68 
69 end subroutine da_proc_sum_count_obs
70 
71