da_check.inc
References to this file elsewhere.
1 subroutine da_check(cv_size, xb, xbx, be, ep, iv, &
2 xa, vv, vp, xp, y)
3
4 !-----------------------------------------------------------------------
5 ! Purpose: TBD
6 !-----------------------------------------------------------------------
7
8 implicit none
9
10 integer, intent(in) :: cv_size ! Size of cv array.
11 type (xb_type), intent(in) :: xb ! first guess (local).
12 type (xbx_type), intent(in) :: xbx ! Header & non-gridded vars.
13 type (be_type), intent(in) :: be ! background error structure.
14 type (ep_type), intent(in) :: ep ! Ensemble perturbation structure.
15 type (ob_type), intent(in) :: iv ! ob. increment vector.
16 type (x_type), intent(inout) :: xa ! analysis increments (local).
17 type (vp_type), intent(inout) :: vv ! Grdipt/EOF CV.
18 type (vp_type), intent(inout) :: vp ! Grdipt/level CV.
19 type (xpose_type), intent(inout) :: xp ! Dimensions and xpose buffers.
20 type (y_type), intent(inout) :: y ! y = h (xa)
21
22 integer :: sizec
23 real :: cvtest(1:cv_size) ! background error structure.
24 real :: field(its:ite,jts:jte) ! Field for spectral transform test.
25
26 call da_trace_entry("da_check")
27
28 !----------------------------------------------------------------------------
29 ! [1] Set up test data:
30 !----------------------------------------------------------------------------
31
32 ! Initialize cv values with random data:
33 call random_number(cvtest(:))
34 cvtest(:) = cvtest(:) - 0.5
35
36 ! vv arrays initialized already.
37 ! vp arrays initialized already.
38
39 !----------------------------------------------------------------------------
40 ! [2] Perform vtox adjoint tests:
41 !----------------------------------------------------------------------------
42
43 call da_message((/"Performing vtox adjoint tests"/))
44
45 ! v_to_vv adjoint test:
46
47 call da_check_cvtovv_adjoint(cv_size, xb, xbx,xp, be, cvtest, vv)
48
49 !-------------------------------------------------------------------------
50 ! vv_to_vp adjoint test:
51 !-------------------------------------------------------------------------
52
53 call da_check_vvtovp_adjoint(be % ne, xb, be, vv, vp)
54
55 !-------------------------------------------------------------------------
56 ! vptox adjoint test:
57 !-------------------------------------------------------------------------
58
59 call da_check_vptox_adjoint(be % ne, xb, be, ep, xp, vp, xa)
60
61 !-------------------------------------------------------------------------
62 ! vtox adjoint test: <x,x> = <v_adj,v>
63 !-------------------------------------------------------------------------
64
65 call da_check_vtox_adjoint(cv_size, xb, xbx, be, ep, cvtest, vv, vp, xp, &
66 xa)
67
68 !----------------------------------------------------------------------------
69 ! [2] Perform xtoy adjoint tests:
70 !----------------------------------------------------------------------------
71
72 call da_message((/"Performing xtoy adjoint tests"/))
73
74 call da_allocate_y(iv, y)
75 call da_zero_x(xa)
76
77 call da_setup_testfield(xb, xa, xp)
78
79 ! WHY
80 ! Make cv_array random.
81
82 ! call random_number(cvtest(1:cv_size))
83 ! cvtest(1:cv_size) = cvtest(1:cv_size) - 0.5
84
85 ! call da_transform_vtox(cv_size, xb, xbx, be, ep, cvtest, vv, vp, xp, xa)
86
87 call da_check_xtoy_adjoint(xb, xa, iv, xp, y)
88
89 call da_deallocate_y(y)
90
91 !----------------------------------------------------------------------------
92 ! [4] Perform spectral test:
93 !----------------------------------------------------------------------------
94
95 if (global) then
96
97 call da_message((/"Performing spectral tests"/))
98
99 call random_number(field(:,:))
100 field(:,:) = field(:,:) - 0.5
101
102 sizec = (be % max_wave+1) * (be % max_wave+2)/2
103 call da_test_spectral(be % max_wave, sizec, xbx, field)
104
105 end if
106
107 call da_trace_exit("da_check")
108
109 end subroutine da_check
110
111