!
!##################################################################
!##################################################################
!###### ######
!###### SUBROUTINE RECURSIVE_FILTER ######
!###### ######
!###### Developed by ######
!###### Center for Analysis and Prediction of Storms ######
!###### University of Oklahoma ######
!###### ######
!##################################################################
!##################################################################
!
!-----------------------------------------------------------------------
!
! PURPOSE:
!
! recursive filter in xy two direction. according to paper
! published by Lorenc and Purser.
!
!-----------------------------------------------------------------------
!
! AUTHOR:
!
! Jidong Gao, CAPS, July, 2000
!
!-----------------------------------------------------------------------
!
SUBROUTINE recurfilt_2d(nx,ny,pgrd,ipass_filt,radius)
!
!
INTEGER :: nx, ny, ipass_filt, radius
DIMENSION pgrd(nx,ny)
REAL, DIMENSION (:), allocatable :: temx
REAL, DIMENSION (:), allocatable :: temy
!
!
allocate (temx(nx))
allocate (temy(ny))
!
!
ee = REAL(ipass_filt) / REAL(radius* radius)
alpha = 1 + ee - SQRT(ee*(ee+2.))
!
!
DO n = 1, ipass_filt
!
DO j = 1, ny
!
DO i = 1, nx
temx (i) = pgrd(i,j)
END DO
!
CALL recurfilt_1d
( temx,nx,alpha )
!
DO i = 1, nx
pgrd(i,j) = temx(i)
END DO
!
END DO
!
!
DO i = 1, nx
!
DO j = 1, ny
temy (j) = pgrd(i,j)
END DO
!
CALL recurfilt_1d
( temy,ny,alpha )
!
DO j = 1, ny
pgrd(i,j) = temy (j)
END DO
!
END DO
!
END DO
!
!
deallocate (temx)
deallocate (temy)
!
RETURN
END SUBROUTINE recurfilt_2d
!
!
SUBROUTINE arecurfilt_2d(nx,ny,pgrd,ipass_filt,radius)
!
!
INTEGER :: nx, ny, ipass_filt
DIMENSION pgrd(nx,ny)
REAL, DIMENSION (:), allocatable :: temx
REAL, DIMENSION (:), allocatable :: temy
!
!
allocate (temx(nx))
allocate (temy(ny))
!
!
ee = REAL(ipass_filt) / REAL( radius*radius )
alpha = 1 + ee - SQRT(ee*(ee+2.))
!
!
DO i = 1, nx
temx (i) = 0.
END DO
!
DO j = 1, ny
temy (j) = 0.
END DO
!
!
DO n = 1, ipass_filt
!
!
DO i = nx, 1, -1
DO j = ny, 1, -1
temy(j) = temy(j) + pgrd(i,j)
pgrd(i,j) = 0.
END DO
!
CALL arecurfilt_1d
( temy,ny,alpha )
!
DO j = ny, 1, -1
pgrd(i,j) = pgrd(i,j)+ temy(j)
temy(j) = 0.
END DO
!
END DO
!
!
DO j = ny, 1, -1
!
DO i = nx, 1, -1
temx(i) = temx(i) + pgrd(i,j)
pgrd(i,j) = 0.
END DO
!
CALL arecurfilt_1d
( temx,nx,alpha )
!
DO i = nx, 1, -1
pgrd(i,j) = pgrd(i,j) + temx(i)
temx(i) = 0.
END DO
!
END DO
!
END DO
!
!
deallocate (temx)
deallocate (temy)
!
!
RETURN
END SUBROUTINE arecurfilt_2d