da_check_cvtovv_adjoint.inc
References to this file elsewhere.
1 subroutine da_check_cvtovv_adjoint(grid, cv_size, xbx, be, cv, vv)
2
3 !---------------------------------------------------------------------------
4 ! Purpose: Test vtovv routine and adjoint for compatibility.
5 !
6 ! Method: Standard adjoint test: < vv, vv > = < cv_adj, cv >.
7 !---------------------------------------------------------------------------
8
9 implicit none
10
11 type(domain), intent(inout) :: grid
12
13 integer, intent(in) :: cv_size ! Size of cv array.
14 type (xbx_type),intent(in) :: xbx ! Header & non-gridded vars.
15 type (be_type), intent(in) :: be ! background error structure.
16 real, intent(in) :: cv(1:cv_size) ! control variable.
17 type (vp_type), intent(inout) :: vv ! CV(i,j,m).
18
19 real :: adj_par_lhs ! < Vv, Vv >
20 real :: adj_par_rhs ! < cv_adj, cv >
21 real :: adj_sum_lhs ! < Vv, Vv >
22 real :: adj_sum_rhs ! < cv_adj, cv >
23 real :: cv2(1:cv_size)! control variable.
24
25 !-------------------------------------------------------------------------
26 ! [1.0] Initialise:
27 !-------------------------------------------------------------------------
28
29 if (trace_use) call da_trace_entry("da_check_cvtovv_adjoint")
30
31 write(unit=stdout, fmt='(/a/)') 'da_check_cvtovv_adjoint: Test Results:'
32
33 !-------------------------------------------------------------------------
34 ! [2.0] Perform Vp = U_v Vv transform:
35 !-------------------------------------------------------------------------
36
37 if (global) then
38 call da_transform_vtovv_global(cv_size, xbx, be, cv, vv)
39 else
40 call da_transform_vtovv(grid, cv_size, be, cv, vv)
41 end if
42
43 !----------------------------------------------------------------------
44 ! [3.0] Calculate LHS of adjoint test equation:
45 !----------------------------------------------------------------------
46
47 adj_par_lhs = sum(vv % v1(its:ite,jts:jte,1:be%v1%mz)**2) &
48 + sum(vv % v2(its:ite,jts:jte,1:be%v2%mz)**2) &
49 + sum(vv % v3(its:ite,jts:jte,1:be%v3%mz)**2) &
50 + sum(vv % v4(its:ite,jts:jte,1:be%v4%mz)**2) &
51 + sum(vv % v5(its:ite,jts:jte,1:be%v5%mz)**2)
52
53 if (be % ne > 0) then
54 adj_par_lhs = adj_par_lhs + sum(vv % alpha(its:ite,jts:jte,1:be%ne)**2)
55 end if
56
57 !----------------------------------------------------------------------
58 ! [4.0] Calculate RHS of adjoint test equation:
59 !----------------------------------------------------------------------
60
61 if (global) then
62 call da_transform_vtovv_global_adj(cv_size, xbx, be, cv2, vv)
63 else
64 call da_transform_vtovv_adj(grid, cv_size, be, cv2, vv)
65 end if
66
67 adj_par_rhs = sum(cv(1:cv_size) * cv2(1:cv_size))
68
69 !----------------------------------------------------------------------
70 ! [5.0] Print output:
71 !----------------------------------------------------------------------
72
73 if (.not. global ) then
74 if( num_procs == 1) then
75 write(unit=stdout, fmt='(a,1pe22.14)') &
76 'Single Domain: < Vv, Vv > = ', adj_par_lhs, &
77 'Single Domain: < cv_adj, cv > = ', adj_par_rhs
78 else
79 write(unit=stdout, fmt='(/a/,a/)')&
80 'It is Multi Processor Run: ',&
81 'For Single Domain: da_check_cvtovv_adjoint Test: Not Performed'
82 endif
83 end if
84
85 adj_sum_lhs = wrf_dm_sum_real(adj_par_lhs)
86
87 if (global) then
88 adj_sum_rhs = adj_par_rhs
89 else
90 adj_sum_rhs = wrf_dm_sum_real(adj_par_rhs)
91 end if
92
93 if (rootproc) then
94 write(unit=stdout, fmt='(/)')
95 write(unit=stdout, fmt='(a,1pe22.14)') &
96 'Whole Domain: < Vv, Vv > = ', adj_sum_lhs, &
97 'Whole Domain: < cv_adj, cv > = ', adj_sum_rhs
98 end if
99
100 write(unit=stdout, fmt='(/a/)') &
101 'da_check_cvtovv_adjoint: Test Finished.'
102
103 if (trace_use) call da_trace_exit("da_check_cvtovv_adjoint")
104
105 end subroutine da_check_cvtovv_adjoint
106
107