<HTML> <BODY BGCOLOR=#ccccdd LINK=#0000aa VLINK=#0000ff ALINK=#ff0000 ><BASE TARGET="bottom_target"><PRE>
<A NAME='DA_INTERPOLATE_REGCOEFF'><A href='../../html_code/setup_structures/da_interpolate_regcoeff.inc.html#DA_INTERPOLATE_REGCOEFF' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
subroutine da_interpolate_regcoeff (iy, iys, kz, kzs, meanl_stats, meanl_xb, meanp_stats, meanp_xb, &,6
pb_vert_reg_stats, pb_vert_reg)
!---------------------------------------------------------------------------
! Purpose: Interpolate statistical regression coefficient to new domain.
!
! Method: i,k,k Interpolation.
!---------------------------------------------------------------------------
implicit none
integer, intent(in) :: iy ! Number of rows in xb.
integer, intent(in) :: iys ! Number of rows in stats.
integer, intent(in) :: kz ! Number of levels in xb.
integer, intent(in) :: kzs ! Number of levels in stats.
real, intent(in) :: meanl_stats(:) ! Mean latitude on stats rows.
real, intent(in) :: meanl_xb(:) ! Mean latitude on xb rows.
real, intent(in) :: meanp_stats(:) ! Mean pressure on stats levs.
real, intent(in) :: meanp_xb(:) ! Mean pressure on xb levs.
real*8, intent(in) :: pb_vert_reg_stats(:,:,:) ! Coefficient on stats grid.
real*8, intent(out) :: pb_vert_reg(:,:,:) ! Coefficient on xb grid.
integer :: i, is, i_south ! Loop counters.
integer :: k1, k2, k, ks ! Loop counters.
integer :: k1s, k2s
real :: lat_wgt
integer :: k_above(1:kz)
real :: pb_vert_reg_temp(1:iys,1:kz,1:kz)
real :: weight(1:kz)
if (trace_use) call da_trace_entry
("da_interpolate_regcoeff")
pb_vert_reg = 0.0
!------------------------------------------------------------------------
! [1.0] Find xb levels/rows bounded by stats domain:
!------------------------------------------------------------------------
do k = 1, kz
if (meanp_xb(k) <= meanp_stats(1)) then
weight(k) = 1.0e-6
k_above(k) = 1
else if (meanp_xb(k) >= meanp_stats(kzs)) then
weight(k) = 1.0-1.0e-6
k_above(k) = kzs-1
else
do ks = 1, kzs-1
if (meanp_xb(k) >= meanp_stats(ks) .AND. meanp_xb(k) <= meanp_stats(ks+1)) then
weight(k) = (meanp_xb(k) - meanp_stats(ks)) / (meanp_stats(ks+1) - meanp_stats(ks))
k_above(k) = ks
exit
end if
end do
end if
end do
!------------------------------------------------------------------------
! [3.0] Interpolate regression coefficient from stats to xb levels:
!------------------------------------------------------------------------
pb_vert_reg_temp(1:iys,1:kz,1:kz) = 0.0
do is = 1, iys
do k1 = 1, kz
k1s = k_above(k1)
do k2 = 1, kz
k2s = k_above(k2)
pb_vert_reg_temp(is,k1,k2) = (1.0-weight(k1)) * (1.0-weight(k2)) * &
pb_vert_reg_stats(is,k1s,k2s) + &
weight(k1) * (1.0-weight(k2)) * &
pb_vert_reg_stats(is,k1s+1,k2s) + &
weight(k2) * (1.0-weight(k1)) * &
pb_vert_reg_stats(is,k1s,k2s+1) + &
weight(k2) * weight(k1) * &
pb_vert_reg_stats(is,k1s+1,k2s+1)
end do
end do
end do
!------------------------------------------------------------------------
! [4.0] Interpolate to from statistics latitudes to xb latitudes:
!------------------------------------------------------------------------
i_south = 2
do i = 1, iy
! Find position of xb latitude in statistics rows:
if (meanl_xb(i) <= meanl_stats(2)) then
i_south = 2
lat_wgt = 0.5
else if (meanl_xb(i) >= meanl_stats(iys-1)) then
i_south = iys-2
lat_wgt = 0.5
else
do is = 1, iys-1
if (meanl_xb(i) >= meanl_stats(is) .AND. meanl_xb(i) <= meanl_stats(is+1)) then
lat_wgt = (meanl_xb(i) - meanl_stats(is)) / (meanl_stats(is+1) - meanl_stats(is))
i_south = is
exit
end if
end do
end if
do k1 = 1, kz
do k2 = 1, kz
pb_vert_reg(i,k1,k2) = lat_wgt * pb_vert_reg_temp(i_south+1,k1,k2) + &
(1.0 - lat_wgt) * pb_vert_reg_temp(i_south,k1,k2)
end do
end do
end do
if (print_detail_regression) then
call da_array_print(1, pb_vert_reg_stats(1,:,:), 'pb_vert_reg_stats(1,:,:)')
call da_array_print(1, pb_vert_reg(1,:,:), 'pb_vert_reg(1,:,:)')
call da_array_print(1, pb_vert_reg_stats(:,1,:), 'pb_vert_reg_stats(:,1,:)')
call da_array_print(1, pb_vert_reg(:,1,:), 'pb_vert_reg(:,1,:)')
end if
if (trace_use) call da_trace_exit("da_interpolate_regcoeff")
end subroutine da_interpolate_regcoeff