da_setup_testfield.inc
References to this file elsewhere.
1 subroutine da_setup_testfield(grid)
2
3 !----------------------------------------------------------------------------
4 ! Purpose: produce test increment field based on grid%xb field.
5 !
6 ! Method: pass through x=uv transfom to ensure satisfies boundary conditions
7 !----------------------------------------------------------------------------
8
9 implicit none
10
11 type (domain), intent(inout) :: grid
12
13 integer :: i, j
14
15 if (trace_use) call da_trace_entry("da_setup_testfield")
16
17 !-------------------------------------------------------------------------
18 ! [1.0]: initialise:
19 !-------------------------------------------------------------------------
20
21 write(unit=stdout, fmt='(/a/)') &
22 'Starting da_setup_testfield ...'
23
24 !-------------------------------------------------------------------------
25 ! [2.0]: set up test increment field structure:
26 !-------------------------------------------------------------------------
27
28 ! [2.1] test wind, temperature, pressure, and humidity.
29
30 call da_set_tst_trnsf_fld(grid, grid%xa%u, grid%xb%u, typical_u_rms)
31 call da_set_tst_trnsf_fld(grid, grid%xa%v, grid%xb%v, typical_v_rms)
32 call da_set_tst_trnsf_fld(grid, grid%xa%w, grid%xb%w, typical_w_rms)
33 call da_set_tst_trnsf_fld(grid, grid%xa%t, grid%xb%t, typical_t_rms)
34 call da_set_tst_trnsf_fld(grid, grid%xa%p, grid%xb%p, typical_p_rms)
35 call da_set_tst_trnsf_fld(grid, grid%xa%q, grid%xb%q, typical_q_rms)
36 call da_set_tst_trnsf_fld(grid, grid%xa%qcw, grid%xb%qcw, typical_qcw_rms)
37 call da_set_tst_trnsf_fld(grid, grid%xa%qrn, grid%xb%qrn, typical_qrn_rms)
38
39 ! [2.5] get test density increment from linearised ideal gas law:
40
41 call da_pt_to_rho_lin(grid)
42
43 grid%xa%psfc(grid%xp%its:grid%xp%ite, grid%xp%jts:grid%xp%jte) = &
44 grid%xa%p (grid%xp%its:grid%xp%ite, grid%xp%jts:grid%xp%jte, grid%xp%kts)
45
46 if (print_detail_testing) then
47 write(unit=stdout, fmt='(2a,4x,a,i8)') &
48 'file:', __FILE__, 'line:', __LINE__
49
50 write(unit=stdout, fmt=*) 'grid%xp%its, grid%xp%ite, grid%xp%jts, grid%xp%jte) =', &
51 grid%xp%its, grid%xp%ite, grid%xp%jts, grid%xp%jte
52
53 do j=grid%xp%jts, grid%xp%jte
54 do i=grid%xp%its, grid%xp%ite
55 if (i == j) then
56 write(unit=stdout, fmt='(2(a,i4),a,f14.6)') &
57 'grid%xa%psfc(', i, ',', j, ') =', grid%xa%psfc(i, j)
58 end if
59 end do
60 end do
61 end if
62
63 #ifdef DM_PARALLEL
64 #include "HALO_XA.inc"
65 #endif
66
67 if (sfc_assi_options == 2) then
68 #ifdef DM_PARALLEL
69 #include "HALO_SFC_XA.inc"
70 #endif
71 end if
72
73 if (use_ssmt1obs .or. use_ssmt2obs .or. use_gpspwobs .or. &
74 use_ssmitbobs .or. use_ssmiretrievalobs) then
75
76 ! Now do something for PW
77 call da_transform_xtotpw(grid)
78
79 ! GPS Refractivity:
80 if (use_gpsrefobs) &
81 call da_transform_xtogpsref_lin(grid)
82
83 if (use_ssmt1obs .or. use_ssmt2obs .or. use_ssmitbobs .or. use_ssmiretrievalobs) then
84 call da_transform_xtoseasfcwind_lin(grid)
85 end if
86
87 #ifdef DM_PARALLEL
88 #include "HALO_SSMI_XA.inc"
89 #endif
90 end if
91
92 write(unit=stdout, fmt='(/a/)') 'End of da_setup_testfield.'
93
94 if (trace_use) call da_trace_exit("da_setup_testfield")
95
96 end subroutine da_setup_testfield
97
98