orography_filter.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 orography_filter(HGRID,PGRID_PAR,PSEA,KZSFILTER,PZS)
!     ##############################################################
!
!!**** *OROGRAPHY_FILTER* filters the orography
!!
!!    PURPOSE
!!    -------
!!
!!    METHOD
!!    ------
!!   
!
!!    EXTERNAL
!!    --------
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!    AUTHOR
!!    ------
!!
!!    V. Masson        Meteo-France
!!
!!    MODIFICATION
!!    ------------
!!
!!    Original    06/2004
!!
!----------------------------------------------------------------------------
!
!*    0.     DECLARATION
!            -----------
!
USE modi_get_grid_dim
USE modi_zsfilter
!
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*    0.1    Declaration of arguments
!            ------------------------
!
 CHARACTER(LEN=10),    INTENT(IN)    :: hgrid    ! type of grid
REAL, DIMENSION(:),   POINTER       :: pgrid_par! lits of parameters used to define the grid
REAL, DIMENSION(:),   INTENT(IN)    :: psea     ! sea  fraction
INTEGER,              INTENT(IN)    :: kzsfilter! number of filter iteration
REAL, DIMENSION(:),   INTENT(INOUT) :: pzs      ! orography
!
!
!*    0.2    Declaration of local variables
!            ------------------------------
!
LOGICAL :: grect    ! true when grid is rectangular
INTEGER :: ix       ! number of points in X direction
INTEGER :: iy       ! number of points in Y direction
INTEGER :: jx       ! loop counter
INTEGER :: jy       ! loop counter
REAL, DIMENSION(:,:), ALLOCATABLE :: zzs ! orography in a 2D array
REAL, DIMENSION(:,:), ALLOCATABLE :: zsea! sea fraction in a 2D array
REAL(KIND=JPRB) :: zhook_handle
!-------------------------------------------------------------------------------
!
!*    1.     Gets the geometry of the grid
!            -----------------------------
!
IF (lhook) CALL dr_hook('OROGRAPHY_FILTER',0,zhook_handle)
 CALL get_grid_dim(hgrid,SIZE(pgrid_par),pgrid_par,grect,ix,iy)
!
!-------------------------------------------------------------------------------
!
!*    2.     If grid is not rectangular, nothing is done
!            -------------------------------------------
!
IF (.NOT. grect .AND. lhook) CALL dr_hook('OROGRAPHY_FILTER',1,zhook_handle)
IF (.NOT. grect) RETURN
!
IF (SIZE(pzs) /= ix * iy .AND. lhook) CALL dr_hook('OROGRAPHY_FILTER',1,zhook_handle)
IF (SIZE(pzs) /= ix * iy) RETURN
!
!-------------------------------------------------------------------------------
!
!*    3.     Grid rectangular: orography is put in a 2D array
!            ------------------------------------------------
!
ALLOCATE(zzs(ix,iy))
ALLOCATE(zsea(ix,iy))
!
DO jy=1,iy
  DO jx=1,ix
    zzs(jx,jy) = pzs( jx + (jy-1)*ix ) 
    zsea(jx,jy) = psea( jx + (jy-1)*ix ) 
  END DO
END DO
!
!-------------------------------------------------------------------------------
!
!*    4.     Filtering in x and Y directions
!            -------------------------------
!
IF (kzsfilter>0) CALL zsfilter(zzs,(1.-zsea),kzsfilter)
!
!-------------------------------------------------------------------------------
!
!*    5.     Output field comes back into 1D vector
!            --------------------------------------
!
DO jy=1,iy
  DO jx=1,ix
    pzs( jx + (jy-1)*ix ) = zzs(jx,jy)
  END DO
END DO
!
DEALLOCATE(zzs )
DEALLOCATE(zsea)
IF (lhook) CALL dr_hook('OROGRAPHY_FILTER',1,zhook_handle)
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE orography_filter