esmoothe_mod.F90 Source File


Files dependent on this one

sourcefile~~esmoothe_mod.f90~~AfferentGraph sourcefile~esmoothe_mod.f90 esmoothe_mod.F90 sourcefile~etibihie.f90 etibihie.F90 sourcefile~etibihie.f90->sourcefile~esmoothe_mod.f90 sourcefile~fpbipere.f90 fpbipere.F90 sourcefile~fpbipere.f90->sourcefile~esmoothe_mod.f90

Source Code

! (C) Copyright 2001- ECMWF.
! (C) Copyright 2001- Meteo-France.
! 
! This software is licensed under the terms of the Apache Licence Version 2.0
! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
! In applying this licence, ECMWF does not waive the privileges and immunities
! granted to it by virtue of its status as an intergovernmental organisation
! nor does it submit to any jurisdiction.
! 


MODULE ESMOOTHE_MOD
CONTAINS
SUBROUTINE ESMOOTHE(KDLUN,KDLON,KDGUN,KDGL,KDLUX,KDGUX,KSTART,&
 & KDLSM,KDGSA,KDGEN,KNUBI,PWORK,LDBIX,LDBIY)  

!   purpose  :
!   --------
!     To smooth the fields over the extension zone.

!*    *CALL* *ESMOOTHE*(...)

!      externals :
!      ----------
!             None

!      explicit arguments :
!      ------------------
!     KDLUN : lower bound for the x (or longitude) dimension
!             of the gridpoint array
!     KDLON : upper bound for the x (or longitude) dimension
!             of the gridpoint array on C U I U E
!     KDGUN : lower bound for the y (or latitude) dimension
!             of the gridpoint array
!     KDGL : upper bound for the y (or latitude) dimension
!             of the gridpoint array on C U I U E
!     KDLUX : upper bound for the x (or longitude) dimension
!             of  C U I.
!     KDGUX : upper bound for the y (or latitude) dimension
!             of  C U I.
!     KDLSM  : dimension in x direction of g-p array
!     KDGSA  : first dimension index in y of g-p array
!     KDGEN  : last dimension index in y of g-p array
!     KSTART :  first dimension index in x of g-p array
!     KDLSM  :  last dimension index in x of g-p array
!     KNUBI  : number of levels to biperiodicise

!     PWORK : gridpoint array on C U I U E.

!     LDBIX  : .TRUE.: biperiodicise in x direction (and vice versa)
!     LDBIY  : .TRUE.: biperiodicise in y direction (and vice versa)

!      references :
!      ----------

!      author :
!      ------
!       Michal Batka and Radmila Bubnova ( B & B )

!      modifications :
!      -------------
!      R. El Khatib 03-05-05 Optimizations
!      --------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK, JPHOOK

!      --------------------------------------------------------------

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KSTART 
INTEGER(KIND=JPIM),INTENT(IN)    :: KDLSM 
INTEGER(KIND=JPIM),INTENT(IN)    :: KDGSA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KDGEN 
INTEGER(KIND=JPIM),INTENT(IN)    :: KNUBI 
INTEGER(KIND=JPIM),INTENT(IN)    :: KDLUN 
INTEGER(KIND=JPIM),INTENT(IN)    :: KDLON 
INTEGER(KIND=JPIM),INTENT(IN)    :: KDGUN 
INTEGER(KIND=JPIM),INTENT(IN)    :: KDGL 
INTEGER(KIND=JPIM),INTENT(IN)    :: KDLUX 
INTEGER(KIND=JPIM),INTENT(IN)    :: KDGUX 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PWORK(KSTART:KDLSM,KNUBI,KDGSA:KDGEN) 
LOGICAL           ,INTENT(IN)    :: LDBIX 
LOGICAL           ,INTENT(IN)    :: LDBIY 

!      --------------------------------------------------------------

REAL(KIND=JPRB) :: ZPRAC(KDLUN-1:KDLON+1,KDGUN-1:KDGL+1)
INTEGER(KIND=JPIM) :: IEND, IENX1, IENX2, IENY1, IENY2, JFL, JLAT, JLL, JLON
REAL(KIND=JPHOOK) :: ZHOOK_HANDLE

!      --------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('ESMOOTHE',0,ZHOOK_HANDLE)
!      --------------------------------------------------------------

!*         1. Calculation.
!             ------------

IEND = MAX(KDLON-KDLUX,KDGL-KDGUX)
IEND = (IEND+1)/2
IENX1= KDLON
IENX2= KDGL
IENY1= KDGL
IENY2= KDLON
IF(LDBIX.AND.(.NOT.LDBIY)) THEN
  IENX2 = KDGUX
  IENY1 = KDGUX
ELSEIF((.NOT.LDBIX).AND.LDBIY) THEN
  IENX1 = KDLUX
  IENY2 = KDLUX
ELSEIF((.NOT.LDBIX).AND.(.NOT.LDBIY)) THEN
  IF (LHOOK) CALL DR_HOOK('ESMOOTHE',1,ZHOOK_HANDLE)
  RETURN
ENDIF

DO JFL = 1, KNUBI

  DO JLL = 1, IEND

    DO JLON = KDLUX,KDLON
      DO JLAT = KDGUN,KDGL
        ZPRAC(JLON,JLAT) = PWORK(JLON,JFL,JLAT)
      ENDDO
    ENDDO

    DO JLON = KDLUX,KDLON
      ZPRAC(JLON,KDGUN-1) = PWORK(JLON,JFL,KDGL)
      ZPRAC(JLON,KDGL +1) = PWORK(JLON,JFL,KDGUN)
    ENDDO
    DO JLAT = KDGUN,KDGL
      ZPRAC(KDLON+1,JLAT) = PWORK(KDLUN,JFL,JLAT)
    ENDDO
    ZPRAC(KDLON+1,KDGUN-1) = PWORK(KDLUN,JFL,KDGL)
    ZPRAC(KDLON+1,KDGL +1) = PWORK(KDLUN,JFL,KDGUN)

    DO JLON = KDLUX + JLL,IENX1 - JLL + 1
      DO JLAT = KDGUN, IENX2  
        PWORK(JLON,JFL,JLAT)=(4._JPRB*ZPRAC(JLON,JLAT)+2.0_JPRB*(ZPRAC(JLON+&
         & 1,JLAT)+&
         & ZPRAC(JLON-1,JLAT) + ZPRAC(JLON,JLAT+1) +&
         & ZPRAC(JLON,JLAT-1)) + ZPRAC(JLON+1,JLAT+1) +&
         & ZPRAC(JLON-1,JLAT+1) + ZPRAC(JLON+1,JLAT-1)+&
         & ZPRAC(JLON-1,JLAT-1))/16._JPRB  
      ENDDO
    ENDDO

    DO JLAT = KDGUX,KDGL
      DO JLON = KDLUN,KDLON
        ZPRAC(JLON,JLAT) = PWORK(JLON,JFL,JLAT)
      ENDDO
    ENDDO

    DO JLAT = KDGUX,KDGL
      ZPRAC(KDLUN-1,JLAT) = PWORK(KDLON,JFL,JLAT)
      ZPRAC(KDLON+1,JLAT) = PWORK(KDLUN,JFL,JLAT)
    ENDDO
    DO JLON = KDLUN,KDLON
      ZPRAC(JLON,KDGL +1) = PWORK(JLON,JFL,KDGUN)
    ENDDO
    ZPRAC(KDLUN-1,KDGL +1) = PWORK(KDLON,JFL,KDGUN)
    ZPRAC(KDLON+1,KDGL +1) = PWORK(KDLUN,JFL,KDGUN)

    DO JLAT = KDGUX + JLL, IENY1 - JLL + 1
      DO JLON = KDLUN,IENY2
        PWORK(JLON,JFL,JLAT)=(4._JPRB*ZPRAC(JLON,JLAT)+2.0_JPRB*(ZPRAC(JLON+&
         & 1,JLAT)+&
         & ZPRAC(JLON-1,JLAT) + ZPRAC(JLON,JLAT+1) +&
         & ZPRAC(JLON,JLAT-1)) + ZPRAC(JLON+1,JLAT+1) +&
         & ZPRAC(JLON-1,JLAT+1) + ZPRAC(JLON+1,JLAT-1)+&
         & ZPRAC(JLON-1,JLAT-1))/16._JPRB  
      ENDDO
    ENDDO

  ENDDO

ENDDO

!      --------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('ESMOOTHE',1,ZHOOK_HANDLE)
END SUBROUTINE ESMOOTHE
END MODULE ESMOOTHE_MOD