get_grid_coord.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 get_grid_coord (UG, U, &
                                 kluout,px,py,kl,hgrid,pgrid_par)
!     #######################################
!!
!!    PURPOSE
!!    -------
!!     Gets the coordinates of all points in the natural system of each projection
!!
!!    METHOD
!!    ------
!!   
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!
!!    REFERENCE
!!    ---------
!!
!!    AUTHOR
!!    ------
!!
!!    V. Masson                   Meteo-France
!!
!!    MODIFICATION
!!    ------------
!!
!!    Original     01/2004
!!                 10/2007  E. Martin  IGN Grid
!!                 10/2014  P. Samuelsson SMHI Rotated lonlat
!----------------------------------------------------------------------------
!
!*    0.     DECLARATION
!            -----------
!
!
!
!
USE modd_surf_atm_grid_n, ONLY : surf_atm_grid_t
USE modd_surf_atm_n, ONLY : surf_atm_t
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE modi_abor1_sfx
!
USE modi_get_grid_coord_cartesian
!
USE modi_get_grid_coord_conf_proj
!
USE modi_get_grid_coord_gauss
!
USE modi_get_grid_coord_ign
!
USE modi_get_grid_coord_lonlat_reg
!
USE modi_get_grid_coord_lonlatval
!
USE modi_get_grid_coord_lonlat_rot
IMPLICIT NONE
!
!*    0.1    Declaration of dummy arguments
!            ------------------------------
!
!
TYPE(surf_atm_grid_t), INTENT(INOUT) :: ug
TYPE(surf_atm_t), INTENT(INOUT) :: u
!
INTEGER,                      INTENT(IN)  :: kluout ! output listing logical unit
REAL, DIMENSION(:), OPTIONAL, INTENT(OUT) :: px     ! X natural coordinate in the projection
REAL, DIMENSION(:), OPTIONAL, INTENT(OUT) :: py     ! X natural coordinate in the projection
INTEGER,            OPTIONAL, INTENT(IN)  :: kl         ! number of points
 CHARACTER(LEN=10),  OPTIONAL, INTENT(IN)  :: hgrid      ! grid type
REAL, DIMENSION(:), OPTIONAL, POINTER     :: pgrid_par  ! parameters defining this grid
!
!
!*    0.2    Declaration of local variables
!            ------------------------------
!
REAL, DIMENSION(:), ALLOCATABLE :: zx
REAL, DIMENSION(:), ALLOCATABLE :: zy
!
 CHARACTER(LEN=10)           :: ygrid
REAL, DIMENSION(:), ALLOCATABLE :: zgrid_par
INTEGER                     :: igrid_par
INTEGER                     :: il
REAL(KIND=JPRB) :: zhook_handle
!------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('GET_GRID_COORD',0,zhook_handle)
IF (present(hgrid)) THEN
  ygrid = hgrid
  igrid_par = SIZE(pgrid_par)
  il = kl
  ALLOCATE(zgrid_par(igrid_par))
  zgrid_par = pgrid_par
ELSE
  ygrid = ug%CGRID
  igrid_par = ug%NGRID_PAR
  il = u%NSIZE_FULL
  ALLOCATE(zgrid_par(igrid_par))
  zgrid_par = ug%XGRID_PAR
END IF
!
ALLOCATE(zx(il))
ALLOCATE(zy(il))
!
!
SELECT CASE (ygrid)
!
!*    1.      Conformal projection grid
!             -------------------------
!
      CASE ('CONF PROJ ')
        CALL get_grid_coord_conf_proj(igrid_par,il,zgrid_par,zx,zy)
        ! note that all points of the grid will be kept, whatever the surface
        ! type under consideration (e.g. sea points will be kept even for
        ! initialization of continents)
        !
!
!*    2.      Regular latlon grid
!             -------------------
!
      CASE ('LONLAT REG')
        CALL get_grid_coord_lonlat_reg(igrid_par,il,zgrid_par,zx,zy)

!
!*    3.      Cartesian grid
!             --------------
!
      CASE ('CARTESIAN ')
        CALL get_grid_coord_cartesian(igrid_par,il,zgrid_par,zx,zy)
        ! note that all points of the grid will be kept, whatever the surface
        ! type under consideration (e.g. sea points will be kept even for
        ! initialization of continents)
        !
!
!*    4.      Gaussian grid
!             -------------
!
      CASE ('GAUSS     ')
        CALL get_grid_coord_gauss(igrid_par,il,zgrid_par,zx,zy)
!
!*    5.      IGN grid
!             -------------
!
      CASE ('IGN       ')
        CALL get_grid_coord_ign(igrid_par,il,zgrid_par,zx,zy)

!
!*    6.      lonlatval
!             -------------
!
      CASE ('LONLATVAL ')
        CALL get_grid_coord_lonlatval(igrid_par,il,zgrid_par,zx,zy)

!
!*    7.      Rotated lonlat grid
!             -------------------
!
      CASE ('LONLAT ROT')
        CALL get_grid_coord_lonlat_rot(igrid_par,il,zgrid_par,zx,zy)

!
!*    8.      Other cases
!             -----------
!
      CASE default
        CALL abor1_sfx('GET_GRID_COORD: GRID TYPE '//ygrid//' NOT SUPPORTED')

END SELECT
!
IF(present(px)) px(:)=zx(:)
IF(present(py)) py(:)=zy(:)
!
DEALLOCATE(zx)
DEALLOCATE(zy)
DEALLOCATE(zgrid_par)
IF (lhook) CALL dr_hook('GET_GRID_COORD',1,zhook_handle)
!-------------------------------------------------------------------------------
!
END SUBROUTINE get_grid_coord