da_obs_diagnostics.inc
References to this file elsewhere.
1 subroutine da_obs_diagnostics(num_sound, ob, iv, re)
2
3 !-----------------------------------------------------------------------
4 ! Purpose: TBD
5 !-----------------------------------------------------------------------
6
7 implicit none
8
9 integer, intent(in) :: num_sound
10 type (residual_sound_type), intent(in) :: ob(:)
11 type (sound_type), intent(in) :: iv(:)
12 type (residual_sound_type), intent(in) :: re(:)
13
14 integer :: n, k
15 integer :: sound_diag_unit1
16 integer :: sound_diag_unit2
17 integer :: sound_diag_unit3
18 integer :: sound_diag_unit4
19
20 if (trace_use) call da_trace_entry("da_obs_diagnostics")
21
22 call da_get_unit(sound_diag_unit1)
23 call da_get_unit(sound_diag_unit2)
24 call da_get_unit(sound_diag_unit3)
25 call da_get_unit(sound_diag_unit4)
26 open(unit=sound_diag_unit1,file="sound_diag1",status="replace")
27 open(unit=sound_diag_unit2,file="sound_diag2",status="replace")
28 open(unit=sound_diag_unit3,file="sound_diag3",status="replace")
29 open(unit=sound_diag_unit4,file="sound_diag4",status="replace")
30
31 do n = 1, num_sound
32 do k = 1, iv(n) % info % levels
33 if (iv(n) % u(k) % qc >= obs_qc_pointer) then
34 write(unit=sound_diag_unit1,fmt='(a5,2f9.3,5f17.7,i8)') &
35 iv(n) % info % id, & ! Station
36 iv(n) % info % lat, & ! Latitude
37 iv(n) % info % lon, & ! Longitude
38 iv(n) % p(k), & ! Obs Pressure
39 ob(n) % u(k), & ! O
40 iv(n) % u(k) % inv, & ! O-B
41 re(n) % u(k), & ! O-A
42 iv(n) % u(k) % error, &! Obs error
43 iv(n) % u(k) % qc ! QC flag
44 end if
45
46 if (iv(n) % v(k) % qc >= obs_qc_pointer) then
47 write(unit=sound_diag_unit2,fmt='(a5,2f9.3,5f17.7,i8)') &
48 iv(n) % info % id, & ! Station
49 iv(n) % info % lat, & ! Latitude
50 iv(n) % info % lon, & ! Longitude
51 iv(n) % h(k), & ! Obs Pressure
52 ob(n) % v(k), & ! O
53 iv(n) % v(k) % inv, & ! O-B
54 re(n) % v(k), & ! O-A
55 iv(n) % v(k) % error, &! Obs error
56 iv(n) % v(k) % qc ! QC flag
57 end if
58
59 if (iv(n) % t(k) % qc >= obs_qc_pointer) then
60 write(unit=sound_diag_unit3,fmt='(a5,2f9.3,5f17.7,i8)') &
61 iv(n) % info % id, & ! Station
62 iv(n) % info % lat, & ! Latitude
63 iv(n) % info % lon, & ! Longitude
64 iv(n) % h(k), & ! Obs Pressure
65 ob(n) % t(k), & ! O
66 iv(n) % t(k) % inv, & ! O-B
67 re(n) % t(k), & ! O-A
68 iv(n) % t(k) % error, &! Obs error
69 iv(n) % t(k) % qc ! QC flag
70 end if
71
72 if (iv(n) % q(k) % qc >= obs_qc_pointer) then
73 write(unit=sound_diag_unit4,fmt='(a5,2f9.3,5f17.7,i8)') &
74 iv(n) % info % id, & ! Station
75 iv(n) % info % lat, & ! Latitude
76 iv(n) % info % lon, & ! Longitude
77 iv(n) % h(k), & ! Obs Pressure
78 ob(n) % q(k), & ! O
79 iv(n) % q(k) % inv, & ! O-B (kg/kg)
80 re(n) % q(k), & ! O-A
81 iv(n) % q(k) % error, &! Obs error (kg/kg)
82 iv(n) % q(k) % qc ! QC flag
83 end if
84 end do
85 end do
86
87 ! End of file markers:
88 write(unit=sound_diag_unit1,fmt='(a5,2f9.3,5f17.7,i8)') &
89 '00000',0.0,0.0,0.0,0.0,0.0,0.0,0.0,0
90
91 write(unit=sound_diag_unit2,fmt='(a5,2f9.3,5f17.7,i8)') &
92 '00000',0.0,0.0,0.0,0.0,0.0,0.0,0.0,0
93
94 write(unit=sound_diag_unit3,fmt='(a5,2f9.3,5f17.7,i8)') &
95 '00000',0.0,0.0,0.0,0.0,0.0,0.0,0.0,0
96
97 write(unit=sound_diag_unit4,fmt='(a5,2f9.3,5f17.7,i8)') &
98 '00000',0.0,0.0,0.0,0.0,0.0,0.0,0.0,0
99
100 close(sound_diag_unit1)
101 close(sound_diag_unit2)
102 close(sound_diag_unit3)
103 close(sound_diag_unit4)
104 call da_free_unit(sound_diag_unit1)
105 call da_free_unit(sound_diag_unit2)
106 call da_free_unit(sound_diag_unit3)
107 call da_free_unit(sound_diag_unit4)
108
109 if (trace_use) call da_trace_exit("da_obs_diagnostics")
110
111 end subroutine da_obs_diagnostics
112
113