Merge remote-tracking branch 'origin/release-v4.5.2'
[WRF.git] / var / da / da_ships / da_oi_stats_ships.inc
blob322353e12a436b441722b46a9bad511e6710ddbf
1 subroutine da_oi_stats_ships (stats_unit, iv, ob)
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
11    type(y_type),   intent (in) :: ob            ! Observation structure.
13    type (stats_ships_type) :: stats
14    integer                 :: nu, nv, nt, np, nq
15    integer                 :: n
16    real                    :: u_inv, v_inv, u_obs, v_obs
18    if (trace_use_dull) call da_trace_entry("da_oi_stats_ships")
20    nu = 0
21    nv = 0
22    nt = 0
23    np = 0
24    nq = 0
26    stats%maximum%u = maxmin_type(missing_r, 0, 0)
27    stats%maximum%v = maxmin_type(missing_r, 0, 0)
28    stats%maximum%t = maxmin_type(missing_r, 0, 0)
29    stats%maximum%p = maxmin_type(missing_r, 0, 0)
30    stats%maximum%q = maxmin_type(missing_r, 0, 0)
31    stats%minimum%u = maxmin_type(-missing_r, 0, 0)
32    stats%minimum%v = maxmin_type(-missing_r, 0, 0)
33    stats%minimum%t = maxmin_type(-missing_r, 0, 0)
34    stats%minimum%p = maxmin_type(-missing_r, 0, 0)
35    stats%minimum%q = maxmin_type(-missing_r, 0, 0)
37    stats%average = residual_ships1_type(0.0, 0.0, 0.0, 0.0, 0.0)
38    stats%rms_err = stats%average
40    do n=1, iv%info(ships)%nlocal
41       if (iv%info(ships)%proc_domain(1,n)) then
43          u_inv = iv%ships(n)%u%inv
44          v_inv = iv%ships(n)%v%inv
45          u_obs = ob%ships(n)%u
46          v_obs = ob%ships(n)%v
48          if (.not. wind_sd_ships .and. wind_stats_sd) &
49             call da_ffdduv_diagnose(u_obs, u_inv, u_obs, v_obs, v_inv, v_obs, &
50                                     iv%ships(n)%u%qc, iv%ships(n)%v%qc, convert_uv2fd)
51          if (wind_sd_ships .and. .not. wind_stats_sd) &
52             call da_ffdduv_diagnose(u_obs, u_inv, u_obs, v_obs, v_inv, v_obs, &
53                                     iv%ships(n)%u%qc, iv%ships(n)%v%qc, convert_fd2uv)
55          call da_stats_calculate(iv%info(ships)%obs_global_index(n), &
56             0, iv%ships(n)%u%qc, &
57             u_inv, nu, &
58             stats%minimum%u, stats%maximum%u, &
59             stats%average%u, stats%rms_err%u)
60          call da_stats_calculate(iv%info(ships)%obs_global_index(n), &
61             0, iv%ships(n)%v%qc, &
62             v_inv, nv, &
63             stats%minimum%v, stats%maximum%v, &
64             stats%average%v, stats%rms_err%v)
65          call da_stats_calculate(iv%info(ships)%obs_global_index(n), &
66             0, iv%ships(n)%t%qc, &
67             iv%ships(n)%t%inv, nt, &
68             stats%minimum%t, stats%maximum%t, &
69             stats%average%t, stats%rms_err%t)
70          call da_stats_calculate(iv%info(ships)%obs_global_index(n), &
71             0, iv%ships(n)%p%qc, &
72             iv%ships(n)%p%inv, np, &
73             stats%minimum%p, stats%maximum%p, &
74             stats%average%p, stats%rms_err%p)
75          call da_stats_calculate(iv%info(ships)%obs_global_index(n), &
76             0, iv%ships(n)%q%qc, &
77             iv%ships(n)%q%inv, nq, &
78             stats%minimum%q, stats%maximum%q, &
79             stats%average%q, stats%rms_err%q)
80       end if    ! end if (iv%info(ships)%proc_domain(1,n))
81    end do
83    ! Do inter-processor communication to gather statistics.
84    call da_proc_sum_int(nu)
85    call da_proc_sum_int(nv)
86    call da_proc_sum_int(nt)
87    call da_proc_sum_int(np)
88    call da_proc_sum_int(nq)
90    call da_proc_stats_combine(stats%average%u, stats%rms_err%u, &
91       stats%minimum%u%value, stats%maximum%u%value, &
92       stats%minimum%u%n, stats%maximum%u%n, &
93       stats%minimum%u%l, stats%maximum%u%l)
94    call da_proc_stats_combine(stats%average%v, stats%rms_err%v, &
95       stats%minimum%v%value, stats%maximum%v%value, &
96       stats%minimum%v%n, stats%maximum%v%n, &
97       stats%minimum%v%l, stats%maximum%v%l)
98    call da_proc_stats_combine(stats%average%t, stats%rms_err%t, &
99       stats%minimum%t%value, stats%maximum%t%value, &
100       stats%minimum%t%n, stats%maximum%t%n, &
101       stats%minimum%t%l, stats%maximum%t%l)
102    call da_proc_stats_combine(stats%average%p, stats%rms_err%p, &
103       stats%minimum%p%value, stats%maximum%p%value, &
104       stats%minimum%p%n, stats%maximum%p%n, &
105       stats%minimum%p%l, stats%maximum%p%l)
106    call da_proc_stats_combine(stats%average%q, stats%rms_err%q, &
107       stats%minimum%q%value, stats%maximum%q%value, &
108       stats%minimum%q%n, stats%maximum%q%n, &
109       stats%minimum%q%l, stats%maximum%q%l)
111    if (rootproc) then
112       if (nu /= 0 .or. nv /= 0 .or. nt /= 0 .or. np /= 0 .or. nq /= 0) then
113          write(unit=stats_unit, fmt='(/a/)') ' Diagnostics of OI for ships'
114          call da_print_stats_ships(stats_unit, nu, nv, nt, np, nq, stats)
115       end if
116    end if
118    if (trace_use_dull) call da_trace_exit("da_oi_stats_ships")
120 end subroutine da_oi_stats_ships