var/da/da_vtox_transforms/da_transform_vtovv.inc

   1 subroutine da_transform_vtovv(grid, cv_size, be, cv, vv &
   2 #if (WRF_CHEM == 1)
   3                         , vchem &
   4 #endif
   5                         )
   6
   7    !-----------------------------------------------------------------------
   8    ! Purpose: TBD
   9    !-----------------------------------------------------------------------
  10
  11    implicit none
  12
  13    type(domain),  intent(inout) :: grid
  14    integer,       intent(in)    :: cv_size ! Size of cv array.
  15    type(be_type), intent(in)    :: be   ! Background error structure.
  16    real,          intent(in)    :: cv(cv_size)   ! control variables.
  17    type(vp_type), intent(inout) :: vv   ! Grid point/EOF equivalent.
  18
  19 #if (WRF_CHEM == 1)
  20    type(xchem_type), optional, intent(inout) :: vchem   ! Grid point/EOF equivalent.
  21    integer :: ic
  22 #endif
  23
  24    integer :: s(4)   ! Index bounds into arrays.
  25    integer :: n      ! Loop counter.
  26    integer :: mz     ! Vertical truncations.
  27    integer :: ne     ! Ensemble size.
  28
  29    logical :: scaling
  30
  31    scaling = .false.
  32
  33    if (trace_use) call da_trace_entry("da_transform_vtovv")
  34
  35    if( use_rf )then
  36       !-------------------------------------------------------------------------
  37       ! [1.0] Fill vv arrays from 1-dimensional cv array.
  38       !-------------------------------------------------------------------------
  39 #if (WRF_CHEM == 1)
  40       if (present(vchem)) then
  41          call da_cv_to_vv(cv_size, cv, be%cv_mz, be%ncv_mz, vv, be%cv_mz_chemic, vchem=vchem)
  42       else
  43 #endif
  44          call da_cv_to_vv(cv_size, cv, be%cv_mz, be%ncv_mz, vv)
  45 #if (WRF_CHEM == 1)
  46       end if
  47 #endif
  48    endif
  49    if( .not. use_rf .or. do_normalize ) s(1:2)=1
  50
  51    !-------------------------------------------------------------------------
  52    ! [2.0] Perform VToVV Transform:
  53    !-------------------------------------------------------------------------
  54
  55    ! [2.1] Transform 1st control variable:
  56
  57    mz = be % v1 % mz
  58    s(3)=s(1)+mz-1
  59    if( use_rf .and. mz > 0 .and. len_scaling1(1) /= 0.0) then
  60       call da_transform_through_rf(grid, mz, be % v1 % rf_alpha, be % v1 % val, vv % v1)
  61    elseif( mz > 0 ) then
  62       s(4)=s(2)+nij(0,0,2)*nij(0,1,2)*mz-1
  63       call da_transform_through_wavelet(grid,mz,be%wsd(:,:,s(1):s(3)),cv(s(2):s(4)),vv%v1)
  64       s(2)=s(4)+1
  65    else
  66 !      print'(a,": be%v1%mz=",I0)',__FILE__,mz
  67    endif
  68    if( do_normalize )call da_transform_rescale(mz,be%sd(:,:,s(1):s(3)),vv%v1)
  69    s(1)=s(3)+1
  70
  71    ! [2.2] Transform 2nd control variable:
  72
  73    mz = be % v2 % mz
  74    s(3)=s(1)+mz-1
  75    if( use_rf .and. mz > 0 .and. len_scaling2(1) /= 0.0) then
  76       call da_transform_through_rf(grid, mz, be % v2 % rf_alpha, be % v2 % val, vv % v2)
  77    elseif( mz > 0 ) then
  78       s(4)=s(2)+nij(0,0,2)*nij(0,1,2)*mz-1
  79       call da_transform_through_wavelet(grid,mz,be%wsd(:,:,s(1):s(3)),cv(s(2):s(4)),vv%v2)
  80       s(2)=s(4)+1
  81    else
  82 !      print'(a,": be%v2%mz=",I0)',__FILE__,mz
  83    endif
  84    if( do_normalize )call da_transform_rescale(mz,be%sd(:,:,s(1):s(3)),vv%v2)
  85    s(1)=s(3)+1
  86
  87    ! [2.3] Transform 3rd control variable
  88
  89    mz = be % v3 % mz
  90    s(3)=s(1)+mz-1
  91    if( use_rf .and. mz > 0 .and. len_scaling3(1) /= 0.0) then
  92       call da_transform_through_rf(grid, mz, be % v3 % rf_alpha,be % v3 % val, vv % v3)
  93    elseif( mz > 0 ) then
  94       s(4)=s(2)+nij(0,0,2)*nij(0,1,2)*mz-1
  95       call da_transform_through_wavelet(grid,mz,be%wsd(:,:,s(1):s(3)),cv(s(2):s(4)),vv%v3)
  96       s(2)=s(4)+1
  97    else
  98 !      print'(a,": be%v3%mz=",I0)',__FILE__,mz
  99    endif
 100    if( do_normalize )call da_transform_rescale(mz,be%sd(:,:,s(1):s(3)),vv%v3)
 101    s(1)=s(3)+1
 102
 103    ! [2.4] Transform 4th control variable
 104
 105    mz = be % v4 % mz
 106    s(3)=s(1)+mz-1
 107    if( use_rf .and. mz > 0 .and. len_scaling4(1) /= 0.0) then
 108       call da_transform_through_rf(grid, mz, be % v4 % rf_alpha, be % v4 % val, vv % v4)
 109    elseif( mz > 0 ) then
 110       s(4)=s(2)+nij(0,0,2)*nij(0,1,2)*mz-1
 111       call da_transform_through_wavelet(grid,mz,be%wsd(:,:,s(1):s(3)),cv(s(2):s(4)),vv%v4)
 112       s(2)=s(4)+1
 113    else
 114 !      print'(a,": be%v4%mz=",I0)',__FILE__,mz
 115    endif
 116    if( do_normalize )call da_transform_rescale(mz,be%sd(:,:,s(1):s(3)),vv%v4)
 117    s(1)=s(3)+1
 118
 119    ! [2.5] Transform 5th control variable
 120
 121    mz = be % v5 % mz
 122    s(3)=s(1)+mz-1
 123    if( use_rf .and. mz > 0 .and. len_scaling5(1) /= 0.0) then
 124       call da_transform_through_rf(grid, mz, be % v5 % rf_alpha, be % v5 % val, vv % v5)
 125    elseif( mz > 0 ) then
 126       s(4)=s(2)+nij(0,0,2)*nij(0,1,2)*mz-1
 127       call da_transform_through_wavelet(grid,mz,be%wsd(:,:,s(1):s(3)),cv(s(2):s(4)),vv%v5)
 128       s(2)=s(4)+1
 129    else
 130 !      print'(a,": be%v5%mz=",I0)',__FILE__,mz
 131    endif
 132    if( do_normalize )call da_transform_rescale(mz,be%sd(:,:,s(1):s(3)),vv%v5)
 133    s(1)=s(3)+1
 134
 135    if ( .not. use_rf .and. cloud_cv_options > 0 ) then
 136       call da_error(__FILE__,__LINE__,(/"no da_transform_through_wavelet for v6-v11"/))
 137    end if
 138
 139    if ( use_rf .and. cloud_cv_options <= 1 ) then
 140       vv % v6  = 0.0
 141       vv % v7  = 0.0
 142       vv % v8  = 0.0
 143       vv % v9  = 0.0
 144       vv % v10 = 0.0
 145       vv % v11 = 0.0
 146    end if
 147
 148    ! [2.6] Transform 6th-10th cloud control variables
 149
 150    if ( use_rf .and. cloud_cv_options >= 2 ) then
 151       select case ( cloud_cv_options )
 152          case ( 2 )
 153 !hcl-check array index of len_scaling
 154             mz = be % v6 % mz
 155             if ( mz > 0 .and. len_scaling6(1) > 0.0 ) then
 156                call da_transform_through_rf(grid, mz, be % v6 % rf_alpha, be % v6 % val, vv % v6)
 157             end if
 158             mz = be % v7 % mz
 159             if ( mz > 0 .and. len_scaling7(1) > 0.0 ) then
 160                call da_transform_through_rf(grid, mz, be % v7 % rf_alpha, be % v7 % val, vv % v7)
 161             end if
 162             mz = be % v8 % mz
 163             if ( mz > 0 .and. len_scaling8(1) > 0.0 ) then
 164                call da_transform_through_rf(grid, mz, be % v8 % rf_alpha, be % v8 % val, vv % v8)
 165             end if
 166             mz = be % v9 % mz
 167             if ( mz > 0 .and. len_scaling9(1) > 0.0 ) then
 168                call da_transform_through_rf(grid, mz, be % v9 % rf_alpha, be % v9 % val, vv % v9)
 169             end if
 170             mz = be % v10 % mz
 171             if ( mz > 0 .and. len_scaling10(1) > 0.0 ) then
 172                call da_transform_through_rf(grid, mz, be % v10 % rf_alpha, be % v10 % val, vv % v10)
 173             end if
 174          case ( 3 )
 175             scaling = .true.
 176             mz = be % v6 % mz
 177             if ( mz > 0 .and. len_scaling6(1) > 0.0 ) then
 178                call da_transform_through_rf(grid, mz, be % v6 % rf_alpha, be % v6 % val, vv % v6, scaling)
 179             end if
 180             mz = be % v7 % mz
 181             if ( mz > 0 .and. len_scaling7(1) > 0.0 ) then
 182                call da_transform_through_rf(grid, mz, be % v7 % rf_alpha, be % v7 % val, vv % v7, scaling)
 183             end if
 184             mz = be % v8 % mz
 185             if ( mz > 0 .and. len_scaling8(1) > 0.0 ) then
 186                call da_transform_through_rf(grid, mz, be % v8 % rf_alpha, be % v8 % val, vv % v8, scaling)
 187             end if
 188             mz = be % v9 % mz
 189             if ( mz > 0 .and. len_scaling9(1) > 0.0 ) then
 190                call da_transform_through_rf(grid, mz, be % v9 % rf_alpha, be % v9 % val, vv % v9, scaling)
 191             end if
 192             mz = be % v10 % mz
 193             if ( mz > 0 .and. len_scaling10(1) > 0.0 ) then
 194                call da_transform_through_rf(grid, mz, be % v10 % rf_alpha, be % v10 % val, vv % v10, scaling)
 195             end if
 196       end select
 197    end if
 198
 199    ! [2.7] Transform w control variables
 200
 201    if ( use_rf ) then
 202       if ( .not. use_cv_w ) then
 203          vv % v11 = 0.0
 204       else
 205          mz = be % v11 % mz
 206          if ( mz > 0 .and. len_scaling11(1) > 0.0 ) then
 207             if ( cloud_cv_options == 2 ) then
 208                call da_transform_through_rf(grid, mz, be % v11 % rf_alpha, be % v11 % val, vv % v11)
 209             else if ( cloud_cv_options == 3 ) then
 210                scaling = .true.
 211                call da_transform_through_rf(grid, mz, be % v11 % rf_alpha, be % v11 % val, vv % v11, scaling)
 212             end if
 213          end if
 214       end if
 215    end if
 216
 217    ! [2.8] Transform alpha control variable
 218
 219    ne = be % ne
 220    if (ne > 0) then
 221       mz = be % alpha % mz
 222       if( use_rf )then
 223          do n = 1, ne
 224             if ( anal_type_hybrid_dual_res ) then
 225                call da_transform_through_rf_dual_res(grid%intermediate_grid, mz, be % alpha % rf_alpha, &
 226                              be % alpha % val, vv % alpha(:,:,:,n) )
 227             else
 228                call da_transform_through_rf(grid, mz, be % alpha % rf_alpha, be % alpha % val, vv % alpha(:,:,:,n) )
 229             endif
 230          end do
 231       else
 232          do n = 1, ne
 233             s(4)=s(2)+nij(0,0,2)*nij(0,1,2)*mz-1
 234             call da_transform_through_wavelet(grid,mz,be%alpha%wsd,cv(s(2):s(4)),vv%alpha(:,:,:,n))
 235             s(2)=s(4)+1
 236          end do
 237       endif
 238       if( do_normalize )then
 239          do n = 1, ne
 240             call da_transform_rescale(mz,be%alpha%sd,vv%alpha(:,:,:,n))
 241          end do
 242       endif
 243    endif
 244
 245 #if (WRF_CHEM == 1)
 246    ! [2.10] Transform chem_ic control variables
 247
 248    if (present(vchem)) then
 249    do ic = PARAM_FIRST_SCALAR, num_chem
 250       mz = be % v12 (ic-1) % mz
 251       if( use_rf .and. mz > 0 ) then
 252          call da_transform_through_rf(grid, mz, be % v12 (ic-1) % rf_alpha, &
 253                                                 be % v12 (ic-1) % val, &
 254                                                 vchem % chem_ic (:,:,:,ic))
 255
 256      elseif( .not. use_rf ) then
 257          call da_error(__FILE__,__LINE__,(/"no da_transform_through_wavelet for chem_ic"/))
 258       endif
 259    end do
 260    end if
 261
 262 #endif
 263
 264    if (trace_use) call da_trace_exit("da_transform_vtovv")
 265
 266 endsubroutine da_transform_vtovv