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 (DGU, U, &
                             hprogram,hgrid,pgrid_par,plat,plon,pmesh_size,kresp,pdir,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
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
!
!
USE modd_diag_surf_atm_n, ONLY : diag_surf_atm_t
USE modd_surf_atm_n, ONLY : surf_atm_t
!
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
!              -------------------------
!
!
TYPE(diag_surf_atm_t), INTENT(INOUT) :: dgu
TYPE(surf_atm_t), INTENT(INOUT) :: u
!
 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
REAL, DIMENSION(:), INTENT(IN) , OPTIONAL :: pdir ! heading of main axis of grid compared to North (degrees)
 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)
ycomment='GRID TYPE'
 CALL write_surf(dgu, u, &
                 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(DGU, U, &
                                  HPROGRAM,SIZE(PLAT),SIZE(PGRID_PAR),PGRID_PAR(:),KRESP,YDIR)
  CASE("CARTESIAN ")
    CALL WRITE_GRIDTYPE_CARTESIAN(DGU, U, &
                                  HPROGRAM,SIZE(PLAT),SIZE(PGRID_PAR),PGRID_PAR(:),KRESP,YDIR)
  CASE("LONLAT REG")
    CALL WRITE_GRIDTYPE_LONLAT_REG(DGU, U, &
                                   HPROGRAM,SIZE(PLAT),SIZE(PGRID_PAR),PGRID_PAR(:),KRESP)
  CASE("GAUSS     ")
    CALL WRITE_GRIDTYPE_GAUSS(DGU, U, &
                              HPROGRAM,SIZE(PLAT),SIZE(PGRID_PAR),PGRID_PAR(:),KRESP)
  CASE("IGN       ")
    CALL WRITE_GRIDTYPE_IGN(DGU, U, &
                            HPROGRAM,SIZE(PLAT),SIZE(PGRID_PAR),PGRID_PAR(:),KRESP)
  CASE("LONLATVAL ")
    CALL WRITE_GRIDTYPE_LONLATVAL(DGU, U, &
                                  HPROGRAM,SIZE(PLAT),SIZE(PGRID_PAR),PGRID_PAR(:),KRESP)
  CASE("LONLAT ROT")
    CALL WRITE_GRIDTYPE_LONLAT_ROT(DGU, U, &
                                   HPROGRAM,SIZE(PLAT),SIZE(PGRID_PAR),PGRID_PAR(:),KRESP)
  CASE("NONE      ")
    YCOMMENT='lon(degrees)'
    CALL WRITE_SURF(DGU, U, &
                 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(DGU, U, &
                 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(DGU, U, &
                 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