da_get_y_lhs_value.inc

1 subroutine da_get_y_lhs_value( iv, y, &
2                                partial_lhs, pertile_lhs, adj_ttl_lhs) 
3 
4    !-----------------------------------------------------------------------
5    ! Purpose: TBD
6    !-----------------------------------------------------------------------
7     
8    implicit none
9    
10    type(ob_type),    intent(in)    :: iv    ! ob. increment vector.
11    type(y_type),     intent(inout) :: y     ! y = h(xa)
12 
13    real,              intent(out)   :: partial_lhs, pertile_lhs, adj_ttl_lhs
14 
15    partial_lhs = 0.0
16    pertile_lhs = 0.0
17 
18    if (use_soundobs)  then
19        call da_check_xtoy_adjoint_sound( iv, y, partial_lhs, pertile_lhs) 
20        call da_check_xtoy_adjoint_sonde_sfc( iv, y, partial_lhs, pertile_lhs) 
21    end if
22 
23    if (use_synopobs)  &
24       call da_check_xtoy_adjoint_synop( iv, y, partial_lhs, pertile_lhs) 
25 
26    if (use_geoamvobs)  &
27       call da_check_xtoy_adjoint_geoamv( iv, y, partial_lhs, pertile_lhs) 
28 
29    if (use_polaramvobs)  &
30       call da_check_xtoy_adjoint_polaramv( iv, y, partial_lhs, pertile_lhs) 
31 
32    if (use_airepobs)  &
33       call da_check_xtoy_adjoint_airep( iv, y, partial_lhs, pertile_lhs) 
34 
35    if (use_pilotobs)  &
36       call da_check_xtoy_adjoint_pilot( iv, y, partial_lhs, pertile_lhs) 
37 
38    if (use_radarobs)  &
39       call da_check_xtoy_adjoint_radar( iv, y, partial_lhs, pertile_lhs) 
40 
41    if (use_satemobs)  &
42       call da_check_xtoy_adjoint_satem( iv, y, partial_lhs, pertile_lhs) 
43 
44    if (use_metarobs)  &
45       call da_check_xtoy_adjoint_metar( iv, y, partial_lhs, pertile_lhs) 
46  
47    if (use_shipsobs)  &
48       call da_check_xtoy_adjoint_ships( iv, y, partial_lhs, pertile_lhs) 
49 
50    if (use_gpspwobs)  &
51       call da_check_xtoy_adjoint_gpspw( iv, y, partial_lhs, pertile_lhs) 
52 
53    if (use_gpsrefobs)  &
54       call da_check_xtoy_adjoint_gpsref( iv, y, partial_lhs, pertile_lhs) 
55    
56    if (use_ssmitbobs .or. use_ssmiretrievalobs)  &
57       call da_check_xtoy_adjoint_ssmi( iv, y, partial_lhs, pertile_lhs) 
58 
59    if (use_ssmt1obs)  &
60       call da_check_xtoy_adjoint_ssmt1( iv, y, partial_lhs, pertile_lhs) 
61 
62    if (use_ssmt2obs)  &
63       call da_check_xtoy_adjoint_ssmt2( iv, y, partial_lhs, pertile_lhs) 
64 
65    if (use_qscatobs)  &
66       call da_check_xtoy_adjoint_qscat( iv, y, partial_lhs, pertile_lhs) 
67 
68    if (use_profilerobs)  &
69       call da_check_xtoy_adjoint_profiler( iv, y, partial_lhs, pertile_lhs) 
70 
71    if (use_buoyobs)  &
72       call da_check_xtoy_adjoint_buoy( iv, y, partial_lhs, pertile_lhs) 
73 
74    if (use_bogusobs)  &
75       call da_check_xtoy_adjoint_bogus( iv, y, partial_lhs, pertile_lhs) 
76 
77    ! JRB consider using dm_sum_real
78 #ifdef DM_PARALLEL
79    call mpi_allreduce( partial_lhs, adj_ttl_lhs, 1, true_mpi_real, mpi_sum, &
80                        comm, ierr) 
81 #else
82    adj_ttl_lhs = partial_lhs
83 #endif
84    
85 end subroutine da_get_y_lhs_value
86 
87