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, be%cv_mz, be%ncv_mz, vp )
  17
  18 !  [2.0] Transform control variable:
  19
  20    !$OMP PARALLEL DO &
  21    !$OMP PRIVATE ( ij, k, j, i )
  22    do ij = 1, grid%num_tiles
  23       do k=grid%xp%kts,grid%xp%kte
  24       do j=grid%j_start(ij), grid%j_end(ij)
  25       do i=grid%xp%its,grid%xp%ite
  26          vp % v1(i,j,k)=vp % v1(i,j,k)*be % corz(i,j,k,1)
  27          vp % v2(i,j,k)=vp % v2(i,j,k)*be % corz(i,j,k,2)
  28          vp % v3(i,j,k)=vp % v3(i,j,k)*be % corz(i,j,k,3)
  29          vp % v4(i,j,k)=vp % v4(i,j,k)*be % corz(i,j,k,4)
  30       enddo
  31       enddo
  32       enddo
  33    enddo
  34    !$OMP END PARALLEL DO
  35
  36 !-----Transform 5th control variable
  37       k=1
  38    !$OMP PARALLEL DO &
  39    !$OMP PRIVATE ( ij, i, j )
  40    do ij = 1, grid%num_tiles
  41       do j=grid%j_start(ij),grid%j_end(ij)
  42       do i=grid%xp%its,grid%xp%ite
  43          vp % v5(i,j,k)=vp % v5(i,j,k)*be % corp(i,j)
  44       enddo
  45       enddo
  46    enddo
  47    !$OMP END PARALLEL DO
  48
  49    CALL da_apply_rf( be, vp , grid )
  50
  51 END SUBROUTINE da_apply_be
  52