wrfv2_fire/var/da/da_vtox_transforms/da_apply_be.inc

   1 SUBROUTINE da_apply_be( be, cv, vp, grid )
   2
   3    IMPLICIT NONE
   4
   5    TYPE (be_type), INTENT(IN)           :: be   ! Background error structure.
   6    REAL, INTENT(IN)                     :: cv(:)! Control variable.
   7    TYPE (vp_type), INTENT(INOUT)        :: vp   ! Grid point/EOF equivalent.
   8    type (domain) , intent(inout) :: grid   ! Dimensions and xpose buffers.
   9
  10    INTEGER                              :: i,j,k,ij
  11
  12 !-------------------------------------------------------------------------
  13 !  [1.0] Make local-grid copy of vp from 1-dimensional global-grid cv.
  14 !-------------------------------------------------------------------------
  15
  16    call da_cv_to_vv( cv_size, cv,&
  17            (/ be%v1%mz, be%v2%mz, be%v3%mz, be%v4%mz, be%v5%mz, be%ne /), vp )
  18
  19 !  [2.0] Transform control variable:
  20
  21    !$OMP PARALLEL DO &
  22    !$OMP PRIVATE ( ij, k, j, i )
  23    do ij = 1, grid%num_tiles
  24       do k=grid%xp%kts,grid%xp%kte
  25       do j=grid%j_start(ij), grid%j_end(ij)
  26       do i=grid%xp%its,grid%xp%ite
  27          vp % v1(i,j,k)=vp % v1(i,j,k)*be % corz(i,j,k,1)
  28          vp % v2(i,j,k)=vp % v2(i,j,k)*be % corz(i,j,k,2)
  29          vp % v3(i,j,k)=vp % v3(i,j,k)*be % corz(i,j,k,3)
  30          vp % v4(i,j,k)=vp % v4(i,j,k)*be % corz(i,j,k,4)
  31       enddo
  32       enddo
  33       enddo
  34    enddo
  35    !$OMP END PARALLEL DO
  36
  37 !-----Transform 5th control variable
  38       k=1
  39    !$OMP PARALLEL DO &
  40    !$OMP PRIVATE ( ij, i, j )
  41    do ij = 1, grid%num_tiles
  42       do j=grid%j_start(ij),grid%j_end(ij)
  43       do i=grid%xp%its,grid%xp%ite
  44          vp % v5(i,j,k)=vp % v5(i,j,k)*be % corp(i,j)
  45       enddo
  46       enddo
  47    enddo
  48    !$OMP END PARALLEL DO
  49
  50    CALL da_apply_rf( be, vp , grid )
  51
  52 END SUBROUTINE da_apply_be
  53