hor_interpol.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 hor_interpol (DTCO, U, &
                         kluout,pfieldin,pfieldout)
!     #################################################################################
!
!!****  *HOR_INTERPOL * - Call the interpolation of a surface field
!!
!!    PURPOSE
!!    -------
!
!!**  METHOD
!!    ------
!!
!!    REFERENCE
!!    ---------
!!      
!!
!!    AUTHOR
!!    ------
!!     V. Masson 
!!
!!    MODIFICATIONS
!!    -------------
!!      Original     01/2004
!!      P. Le Moigne 10/2005, Phasage Arome
!!------------------------------------------------------------------
!
!
!
!
USE modd_data_cover_n, ONLY : data_cover_t
USE modd_surf_atm_n, ONLY : surf_atm_t
!
USE modd_prep,       ONLY : cingrid_type, cinterp_type
!
USE modi_hor_interpol_gauss
USE modi_hor_interpol_rotlatlon
USE modi_hor_interpol_arome
USE modi_hor_interpol_conf_proj
USE modi_hor_interpol_cartesian
USE modi_hor_interpol_latlon
!
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE modi_abor1_sfx
!
USE modi_hor_interpol_buffer
IMPLICIT NONE
!
!*      0.1    declarations of arguments
!
!
TYPE(data_cover_t), INTENT(INOUT) :: dtco
TYPE(surf_atm_t), INTENT(INOUT) :: u
!
INTEGER,            INTENT(IN)  :: kluout    ! logical unit of output listing
REAL, DIMENSION(:,:), INTENT(IN)   :: pfieldin  ! field to interpolate horizontally
REAL, DIMENSION(:,:), INTENT(OUT)  :: pfieldout ! interpolated field
!
!*      0.2    declarations of local variables
!
INTEGER :: jl ! loop counter
REAL(KIND=JPRB) :: zhook_handle
!
!-------------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('HOR_INTERPOL',0,zhook_handle)
SELECT CASE (cinterp_type)
!
!*      1.     Interpolation with horibl (from gaussian, Legendre or regular grid)
!              -------------------------------------------------------------------
!
  CASE('HORIBL')
    SELECT CASE(cingrid_type)
!
!*      1.1    Interpolation from gaussian or Legendre
!
      CASE ('GAUSS     ')
        CALL hor_interpol_gauss(kluout,pfieldin,pfieldout)
!
!*      1.2    Interpolation from regular grid
!
      CASE ('AROME     ')
        CALL hor_interpol_arome(kluout,pfieldin,pfieldout)
!
!*      1.3    Interpolation from regular lat/lon coord
!
      CASE ('LATLON    ')
        CALL hor_interpol_latlon(kluout,pfieldin,pfieldout)
!
!*      1.4    Interpolation from rotated lat/lon coord
!
      CASE ('ROTLATLON ')
        CALL hor_interpol_rotlatlon(kluout,pfieldin,pfieldout)        

      CASE default
        CALL abor1_sfx('HOR_INTERPOL: WRONG GRID TYPE'//cingrid_type)

    END SELECT
!
!*      2.     Prescribed uniform field
!              ------------------------
!
  CASE('UNIF  ')
    DO jl=1,SIZE(pfieldin,2)
      pfieldout(:,jl) = pfieldin(1,jl)
    END DO
!
!*      3.     Bilinear interpolation
!              ----------------------
!
  CASE('BILIN ')
    SELECT CASE(cingrid_type)
      CASE ('CONF PROJ ')
        CALL hor_interpol_conf_proj(kluout,pfieldin,pfieldout)
      CASE ('CARTESIAN ')
        CALL hor_interpol_cartesian(kluout,pfieldin,pfieldout)
    END SELECT
!
!*      4.     no interpolation, only packing
!              ------------------------------
!
  CASE('BUFFER')
    CALL hor_interpol_buffer(dtco, u, &
                             kluout,pfieldin,pfieldout)

!
!*      4.     no interpolation
!              ----------------
!
  CASE('NONE  ')
    DO jl=1,SIZE(pfieldin,2)
      pfieldout(:,jl) = pfieldin(:,jl)
    END DO

  CASE default 
    CALL abor1_sfx('HOR_INTERPOL: WRONG INTERPOLATION TYPE'//cinterp_type)

END SELECT
IF (lhook) CALL dr_hook('HOR_INTERPOL',1,zhook_handle)
!
!-------------------------------------------------------------------------------------
END SUBROUTINE hor_interpol