wrfv2_fire/var/da/da_recursive_filter/da_apply_rf.inc

   1 SUBROUTINE da_apply_rf( be, vp, grid )
   2
   3    IMPLICIT NONE
   4
   5    TYPE (be_type), INTENT(IN)       :: be   ! Background error structure.
   6    TYPE (vp_type), INTENT(INOUT)    :: vp   ! working array
   7    type (domain) , intent(inout)    :: grid   ! Dimensions and xpose buffers.
   8
   9    integer :: in, jn
  10
  11    integer :: i, j, k
  12
  13 !-------------------------------------------------------------------------
  14
  15 #ifndef DEREF_KLUDGE
  16    call da_apply_rf_1v( be, vp%v1, grid, 1)
  17 #else
  18    call da_apply_rf_1v( be, vp%v1(ims,jms,kms), grid, 1)
  19 #endif
  20
  21 !-------------------------------------------------------------------------
  22
  23 #ifndef DEREF_KLUDGE
  24    call da_apply_rf_1v( be, vp%v2, grid, 2)
  25 #else
  26    call da_apply_rf_1v( be, vp%v2(ims,jms,kms), grid, 2)
  27 #endif
  28
  29 !-------------------------------------------------------------------------
  30
  31 #ifndef DEREF_KLUDGE
  32    call da_apply_rf_1v( be, vp%v3, grid, 3)
  33 #else
  34    call da_apply_rf_1v( be, vp%v3(ims,jms,kms), grid, 3)
  35 #endif
  36
  37 !-------------------------------------------------------------------------
  38
  39 #ifndef DEREF_KLUDGE
  40    call da_apply_rf_1v( be, vp%v4, grid, 4)
  41 #else
  42    call da_apply_rf_1v( be, vp%v4(ims,jms,kms), grid, 4)
  43 #endif
  44
  45 !-------------------------------------------------------------------------
  46 !-------------------------------------------------------------------------
  47 !  [2.0]: Perform 1D recursive filter in y-x direction:
  48 !-------------------------------------------------------------------------
  49
  50    grid%xp%v1z(its:ite,jts:jte,1) = vp%v5(its:ite,jts:jte,1)
  51
  52    call da_transpose_z2x ( grid )
  53
  54    in=grid%xp%ipex-grid%xp%ipsx
  55    jn=grid%xp%jpex-grid%xp%jpsx
  56
  57    if ( LBOUND(grid%xp%v1x,3) == 1 ) then
  58       call smoothx(in,jn,&
  59            grid%xp%v1x(grid%xp%ipsx:grid%xp%ipex,grid%xp%jpsx:grid%xp%jpex,1),&
  60            be%slipx(grid%xp%ipsx:grid%xp%ipex,grid%xp%jpsx:grid%xp%jpex),&
  61            be%ndeg,be%be,be%nta,be%swidth,be%table)
  62    endif
  63
  64    call da_transpose_x2y ( grid )
  65
  66    in=grid%xp%ipey-grid%xp%ipsy
  67    jn=grid%xp%jpey-grid%xp%jpsy
  68
  69    if ( LBOUND(grid%xp%v1y,3) == 1 ) then
  70       call smoothy(in,jn, &
  71            grid%xp%v1y(grid%xp%ipsy:grid%xp%ipey,grid%xp%jpsy:grid%xp%jpey,1),&
  72            be%sljpy(grid%xp%ipsy:grid%xp%ipey,grid%xp%jpsy:grid%xp%jpey),&
  73            be%ndeg,be%be,be%nta,be%swidth,be%table)
  74    endif
  75
  76    call da_transpose_y2z ( grid )
  77
  78    vp%v5(its:ite,jts:jte,1)= grid%xp % v1z(its:ite,jts:jte,1)
  79
  80 !-------------------------------------------------------------------------
  81
  82 END SUBROUTINE da_apply_rf
  83