write_grid.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 write_grid (HSELECT,HPROGRAM,HGRID,PGRID_PAR,PLAT,PLON,PMESH_SIZE,KRESP,HDIR)
!     #########################################
!
!!****  *WRITE_GRID* - routine to write the horizontal grid of a scheme
!!
!!    PURPOSE
!!    -------
!!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!      V. Masson   *Meteo France*
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    01/2004 
!!      P. Samuelsson SMHI  12/2012  Rotated lonlat
!!      S. Senesi    08/15  Adapt to XIOS (non-sensical in that case => return immediately)
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
!
USE modi_write_surf
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE modi_write_gridtype_cartesian
!
USE modi_write_gridtype_conf_proj
!
USE modi_write_gridtype_gauss
!
USE modi_write_gridtype_ign
!
USE modi_write_gridtype_lonlat_reg
!
USE modi_write_gridtype_lonlatval
!
USE modi_write_gridtype_lonlat_rot
IMPLICIT NONE
!
!*       0.1   Declarations of arguments
!              -------------------------
!
 CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
!
 CHARACTER(LEN=6),   INTENT(IN)  :: HPROGRAM   ! calling program
 CHARACTER(LEN=10),  INTENT(IN)  :: HGRID      ! type of horizontal grid
REAL, DIMENSION(:), POINTER     :: PGRID_PAR  ! parameters defining this grid
REAL, DIMENSION(:), INTENT(IN)  :: PLAT       ! latitude  (degrees)
REAL, DIMENSION(:), INTENT(IN)  :: PLON       ! longitude (degrees)
REAL, DIMENSION(:), INTENT(IN)  :: PMESH_SIZE ! horizontal mesh size (m2)
INTEGER,            INTENT(OUT) :: KRESP      ! error return code
 CHARACTER(LEN=1),    INTENT(IN), OPTIONAL :: HDIR ! type of field :
                                                  ! 'H' : field with
                                                  !       horizontal spatial dim.
                                                  ! 'A' : (complete) field with
                                                  !       horizontal spatial dim.
                                                  ! '-' : no horizontal dim.
!
!*       0.2   Declarations of local variables
!              -------------------------------
!
 CHARACTER(LEN=100) :: YCOMMENT
 CHARACTER(LEN=1) :: YDIR
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!---------------------------------------------------------------------------
!
!*       1.    Write type of grid
!              ------------------
!
IF (lhook) CALL dr_hook('WRITE_GRID',0,zhook_handle)
!
IF (trim(hprogram) == 'XIOS') THEN 
  IF (lhook) CALL dr_hook('WRITE_GRID',1,zhook_handle)
  RETURN
ENDIF
!
ycomment='GRID TYPE'
 CALL write_surf(hselect, hprogram,'GRID_TYPE',hgrid,kresp,ycomment)
!
!---------------------------------------------------------------------------
!
!*       2.    Write parameters of the grid
!              ----------------------------
!
ydir='h'
IF (PRESENT(HDIR)) YDIR = HDIR
!
SELECT CASE (HGRID)
  CASE("CONF PROJ ")
    CALL WRITE_GRIDTYPE_CONF_PROJ(HSELECT, HPROGRAM,SIZE(PLAT),SIZE(PGRID_PAR),PGRID_PAR(:),KRESP,YDIR)
  CASE("CARTESIAN ")
    CALL WRITE_GRIDTYPE_CARTESIAN(HSELECT, HPROGRAM,SIZE(PLAT),SIZE(PGRID_PAR),PGRID_PAR(:),KRESP,YDIR)
  CASE("LONLAT REG")
    CALL WRITE_GRIDTYPE_LONLAT_REG(HSELECT, HPROGRAM,SIZE(PLAT),SIZE(PGRID_PAR),PGRID_PAR(:),KRESP)
  CASE("GAUSS     ")
    CALL WRITE_GRIDTYPE_GAUSS(HSELECT, HPROGRAM,SIZE(PLAT),SIZE(PGRID_PAR),PGRID_PAR(:),KRESP)
  CASE("IGN       ")
    CALL WRITE_GRIDTYPE_IGN(HSELECT, HPROGRAM,SIZE(PLAT),SIZE(PGRID_PAR),PGRID_PAR(:),KRESP)
  CASE("LONLATVAL ")
    CALL WRITE_GRIDTYPE_LONLATVAL(HSELECT, HPROGRAM,SIZE(PLAT),SIZE(PGRID_PAR),PGRID_PAR(:),KRESP)
  CASE("LONLAT ROT")
    CALL WRITE_GRIDTYPE_LONLAT_ROT(HSELECT, HPROGRAM,SIZE(PLAT),SIZE(PGRID_PAR),PGRID_PAR(:),KRESP)
  CASE("NONE      ")
    YCOMMENT='lon(degrees)'
    CALL WRITE_SURF(HSELECT, HPROGRAM,'lon',      PLON,KRESP,YCOMMENT)
.AND.    IF (KRESP/=0  LHOOK) CALL DR_HOOK('write_grid',1,ZHOOK_HANDLE)
    IF (KRESP/=0) RETURN
    YCOMMENT='lat(degrees)'
    CALL WRITE_SURF(HSELECT,  HPROGRAM,'lat',      PLAT,KRESP,YCOMMENT)
.AND.    IF (KRESP/=0  LHOOK) CALL DR_HOOK('write_grid',1,ZHOOK_HANDLE)
    IF (KRESP/=0) RETURN
    YCOMMENT='mesh SIZE (m2)'
    CALL WRITE_SURF(HSELECT, HPROGRAM,'mesh_size',PMESH_SIZE,KRESP,YCOMMENT)
.AND.    IF (KRESP/=0  LHOOK) CALL DR_HOOK('write_grid',1,ZHOOK_HANDLE)
    IF (KRESP/=0) RETURN
END SELECT
IF (LHOOK) CALL DR_HOOK('write_grid',1,ZHOOK_HANDLE)
!
!---------------------------------------------------------------------------
!
END SUBROUTINE WRITE_GRID