wrf svn trunk commit r4103
[wrffire.git] / wrfv2_fire / var / da / da_recursive_filter / da_apply_rf_1v.inc
blob84bc521cdee19cda26f1ed08ea1bdb1c8219d71e
1 SUBROUTINE da_apply_rf_1v( be, vp, grid, nv )
3    IMPLICIT NONE
5    TYPE (be_type), INTENT(IN)       :: be     ! Background error structure.
6    type (domain) , intent(inout)    :: grid   ! Dimensions and xpose buffers.
8    integer, intent(in) :: nv                        ! # of var.
10    real, dimension(ims:ime, jms:jme, kms:kme), INTENT(INOUT) :: vp   ! working array
12    integer                 :: in, jn, kn, k
13 !-------------------------------------------------------------------------
14 !  [1.0] Initialise:
15 !-------------------------------------------------------------------------
17    in=ite-its+1
18    jn=jte-jts+1
19    kn=kte-kts+1
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 )
27 !-------------------------------------------------------------------------
28 !  [2.0]: Perform 1D recursive filter in y-x direction:
29 !-------------------------------------------------------------------------
31    do k = kts,kte
32       grid%xp % v1z(its:ite,jts:jte,k) = vp(its:ite,jts:jte,k)
33    end do
35    call da_transpose_z2x ( grid )
37    in=grid%xp%ipex-grid%xp%ipsx
38    jn=grid%xp%jpex-grid%xp%jpsx
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
51    call da_transpose_x2y ( grid )
53    in=grid%xp%ipey-grid%xp%ipsy
54    jn=grid%xp%jpey-grid%xp%jpsy
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
67    call da_transpose_y2z ( grid )
69    do k = kts,kte
70       vp(its:ite,jts:jte,k)= grid%xp % v1z(its:ite,jts:jte,k)
71    end do
73 END SUBROUTINE da_apply_rf_1v