var/da/da_setup_structures/da_chgvres.inc

   1 subroutine da_chgvres(nlath,nsig,kz,sigmah,sigma_avn,&
   2    corz_avn,cord_avn,corh_avn,corq_avn,hwll_avn,vztdq_avn,agv_avn,bv_avn,wgv_avn,&
   3    corz_kz, cord_kz, corh_kz, corq_kz, hwll_kz, vztdq_kz, agv_kz, bv_kz, wgv_kz)
   4
   5    !---------------------------------------------------------------------------
   6    ! Purpose: Change vertical resolution of background stats for cv_options=3
   7    !---------------------------------------------------------------------------
   8
   9    implicit none
  10
  11    integer, intent(in) :: nlath,nsig,kz
  12    real, intent(in)    ::  sigmah(kz),sigma_avn(1:nsig)
  13
  14    real, intent(out) :: corz_kz(1:2*nlath+1,1:kz),cord_kz(1:2*nlath+1,1:kz)
  15    real, intent(out) :: corh_kz(1:2*nlath+1,1:kz),corq_kz(1:2*nlath+1,1:kz)
  16    real, intent(out) :: hwll_kz(0:nlath*2+1,1:kz,1:4)
  17    real, intent(out) :: vztdq_kz(1:kz,0:nlath*2+1,1:4)
  18    real, intent(out) :: agv_kz(0:nlath*2+1,1:kz,1:kz)
  19    real, intent(out) :: bv_kz(0:nlath*2+1,1:kz),wgv_kz(0:nlath*2+1,1:kz)
  20
  21    real, intent(in) :: corz_avn(1:2*nlath+1,1:nsig),cord_avn(1:2*nlath+1,1:nsig)
  22    real, intent(in) :: corh_avn(1:2*nlath+1,1:nsig),corq_avn(1:2*nlath+1,1:nsig)
  23    real, intent(in) :: hwll_avn(0:nlath*2+1,1:nsig,1:4)
  24    real, intent(in) :: vztdq_avn(1:nsig,0:nlath*2+1,1:4)
  25    real, intent(in) :: agv_avn(0:nlath*2+1,1:nsig,1:nsig)
  26    real, intent(in) :: bv_avn(0:nlath*2+1,1:nsig),wgv_avn(0:nlath*2+1,1:nsig)
  27
  28    integer :: i,j,k,m,l,l1,m1,n
  29    real    :: rsigo(nsig),rsig(kz)
  30    real    :: coef1(kz),coef2(kz)
  31    integer :: lsig(kz)
  32
  33    if (trace_use) call da_trace_entry("da_chgvres")
  34
  35    if (kz==nsig) then
  36       corz_kz=corz_avn
  37       cord_kz=cord_avn
  38       corh_kz=corh_avn
  39       corq_kz=corq_avn
  40       hwll_kz=hwll_avn
  41       vztdq_kz=vztdq_avn
  42       agv_kz=agv_avn
  43       bv_kz=bv_avn
  44       wgv_kz=wgv_avn
  45       if (trace_use) call da_trace_exit("da_chgvres")
  46       return
  47    end if
  48
  49    do k=1,kz
  50       rsig(k)=log(sigmah(k))
  51    end do
  52    do k=1,nsig
  53       rsigo(k)=log(sigma_avn(k))
  54    end do
  55
  56    do k=1,kz
  57       if (rsig(k).ge.rsigo(1)) then
  58         m=1
  59         m1=2
  60         lsig(k)=1
  61         coef1(k)=1.0
  62            coef2(k)=0.0
  63       else if (rsig(k).lt.rsigo(nsig)) then
  64          m=nsig-1
  65          m1=nsig
  66          lsig(k)=nsig-1
  67          coef1(k)=0.0
  68          coef2(k)=1.0
  69       else
  70          do m=1,nsig
  71             m1=m+1
  72             if ((rsig(k).le.rsigo(m))   .and.  &
  73                 (rsig(k).gt.rsigo(m1))    )then
  74                lsig(k)=m
  75                go to 2345
  76             end if
  77          end do
  78 2345     continue
  79          coef1(k)=(rsigo(m1)-rsig(k))/(rsigo(m1)-rsigo(m))
  80          coef2(k)=1.0-coef1(k)
  81          if (lsig(k)==nsig) then
  82             lsig(k)=nsig-1
  83             coef2(k)=1.0
  84             coef1(k)=0.0
  85          end if
  86       end if
  87    end do
  88
  89    ! agv wgv bv
  90    do k=1,kz
  91       m=lsig(k)
  92       m1=m+1
  93       do i=1,nlath*2
  94          wgv_kz(i,k)=wgv_avn(i,m)*coef1(k)+wgv_avn(i,m1)*coef2(k)
  95          bv_kz(i,k)=bv_avn(i,m)*coef1(k)+bv_avn(i,m1)*coef2(k)
  96       end do
  97
  98       do j=1,kz
  99          l=lsig(j)
 100          l1=l+1
 101          do i=1,nlath*2
 102             agv_kz(i,j,k)=(agv_avn(i,l,m)*coef1(j)+agv_avn(i,l1,m)*coef2(j))*coef1(k) &
 103                     +(agv_avn(i,l,m1)*coef1(j)+agv_avn(i,l1,m1)*coef2(j))*coef2(k)
 104          end do
 105       end do
 106    end do
 107
 108    agv_kz(0,:,:)=agv_kz(1,:,:)
 109    wgv_kz(0,:)=wgv_kz(1,:)
 110    bv_kz(0,:)=bv_kz(1,:)
 111    agv_kz(nlath*2+1,:,:)=agv_kz(nlath*2,:,:)
 112    wgv_kz(nlath*2+1,:)=wgv_kz(nlath*2,:)
 113    bv_kz(nlath*2+1,:)=bv_kz(nlath*2,:)
 114
 115    do k=1,kz
 116       m=lsig(k)
 117       m1=m+1
 118
 119       ! corz,cord,corh,corq
 120       do i=1,nlath*2
 121          corz_kz(i,k)=corz_avn(i,m)*coef1(k)+corz_avn(i,m1)*coef2(k)
 122          cord_kz(i,k)=cord_avn(i,m)*coef1(k)+cord_avn(i,m1)*coef2(k)
 123          corh_kz(i,k)=corh_avn(i,m)*coef1(k)+corh_avn(i,m1)*coef2(k)
 124          corq_kz(i,k)=corq_avn(i,m)*coef1(k)+corq_avn(i,m1)*coef2(k)
 125       end do
 126
 127       do n=1,4
 128          do i=1,nlath*2
 129             ! hwll
 130             hwll_kz(i,k,n)=hwll_avn(i,m,n)*coef1(k)+hwll_avn(i,m1,n)*coef2(k)
 131             ! vztdq
 132             vztdq_kz(k,i,n)=vztdq_avn(m,i,n)*coef1(k)+vztdq_avn(m1,i,n)*coef2(k)
 133           end do
 134       end do
 135    end do
 136
 137    if (trace_use) call da_trace_exit("da_chgvres")
 138
 139 end subroutine da_chgvres
 140
 141