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