Merge remote-tracking branch 'origin/release-v4.6.1'
[WRF.git] / var / da / da_ssmi / da_oi_stats_ssmi_tb.inc
blob634d60f0424731c7e76ad0de244fed1512e93667
1 subroutine da_oi_stats_ssmi_tb (stats_unit, iv)
3    !-----------------------------------------------------------------------
4    ! Purpose: TBD
5    !-----------------------------------------------------------------------
7    implicit none
9    integer,        intent (in) :: stats_unit    ! Output unit for stats.
10    type (iv_type), intent (in) :: iv            ! OI
12    integer                   :: ntb19v,ntb19h,ntb22v,ntb37v,ntb37h, ntb85v,ntb85h
13    integer                   :: n
14    type (stats_ssmi_tb_type) :: stats
16    if (trace_use) call da_trace_entry("da_oi_stats_ssmi_tb")
18    ntb19v = 0
19    ntb19h = 0
20    ntb22v = 0
21    ntb37v = 0
22    ntb37h = 0
23    ntb85v = 0
24    ntb85h = 0
26    stats%maximum%tb19v = maxmin_type(missing_r, 0, 0)
27    stats%maximum%tb19h = maxmin_type(missing_r, 0, 0)
28    stats%maximum%tb22v = maxmin_type(missing_r, 0, 0)
29    stats%maximum%tb37v = maxmin_type(missing_r, 0, 0)
30    stats%maximum%tb37h = maxmin_type(missing_r, 0, 0)
31    stats%maximum%tb85v = maxmin_type(missing_r, 0, 0)
32    stats%maximum%tb85h = maxmin_type(missing_r, 0, 0)
33    stats%minimum%tb19v = maxmin_type(-missing_r, 0, 0)
34    stats%minimum%tb19h = maxmin_type(-missing_r, 0, 0)
35    stats%minimum%tb22v = maxmin_type(-missing_r, 0, 0)
36    stats%minimum%tb37v = maxmin_type(-missing_r, 0, 0)
37    stats%minimum%tb37h = maxmin_type(-missing_r, 0, 0)
38    stats%minimum%tb85v = maxmin_type(-missing_r, 0, 0)
39    stats%minimum%tb85h = maxmin_type(-missing_r, 0, 0)
41    stats%average = residual_ssmi_tb_type(0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0)
42    stats%rms_err = stats%average
44    do n=1, iv%info(ssmi_tb)%nlocal
45       if (iv%info(ssmi_tb)%proc_domain(1,n)) then
46          call da_stats_calculate(iv%info(ssmi_tb)%obs_global_index(n), &
47             0, iv%ssmi_tb(n)%tb19v%qc, & 
48             iv%ssmi_tb(n)%tb19v%inv, ntb19v, &
49             stats%minimum%tb19v, stats%maximum%tb19v,&
50             stats%average%tb19v, stats%rms_err%tb19v)
51          call da_stats_calculate(iv%info(ssmi_tb)%obs_global_index(n), &
52             0, iv%ssmi_tb(n)%tb19h%qc, & 
53             iv%ssmi_tb(n)%tb19h%inv, ntb19h, &
54             stats%minimum%tb19h, stats%maximum%tb19h,&
55             stats%average%tb19h, stats%rms_err%tb19h)
56          call da_stats_calculate(iv%info(ssmi_tb)%obs_global_index(n), &
57             0, iv%ssmi_tb(n)%tb22v%qc, & 
58             iv%ssmi_tb(n)%tb22v%inv, ntb22v, &
59             stats%minimum%tb22v, stats%maximum%tb22v,&
60             stats%average%tb22v, stats%rms_err%tb22v)
61          call da_stats_calculate(iv%info(ssmi_tb)%obs_global_index(n), &
62             0, iv%ssmi_tb(n)%tb37v%qc, & 
63             iv%ssmi_tb(n)%tb37v%inv, ntb37v, &
64             stats%minimum%tb37v, stats%maximum%tb37v,&
65             stats%average%tb37v, stats%rms_err%tb37v)
66          call da_stats_calculate(iv%info(ssmi_tb)%obs_global_index(n), &
67             0, iv%ssmi_tb(n)%tb37h%qc, & 
68             iv%ssmi_tb(n)%tb37h%inv, ntb37h, &
69             stats%minimum%tb37h, stats%maximum%tb37h,&
70             stats%average%tb37h, stats%rms_err%tb37h)
71          call da_stats_calculate(iv%info(ssmi_tb)%obs_global_index(n), &
72             0, iv%ssmi_tb(n)%tb85v%qc, & 
73             iv%ssmi_tb(n)%tb85v%inv, ntb85v, &
74             stats%minimum%tb85v, stats%maximum%tb85v,&
75             stats%average%tb85v, stats%rms_err%tb85v)
76          call da_stats_calculate(iv%info(ssmi_tb)%obs_global_index(n), &
77             0, iv%ssmi_tb(n)%tb85h%qc, & 
78             iv%ssmi_tb(n)%tb85h%inv, ntb85h, &
79             stats%minimum%tb85h, stats%maximum%tb85h,&
80             stats%average%tb85h, stats%rms_err%tb85h)
81       end if
82    end do
84    ! Do inter-processor communication to gather statistics.
85    call da_proc_sum_int(ntb19v)
86    call da_proc_sum_int(ntb19h)
87    call da_proc_sum_int(ntb22v)
88    call da_proc_sum_int(ntb37v)
89    call da_proc_sum_int(ntb37h)
90    call da_proc_sum_int(ntb85v)
91    call da_proc_sum_int(ntb85h)
93    call da_proc_stats_combine(stats%average%tb19v, stats%rms_err%tb19v, &
94       stats%minimum%tb19v%value, stats%maximum%tb19v%value, &
95       stats%minimum%tb19v%n, stats%maximum%tb19v%n, &
96       stats%minimum%tb19v%l, stats%maximum%tb19v%l)
98    call da_proc_stats_combine(stats%average%tb19h, stats%rms_err%tb19h, &
99       stats%minimum%tb19h%value, stats%maximum%tb19h%value, &
100       stats%minimum%tb19h%n, stats%maximum%tb19h%n, &
101       stats%minimum%tb19h%l, stats%maximum%tb19h%l)
103    call da_proc_stats_combine(stats%average%tb22v, stats%rms_err%tb22v, &
104       stats%minimum%tb22v%value, stats%maximum%tb22v%value, &
105       stats%minimum%tb22v%n, stats%maximum%tb22v%n, &
106       stats%minimum%tb22v%l, stats%maximum%tb22v%l)
108    call da_proc_stats_combine(stats%average%tb37v, stats%rms_err%tb37v, &
109       stats%minimum%tb37v%value, stats%maximum%tb37v%value, &
110       stats%minimum%tb37v%n, stats%maximum%tb37v%n, &
111       stats%minimum%tb37v%l, stats%maximum%tb37v%l)
113    call da_proc_stats_combine(stats%average%tb37h, stats%rms_err%tb37h, &
114       stats%minimum%tb37h%value, stats%maximum%tb37h%value, &
115       stats%minimum%tb37h%n, stats%maximum%tb37h%n, &
116       stats%minimum%tb37h%l, stats%maximum%tb37h%l)
118    call da_proc_stats_combine(stats%average%tb85v, stats%rms_err%tb85v, &
119       stats%minimum%tb85v%value, stats%maximum%tb85v%value, &
120       stats%minimum%tb85v%n, stats%maximum%tb85v%n, &
121       stats%minimum%tb85v%l, stats%maximum%tb85v%l)
123    call da_proc_stats_combine(stats%average%tb85h, stats%rms_err%tb85h, &
124       stats%minimum%tb85h%value, stats%maximum%tb85h%value, &
125       stats%minimum%tb85h%n, stats%maximum%tb85h%n, &
126       stats%minimum%tb85h%l, stats%maximum%tb85h%l)
128    if (rootproc) then
129       if (ntb19v > 0) then
130          write(unit=stats_unit, fmt='(/a/)') ' Diagnostics of OI for ssmi_tb'
131          write(unit=stats_unit, fmt='(a/)') '   var           tb19v(m/s)     n'
132          write(unit=stats_unit, fmt='(a,i14)') '  Number: ', ntb19v
133          write(unit=stats_unit, fmt='(a, f12.4,i9)') &
134             ' Minimum(n): ', stats%minimum%tb19v%value, stats%minimum%tb19v%n    , &
135             ' Maximum(n): ', stats%maximum%tb19v%value, stats%maximum%tb19v%n
136          write(unit=stats_unit, fmt='(a, f12.4,5x)') &
137             ' Average   : ', stats%average%tb19v/real(ntb19v), &
138             '    RMSE   : ', sqrt(stats%rms_err%tb19v/real(ntb19v))
139       end if
141       if (ntb19h > 0) then
142          write(unit=stats_unit, fmt='(/a/)') ' Diagnostics of OI for ssmi_tb'
143          write(unit=stats_unit, fmt='(a/)') '   var           tb19h(m/s)     n'
144          write(unit=stats_unit, fmt='(a,i14)') '  Number: ', ntb19h
145          write(unit=stats_unit, fmt='(a, f12.4,i9)') &
146             ' Minimum(n): ', stats%minimum%tb19h%value, stats%minimum%tb19h%n    , &
147             ' Maximum(n): ', stats%maximum%tb19h%value, stats%maximum%tb19h%n
148          write(unit=stats_unit, fmt='(a, f12.4,5x)') &
149             ' Average   : ', stats%average%tb19h/real(ntb19h), &
150             '    RMSE   : ', sqrt(stats%rms_err%tb19h/real(ntb19h))
151       end if
153       if (ntb22v > 0) then
154          write(unit=stats_unit, fmt='(/a/)') ' Diagnostics of OI for ssmi_tb'
155          write(unit=stats_unit, fmt='(a/)') '   var           tb22v(m/s)     n'
156          write(unit=stats_unit, fmt='(a,i14)') '  Number: ', ntb22v
157          write(unit=stats_unit, fmt='(a, f12.4,i9)') &
158             ' Minimum(n): ', stats%minimum%tb22v%value, stats%minimum%tb22v%n    , &
159             ' Maximum(n): ', stats%maximum%tb22v%value, stats%maximum%tb22v%n
160           write(unit=stats_unit, fmt='(a, f12.4,5x)') &
161              ' Average   : ', stats%average%tb22v/real(ntb22v), &
162              '    RMSE   : ', sqrt(stats%rms_err%tb22v/real(ntb22v))
163       end if
165       if (ntb37v > 0) then
166          write(unit=stats_unit, fmt='(/a/)') ' Diagnostics of OI for ssmi_tb'
167          write(unit=stats_unit, fmt='(a/)') '   var           tb37v(m/s)     n'
168          write(unit=stats_unit, fmt='(a,i14)') '  Number: ', ntb37v
169          write(unit=stats_unit, fmt='(a, f12.4,i9)') &
170             ' Minimum(n): ', stats%minimum%tb37v%value, stats%minimum%tb37v%n    , &
171             ' Maximum(n): ', stats%maximum%tb37v%value, stats%maximum%tb37v%n
172          write(unit=stats_unit, fmt='(a, f12.4,5x)') &
173             ' Average   : ', stats%average%tb37v/real(ntb37v), &
174             '    RMSE   : ', sqrt(stats%rms_err%tb37v/real(ntb37v))
175       end if
177       if (ntb37h > 0) then
178          write(unit=stats_unit, fmt='(/a/)') ' Diagnostics of OI for ssmi_tb'
179          write(unit=stats_unit, fmt='(a/)') '   var           tb37h(m/s)     n'
180          write(unit=stats_unit, fmt='(a,i14)') '  Number: ', ntb37h
181          write(unit=stats_unit, fmt='(a, f12.4,i9)') &
182             ' Minimum(n): ', stats%minimum%tb37h%value, stats%minimum%tb37h%n    , &
183             ' Maximum(n): ', stats%maximum%tb37h%value, stats%maximum%tb37h%n
184          write(unit=stats_unit, fmt='(a, f12.4,5x)') &
185             ' Average   : ', stats%average%tb37h/real(ntb37h), &
186             '    RMSE   : ', sqrt(stats%rms_err%tb37h/real(ntb37h))
187       end if
189       if (ntb85v > 0) then
190          write(unit=stats_unit, fmt='(/a/)') ' Diagnostics of OI for ssmi_tb'
191          write(unit=stats_unit, fmt='(a/)') '   var           tb85v(m/s)     n'
192          write(unit=stats_unit, fmt='(a,i14)') '  Number: ', ntb85v
193          write(unit=stats_unit, fmt='(a, f12.4,i9)') &
194             ' Minimum(n): ', stats%minimum%tb85v%value, stats%minimum%tb85v%n    , &
195             ' Maximum(n): ', stats%maximum%tb85v%value, stats%maximum%tb85v%n
196          write(unit=stats_unit, fmt='(a, f12.4,5x)') &
197             ' Average   : ', stats%average%tb85v/real(ntb85v), &
198             '    RMSE   : ', sqrt(stats%rms_err%tb85v/real(ntb85v))
199       end if
201       if (ntb85h > 0) then
202          write(unit=stats_unit, fmt='(/a/)') ' Diagnostics of OI for ssmi_tb'
203          write(unit=stats_unit, fmt='(a/)') '   var           tb85h(m/s)     n'
204          write(unit=stats_unit, fmt='(a,i14)') '  Number: ', ntb85h
205          write(unit=stats_unit, fmt='(a, f12.4,i9)') &
206             ' Minimum(n): ', stats%minimum%tb85h%value, stats%minimum%tb85h%n    , &
207             ' Maximum(n): ', stats%maximum%tb85h%value, stats%maximum%tb85h%n
208          write(unit=stats_unit, fmt='(a, f12.4,5x)') &
209             ' Average   : ', stats%average%tb85h/real(ntb85h), &
210             '    RMSE   : ', sqrt(stats%rms_err%tb85h/real(ntb85h))
211       end if
212    end if
214    if (trace_use) call da_trace_exit("da_oi_stats_ssmi_tb")
216 end subroutine da_oi_stats_ssmi_tb