var/da/da_setup_structures/da_chg_be_Vres.inc

   1 SUBROUTINE da_chg_be_Vres(kz, nk, eta_h, eta_be,&
   2                         reg_chi_be,reg_ps_be,reg_t_be, &
   3                         reg_chi   ,reg_ps   ,reg_t   , &
   4                         covm1_be, covm2_be, covm3_be, covm4_be, &
   5                         covm1   , covm2   , covm3   , covm4   , &
   6                         rfls1_be, rfls2_be, rfls3_be, rfls4_be, &
   7                         rfls1, rfls2, rfls3, rfls4)
   8
   9 !------------------------------------------------------------------------------
  10 !  PURPOSE: Change vertical resolution of background stats for cv_options=3
  11 !------------------------------------------------------------------------------
  12    integer, intent(in) :: kz, nk  ! model V-resolution and BE V-resolution
  13    real   , intent(in) :: eta_h(kz), eta_be(nk) ! Eta level definition
  14 !
  15 !  Regression coefficient's arrays:
  16    real, dimension(1:nk),      intent(in) :: reg_chi_be, reg_ps_be
  17    real, dimension(1:nk,1:nk), intent(in) :: reg_t_be
  18    real, dimension(1:kz),      intent(out):: reg_chi   , reg_ps
  19    real, dimension(1:kz,1:kz), intent(out):: reg_t
  20
  21 ! Vertical Convarince matrix arrays:
  22    real, dimension(1:nk,1:nk), intent(in) :: covm1_be, covm2_be, &
  23                                              covm3_be, covm4_be
  24    real, dimension(1:kz,1:kz), intent(out):: covm1   , covm2   , &
  25                                              covm3   , covm4
  26
  27 ! Recursive filter scale-length arrays:
  28    real, dimension(nk),        intent(in) :: rfls1_be, rfls2_be, &
  29                                              rfls3_be, rfls4_be
  30    real, dimension(kz),        intent(out):: rfls1   , rfls2   , &
  31                                              rfls3   , rfls4
  32
  33
  34    integer             :: i,j,k,m,l,l1,m1,n
  35    integer             :: lsig(kz)
  36    real                :: rsig(kz), rsigo(nk)
  37    real                :: coef1(kz),coef2(kz)
  38    logical             :: NO_INTERP
  39 ! ---------------------------------------------------------------------
  40
  41    NO_INTERP = .FALSE.
  42
  43 ! Check if the # of levels and the values of eta are same:
  44 !
  45    NO_INTERP = (kz == nk)
  46    if (NO_INTERP) then
  47       do k = 1, nk
  48         if (abs(eta_h(k)-eta_be(k)) > 1.0e-6) then
  49           NO_INTERP = .FALSE.
  50           exit
  51         endif
  52        enddo
  53    endif
  54
  55    if(NO_INTERP )then
  56 ! Regression coefficients:
  57      reg_chi = reg_chi_be
  58      reg_ps  = reg_ps_be
  59      reg_t   = reg_t_be
  60
  61 ! Vertical covarince matrix:
  62      covm1 = covm1_be
  63      covm2 = covm2_be
  64      covm3 = covm3_be
  65      covm4 = covm4_be
  66
  67 ! Recursive filter scale-length:
  68      rfls1 = rfls1_be
  69      rfls2 = rfls2_be
  70      rfls3 = rfls3_be
  71      rfls4 = rfls4_be
  72
  73      return
  74    endif
  75
  76 !   if (.not.NO_INTERP) then
  77 !     write(6,'(/10X,a/2X,"Model eta levels:")') &
  78 !             "Vertical resolution conversion needed for CV5 BE:::"
  79 !     write(6,'(2X,I3,2X,f10.5)') ( k,eta_h(k),k=1,kz)
  80 !   endif
  81
  82 ! Convert Eta to log(eta):
  83     do k=1,kz
  84       rsig(k)=log(eta_h(k))
  85     enddo
  86     do k=1,nk
  87       rsigo(k)=log(eta_be(k))
  88     enddo
  89
  90 ! Find the coef1 and coef2 for the vertical interpolation:
  91 !
  92   do k=1,kz
  93
  94 ! Model levels below the lowest BE level:
  95   if(rsig(k).ge.rsigo(1))then
  96      m=1
  97      m1=2
  98      lsig(k)=1
  99      coef1(k)=1.
 100      coef2(k)=0.
 101
 102 ! Model levels above the highest BE level:
 103   else if(rsig(k).lt.rsigo(nk))then
 104      m=nk-1
 105      m1=nk
 106      lsig(k)=nk-1
 107      coef1(k)=0.
 108      coef2(k)=1
 109
 110 ! Model levels located within the BE levels:
 111   else
 112      do m=1,nk
 113        m1=m+1
 114        if((rsig(k).le.rsigo(m))   .and.  &
 115           (rsig(k).gt.rsigo(m1))     )then
 116          lsig(k)=m
 117         go to 2345
 118        end if
 119      end do
 120
 121 2345    continue
 122     coef1(k)=(rsigo(m1)-rsig(k))/(rsigo(m1)-rsigo(m))
 123     coef2(k)=1.-coef1(k)
 124      if(lsig(k)==nk)then
 125      lsig(k)=nk-1
 126      coef2(k)=1.
 127      coef1(k)=0.
 128      endif
 129  endif
 130
 131    end do
 132
 133   do k=1,kz
 134     m=lsig(k)
 135     m1=m+1
 136 ! Interpolation for Regression coefficients:
 137       reg_chi(k)=reg_chi_be(m)*coef1(k)+reg_chi_be(m1)*coef2(k)
 138       reg_ps(k) =reg_ps_be (m)*coef1(k)+reg_ps_be(m1) *coef2(k)
 139
 140 ! Recursive filter scale-lengths:
 141       rfls1(k) =rfls1_be (m)*coef1(k)+rfls1_be(m1) *coef2(k)
 142       rfls2(k) =rfls2_be (m)*coef1(k)+rfls2_be(m1) *coef2(k)
 143       rfls3(k) =rfls3_be (m)*coef1(k)+rfls3_be(m1) *coef2(k)
 144       rfls4(k) =rfls4_be (m)*coef1(k)+rfls4_be(m1) *coef2(k)
 145
 146     do j=1,kz
 147       l=lsig(j)
 148       l1=l+1
 149 ! Interpolation for Regression coefficients:
 150         reg_t(j,k)=(reg_t_be(l,m)*coef1(j)+reg_t_be(l1,m)*coef2(j))*coef1(k) &
 151                   +(reg_t_be(l,m1)*coef1(j)+reg_t_be(l1,m1)*coef2(j))*coef2(k)
 152 ! Vertical covariance matrix:
 153         covm1(j,k)=(covm1_be(l,m)*coef1(j)+covm1_be(l1,m)*coef2(j))*coef1(k) &
 154                   +(covm1_be(l,m1)*coef1(j)+covm1_be(l1,m1)*coef2(j))*coef2(k)
 155         covm2(j,k)=(covm2_be(l,m)*coef1(j)+covm2_be(l1,m)*coef2(j))*coef1(k) &
 156                   +(covm2_be(l,m1)*coef1(j)+covm2_be(l1,m1)*coef2(j))*coef2(k)
 157         covm3(j,k)=(covm3_be(l,m)*coef1(j)+covm3_be(l1,m)*coef2(j))*coef1(k) &
 158                   +(covm3_be(l,m1)*coef1(j)+covm3_be(l1,m1)*coef2(j))*coef2(k)
 159         covm4(j,k)=(covm4_be(l,m)*coef1(j)+covm4_be(l1,m)*coef2(j))*coef1(k) &
 160                   +(covm4_be(l,m1)*coef1(j)+covm4_be(l1,m1)*coef2(j))*coef2(k)
 161     enddo
 162   enddo
 163
 164 !--------------------------------------------------------------------
 165 end subroutine da_chg_be_Vres