    SUBROUTINE FILT25(ZI,TM,IPASS)
!$$$  SUBPROGRAM DOCUMENTATION BLOCK
!                .      .    .                                       .
! SUBPROGRAM:    FILTER      FILTERS THE ARRAY ZI
!   PRGMMR: DIMEGO           ORG: W/NP22     DATE: 86-07-18

! ABSTRACT: FILTERS AN ARRAY USING A 25PT BLECK FILTER IN THE
!   INTERIOR OF THE DOMAIN

! PROGRAM HISTORY LOG:
!   86-07-18  G DIMEGO - ORIGINATOR
!   88-09-23  B SCHMIDT - ADDED THE DOCBLOCK
!   90-11-27  G DIMEGO - LEFT Z AS INTERNAL WORK ARRAY ON CRAY
!   93-06-21  R TREADON - STREAMLINED CODE
!   95-06-21  T BLACK - MODIFIED FOR THE E-GRID
!   99-08-25  T BLACK - MODIFIED FOR DISTRIBUTED MEMORY

! USAGE:    CALL FILTER (IDIM1,IDIM2,JDIM1,JDIM2,ZI,IPASS)
!   INPUT ARGUMENT LIST:
!     ZI       - ARRAY CONTAINING THE ARRAY TO BE FILTERED
!     TM       - ARRAY CONTAINING THE TOPOGRAPHY MASK
!     IPASS    - NUMBER OF PASSES THROUGH THE FILTER

!   OUTPUT ARGUMENT LIST:
!     ZI       - ARRAY CONTAINING THE FILTERED FIELD

! ATTRIBUTES:
!   LANGUAGE: FORTRAN 90
!    MACHINE: IBM SP

!$$$
!----------------------------------------------------------------
    INCLUDE "EXCHM.h"
    INCLUDE "parmeta.f90"
    INCLUDE "mpp.h"
!----------------------------------------------------------------
    INCLUDE "COMM_INDX.f90"
!----------------------------------------------------------------
    REAL :: ZI(IDIM1:IDIM2,JDIM1:JDIM2),Z(IDIM1:IDIM2,JDIM1:JDIM2)
    REAL :: TM(IDIM1:IDIM2,JDIM1:JDIM2)

    DATA CF1/0.279372/,CF2/0.171943/,CF3/-0.006918/ &
    ,    CF4/0.077458/,CF5/-0.024693/,CF6/-0.012940/
!----------------------------------------------------------------

    IPC=IPASS

    DO J=JDIM1,JDIM2
        DO I=IDIM1,IDIM2
            Z(I,J)=0.
        ENDDO
    ENDDO
!***
!***  FILTER THE INTERIOR POINTS WITH 25-PT BLECK FILTER
!***
    DO 105 IP=1,IPC
    
    ! omp parallel do private(htot,i,iihe,iihw,rsumh,sumh)
        DO 102 J=MYJS4,MYJE4
            DO 101 I=MYIS2,MYIE2
            
                IIHE=I+IHE(J)
                IIHW=I+IHW(J)
            !     if(mype.eq.6.and.i.eq.16.and.j.eq.34)then
            !       write(6,12345)tm(i,j),ihe(j),ihw(j),l
            !       write(6,12346)tm(IIHW,J-1),tm(IIHE,J-1),tm(IIHE,J+1),
            !    1                tm(IIHW,J+1)
            !       write(6,12347)tm(I-1,J-2),tm(I+1,J-2),tm(I+1,J+2),
            !    1                tm(I-1,J+2)
            !       write(6,12348)tm(I,J-2),tm(I,J+2),tm(I+1,J),
            !    1                tm(I-1,J)
            !       write(6,12349)tm(IIHE,J-3),tm(IIHE+1,J-1),tm(IIHW,J-3),
            !    1                tm(IIHE+1,J+1)
            !       write(6,12350)tm(IIHW-1,J-1),tm(IIHE,J+3),tm(IIHW-1,J+1),
            !    1                tm(IIHW,J+3)
            !       write(6,12351)tm(I,J-4),tm(I+2,J),tm(I-2,J),
            !    1                tm(I,J+4)
                12345 format(' mask=',f2.0,' ihe=',i2,' ihw=',i2,' l=',i2)
                12346 format(' 2nd row=',4(1x,f2.0))
                12347 format(' 3rd row=',4(1x,f2.0))
                12348 format(' 4th row=',4(1x,f2.0))
                12349 format(' 5th row=',4(1x,f2.0))
                12350 format(' 6th row=',4(1x,f2.0))
                12351 format(' 7th row=',4(1x,f2.0))
            !     endif
                HTOT=TM(I,J) &
                +TM(IIHW,J-1)+TM(IIHE,J-1)+TM(IIHE,J+1)+TM(IIHW,J+1) &
                +TM(I-1,J-2)+TM(I+1,J-2)+TM(I+1,J+2)+TM(I-1,J+2) &
                +TM(I,J-2)+TM(I,J+2)+TM(I+1,J)+TM(I-1,J) &
                +TM(IIHE,J-3)+TM(IIHE+1,J-1)+TM(IIHW,J-3)+TM(IIHE+1,J+1) &
                +TM(IIHW-1,J-1)+TM(IIHE,J+3)+TM(IIHW-1,J+1)+TM(IIHW,J+3) &
                +TM(I,J-4)+TM(I+2,J)+TM(I-2,J)+TM(I,J+4)
            
                IF(HTOT > 0.)THEN
                    SUMH=CF1*TM(I,J) &
                    +CF2*(TM(IIHW,J-1)+TM(IIHE,J-1)+TM(IIHE,J+1)+TM(IIHW,J+1)) &
                    +CF3*(TM(I-1,J-2)+TM(I+1,J-2)+TM(I+1,J+2)+TM(I-1,J+2)) &
                    +CF4*(TM(I,J-2)+TM(I,J+2)+TM(I+1,J)+TM(I-1,J)) &
                    +CF5*(TM(IIHE,J-3)+TM(IIHE+1,J-1)+TM(IIHW,J-3)+TM(IIHE+1,J+1) &
                    +TM(IIHW-1,J-1)+TM(IIHE,J+3)+TM(IIHW-1,J+1)+TM(IIHW,J+3)) &
                    +CF6*(TM(I,J-4)+TM(I+2,J)+TM(I-2,J)+TM(I,J+4))
                
                    RSUMH=1./SUMH
                
                    Z(I,J)=(CF1*ZI(I,J)*TM(I,J) &
                    +CF2*(ZI(IIHW,J-1)*TM(IIHW,J-1)+ZI(IIHE,J-1)*TM(IIHE,J-1) &
                    +ZI(IIHE,J+1)*TM(IIHE,J+1)+ZI(IIHW,J+1)*TM(IIHW,J+1)) &
                    +CF3*(ZI(I-1,J-2)*TM(I-1,J-2)+ZI(I+1,J-2)*TM(I+1,J-2) &
                    +ZI(I+1,J+2)*TM(I+1,J+2)+ZI(I-1,J+2)*TM(I-1,J+2)) &
                    +CF4*(ZI(I,J-2)*TM(I,J-2)+ZI(I,J+2)*TM(I,J+2) &
                    +ZI(I+1,J)*TM(I+1,J)+ZI(I-1,J)*TM(I-1,J)) &
                    +CF5*(ZI(IIHE,J-3)*TM(IIHE,J-3)+ZI(IIHE+1,J-1)*TM(IIHE+1,J-1) &
                    +ZI(IIHW,J-3)*TM(IIHW,J-3)+ZI(IIHE+1,J+1)*TM(IIHE+1,J+1) &
                    +ZI(IIHW-1,J-1)*TM(IIHW-1,J-1)+ZI(IIHE,J+3)*TM(IIHE,J+3) &
                    +ZI(IIHW-1,J+1)*TM(IIHW-1,J+1)+ZI(IIHW,J+3)*TM(IIHW,J+3)) &
                    +CF6*(ZI(I,J-4)*TM(I,J-4)+ZI(I+2,J)*TM(I+2,J) &
                    +ZI(I-2,J)*TM(I-2,J)+ZI(I,J+4)*TM(I,J+4))) &
                    *RSUMH
                ENDIF
            
            101 END DO
        102 END DO
    
    ! omp parallel do
        DO J=MYJS4,MYJE4
            DO I=MYIS2,MYIE2
                IF(TM(I,J) > 0.5)THEN
                    ZI(I,J)=Z(I,J)
                ENDIF
            ENDDO
        ENDDO
    
        CALL EXCH(ZI,1,4,4)
    
    105 END DO

    RETURN
    END SUBROUTINE FILT25
