<HTML> <BODY BGCOLOR=#ccccdd LINK=#0000aa VLINK=#0000ff ALINK=#ff0000 ><BASE TARGET="bottom_target"><PRE>
<A NAME='DA_TRANSFORM_VTOY'><A href='../../html_code/minimisation/da_transform_vtoy.inc.html#DA_TRANSFORM_VTOY' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
subroutine da_transform_vtoy(cv_size, be, ep, cv, iv, vp, vv, vp6, vv6, xbx, & 5,19
y, grid, config_flags)
!----------------------------------------------------------------------
! Purpose: Does transform of control variable (V) to Obs-space (Y)
!----------------------------------------------------------------------
implicit none
integer, intent(in) :: cv_size ! Size of cv array.
type(be_type), intent(in) :: be ! background error structure.
type(ep_type), intent(in) :: ep ! Ensemble perturbation structure.
real, intent(in) :: cv(1:cv_size) ! control variables.
type(iv_type), intent(inout) :: iv ! innovation vector (o-b).
type(vp_type), intent(inout) :: vp ! Grdipt/level CV.
type(vp_type), intent(inout) :: vp6 ! Grdipt/level CV for 6h.
type(vp_type), intent(inout) :: vv ! Grdipt/EOF CV.
type(vp_type), intent(inout) :: vv6 ! Grdipt/EOF CV for 6h.
type(xbx_type), intent(inout) :: xbx ! For header & non-grid arrays.
type(y_type), intent(inout) :: y ! y = H(x_inc).
type(domain), intent(inout) :: grid
type(grid_config_rec_type), intent(inout) :: config_flags
type(x_type) :: shuffle
integer :: nobwin, jl_start, jl_end, time_step_seconds
character(len=4) :: filnam
character(len=256) :: timestr, timestr1
real, dimension(:,:,:), allocatable :: hr_rainc, hr_rainnc
real, dimension(:,:,:), allocatable :: g_rainc, g_rainnc
if (trace_use) call da_trace_entry
("da_transform_vtoy")
if (var4d) then
#ifdef VAR4D
call da_transform_vtox(grid, be%cv%size_jb, xbx, be, ep, cv(1:be%cv%size_jb), vv, vp)
call domain_clock_get( grid, start_timestr=timestr )
call da_transfer_xatowrftl(grid, config_flags, 'tl01', timestr)
if ( var4d_lbc ) then
call domain_clock_get (grid, stop_timestr=timestr1)
call domain_clock_set( grid, current_timestr=timestr1 )
grid%u_2 = u6_2 ; grid%v_2 = v6_2; grid%t_2 = t6_2;
grid%w_2 = w6_2 ; grid%mu_2 = mu6_2 ; grid%ph_2 =ph6_2
grid%moist = moist6; grid%p = p6; grid%psfc = psfc6
call da_transfer_wrftoxb(xbx, grid, config_flags)
shuffle = grid%xa
jl_start = be%cv%size_jb + be%cv%size_je + be%cv%size_jp + 1
jl_end = be%cv%size_jb + be%cv%size_je + be%cv%size_jp + be%cv%size_jl
grid%xa = grid%x6a
call da_transform_vtox(grid, be%cv%size_jl, xbx, be, ep, cv(jl_start:jl_end), vv6, vp6)
grid%xa = shuffle
call da_transfer_xatowrftl_lbc(grid, config_flags, 'tl01')
call domain_clock_get( grid, start_timestr=timestr1 )
call domain_clock_set( grid, current_timestr=timestr1 )
call da_read_basicstates ( xbx, grid, config_flags, timestr1 )
else
call da_transfer_xatowrftl_lbc(grid, config_flags, 'tl01')
endif
call da_tl_model
if (num_fgat_time > 1 .and. use_rainobs) then
! Buffer to save var4d_bin_rain rainfall
allocate (hr_rainc (ims:ime,jms:jme,1:num_fgat_time))
allocate (hr_rainnc(ims:ime,jms:jme,1:num_fgat_time))
hr_rainc =0.0
hr_rainnc=0.0
! Buffer to save accumulated rainfall
allocate (g_rainc (ims:ime,jms:jme,1:num_fgat_time))
allocate (g_rainnc(ims:ime,jms:jme,1:num_fgat_time))
g_rainc =0.0
g_rainnc=0.0
endif
if ( num_fgat_time > 1 ) then
call domain_clock_get (grid, stop_timestr=timestr1)
call domain_clock_set( grid, current_timestr=timestr1 )
call domain_clock_set (grid, time_step_seconds=-1*var4d_bin)
call domain_clockprint(150, grid, 'get CurrTime from clock,')
endif
do nobwin= num_fgat_time, 1 , -1
call domain_clock_get( grid, current_timestr=timestr )
call da_read_basicstates ( xbx, grid, config_flags, timestr )
iv%time = nobwin
iv%info(:)%n1 = iv%info(:)%plocal(iv%time-1) + 1
iv%info(:)%n2 = iv%info(:)%plocal(iv%time)
if ( use_rad ) then
iv%instid(:)%info%n1 = iv%instid(:)%info%plocal(iv%time-1) + 1
iv%instid(:)%info%n2 = iv%instid(:)%info%plocal(iv%time)
end if
write(filnam,'(a2,i2.2)') 'tl',nobwin
call da_zero_x(grid%xa)
call da_transfer_wrftltoxa(grid, config_flags, filnam, timestr)
if ( use_rainobs ) then
g_rainc (:,:,nobwin)=grid%g_rainc(:,:)
g_rainnc(:,:,nobwin)=grid%g_rainnc(:,:)
endif
call da_transform_xtoxa(grid)
call da_transform_xtoy(cv_size, cv, grid, iv, y)
if ( nobwin > 1 ) call domain_clockadvance (grid) ! We don't need the advance at the last step
call domain_clockprint(150, grid, 'DEBUG : get CurrTime from clock,')
end do
! Caculate var4d_bin_rain rainfall
if (num_fgat_time > 1 .and. use_rainobs) then
do nobwin=num_fgat_time, 1, -1
if ( .not. fgat_rain_flags(nobwin) ) cycle
if (nobwin .lt. num_fgat_time) then
hr_rainc (:,:,nobwin+INT(var4d_bin_rain/var4d_bin))= &
hr_rainc (:,:,nobwin+INT(var4d_bin_rain/var4d_bin))-g_rainc(:,:,nobwin)
hr_rainnc(:,:,nobwin+INT(var4d_bin_rain/var4d_bin))= &
hr_rainnc(:,:,nobwin+INT(var4d_bin_rain/var4d_bin))-g_rainnc(:,:,nobwin)
else
hr_rainc (:,:,nobwin)=g_rainc(:,:,nobwin)
hr_rainnc(:,:,nobwin)=g_rainnc(:,:,nobwin)
endif
end do
endif
if (iv%info(rain)%nlocal > 0 .and. num_fgat_time > 1) then
do nobwin=num_fgat_time, 1, -1
iv%time = nobwin
iv%info(rain)%n1 = iv%info(rain)%plocal(iv%time-1) + 1
iv%info(rain)%n2 = iv%info(rain)%plocal(iv%time)
call da_transform_xtoy_rain( grid, iv, y, hr_rainc(:,:,nobwin), hr_rainnc(:,:,nobwin))
end do
endif
if ( num_fgat_time > 1 ) then
call nl_get_time_step ( grid%id, time_step_seconds)
call domain_clock_set (grid, time_step_seconds=time_step_seconds)
call domain_clockprint(150, grid, 'get CurrTime from clock,')
endif
if (num_fgat_time > 1 .and. use_rainobs) then
deallocate (hr_rainc )
deallocate (hr_rainnc)
deallocate (g_rainc )
deallocate (g_rainnc)
endif
#endif
else ! not var4d
call da_transform_vtox(grid, cv_size, xbx, be, ep, cv, vv, vp)
iv%info(:)%n1 = 1
iv%info(:)%n2 = iv%info(:)%nlocal
if ( use_rad ) then
iv%instid(:)%info%n1 = 1
iv%instid(:)%info%n2 = iv%instid(:)%num_rad
end if
call da_transform_xtoxa(grid)
call da_transform_xtoy(cv_size, cv, grid, iv, y)
end if ! var4d
!--------------------------------------------------------------
! TL of Variational Bias Correction
!--------------------------------------------------------------
#if defined(RTTOV) || defined(CRTM)
if (use_varbc) call da_varbc_tl(cv_size, cv, iv, y)
#endif
if (trace_use) call da_trace_exit("da_transform_vtoy")
end subroutine da_transform_vtoy