wrfv2_fire/var/da/da_recursive_filter/da_apply_rf_1v_adj.inc

   1 SUBROUTINE da_apply_rf_1v_adj( 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 !-------------------------------------------------------------------------
  15 !  [1.0] Perform 1D recursive filter in x-y direction:
  16 !-------------------------------------------------------------------------
  17
  18    do k = kts,kte
  19       grid%xp % v1z(its:ite,jts:jte,k) = vp(its:ite,jts:jte,k)
  20    end do
  21
  22    call da_transpose_z2y ( grid )
  23
  24    in=grid%xp%ipey-grid%xp%ipsy
  25    jn=grid%xp%jpey-grid%xp%jpsy
  26
  27    !$OMP PARALLEL DO &
  28    !$OMP PRIVATE ( k )
  29    do k=grid%xp%kpsy,grid%xp%kpey
  30       call smoothy(in,jn,&
  31                grid%xp % v1y(grid%xp%ipsy:grid%xp%ipey,grid%xp%jpsy:grid%xp%jpey,k),&
  32                be%sljy(grid%xp%ipsy:grid%xp%ipey,grid%xp%jpsy:grid%xp%jpey,k,nv),   &
  33                be%ndeg,be%be,be%nta,be%swidth,be%table)
  34    enddo
  35    !$OMP END PARALLEL DO
  36
  37    call da_transpose_y2x ( grid )
  38
  39    in=grid%xp%ipex-grid%xp%ipsx
  40    jn=grid%xp%jpex-grid%xp%jpsx
  41
  42    !$OMP PARALLEL DO &
  43    !$OMP PRIVATE ( k )
  44    do k=grid%xp%kpsx,grid%xp%kpex
  45       call smoothx(in,jn, &
  46                grid%xp % v1x(grid%xp%ipsx:grid%xp%ipex,grid%xp%jpsx:grid%xp%jpex,k),&
  47                be%slix(grid%xp%ipsx:grid%xp%ipex,grid%xp%jpsx:grid%xp%jpex,k,nv),   &
  48                be%ndeg,be%be,be%nta,be%swidth,be%table)
  49    enddo
  50    !$OMP END PARALLEL DO
  51
  52    call da_transpose_x2z ( grid )
  53
  54    do k = kts,kte
  55       vp(its:ite,jts:jte,k)= grid%xp % v1z(its:ite,jts:jte,k)
  56    end do
  57
  58 !-------------------------------------------------------------------------
  59 !  [2.0]: Perform 1D recursive filter in z direction:
  60 !-------------------------------------------------------------------------
  61
  62    in=ite-its+1
  63    jn=jte-jts+1
  64    kn=kte-kts+1
  65
  66    call da_rfz(vp(ims:ime,jms:jme,kms:kme),in,jn,kn,be%ndeg,&
  67      be%vz(kts:kte,its:ite,jts:jte,nv),be%be,be%table,be%nta,be%swidth,&
  68                                     ids,ide, jds,jde, kds,kde,  &
  69                                     ims,ime, jms,jme, kms,kme,  &
  70                                     its,ite, jts,jte, kts,kte )
  71 END SUBROUTINE da_apply_rf_1v_adj
  72