hor_interpol_conf_proj.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_conf_proj(KLUOUT,PFIELDIN,PFIELDOUT)
!     #################################################################################
!!
!!    PURPOSE
!!    -------
!!
!!    METHOD
!!    ------
!!   
!!    EXTERNAL
!!    --------
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!    AUTHOR
!!    ------
!!
!!    MODIFICATION
!!    ------------
!!
!!    02/04/12 M. Tomasini  Add an index in the second dimension of the ISBA 
!!                          array variables for BILIN interpolation routine to 
!!                          not bug in case 2D (this is not the more beautiful
!!                          method; the BILIN routine should better be adapted)
!!                          Search  ! Ajout MT
!-------------------------------------------------------------------------------
!
!
USE modd_prep,           ONLY : xlat_out, xlon_out, linterp
USE modd_grid_conf_proj, ONLY : xx, xy, nx, ny, xlat0, xlon0, xlatori, &
                                  xlonori, xrpk, xbeta  
USE modd_surf_par,   ONLY : xundef
!
USE mode_gridtype_conf_proj
USE modi_bilin
!
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1    declarations of arguments
!
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
!
REAL, DIMENSION(:), ALLOCATABLE :: zx,zy        !   coordinate of the output field
REAL, DIMENSION(:), ALLOCATABLE :: zx_duplique  ! X coordinate of the output field  ! Ajout MT
REAL, DIMENSION(:), ALLOCATABLE :: zy_duplique  ! Y coordinate of the output field  ! Ajout MT
REAL, DIMENSION(:), ALLOCATABLE :: zxy_duplique ! Y coordinate of the  input field  ! Ajout MT 
REAL, DIMENSION(:,:,:), ALLOCATABLE :: zfieldin           ! input field
REAL, DIMENSION(:,:,:), ALLOCATABLE :: zfieldin_duplique  ! input field               ! Ajout MT
REAL, DIMENSION(:,:),   ALLOCATABLE :: zfieldout_duplique ! interpolated output field ! Ajout MT
!
INTEGER                           :: ino      ! output number of points
INTEGER                         :: ji,jj,jl     ! loop index
!
REAL(KIND=JPRB) :: zhook_handle
!
LOGICAL, DIMENSION(:), ALLOCATABLE :: ginterp_duplique ! .true. where physical value is needed ! Ajout MT
!-------------------------------------------------------------------------------------
!
!*      1.    Allocations
!
IF (lhook) CALL dr_hook('HOR_INTERPOL_CONF_PROJ',0,zhook_handle)
ino = SIZE(xlat_out)
!
ALLOCATE(zx(ino))
ALLOCATE(zy(ino))
!
IF (ny==1) THEN                         ! Ajout MT
   ALLOCATE(zxy_duplique(2),zfieldin_duplique(nx,2,SIZE(pfieldin,2))) 
   ALLOCATE(zx_duplique(2*ino),zy_duplique(2*ino),zfieldout_duplique(2*ino,SIZE(pfieldin,2)))    
   ALLOCATE(ginterp_duplique(SIZE(zfieldout_duplique,1)))    
END IF
!
!*      2.    Transformation of latitudes/longitudes into metric coordinates of output grid
!
 CALL xy_conf_proj(xlat0,xlon0,xrpk,xbeta,xlatori,xlonori, &
                    zx,zy,xlat_out,xlon_out          )  
!
!*      3.    Put input field on its squared grid
!
ALLOCATE(zfieldin(nx,ny,SIZE(pfieldin,2)))
!
DO jj=1,ny
  DO ji=1,nx
    zfieldin(ji,jj,:) = pfieldin(ji+nx*(jj-1),:)
  END DO
END DO
!
IF (ny==1) THEN                  ! Ajout MT
   zfieldin_duplique(:,1,:)=zfieldin(:,1,:)
   zfieldin_duplique(:,2,:)=zfieldin(:,1,:)
   zxy_duplique(1)=xy(1)
   zxy_duplique(2)=xy(1)+10000.
   zx_duplique(1:ino)      =zx(:)
   zx_duplique(ino+1:2*ino)=zx(:)
   zy_duplique(1:ino)      =zy(:)
   zy_duplique(ino+1:2*ino)=zy(:)+10000.
   ginterp_duplique(1:ino)      =linterp(1:ino)
   ginterp_duplique(ino+1:2*ino)=linterp(1:ino)
END IF
!
!*      4.    Interpolation with bilinear
!
IF (ny==1) THEN                  ! Ajout MT
   DO jl=1,SIZE(pfieldin,2)
       CALL bilin(kluout,xx,zxy_duplique,zfieldin_duplique(:,:,jl), &
             zx_duplique,zy_duplique,zfieldout_duplique(:,jl),ginterp_duplique)

       pfieldout(1:ino,jl)=zfieldout_duplique(1:ino,jl)
   END DO
ELSE
   DO jl=1,SIZE(pfieldin,2)
      CALL bilin(kluout,xx,xy,zfieldin(:,:,jl),zx,zy,pfieldout(:,jl),linterp)
   END DO
END IF
!
!
!*      5.    Deallocations
!
!
DEALLOCATE(zx,zy)
DEALLOCATE(zfieldin)
IF (ny==1) DEALLOCATE(zxy_duplique,zx_duplique,zy_duplique,       &
               zfieldin_duplique,zfieldout_duplique,ginterp_duplique) ! Ajout MT
!
IF (lhook) CALL dr_hook('HOR_INTERPOL_CONF_PROJ',1,zhook_handle)
!
!-------------------------------------------------------------------------------------
END SUBROUTINE hor_interpol_conf_proj