zsfilter.F90

Go to the documentation of this file.

!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
!SFX_LIC for details. version 1.
!     #########
      SUBROUTINE zsfilter(PZS,PMASK,KZSFILTER)
!     #############################################
!
!!**** *ZSFILTER* add a Laplacian to filter orographic signal
!!
!!    PURPOSE
!!    -------
!!
!!    METHOD
!!    ------
!!   
!!    An iterative method is used, adding each time the discretized Laplacian
!!    to the point value.
!!    Note that only points where land is present are modified, taking into
!!    account only such points in the filtering.
!!
!!    EXTERNAL
!!    --------
!!                           
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!    AUTHOR
!!    ------
!!
!!    V. Masson          Meteo-France
!!
!!    MODIFICATION
!!    ------------
!!
!!    Original    15/03/96
!!
!----------------------------------------------------------------------------
!
!*    0.     DECLARATION
!            -----------
!
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*    0.1    Declaration of arguments
!            ------------------------
!
REAL,             DIMENSION(:,:), INTENT(INOUT) :: pzs      ! orography
REAL,             DIMENSION(:,:), INTENT(IN)    :: pmask    ! where filter is applied
INTEGER,                          INTENT(IN)    :: kzsfilter! iteration number
!
!*    0.2    Declaration of local variables
!            ------------------------------
!
REAL,DIMENSION(0:SIZE(PZS,1)+1,0:SIZE(PZS,2)+1) :: zzs   ! modified 
                                                         ! orography
REAL,DIMENSION(0:SIZE(PZS,1)+1,0:SIZE(PZS,2)+1) :: zmask ! modified 
                                                         ! orography
INTEGER :: ji,jj,jiter,iiu,iju
REAL    :: zk                 ! filter efficiency coefficient (0.=< ZK =<1.)
REAL(KIND=JPRB) :: zhook_handle
!----------------------------------------------------------------------------
!
!*       1.     Initialisations
!               ---------------
!
IF (lhook) CALL dr_hook('ZSFILTER',0,zhook_handle)
iiu=SIZE(pzs,1)
iju=SIZE(pzs,2)
zk=1.
zzs(:,:)=0.
zzs(1:iiu,1:iju)=pzs(:,:)
zzs(0,:)    =2.*zzs(1,:)  -zzs(2,:)
zzs(iiu+1,:)=2.*zzs(iiu,:)-zzs(iiu-1,:)
zzs(:,0)    =2.*zzs(:,1)  -zzs(:,2)
zzs(:,iju+1)=2.*zzs(:,iju)-zzs(:,iju-1)
zmask(:,:)=0.
zmask(1:iiu,1:iju)=pmask(:,:)
!
!*       2.     Iterative loop
!               --------------
!
DO jiter=1,kzsfilter
  DO ji=1,iiu
    DO jj=1,iju
      pzs(ji,jj)= zzs(ji,jj)                          &
           + zk*0.125* zmask(ji,jj)                     &
            * (     zmask(ji-1,jj)   * zzs(ji-1,jj)     &
                +   zmask(ji+1,jj)   * zzs(ji+1,jj)     &
                +   zmask(ji,jj-1)   * zzs(ji,jj-1)     &
                +   zmask(ji,jj+1)   * zzs(ji,jj+1)     &
                - ( zmask(ji-1,jj)                      &
                   +zmask(ji+1,jj)                      &
                   +zmask(ji,jj-1)                      &
                   +zmask(ji,jj+1) ) * zzs(ji,jj)       )  
    ENDDO
  ENDDO
  zzs(1:iiu,1:iju)=pzs(:,:)
ENDDO
IF (lhook) CALL dr_hook('ZSFILTER',1,zhook_handle)
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE zsfilter