da_dot_cv.inc

1 real function da_dot_cv(cv_size, cv_size_domain, x, y, grid, 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,             intent(in) :: x(cv_size)       ! 1st vector.
17    real,             intent(in) :: y(cv_size)       ! 1st vector.
18    type(domain),     intent(in) :: grid             ! 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    real          :: dtemp1(1), dtemp1x   ! Temporary.
24 
25    if (trace_use) call da_trace_entry("da_dot_cv")
26 
27    dtemp1(1) = 0.0
28 
29    ! Bitwise-exact reduction preserves operation order of serial code for
30    ! testing, at the cost of much-increased run-time.  Turn it off when not
31    ! testing.  This will always be .false. for a serial run or 
32    ! one-processor DM_PARALLEL run.
33 
34    if (test_dm_exact) then
35 
36       ! Collect local cv arrays x and y to globally-sized serially-ordered 
37       ! arrays xg and yg.  Note that xg and yg will only exist on the 
38       ! monitor task.  
39 
40       if (rootproc) then
41          allocate(xg(1:cv_size_domain))
42          allocate(yg(1:cv_size_domain))
43       end if
44 
45       call da_cv_to_global(cv_size, cv_size_domain, x, grid, mzs, xg)
46       call da_cv_to_global(cv_size, cv_size_domain, y, grid, mzs, yg)
47 
48       if (rootproc) then
49          dtemp1(1) = da_dot(cv_size_domain, xg, yg)
50          deallocate(xg, yg)
51       end if
52 
53       ! Broadcast result from monitor to other tasks.  
54       call wrf_dm_bcast_real(dtemp1, 1)
55 
56    else
57 
58       dtemp1(1) = da_dot(cv_size, x, y)
59 
60       if (.not. global) then
61          dtemp1x = dtemp1(1)
62          ! summation across processors:
63          dtemp1(1) = wrf_dm_sum_real(dtemp1x)
64       end if
65 
66    end if
67 
68    da_dot_cv = dtemp1(1)
69 
70    if (trace_use) call da_trace_exit("da_dot_cv")
71 
72 end function da_dot_cv
73 
74