var/da/da_test/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)  call da_check_xtoy_adjoint_sound( iv, y, partial_lhs, pertile_lhs)
  19    if (iv%info(sonde_sfc)%nlocal > 0) call da_check_xtoy_adjoint_sonde_sfc( iv, y, partial_lhs, pertile_lhs)
  20    if (iv%info(mtgirs)%nlocal         > 0) call da_check_xtoy_adjoint_mtgirs   (iv, y, partial_lhs, pertile_lhs)
  21    if (iv%info(tamdar)%nlocal         > 0) call da_check_xtoy_adjoint_tamdar   (iv, y, partial_lhs, pertile_lhs)
  22    if (iv%info(tamdar_sfc)%nlocal     > 0) call da_check_xtoy_adjoint_tamdar_sfc (iv, y, partial_lhs, pertile_lhs)
  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(gpseph)%nlocal         > 0) call da_check_xtoy_adjoint_gpseph   (iv, y, partial_lhs, pertile_lhs)
  35    if (iv%info(ssmi_tb)%nlocal        > 0) call da_check_xtoy_adjoint_ssmi_tb  (iv, y, partial_lhs, pertile_lhs)
  36    if (iv%info(ssmi_rv)%nlocal        > 0) call da_check_xtoy_adjoint_ssmi_rv  (iv, y, partial_lhs, pertile_lhs)
  37    if (iv%info(ssmt2)%nlocal          > 0) call da_check_xtoy_adjoint_ssmt1    (iv, y, partial_lhs, pertile_lhs)
  38    if (iv%info(ssmt2)%nlocal          > 0) call da_check_xtoy_adjoint_ssmt2    (iv, y, partial_lhs, pertile_lhs)
  39    if (iv%info(qscat)%nlocal          > 0) call da_check_xtoy_adjoint_qscat    (iv, y, partial_lhs, pertile_lhs)
  40    if (iv%info(profiler)%nlocal       > 0) call da_check_xtoy_adjoint_profiler (iv, y, partial_lhs, pertile_lhs)
  41    if (iv%info(buoy)%nlocal           > 0) call da_check_xtoy_adjoint_buoy     (iv, y, partial_lhs, pertile_lhs)
  42    if (iv%info(bogus)%nlocal          > 0) call da_check_xtoy_adjoint_bogus    (iv, y, partial_lhs, pertile_lhs)
  43    if (iv%info(radiance)%nlocal       > 0) call da_check_xtoy_adjoint_rad      (iv, y, partial_lhs, pertile_lhs)
  44    if (iv%info(rain)%nlocal           > 0) call da_check_xtoy_adjoint_rain     (iv, y, partial_lhs, pertile_lhs)
  45    ! FIX? consider using dm_sum_real
  46 #ifdef DM_PARALLEL
  47    call mpi_allreduce( partial_lhs, adj_ttl_lhs, 1, true_mpi_real, mpi_sum, comm, ierr)
  48 #else
  49    adj_ttl_lhs = partial_lhs
  50 #endif
  51
  52    if (trace_use) call da_trace_exit("da_get_y_lhs_value")
  53
  54 end subroutine da_get_y_lhs_value
  55
  56