da_get_y_lhs_value.inc

1 subroutine da_get_y_lhs_value (iv, y, partial_lhs, pertile_lhs, adj_ttl_lhs) 
2 
3    !-----------------------------------------------------------------------
4    ! Purpose: TBD
5    !-----------------------------------------------------------------------
6     
7    implicit none
8    
9    type(iv_type), intent(in)    :: iv    ! ob. increment vector.
10    type(y_type),  intent(inout) :: y     ! y = h(xa)
11    real,          intent(out)   :: partial_lhs, pertile_lhs, adj_ttl_lhs
12 
13    if (trace_use) call da_trace_entry("da_get_y_lhs_value")
14 
15    partial_lhs = 0.0
16    pertile_lhs = 0.0
17 
18    if (iv%info(sound)%nlocal > 0)  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 (iv%info(synop)%nlocal          > 0) call da_check_xtoy_adjoint_synop    (iv, y, partial_lhs, pertile_lhs) 
24    if (iv%info(geoamv)%nlocal         > 0) call da_check_xtoy_adjoint_geoamv   (iv, y, partial_lhs, pertile_lhs) 
25    if (iv%info(polaramv)%nlocal       > 0) call da_check_xtoy_adjoint_polaramv (iv, y, partial_lhs, pertile_lhs) 
26    if (iv%info(airep)%nlocal          > 0) call da_check_xtoy_adjoint_airep    (iv, y, partial_lhs, pertile_lhs) 
27    if (iv%info(pilot)%nlocal          > 0) call da_check_xtoy_adjoint_pilot    (iv, y, partial_lhs, pertile_lhs) 
28    if (iv%info(radar)%nlocal          > 0) call da_check_xtoy_adjoint_radar    (iv, y, partial_lhs, pertile_lhs) 
29    if (iv%info(satem)%nlocal          > 0) call da_check_xtoy_adjoint_satem    (iv, y, partial_lhs, pertile_lhs) 
30    if (iv%info(metar)%nlocal          > 0) call da_check_xtoy_adjoint_metar    (iv, y, partial_lhs, pertile_lhs) 
31    if (iv%info(ships)%nlocal          > 0) call da_check_xtoy_adjoint_ships    (iv, y, partial_lhs, pertile_lhs) 
32    if (iv%info(gpspw)%nlocal          > 0) call da_check_xtoy_adjoint_gpspw    (iv, y, partial_lhs, pertile_lhs) 
33    if (iv%info(gpsref)%nlocal         > 0) call da_check_xtoy_adjoint_gpsref   (iv, y, partial_lhs, pertile_lhs) 
34    if (iv%info(ssmi_tb)%nlocal        > 0) call da_check_xtoy_adjoint_ssmi_tb  (iv, y, partial_lhs, pertile_lhs)
35    if (iv%info(ssmi_rv)%nlocal > 0) call da_check_xtoy_adjoint_ssmi_rv  (iv, y, partial_lhs, pertile_lhs) 
36    if (iv%info(ssmt2)%nlocal          > 0) call da_check_xtoy_adjoint_ssmt1    (iv, y, partial_lhs, pertile_lhs) 
37    if (iv%info(ssmt2)%nlocal          > 0) call da_check_xtoy_adjoint_ssmt2    (iv, y, partial_lhs, pertile_lhs) 
38    if (iv%info(qscat)%nlocal          > 0) call da_check_xtoy_adjoint_qscat    (iv, y, partial_lhs, pertile_lhs) 
39    if (iv%info(profiler)%nlocal       > 0) call da_check_xtoy_adjoint_profiler (iv, y, partial_lhs, pertile_lhs) 
40    if (iv%info(buoy)%nlocal           > 0) call da_check_xtoy_adjoint_buoy     (iv, y, partial_lhs, pertile_lhs) 
41    if (iv%info(bogus)%nlocal          > 0) call da_check_xtoy_adjoint_bogus    (iv, y, partial_lhs, pertile_lhs) 
42 
43    ! FIX? consider using dm_sum_real
44 #ifdef DM_PARALLEL
45    call mpi_allreduce( partial_lhs, adj_ttl_lhs, 1, true_mpi_real, mpi_sum, comm, ierr) 
46 #else
47    adj_ttl_lhs = partial_lhs
48 #endif
49 
50    if (trace_use) call da_trace_exit("da_get_y_lhs_value")
51    
52 end subroutine da_get_y_lhs_value
53 
54