wrfv2_fire/var/da/da_recursive_filter/da_apply_rf_1v.inc

   1 SUBROUTINE da_apply_rf_1v( be, vp, grid, nv )
   2
   3    IMPLICIT NONE
   4
   5    TYPE (be_type), INTENT(IN)       :: be     ! Background error structure.
   6    type (domain) , intent(inout)    :: grid   ! Dimensions and xpose buffers.
   7
   8    integer, intent(in) :: nv                        ! # of var.
   9
  10    real, dimension(ims:ime, jms:jme, kms:kme), INTENT(INOUT) :: vp   ! working array
  11
  12    integer                 :: in, jn, kn, k
  13 !-------------------------------------------------------------------------
  14 !  [1.0] Initialise:
  15 !-------------------------------------------------------------------------
  16
  17    in=ite-its+1
  18    jn=jte-jts+1
  19    kn=kte-kts+1
  20
  21    call da_rfz(vp(ims:ime,jms:jme,kms:kme),in,jn,kn,be%ndeg,&
  22      be%vz(kts:kte,its:ite,jts:jte,nv),be%be,be%table,be%nta,be%swidth, &
  23                                     ids,ide, jds,jde, kds,kde,  &
  24                                     ims,ime, jms,jme, kms,kme,  &
  25                                     its,ite, jts,jte, kts,kte )
  26
  27 !-------------------------------------------------------------------------
  28 !  [2.0]: Perform 1D recursive filter in y-x direction:
  29 !-------------------------------------------------------------------------
  30
  31    do k = kts,kte
  32       grid%xp % v1z(its:ite,jts:jte,k) = vp(its:ite,jts:jte,k)
  33    end do
  34
  35    call da_transpose_z2x ( grid )
  36
  37    in=grid%xp%ipex-grid%xp%ipsx
  38    jn=grid%xp%jpex-grid%xp%jpsx
  39
  40    !$OMP PARALLEL DO &
  41    !$OMP PRIVATE ( k )
  42    do k=grid%xp%kpsx,grid%xp%kpex
  43      call smoothx(in,jn, &
  44           grid%xp% v1x(grid%xp%ipsx:grid%xp%ipex,grid%xp%jpsx:grid%xp%jpex,k),&
  45           be%slix(grid%xp%ipsx:grid%xp%ipex,grid%xp%jpsx:grid%xp%jpex,k,nv),  &
  46           be%ndeg,be%be,be%nta,be%swidth,be%table)
  47    enddo
  48    !$OMP END PARALLEL DO
  49
  50
  51    call da_transpose_x2y ( grid )
  52
  53    in=grid%xp%ipey-grid%xp%ipsy
  54    jn=grid%xp%jpey-grid%xp%jpsy
  55
  56    !$OMP PARALLEL DO &
  57    !$OMP PRIVATE ( k )
  58    do k=grid%xp%kpsy,grid%xp%kpey
  59      call smoothy(in,jn, &
  60           grid%xp%v1y(grid%xp%ipsy:grid%xp%ipey,grid%xp%jpsy:grid%xp%jpey,k),&
  61           be%sljy(grid%xp%ipsy:grid%xp%ipey,grid%xp%jpsy:grid%xp%jpey,k,nv), &
  62           be%ndeg,be%be,be%nta,be%swidth,be%table)
  63    enddo
  64    !$OMP END PARALLEL DO
  65
  66
  67    call da_transpose_y2z ( grid )
  68
  69    do k = kts,kte
  70       vp(its:ite,jts:jte,k)= grid%xp % v1z(its:ite,jts:jte,k)
  71    end do
  72
  73 END SUBROUTINE da_apply_rf_1v
  74