da_dot_cv.inc

1 real function da_dot_cv(cv_size, cv_size_domain, x, y, xp, mzs)
2 
3    !-----------------------------------------------------------------------
4    ! Purpose: Forms the dot product of two vectors that are organized in the 
5    ! format of a "cv_type".  
6    !
7    ! Capable of producing bitwise-exact results for distributed-memory 
8    ! parallel runs for testing.  This feature is very slow and consumes 
9    ! lots of memory. 
10    !-----------------------------------------------------------------------
11 
12    implicit none
13 
14    integer, intent(in)          :: cv_size           ! Size of array (tile).
15    integer, intent(in)          :: cv_size_domain    ! Size of array (domain).
16    real, dimension(1:cv_size), intent(in) :: x       ! 1st vector.
17    real, dimension(1:cv_size), intent(in) :: y       ! 1st vector.
18         type (xpose_type),  intent(in) :: xp         ! decomposed dimensions
19         integer,            intent(in) :: mzs(:)     ! mz for each variable
20                                                      ! (to identify 2D arrays)
21 
22    real, pointer                :: xg(:), yg(:)      ! Serial data arrays.
23 
24    real                         :: dtemp1(1), dtemp1x   ! Temporary.
25 
26    dtemp1(1) = 0.0
27 
28    ! Bitwise-exact reduction preserves operation order of serial code for
29    ! testing, at the cost of much-increased run-time.  Turn it off when not
30    ! testing.  This will always be .false. for a serial run or 
31    ! one-processor DM_PARALLEL run.
32 
33    if (testing_dm_exact) then
34 
35       ! Collect local cv arrays x and y to globally-sized serially-ordered 
36       ! arrays xg and yg.  Note that xg and yg will only exist on the 
37       ! monitor task.  
38 
39       if (rootproc) then
40          allocate(xg(1:cv_size_domain))
41          allocate(yg(1:cv_size_domain))
42       end if
43 
44       call da_cv_to_global(cv_size, cv_size_domain, x, xp, mzs, xg)
45       call da_cv_to_global(cv_size, cv_size_domain, y, xp, mzs, yg)
46 
47       if (rootproc) then
48          dtemp1(1) = da_dot(cv_size_domain, xg, yg)
49          deallocate(xg, yg)
50       end if
51 
52       ! Broadcast result from monitor to other tasks.  
53       call wrf_dm_bcast_real(dtemp1, 1)
54 
55    else
56 
57       dtemp1(1) = da_dot(cv_size, x, y)
58 
59       if (.not. global) then
60          dtemp1x = dtemp1(1)
61          ! summation across processors:
62          dtemp1(1) = wrf_dm_sum_real(dtemp1x)
63       end if
64 
65    end if
66 
67    da_dot_cv = dtemp1(1)
68 
69 end function da_dot_cv
70 
71